From cafedfc0df4b2c519a8227e091f746a44af07ce2 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Mon, 6 Dec 2021 14:33:55 +0000 Subject: [PATCH] fix usdb, console.pl, sh/dx /p and sh/register 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. --- Changes | 15 +++++++++++++++ cmd/Aliases | 3 +++ cmd/Commands_en.hlp | 6 ++++++ cmd/set/register.pl | 2 +- cmd/show/dx.pl | 2 ++ cmd/show/registered.pl | 37 +++++++++++++++++++++++-------------- cmd/unset/register.pl | 2 +- connect/gb7tlh | 9 ++------- perl/DXUtil.pm | 1 + perl/Filter.pm | 3 ++- perl/Messages | 14 +++++++------- perl/SysVar.pm | 2 +- perl/USDB.pm | 6 ++++-- perl/cluster.pl | 6 ++++++ perl/console.pl | 36 ++++++++++++++++++++++++++++++------ 15 files changed, 104 insertions(+), 40 deletions(-) diff --git a/Changes b/Changes index 88901906..64977c69 100644 --- 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 diff --git a/cmd/Aliases b/cmd/Aliases index 59c1255e..f2b9b6ac 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -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', ], diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index c6e38efc..ac67b14f 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -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 [..]^Make the callsign a normal user +=== 5^UNSET/ARCLUSTER [..]^Make the callsign a normal user +=== 5^UNSET/NODE [..]^Make the callsign a normal user +=== 5^UNSET/AK1A [..]^Make the callsign a normal user +=== 5^SET/USER [..]^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 diff --git a/cmd/set/register.pl b/cmd/set/register.pl index ac96c2a4..edcf1acd 100644 --- a/cmd/set/register.pl +++ b/cmd/set/register.pl @@ -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; diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index a2c81a17..4f71c13e 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -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; diff --git a/cmd/show/registered.pl b/cmd/show/registered.pl index b3f345d9..71ed0e38 100644 --- a/cmd/show/registered.pl +++ b/cmd/show/registered.pl @@ -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; } diff --git a/cmd/unset/register.pl b/cmd/unset/register.pl index a0c36d78..c18ac3c7 100644 --- a/cmd/unset/register.pl +++ b/cmd/unset/register.pl @@ -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; diff --git a/connect/gb7tlh b/connect/gb7tlh index 15b419a3..48c45f50 100644 --- a/connect/gb7tlh +++ b/connect/gb7tlh @@ -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' diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 5f5af2dd..8beb7e51 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -280,6 +280,7 @@ sub shellregex { my $in = shift; $in =~ s{(.)} { $patmap{$1} || "\Q$1" }ge; + $in =~ s|\\/|/|g; return '^' . $in . "\$"; } diff --git a/perl/Filter.pm b/perl/Filter.pm index bf19719f..7119ed13 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -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; diff --git a/perl/Messages b/perl/Messages index c8381dfc..80b4f46d 100644 --- a/perl/Messages +++ b/perl/Messages @@ -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', diff --git a/perl/SysVar.pm b/perl/SysVar.pm index a4521878..37da05b2 100644 --- a/perl/SysVar.pm +++ b/perl/SysVar.pm @@ -31,4 +31,4 @@ $localcmd = "$root/local_cmd"; $userfn = "$local_data/users"; # the "message of the day" file -$motd = "$local_data/motd"; +$motd = "motd"; diff --git a/perl/USDB.pm b/perl/USDB.pm index 478763ef..2ecb8ce0 100644 --- a/perl/USDB.pm +++ b/perl/USDB.pm @@ -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 diff --git a/perl/cluster.pl b/perl/cluster.pl index d4e9981a..55e0badb 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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(); diff --git a/perl/console.pl b/perl/console.pl index 14c95bac..a0cb5671 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -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; -- 2.34.1