]> dxcluster.net Git - spider.git/commitdiff
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
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',
+                                 '^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',
                                 ],
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.
 
+=== 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
 
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'));
 }
-return (1, $self->msg('reginac')) unless $main::reqreg;
+#return (1, $self->msg('reginac')) unless $main::reqreg;
 
 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');
+
+#      $DB::single=1;
        
        while (@list) { # next field
                $f = shift @list;
index b3f345d96317186b9d58e4ae56d08fc61a375a37..71ed0e38a4609c7b15cbd68827dd54a809b3e9de 100644 (file)
@@ -19,7 +19,7 @@ sub handle
 
        if ($line) {
                $line =~ s/[^\w\-\/]+//g;
-               $line = "^\U\Q$line";
+               $line = "\U\Q$line";
        }
 
        if ($self->{_nospawn}) {
@@ -37,35 +37,44 @@ sub generate
        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);
-       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) {
-                       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;
-               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;
        
 }
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'));
 }
-return (1, $self->msg('reginac')) unless $main::reqreg;
+#return (1, $self->msg('reginac')) unless $main::reqreg;
 
 foreach $call (@args) {
        $call = uc $call;
index 15b419a33126491b414c333cc437cc09a9670d53..48c45f50273e08b32c4fb4ad6b5bd34f2823a9b8 100644 (file)
@@ -1,8 +1,3 @@
 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;
+       $in =~ s|\\/|/|g;
        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');
-       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;
 
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] ($!)',
-                               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',
@@ -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] ($!)',
-                               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',
@@ -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] ($!)',
-                               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',
@@ -1181,7 +1181,7 @@ package DXM;
                                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',
@@ -1455,7 +1455,7 @@ package DXM;
                                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',
@@ -1728,7 +1728,7 @@ package DXM;
                                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',
@@ -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] ($!)',
-                               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',
index a45218781f4bfde4fba7675144bbbc6bf6d85141..37da05b232f4301db0f8a84cadb0c94639d17f4b 100644 (file)
@@ -31,4 +31,4 @@ $localcmd = "$root/local_cmd";
 $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 SysVar;
 use DB_File;
 use File::Copy;
 use DXDebug;
@@ -120,9 +121,10 @@ sub load
        
        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
index d4e9981a2e3df54c649d2dbd806139041ef7f316..55e0badbcfd0484abd98606facb4253b00c4f2aa 100755 (executable)
@@ -545,6 +545,12 @@ sub setup_start
                $SIG{__DIE__} = $w;
        }
 
+       # setup location of motd & issue
+       localdata_mv($motd);
+       $motd = localdata($motd);
+       localdata_mv("issue");
+       
+
        # 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
@@ -132,6 +132,23 @@ sub doresize
        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;
@@ -452,13 +469,18 @@ sub rec_stdin
 # add a line to the end of the top screen
 sub addtotop
 {
+       $Text::Wrap::Columns = $cols;
        while (@_) {
                my $inbuf = shift;
                my $l = length $inbuf;
+               dbg("addtotop: $l $inbuf");
                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;
                }
@@ -552,7 +574,7 @@ sub on_disconnect
 while (@ARGV && $ARGV[0] =~ /^-/) {
        my $arg = shift;
        if ($arg eq '-x') {
-               dbginit();
+               dbginit('console');
                dbgadd('console');
                $maxshist = 200;
        }
@@ -581,7 +603,9 @@ unless ($DB::VERSION) {
 
 $SIG{'HUP'} = \&sig_term;
 
-# start up
+
+# start upb
+$Text::Wrap::Columns = $cols;
 doresize();
 
 $SIG{__DIE__} = \&sig_term;