Fix create_sysop.pl to work on base git install
authorDirk Koopman <djk@tobit.co.uk>
Wed, 24 Nov 2021 20:45:38 +0000 (20:45 +0000)
committerDirk Koopman <djk@tobit.co.uk>
Wed, 24 Nov 2021 20:45:38 +0000 (20:45 +0000)
Changes
cmd/dx.pl
cmd/set/width.pl
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXProt.pm
perl/DXProtHandle.pm
perl/DXUser.pm
perl/Filter.pm

diff --git a/Changes b/Changes
index 9d9bed6e53e82f6c27f3cad3a19abbb5c9e02d97..2a0b26c8b02b964e71018388ba55418732684745 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,7 @@
+24Nov21=======================================================================
+1. Make /spider/perl/create_sysop.pl work on a base git cloned tree.
+2. Add /spider/local /spider/local_cmd /spider/local_data to git. 
+3. Make user supplied console width (set/width) sticky.
 19Nov21=======================================================================
 1. Add the ability of console.pl to resize and have dx spots also resize so
    that the comment field's size will increase accordingly. Sh/dx amd sh/mydx
index 919a34c08f16b8d2a195c3df7fe773e114ca892a..c18a2df372f9d7751e8df8adcc7182a611b8ab64 100644 (file)
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -156,11 +156,15 @@ if ($freq =~ /^69/ || $localonly) {
                Spot::add(@spot);
 
                # send orf to the users
+               my $spot;
+
                if ($ipaddr) {
-                       DXProt::send_dx_spot($self, DXProt::pc61($spotter, $freq, $spotted, $line, $ipaddr), @spot);
+                       $spot = DXProt::pc61($spotter, $freq, $spotted, $line, $ipaddr);
                } else {
-                       DXProt::send_dx_spot($self, DXProt::pc11($spotter, $freq, $spotted, $line), @spot);
+                       $spot = DXProt::pc11($spotter, $freq, $spotted, $line);
                }
+
+               DXProt::send_dx_spot($self, $spot, @spot);
        }
 }
 
index 5575fe3be3099a861e766455259be8c2b96e91f7..27620c2cb4fc0fc1ac06a7eb91d875d8fbdfdbba 100644 (file)
@@ -9,4 +9,5 @@ my $self = shift;
 my $l = shift;
 $l = 80 if $l < 80;
 $self->width($l);
+$self->user->width($l);
 return (1, $self->msg('pagewidth', $l));
index 2d43b0f07cae85dc472abeb4f01ec307847fb6fc..f5fc6eb26c4f792b6ff50acb08051ef2aa3df652 100644 (file)
@@ -128,6 +128,8 @@ $count = 0;
                  next_pc92_update => '9,Next PC92 Update,atime',
                  next_pc92_keepalive => '9,Next PC92 KeepAlive,atime',
                  hostname => '0,Hostname',
+                 isslugged => '9,Still Slugged,yesno',
+                 sluggedpcs => '9,Slugged PCxx Queue,parray',
                 );
 
 $maxerrors = 20;                               # the maximum number of concurrent errors allowed before disconnection
@@ -162,13 +164,14 @@ sub alloc
                $user->new_buddies unless $user->buddies;
                $self->{group} = $user->group;
                $self->{sort} = $user->sort;
+               $self->{width} = $user->width;
        }
        $self->{startt} = $self->{t} = $main::systime;
        $self->{state} = 0;
        $self->{oldstate} = 0;
        $self->{lang} = $main::lang if !$self->{lang};
        $self->{func} = "";
-       $self->{width} = 80;
+       $self->{width} ||=  80;
 
        # add in all the dxcc, itu, zone info
        my @dxcc = Prefix::extract($call);
index 051332b03b75c8f85ff9e32d75dbe23755a25f0d..b10149ec6bcbd9bcf75b27e8839898878c21dd41 100644 (file)
@@ -155,6 +155,10 @@ sub start
                $self->{registered} = 1;
        }
 
+       # establish slug queue, if required
+       $self->{sluggedpc11s} = [];
+       $self->{isslugged} = $DXProt::pc92_slug_changes + $main::systime if $DXProt::pc92_slug_changes;
+
        # send the relevant MOTD
        $self->send_motd;
 
