fix usdb, console.pl, sh/dx /p and sh/register
authorDirk Koopman <djk@tobit.co.uk>
Mon, 6 Dec 2021 14:33:55 +0000 (14:33 +0000)
committerDirk Koopman <djk@tobit.co.uk>
Mon, 6 Dec 2021 14:33:55 +0000 (14:33 +0000)
06Nov21=======================================================================
1. Improve console.pl scrolling. Split long lines (eg on announcements.
04Nov21=======================================================================
1. Fix illogicalities in USDB creations and make sure that O_CREAT on tie does
   NOT encounter an existing file to barf about. Even though it shouldn't.
   Thanks Howard WB3FFV.
2. Fixed a typo in show/registered that prevents a list of callsigns being
   searched for. Got rid of some over complex code. Thnake Fabrizio iZ0UIN.
3. Fix long line wrapping in console.pl
03Nov21=======================================================================
1. Move motd and issue files to local_data if not already there.
30Nov21=======================================================================
1. Fix sh/dx with callsigns that have /p or VE/G1TLH in them.
2. Add unset/ak1a, unset/arcluster aliases and some minimal help for UNSET/
   SPIDER, NODE, ARCLUSTER, AKIA and also SET/USER.

15 files changed:
Changes
cmd/Aliases
cmd/Commands_en.hlp
cmd/set/register.pl
cmd/show/dx.pl
cmd/show/registered.pl
cmd/unset/register.pl
connect/gb7tlh
perl/DXUtil.pm
perl/Filter.pm
perl/Messages
perl/SysVar.pm
perl/USDB.pm
perl/cluster.pl
perl/console.pl

diff --git a/Changes b/Changes
index 88901906eba4e0fa7fc438117299f37f5fc3693c..64977c69faa16f6f3a91668ebc6a9b27f81e488a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,18 @@
+06Nov21=======================================================================
+1. Improve console.pl scrolling. Split long lines (eg on announcements.
+04Nov21=======================================================================
+1. Fix illogicalities in USDB creations and make sure that O_CREAT on tie does
+   NOT encounter an existing file to barf about. Even though it shouldn't.
+   Thanks Howard WB3FFV.
+2. Fixed a typo in show/registered that prevents a list of callsigns being
+   searched for. Got rid of some over complex code. Thnake Fabrizio iZ0UIN. 
+3. Fix long line wrapping in console.pl
+03Nov21=======================================================================
+1. Move motd and issue files to local_data if not already there.
+30Nov21=======================================================================
+1. Fix sh/dx with callsigns that have /p or VE/G1TLH in them.
+2. Add unset/ak1a, unset/arcluster aliases and some minimal help for UNSET/
+   SPIDER, NODE, ARCLUSTER, AKIA and also SET/USER.
 26Nov21=======================================================================
 1. *Really* change spot display format and sh/dx format "back the way they
    were. But They won't stay that way for long!!!! There are four (yes, count
 26Nov21=======================================================================
 1. *Really* change spot display format and sh/dx format "back the way they
    were. But They won't stay that way for long!!!! There are four (yes, count
index 59c1255e67dbd429610002c819b96182dbcff84a..f2b9b6acd87b8ffec7cf54c92a237199a43b3d12 100644 (file)
@@ -160,6 +160,9 @@ package CmdAlias;
                  'u' => [
                                  '^uns?e?t?$', 'apropos unset', 'apropos',
                                  '^uns?e?t?/dbg$', 'unset/debug', 'unset/debug',
                  'u' => [
                                  '^uns?e?t?$', 'apropos unset', 'apropos',
                                  '^uns?e?t?/dbg$', 'unset/debug', 'unset/debug',
+                                 '^uns?e?t?/arc', 'set/user', 'set/user',
+                                 '^uns?e?t?/spider$', 'set/user', 'set/user',
+                                 '^uns?e?t?/ak1a$', 'set/user', 'set/user',
                                  '^uns?e?t?/node$', 'set/user', 'set/user',
                                  '^uns?e?t?/sk', 'set/wantrbn none', 'set/wantrbn',
                                 ],
                                  '^uns?e?t?/node$', 'set/user', 'set/user',
                                  '^uns?e?t?/sk', 'set/wantrbn none', 'set/wantrbn',
                                 ],
index c6e38efcbb2e66d753ac770190af1f52efc9cab3..ac67b14f81f6b093482e770a66d19416f354e2c5 100644 (file)
@@ -2033,6 +2033,12 @@ You can remove your startup script with UNSET/STARTUP.
 Tell the system that the call(s) are to be treated as DXSpider node and
 fed new style DX Protocol rather normal user commands.
 
 Tell the system that the call(s) are to be treated as DXSpider node and
 fed new style DX Protocol rather normal user commands.
 
+=== 5^UNSET/SPIDER <call> [<call>..]^Make the callsign a normal user
+=== 5^UNSET/ARCLUSTER <call> [<call>..]^Make the callsign a normal user
+=== 5^UNSET/NODE <call> [<call>..]^Make the callsign a normal user
+=== 5^UNSET/AK1A <call> [<call>..]^Make the callsign a normal user
+=== 5^SET/USER <call> [<call>..]^Make the callsign a normal user
+
 === 0^SET/TALK^Allow TALK messages to come out on your terminal
 === 0^UNSET/TALK^Stop TALK messages coming out on your terminal
 
 === 0^SET/TALK^Allow TALK messages to come out on your terminal
 === 0^UNSET/TALK^Stop TALK messages coming out on your terminal
 
index ac96c2a4f6c40c8329c1542b81eb264ce627a88d..edcf1acd28c917143c0e773ad76f7bcd4d65d88c 100644 (file)
@@ -17,7 +17,7 @@ if ($self->priv < 9) {
        Log('DXCommand', $self->call . " attempted to register @args");
        return (1, $self->msg('e5'));
 }
        Log('DXCommand', $self->call . " attempted to register @args");
        return (1, $self->msg('e5'));
 }
-return (1, $self->msg('reginac')) unless $main::reqreg;
+#return (1, $self->msg('reginac')) unless $main::reqreg;
 
 foreach $call (@args) {
        $call = uc $call;
 
 foreach $call (@args) {
        $call = uc $call;
index a2c81a17055174b7bf952bce35f744d5859c4269..4f71c13e51d69adf01d86e40b3c3e3af405b4fab 100644 (file)
@@ -41,6 +41,8 @@ sub handle
 
        
        dbg("sh/dx list: " . join(" ", @list)) if isdbg('sh/dx');
 
        
        dbg("sh/dx list: " . join(" ", @list)) if isdbg('sh/dx');
+
+#      $DB::single=1;
        
        while (@list) { # next field
                $f = shift @list;
        
        while (@list) { # next field
                $f = shift @list;
index b3f345d96317186b9d58e4ae56d08fc61a375a37..71ed0e38a4609c7b15cbd68827dd54a809b3e9de 100644 (file)
@@ -19,7 +19,7 @@ sub handle
 
        if ($line) {
                $line =~ s/[^\w\-\/]+//g;
 
        if ($line) {
                $line =~ s/[^\w\-\/]+//g;
-               $line = "^\U\Q$line";
+               $line = "\U\Q$line";
        }
 
        if ($self->{_nospawn}) {
        }
 
        if ($self->{_nospawn}) {
@@ -37,35 +37,44 @@ sub generate
        my $line = shift;
        my @out;
        my @val;
        my $line = shift;
        my @out;
        my @val;
-                                                       
+
+#      dbg("set/register line: $line");
+
+       my %call = ();
+       $call{$_} = 1 for split /\s+/, $line;
+       delete $call{'ALL'};
 
        my ($action, $count, $key, $data) = (0,0,0,0);
 
        my ($action, $count, $key, $data) = (0,0,0,0);
-       eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) {
-       if (\$data =~ m{registered}) {                                  
-               if (!\$line || (\$line && \$key =~ /^$line/)) {
-                       my \$u = DXUser::get_current(\$key);
-                       if (\$u && \$u->registered) {
-                               push \@val, \$key;
-                               ++\$count;
+       unless (keys %call) {
+               for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
+                       if ($data =~ m{registered}) {
+                               $call{$key} = 1;       # possible candidate
                        }
                }
        }
                        }
                }
        }
-} };
+
+       foreach $key (sort keys %call) {
+               my $u = DXUser::get_current($key);
+               if ($u && defined (my $r = $u->registered)) {
+                       push @val, "${key}($r)";
+                       ++$count;
+               }
+       }
+
        my @l;
        foreach my $call (@val) {
                if (@l >= 5) {
        my @l;
        foreach my $call (@val) {
                if (@l >= 5) {
-                       push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
+                       push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
                        @l = ();
                }
                push @l, $call;
        }
        if (@l) {
                push @l, "" while @l < 5;
                        @l = ();
                }
                push @l, $call;
        }
        if (@l) {
                push @l, "" while @l < 5;
-               push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
+               push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
        }
 
        }
 
-       push @out, $@ if $@;
-       push @out, , $self->msg('rec', $count);
+       push @out, $self->msg('rec', $count);
        return @out;
        
 }
        return @out;
        
 }
index a0c36d78f7ce299514fa5929f73aaca4920f7ed0..c18ac3c7069f24159b993a8a8bc0620d08f63bf7 100644 (file)
@@ -17,7 +17,7 @@ if ($self->priv < 9) {
        Log('DXCommand', $self->call . " attempted to unregister @args");
        return (1, $self->msg('e5'));
 }
        Log('DXCommand', $self->call . " attempted to unregister @args");
        return (1, $self->msg('e5'));
 }
-return (1, $self->msg('reginac')) unless $main::reqreg;
+#return (1, $self->msg('reginac')) unless $main::reqreg;
 
 foreach $call (@args) {
        $call = uc $call;
 
 foreach $call (@args) {
        $call = uc $call;
index 15b419a33126491b414c333cc437cc09a9670d53..48c45f50273e08b32c4fb4ad6b5bd34f2823a9b8 100644 (file)
@@ -1,8 +1,3 @@
 timeout 15
 timeout 15
-abort (Busy|Sorry|Fail)
-# don't forget to chmod 4775 netrom_call!
-connect ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh-0
-'Connect' ''
-'Connect' 'ak1a'
-'Connect'  ''
-client gb7tlh ax25
+connect telnet dirk7.int.tobit.co.uk 7300
+'ogin:' 'gb7tlh-1'
index 5f5af2ddf415100a9c6bfbe64785644ef3055952..8beb7e51e756f44270b0ddf3cfcbbf4f53792f99 100644 (file)
@@ -280,6 +280,7 @@ sub shellregex
 {
        my $in = shift;
        $in =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
 {
        my $in = shift;
        $in =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
+       $in =~ s|\\/|/|g;
        return '^' . $in . "\$";
 }
 
        return '^' . $in . "\$";
 }
 
index bf19719fd41d9fc3ab7df1635ccf486c1a8df7eb..7119ed13e113a5ca84b05d0c6831a8e1e4b83a61 100644 (file)
@@ -416,7 +416,8 @@ sub parse
        
        # check the line for non legal characters
        dbg("Filter::parse line: '$line'") if isdbg('filter');
        
        # check the line for non legal characters
        dbg("Filter::parse line: '$line'") if isdbg('filter');
-       return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\.:\-\*\/\(\)\$!]/;
+       my @ch = $line =~ m|([^\s\w,_\.:\/\-\*\(\)\$!])|g;
+       return ('ill', $dxchan->msg('e19', join(' ', @ch))) if $line !~ /{.*}/ && @ch;
 
        $line = lc $line;
 
 
        $line = lc $line;
 
index c8381dfc570bb55595f217d3fd2e411ca67ed618..80b4f46df5b41f7d7e9c092acb1cc1522616e58f 100644 (file)
@@ -92,7 +92,7 @@ package DXM;
                                e16 => 'File \"$_[0]\" exists',
                                e17 => 'Please don\'t use the words: @_ on here',
                                e18 => 'Cannot connect to $_[0] ($!)',
                                e16 => 'File \"$_[0]\" exists',
                                e17 => 'Please don\'t use the words: @_ on here',
                                e18 => 'Cannot connect to $_[0] ($!)',
-                               e19 => 'Invalid character in line',
+                               e19 => 'Invalid character(s) in line $_[0]',
                                e20 => qq{token '$_[0]' not recognised},
                                e21 => '$_[0] is not numeric',
                                e22 => '$_[0] is not a callsign',
                                e20 => qq{token '$_[0]' not recognised},
                                e21 => '$_[0] is not numeric',
                                e22 => '$_[0] is not a callsign',
@@ -534,7 +534,7 @@ package DXM;
                                e16 => 'Le fichier \"$_[0]\" existe déjà',
                                e17 => 'Prière de ne pas utiliser les mots : @_ ici !', 
                                e18 => 'Connexion impossible avec $_[0] ($!)',
                                e16 => 'Le fichier \"$_[0]\" existe déjà',
                                e17 => 'Prière de ne pas utiliser les mots : @_ ici !', 
                                e18 => 'Connexion impossible avec $_[0] ($!)',
-                               e19 => 'Caractère non valide dans la ligne',
+                               e19 => 'Caractère non valide dans la ligne $_[0]',
                                e20 => 'Symbole $_[0] non reconnu',
                                e21 => '$_[0] n\'est pas une valeur numérique',
                                e22 => '$_[0] n\'est pas un indicatif',
                                e20 => 'Symbole $_[0] non reconnu',
                                e21 => '$_[0] n\'est pas une valeur numérique',
                                e22 => '$_[0] n\'est pas un indicatif',
@@ -856,7 +856,7 @@ package DXM;
                                e16 => 'El fichero \"$_[0]\" ya existe',
                                e17 => 'Por favor no uses la palabra: @_ aquí',
                                e18 => 'No se puede conectar con $_[0] ($!)',
                                e16 => 'El fichero \"$_[0]\" ya existe',
                                e17 => 'Por favor no uses la palabra: @_ aquí',
                                e18 => 'No se puede conectar con $_[0] ($!)',
-                               e19 => 'Carácter no válido en la línea',
+                               e19 => 'Carácter no válido en la línea $_[0]',
                                e20 => 'Símbolo $_[0] no reconocido',
                                e21 => '$_[0] no es numérico',
                                e22 => '$_[0] no es un indicativo',
                                e20 => 'Símbolo $_[0] no reconocido',
                                e21 => '$_[0] no es numérico',
                                e22 => '$_[0] no es un indicativo',
@@ -1181,7 +1181,7 @@ package DXM;
                                e16 => 'Datei \"$_[0]\" existiert',
                                e17 => 'Bitte gebrauche dieses Wort: @_ nicht hier',
                                e18 => 'Kann nicht verbinden mit $_[0] ($!)',
                                e16 => 'Datei \"$_[0]\" existiert',
                                e17 => 'Bitte gebrauche dieses Wort: @_ nicht hier',
                                e18 => 'Kann nicht verbinden mit $_[0] ($!)',
-                               e19 => 'Ungueltiger Character in der Zeile',
+                               e19 => 'Ungueltiger Character in der Zeile $_[0]',
                                e20 => 'Kuerzel $_[0] nicht erkannt',
                                e21 => '$_[0] nicht numerisch',
                                e22 => '$_[0] kein Rufzeichen',
                                e20 => 'Kuerzel $_[0] nicht erkannt',
                                e21 => '$_[0] nicht numerisch',
                                e22 => '$_[0] kein Rufzeichen',
@@ -1455,7 +1455,7 @@ package DXM;
                                e16 => 'Il file \"$_[0]\" esiste',
                                e17 => 'Non usare le parole: @_ qui', 
                                e18 => 'Impossibile connettere $_[0] ($!)',
                                e16 => 'Il file \"$_[0]\" esiste',
                                e17 => 'Non usare le parole: @_ qui', 
                                e18 => 'Impossibile connettere $_[0] ($!)',
-                               e19 => 'Carattere non valido nella linea',
+                               e19 => 'Carattere non valido nella linea  $_[0]',
                                e20 => 'separatore $_[0] non riconosciuto',
                                e21 => '$_[0] non e\' numerico',
                                e22 => '$_[0] non e\' un nominativo',
                                e20 => 'separatore $_[0] non riconosciuto',
                                e21 => '$_[0] non e\' numerico',
                                e22 => '$_[0] non e\' un nominativo',
@@ -1728,7 +1728,7 @@ package DXM;
                                e16 => 'Soubor \"$_[0]\" uz existuje',
                                e17 => 'Prosim nepouzivej zde toto slovo: @_', 
                                e18 => 'Nemohu se pripojit na $_[0] ($!)',
                                e16 => 'Soubor \"$_[0]\" uz existuje',
                                e17 => 'Prosim nepouzivej zde toto slovo: @_', 
                                e18 => 'Nemohu se pripojit na $_[0] ($!)',
-                               e19 => 'neplatny znak v radku',
+                               e19 => 'neplatny znak v radku  $_[0]',
                                e20 => 'retezec $_0] nebyl rozpoznan',
                                e21 => '$_[0] neni cislo',
                                e22 => '$_[0] neni znacka',
                                e20 => 'retezec $_0] nebyl rozpoznan',
                                e21 => '$_[0] neni cislo',
                                e22 => '$_[0] neni znacka',
@@ -2020,7 +2020,7 @@ package DXM;
                                e16 => 'O ficheiro \"$_[0]\" existe',
                                e17 => 'Por favor no use as palavras: @_ aqui', 
                                e18 => 'No posso ligar a $_[0] ($!)',
                                e16 => 'O ficheiro \"$_[0]\" existe',
                                e17 => 'Por favor no use as palavras: @_ aqui', 
                                e18 => 'No posso ligar a $_[0] ($!)',
-                               e19 => 'Caracter invlido na linha',
+                               e19 => 'Caracter invlido na linha $_[0]',
                                e20 => 'sinal $_[0] no reconhecido',
                                e21 => '$_[0] no  numrico',
                                e22 => '$_[0] no  um indicativo',
                                e20 => 'sinal $_[0] no reconhecido',
                                e21 => '$_[0] no  numrico',
                                e22 => '$_[0] no  um indicativo',
index a45218781f4bfde4fba7675144bbbc6bf6d85141..37da05b232f4301db0f8a84cadb0c94639d17f4b 100644 (file)
@@ -31,4 +31,4 @@ $localcmd = "$root/local_cmd";
 $userfn = "$local_data/users";
 
 # the "message of the day" file
 $userfn = "$local_data/users";
 
 # the "message of the day" file
-$motd = "$local_data/motd";
+$motd = "motd";
index 478763efb534bb511a4e38c5bf056fa9cccc1c59..2ecb8ce015af736d1d923700018698a196aac522 100644 (file)
@@ -10,6 +10,7 @@ package USDB;
 use strict;
 
 use DXVars;
 use strict;
 
 use DXVars;
+use SysVar;
 use DB_File;
 use File::Copy;
 use DXDebug;
 use DB_File;
 use File::Copy;
 use DXDebug;
@@ -120,9 +121,10 @@ sub load
        
        my %dbn;
        if (-e $dbfn ) {
        
        my %dbn;
        if (-e $dbfn ) {
-               copy($dbfn, "$dbfn.new") or return "cannot copy $dbfn -> $dbfn.new $!";
+               copy($dbfn, "$dbfn.old") or return "cannot copy $dbfn -> $dbfn.old $!";
        }
        }
-       
+
+       unlink "$dbfn.new";
        tie %dbn, 'DB_File', "$dbfn.new", O_RDWR|O_CREAT, 0664, $a or return "cannot tie $dbfn.new $!";
        
        # now write away all the files
        tie %dbn, 'DB_File', "$dbfn.new", O_RDWR|O_CREAT, 0664, $a or return "cannot tie $dbfn.new $!";
        
        # now write away all the files
index d4e9981a2e3df54c649d2dbd806139041ef7f316..55e0badbcfd0484abd98606facb4253b00c4f2aa 100755 (executable)
@@ -545,6 +545,12 @@ sub setup_start
                $SIG{__DIE__} = $w;
        }
 
                $SIG{__DIE__} = $w;
        }
 
