From 1935ba236a7ef4999bceb00b6faf28038f3b052e Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Wed, 24 Nov 2021 20:45:38 +0000 Subject: [PATCH] Fix create_sysop.pl to work on base git install --- Changes | 4 +++ cmd/dx.pl | 8 +++-- cmd/set/width.pl | 1 + perl/DXChannel.pm | 5 ++- perl/DXCommandmode.pm | 5 +++ perl/DXProt.pm | 2 ++ perl/DXProtHandle.pm | 73 ++++++++++++++++++++++++++++++++++++++----- perl/DXUser.pm | 18 ++++++----- perl/Filter.pm | 2 +- 9 files changed, 99 insertions(+), 19 deletions(-) diff --git a/Changes b/Changes index 9d9bed6e..2a0b26c8 100644 --- 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 diff --git a/cmd/dx.pl b/cmd/dx.pl index 919a34c0..c18a2df3 100644 --- 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); } } diff --git a/cmd/set/width.pl b/cmd/set/width.pl index 5575fe3b..27620c2c 100644 --- a/cmd/set/width.pl +++ b/cmd/set/width.pl @@ -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)); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 2d43b0f0..f5fc6eb2 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -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); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 051332b0..b10149ec 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -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) { diff --git a/perl/DXProt.pm b/perl/DXProt.pm index bd317de4..f8e60b20 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -537,6 +537,8 @@ sub process if ($main::systime - 3600 > $last_hour) { $last_hour = $main::systime; } + + pc11_process(); } # diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index c0711cee..c4344339 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -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); } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index e5afe25b..1af675ab 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -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?]"; diff --git a/perl/Filter.pm b/perl/Filter.pm index 64d05508..bf19719f 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -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; -- 2.34.1