@@ -1001,6 +1005,7 @@ sub format_dx_spot
        
        my $comment = substr (($_[3] || ''), 0, $clth);
        $comment =~ s/\t/ /g;
+       
        $comment .= ' ' x ($clth - (length($comment)));
        
     if ($self->{user}->wantgrid) {
index bd317de470d6441e5969edf0d853614db7a913fe..f8e60b201cc809744da179708fe8a84b9fbe288b 100644 (file)
@@ -537,6 +537,8 @@ sub process
        if ($main::systime - 3600 > $last_hour) {
                $last_hour = $main::systime;
        }
+
+    pc11_process();
 }
 
 #
index c0711ceee0820cecb59d484971a730c502a763e6..c4344339f16131424117c3e1d36f6f6f9fbe5af4 100644 (file)
@@ -49,11 +49,11 @@ use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restim
 
 $pc9x_dupe_age = 60;                   # catch loops of circular (usually) D records
 $pc10_dupe_age = 45;                   # just something to catch duplicate PC10->PC93 conversions
-$pc92_slug_changes = 60*5;             # slug any changes going outward for this long
+$pc92_slug_changes = 60*1;             # slug any changes going outward for this long
 $last_pc92_slug = 0;                   # the last time we sent out any delayed add or del PC92s
 $pc9x_time_tolerance = 15*60;  # the time on a pc9x is allowed to be out by this amount
 $pc9x_past_age = (122*60)+             # maximum age in the past of a px9x (a config record might be the only
-       $pc9x_time_tolerance;           # thing a node might send - once an hour and we allow an extra hour for luck)
+$pc9x_time_tolerance;           # thing a node might send - once an hour and we allow an extra hour for luck)
                                 # this is actually the partition between "yesterday" and "today" but old.
 
 $pc92filterdef = bless ([
@@ -65,6 +65,10 @@ $pc92filterdef = bless ([
                          ['zone', 'nz', 3],
                         ], 'Filter::Cmd');
 
+our %pc11q;
+# this is a place to park an incoming PC11 in the sure and certain hope that
+# a PC61 will be along soon. This has the side benefit that it will delay a
+# a PC11 for one second - assuming that it is not removed by a PC61 version
 
 # incoming talk commands
 sub handle_10
@@ -125,6 +129,8 @@ sub handle_10
        $main::me->normal(pc93($to, $from, $via, $pc->[3], $pc->[6]));
 }
 
+my $last;
+
 # DX Spot handling
 sub handle_11
 {
@@ -204,6 +210,7 @@ sub handle_11
        }
 
        my @spot = Spot::prepare($pc->[1], $pc->[2], $d, $pc->[5], $nossid, $pc->[7], $pc->[8]);
+
        # global spot filtering on INPUT
        if ($self->{inspotsfilter}) {
                my ($filter, $hops) = $self->{inspotsfilter}->it(@spot);
@@ -213,14 +220,60 @@ sub handle_11
                }
        }
 
+       # If is a new PC11, store it, releasing the one that is there (if any),
+       # if a PC61 comes along then dump the stored PC11
+       # If there is a different PC11 stored, release that one and store this PC11 instead,
+       my $key = join '|', @spot[0..2,4,7];
+       if (0) {
+       
+       if ($pc->[0] eq 'PC11') {
+               my $r = [$main::systime, $key, \@spot, $line, $origin, $pc];
+               if (!$last) {
+                       $last = [$main::systime, $key, \@spot, $line, $origin, $pc];
+                       dbg("PC11: $origin -> $key stored") if isdbg('pc11');
+                       return;
+               } elsif ($key eq $last->[1]) { # same as last one
+                       dbg("PC11: $origin -> $key dupe dropped") if isdbg('pc11');
+                       return;
+               } else {
+                       # it's a different PC11, kick the stored one onward and store this one instead,
+                       dbg("PC11: PC11 new $origin -> $key stored, $last->[4] -> $last->[1] passed onward") if isdbg('pc11');
+                       @spot = @{$last->[2]};
+                       $line = $last->[3];
+                       $origin = $last->[4];
+                       $pc = $last->[5];
+                       $last = $r;
+               }
+       } elsif ($pc->[0] eq 'PC61') {
+               if ($last) {
+                       if ($last->[1] eq $key) {
+                               # dump $last and proceed with the PC61
+                               dbg("PC11: $origin -> $key dropped in favour of PC61") if isdbg('pc11');
+                               undef $last;
+                       } else {
+                               # it's a different spot send out stored pc11
+                               dbg("PC11: last $last->[4] -> $last->[1] different PC61 $origin -> $key, send PC11 first ") if isdbg('pc11');
+                               $last->[1] = 'new pc61';
+                               handle_11($self, 11, $last->[3], $last->[4], $last->[5]);
+                               undef $last;
+                               dbg("PC11: now process PC61 $origin -> $key") if isdbg('pc11');
+                       }
+               }
+       } else {
+               dbg("PC11: Unexpected line '$line' in bagging area (expecting PC61, PC11), ignored");
+               return;
+       }
+
+}
+       
        # this goes after the input filtering, but before the add
        # so that if it is input filtered, it isn't added to the dup
        # list. This allows it to come in from a "legitimate" source
        if (Spot::dup(@spot[0..4,5])) {
-               dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr');
+               dbg("PCPROT: Duplicate Spot $pc->[0] $key ignored\n") if isdbg('chanerr') || isdbg('dupespot');
                return;
        }