+       # setup location of motd & issue
+       localdata_mv($motd);
+       $motd = localdata($motd);
+       localdata_mv("issue");
+       
+
        # try to load XML::Simple
        DXXml::init();
 
        # try to load XML::Simple
        DXXml::init();
 
index 14c95bac6b14505493d4891098c1a8b117187b7c..a0cb567175ec7f55b4380626e333311e1216ec6b 100755 (executable)
@@ -13,7 +13,7 @@
 #
 # 
 
 #
 # 
 
-require 5.004;
+require 5.16.1;
 use warnings;
 
 # search local then perl directories
 use warnings;
 
 # search local then perl directories
@@ -132,6 +132,23 @@ sub doresize
        do_initscr();
 
        $inscroll = 0;
        do_initscr();
 
        $inscroll = 0;
+       dbg("resize: l=$lines c=$cols");
+       dbg("resize: sh=". scalar @sh );
+#      my @tsh;
+#      my $t;
+#      while (defined ($t = shift @sh)) {
+#              dbg("t: $t(" , length $t . ')'); 
+#              if ($t =~ /^\t/) {
+#                      $t =~ s/^\t/ /;
+#                      push(@tsh, pop(@tsh) . $t)
+#              } else {
+#                      push(@tsh, $t);
+#              }
+#              dbg("tsh: " . scalar @tsh);
+#      }
+#      dbg("resize: tsh=". scalar @tsh );
+#      $spos = @tsh < $pagel ? 0 :  @tsh - $pagel;
+       #       addtotop(@tsh);
        $spos = @sh < $pagel ? 0 :  @sh - $pagel;
        show_screen();
        $conn->send_later("C$call|$cols") if $conn;
        $spos = @sh < $pagel ? 0 :  @sh - $pagel;
        show_screen();
        $conn->send_later("C$call|$cols") if $conn;
@@ -452,13 +469,18 @@ sub rec_stdin
 # add a line to the end of the top screen
 sub addtotop
 {
 # add a line to the end of the top screen
 sub addtotop
 {
+       $Text::Wrap::Columns = $cols;
        while (@_) {
                my $inbuf = shift;
                my $l = length $inbuf;
        while (@_) {
                my $inbuf = shift;
                my $l = length $inbuf;
+               dbg("addtotop: $l $inbuf");
                if ($l > $cols) {
                if ($l > $cols) {
-#                      $Text::Wrap::Columns = $cols;
-#                      push @sh, wrap('',"\t", $inbuf);
-                       push @sh, $inbuf;
+                       $inbuf =~ s/\s+/ /g;
+                       if (length $inbuf > $cols) {
+                               push @sh, split /\n/, wrap('',' ' x 19, $inbuf);
+                       } else {
+                               push @sh, $inbuf;
+                       }
                } else {
                        push @sh, $inbuf;
                }
                } else {
                        push @sh, $inbuf;
                }
@@ -552,7 +574,7 @@ sub on_disconnect
 while (@ARGV && $ARGV[0] =~ /^-/) {
        my $arg = shift;
        if ($arg eq '-x') {
 while (@ARGV && $ARGV[0] =~ /^-/) {
        my $arg = shift;
        if ($arg eq '-x') {
-               dbginit();
+               dbginit('console');
                dbgadd('console');
                $maxshist = 200;
        }
                dbgadd('console');
                $maxshist = 200;
        }
@@ -581,7 +603,9 @@ unless ($DB::VERSION) {
 
 $SIG{'HUP'} = \&sig_term;
 
 
 $SIG{'HUP'} = \&sig_term;
 
-# start up
+
+# start upb
+$Text::Wrap::Columns = $cols;
 doresize();
 
 $SIG{__DIE__} = \&sig_term;
 doresize();
 
 $SIG{__DIE__} = \&sig_term;