-
+       
        # add it
        Spot::add(@spot);
 
@@ -272,8 +325,8 @@ sub handle_11
                                } else {
                                        route(undef, $to, pc34($main::mycall, $to, $cmd));
                                }
-                               if ($to ne $pc->[7]) {
-                                       $to = $pc->[7];
+                               if ($to ne $origin) {
+                                       $to = $origin;
                                        $node = Route::Node::get($to);
                                        if ($node) {
                                                $dxchan = $node->dxchan;
@@ -306,6 +359,12 @@ sub handle_11
        send_dx_spot($self, $line, @spot) if @spot;
 }
 
+# used to kick outstanding PC11 if required
+sub pc11_process
+{
+
+}
+
 # announces
 sub handle_12
 {
@@ -1435,7 +1494,7 @@ sub _decode_pc92_call
        my $is_extnode = $flag & 2;
        my $here = $flag & 1;
        my $ip  = $part[3];
-       $ip ||= $part[1] if $part[1] && ($part[1] =~ /^(?:\d+\.)+/ || $part[1] =~ /^(?:(?:[abcdef\d]+)?,)+/);
+       $ip ||= $part[1] if $part[1] && $part[1] !~ /^\d+$/ && ($part[1] =~ /^(?:\d+\.)+/ || $part[1] =~ /^(?:(?:[abcdef\d]+)?,)+/);
        $ip =~ s/,/:/g if $ip;
        return ($call, $is_node, $is_extnode, $here, $part[1], $part[2], $ip);
 }
index e5afe25b183e4e6871b4f3bf2e66076463cc15db..1af675ab52913e94a12bbc8e24bfe0b70dc95e02 100644 (file)
@@ -136,17 +136,19 @@ sub init
 {
        my $mode = shift;
   
-   $json = DXJSON->new->canonical(1);
+       $json = DXJSON->new->canonical(1);
        my $fn = "users";
        $filename = localdata("$fn.v3j");
-       unless (-e $filename || $mode == 2) {
-               LogDbg('DXUser', "New User File version $filename does not exist, running conversion from users.v3 or v2, please wait");
-               system('/spider/perl/convert-users-v3-to-v3j.pl');
-               init(1);
-               export();
-               return;
+       unless (-e $filename || $mode == 2 ) {
+               if (-e localdata("$fn.v3") || -e localdata("$fn.v2")) {
+                       LogDbg('DXUser', "New User File version $filename does not exist, running conversion from users.v3 or v2, please wait");
+                       system('/spider/perl/convert-users-v3-to-v3j.pl');
+                       init(1);
+                       export();
+                       return;
+               }
        }
-       if (-e $filename || $mode == 2) {
+       if (-e $filename || $mode) {
                $lru = LRU->newbase("DXUser", $lrusize);
                if ($mode) {
                        $dbm = tie (%u, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_json?]";
index 64d05508a5311b63661aeab0095c7f9e3735aca2..bf19719fd41d9fc3ab7df1635ccf486c1a8df7eb 100644 (file)
@@ -416,7 +416,7 @@ 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,_\-\*\/\(\)\$!]/;
+       return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\.:\-\*\/\(\)\$!]/;
 
        $line = lc $line;