From 5756741d9682667ae5b0442c4e6f609bd481b6eb Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Tue, 31 Jan 2023 11:32:02 +0000 Subject: [PATCH] many changes (see Changes) Add and process IP addresses on PC93. Remove uninitialised messages. Add LOCALE=(UTC|LOCAL) time operation to crontab. Make PC92 A/D processing and distribution optional. Add a switch to PC92 C to add IP addresses optional. --- Changes | 28 +++++++++++++ cmd/announce.pl | 3 +- cmd/talk.pl | 10 +++-- cmd/wx.pl | 6 ++- perl/DXCIDR.pm | 1 + perl/DXCommandmode.pm | 9 ++-- perl/DXCron.pm | 25 +++++++++--- perl/DXDupe.pm | 10 ++++- perl/DXProt.pm | 20 +++++---- perl/DXProtHandle.pm | 95 ++++++++++++++++++++++++++----------------- perl/DXProtout.pm | 13 ++++-- perl/Route/Node.pm | 2 +- perl/Route/User.pm | 2 +- perl/cluster.pl | 2 +- 14 files changed, 157 insertions(+), 69 deletions(-) diff --git a/Changes b/Changes index 27b1fe49..9a502165 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,31 @@ +30Jan23======================================================================= +1. Add ip addresses to outgoing PC93 messages +2. Get rid of (some of?) the uninitialised warnings +3. Add the ability to set the (time) locale to UTC or LOCALTIME by adding + the string LOCALE = UTC or LOCALE = LOCAL(TIME)? to your local crontab + + NOTE: this will affect ALL timings in both the system as well as your + local crontabs. Changing the LOCALE will make no difference to the system + crontab other than using localtime rather than UTC. Which is fine by me. + + You can see what crontab is doing and which LOCALE is in use by doing a + 'set/debug cron' in a console and running a 'watchdbg cron' in another + shell. +25Jan23======================================================================= +1. Add a switch to enable the routing of generated PC92 A/D records and also + prevent the rebroadcast of incoming ones. + + set/var $DXProt::pc92_ad_enable 0 + + to disable PC92 A/D records. +2. Add a switch to enable the addition of IP addresses to PC92 C records. + + set/var $DXProt::pc92c_ipaddr_enable 1 + + to enable the addition of IP addresses to outgoing PC92 C records. + + ## These two features are experimental, but will become the default if + ## some other changes and these are successful 24Jan23======================================================================= 1. Optimise the PC11->PC61 promotion code, improve readability of the debugging when 'set/debug pc11' is active. diff --git a/cmd/announce.pl b/cmd/announce.pl index 9065993b..99fba14b 100644 --- a/cmd/announce.pl +++ b/cmd/announce.pl @@ -68,8 +68,9 @@ if ($drop) { } #return (1, $self->msg('dup')) if $self->priv < 5 && AnnTalk::dup($from, $toflag, $line); +my $ipaddr = DXCommandmode::alias_localhost($self->hostname || '127.0.0.1'); Log('ann', $to, $from, $line); -$main::me->normal(DXProt::pc93($to, $from, $via, $line)); +$main::me->normal(DXProt::pc93($to, $from, $via, $line, undef, $ipaddr)); #DXChannel::broadcast_list("To $to de $from ($t): $line\a", 'ann', undef, @locals); #if ($to ne "LOCAL") { diff --git a/cmd/talk.pl b/cmd/talk.pl index dae38e24..46de76fa 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -46,6 +46,8 @@ push @out, $self->msg('e7', $call) unless $dxchan; # default the 'via' #$via ||= '*'; +my $ipaddr = DXCommandmode::alias_localhost($self->hostname || '127.0.0.1'); + # if there is a line send it, otherwise add this call to the talk list # and set talk mode for command mode if ($line) { @@ -55,7 +57,7 @@ if ($line) { $self->badcount(($self->badcount||0) + @bad); LogDbg('DXCommand', "$self->{call} swore: $line (with words:" . join(',', @bad) . ")"); } else { - $main::me->normal(DXProt::pc93($to, $self->call, $via, $line)); + $main::me->normal(DXProt::pc93($to, $self->call, $via, $line, undef, $ipaddr)); } } else { my $s = $to; @@ -63,17 +65,17 @@ if ($line) { my $ref = $self->talklist; if ($ref) { unless (grep { $_ eq $s } @$ref) { - $main::me->normal(DXProt::pc93($to, $self->call, $via, $self->msg('talkstart'))); + $main::me->normal(DXProt::pc93($to, $self->call, $via, $self->msg('talkstart'), undef, $ipaddr)); $self->state('talk'); push @$ref, $s; } } else { $self->talklist([ $s ]); - $main::me->normal(DXProt::pc93($to, $self->call, $via, $self->msg('talkstart'))); + $main::me->normal(DXProt::pc93($to, $self->call, $via, $self->msg('talkstart'), undef, $ipaddr)); push @out, $self->msg('talkinst'); $self->state('talk'); } - Log('talk', $to, $from, '>' . ($via || ($dxchan && $dxchan->call) || '*'), $self->msg('talkstart')); + Log('talk', $to, $from, '>' . ($via || ($dxchan && $dxchan->call) || '*'), $self->msg('talkstart'), undef, $ipaddr); push @out, $self->talk_prompt; } diff --git a/cmd/wx.pl b/cmd/wx.pl index 57147190..dc3dc729 100644 --- a/cmd/wx.pl +++ b/cmd/wx.pl @@ -55,8 +55,10 @@ if ($drop) { return (1, ()); } -Log('ann', $via ? $via : '*', $from, $line); -$main::me->normal(DXProt::pc93($to, $from, $via, $line)); +my $ipaddr = DXCommandmode::alias_localhost($self->hostname || '127.0.0.1'); + +Log('ann', $via ? $via : '*', $from, $line, $ipaddr); +$main::me->normal(DXProt::pc93($to, $from, $via, $line, undef, $ipaddr)); #DXChannel::broadcast_list("WX de $from <$t>: $line", 'wx', undef, @locals); #if ($to ne "LOCAL") { diff --git a/perl/DXCIDR.pm b/perl/DXCIDR.pm index a91d1396..82115220 100644 --- a/perl/DXCIDR.pm +++ b/perl/DXCIDR.pm @@ -44,6 +44,7 @@ sub _read chomp; next if /^\s*\#/; next unless /[\.:]/; + next unless $_; push @out, $_; } $fh->close; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index ffad39cf..510adac2 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -79,11 +79,11 @@ sub new my $ipaddr = alias_localhost($self->hostname); DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $ipaddr], ); - # ALWAYS output the user + # ALWAYS output the user (except if the updates not enabled) my $ref = Route::User::get($call); if ($ref) { $main::me->route_pc16($main::mycall, undef, $main::routeroot, $ref); - $main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref) unless $DXProt::pc92_slug_changes; + $main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref) unless $DXProt::pc92_slug_changes || ! $DXProt::pc92_ad_enable; } return $self; @@ -454,7 +454,8 @@ sub send_chats my $msgid = DXProt::nextchatmsgid(); $text = "#$msgid $text"; - $main::me->normal(DXProt::pc93($target, $self->{call}, undef, $text)); + my $ipaddr = alias_localhost($self->hostname || '127.0.0.1'); + $main::me->normal(DXProt::pc93($target, $self->{call}, undef, $text, undef, $ipaddr)); } sub special_prompt @@ -669,7 +670,7 @@ sub disconnect # issue a pc17 to everybody interested $main::me->route_pc17($main::mycall, undef, $main::routeroot, $uref); - $main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref) unless $DXProt::pc92_slug_changes; + $main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref) unless $DXProt::pc92_slug_changes || ! $DXProt::pc92_ad_enable; } else { confess "trying to disconnect a non existant user $call"; } diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 4cfabc0e..adeff216 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -19,12 +19,12 @@ use DXSubprocess; use strict; -use vars qw{@crontab @lcrontab @scrontab $mtime $lasttime $lastmin}; +use vars qw{@crontab @lcrontab @scrontab $mtime $lasttime $lastmin $use_localtime}; $mtime = 0; $lasttime = 0; $lastmin = 0; - +$use_localtime = 0; my $fn = "$main::cmd/crontab"; my $localfn = "$main::localcmd/crontab"; @@ -67,7 +67,16 @@ sub cread while (my $l = <$fh>) { $line++; chomp $l; - next if $l =~ /^\s*#/o or $l =~ /^\s*$/o; + next if $l =~ /^\s*#/ or $l =~ /^\s*$/; + if (my ($ts) = $l =~/^\s*LOCALE\s*=\s*(UTC|LOCAL)/i) { + $ts = uc $ts; + if ($ts eq 'UTC') { + $use_localtime = 0; + } elsif ($ts eq 'LOCAL') { + $use_localtime = 1; + } + dbg("DXCron: LOCALE set to $ts") if isdbg('cron'); + } my ($min, $hour, $mday, $month, $wday, $cmd) = $l =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/; next unless defined $min; my $ref = bless {}; @@ -140,7 +149,12 @@ sub process my $now = $main::systime; return if $now-$lasttime < 1; - my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6]; + my ($sec, $min, $hour, $mday, $mon, $wday); + if ($use_localtime) { + ($sec, $min, $hour, $mday, $mon, $wday) = (localtime($now))[0,1,2,3,4,6]; + } else { + ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6]; + } # are we at a minute boundary? if ($min != $lastmin) { @@ -158,7 +172,8 @@ sub process (!$cron->{wday} || grep $_ eq $wday, @{$cron->{wday}}) ){ if ($cron->{cmd}) { - dbg("cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'") if isdbg('cron'); + my $s = $use_localtime ? "LOCALTIME" : "UTC"; + dbg("cron: $s $min $hour $mday $mon $wday -> doing '$cron->{cmd}'") if isdbg('cron'); eval $cron->{cmd}; dbg("cron: cmd error $@") if $@ && isdbg('cron'); } diff --git a/perl/DXDupe.pm b/perl/DXDupe.pm index 3625183f..012039ee 100644 --- a/perl/DXDupe.pm +++ b/perl/DXDupe.pm @@ -46,6 +46,7 @@ sub check sub find { + return 0 unless $_[0]; return $d{$_[0]}; } @@ -53,14 +54,19 @@ sub add { my $s = shift; my $t = shift || $main::systime + $default; + return unless $s; + $d{$s} = $t; - dbg(sprintf("DXDupe::add key: $s time: %s", ztime($t))) if isdbg('dxdupe'); + dbg("DXDupe::add key: $s time: " . ztime($t)) if isdbg('dxdupe'); } sub del { my $s = shift; - dbg(sprintf("DXDupe::del key: $s time: %s", ztime($d{$s}))) if isdbg('dxdupe'); + return unless $s; + + my $t = $d{$s}; + dbg("DXDupe::del key: $s time: " . ztime($t)) if isdbg('dxdupe'); delete $d{$s}; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index ac675f7c..bf2d5ed3 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -50,7 +50,8 @@ use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restim %pc92_find $pc92_find_timeout $pc92_short_update_period $next_pc92_obs_timeout $pc92_slug_changes $last_pc92_slug $pc92_extnode_update_period $pc50_interval - $pc92_keepalive_period $senderverify + $pc92_keepalive_period $senderverify $pc92_ad_enabled + $pc92c_ipaddr_enable ); $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 @@ -84,8 +85,9 @@ $pc92_keepalive_period = 1*60*60; # frequency of PC92 K (keepalive) records %pc92_find = (); # outstanding pc92 find operations $pc92_find_timeout = 30; # maximum time to wait for a reply $senderverify = 0; # 1 = check spotter is on node it says it is and check ip address if available - # 2 = do 1 and dump if check - +; # 2 = do 1 and dump if check +$pc92_ad_enabled = 1; # send pc92 A & D records. +$pc92c_ipaddr_enable = 0; # add the local ip address info to each callsign in a PC92 C @checklist = ( @@ -1421,12 +1423,13 @@ sub talk { my ($self, $from, $to, $via, $line, $origin) = @_; + my $ipaddr = DXCommandmode::alias_localhost($self->hostname || '127.0.0.1'); if ($self->{do_pc9x}) { - $self->send(pc93($to, $from, $via, $line)); + $self->send(pc93($to, $from, $via, $line, undef, $ipaddr)); } else { $self->send(pc10($from, $to, $via, $line, $origin)); } - Log('talk', $to, $from, '>' . ($via || $origin || $self->call), $line) unless $origin && $origin ne $main::mycall; + Log('talk', $to, $from, '>' . ($via || $origin || $self->call), $line, $ipaddr) unless $origin && $origin ne $main::mycall; } # send it if it isn't the except list and isn't isolated and still has a hop count @@ -1644,6 +1647,7 @@ sub route_pc92c my $self = shift; my $origin = shift; my $line = shift; + broadcast_route_pc9x($self, $origin, \&pc92c, $line, 1, @_); } @@ -1652,6 +1656,7 @@ sub route_pc92a my $self = shift; my $origin = shift; my $line = shift; + return unless $pc92_ad_enabled; broadcast_route_pc9x($self, $origin, \&pc92a, $line, 1, @_); } @@ -1660,6 +1665,7 @@ sub route_pc92d my $self = shift; my $origin = shift; my $line = shift; + return unless $pc92_ad_enabled; broadcast_route_pc9x($self, $origin, \&pc92d, $line, 1, @_); } @@ -1781,8 +1787,8 @@ sub import_chat $via = '*' if $target eq 'ALL' || $target eq 'SYSOP'; Log('ann', $target, $main::mycall, $text); AnnTalk::add_anncache('ann', $target, $main::mycall, $text); - - $main::me->normal(DXProt::pc93($target, $main::mycall, $via, $text)); + my $ipaddr = DXCommandmode::alias_localhost($main::me->hostname || '127.0.0.1'); + $main::me->normal(DXProt::pc93($target, $main::mycall, $via, $text, undef, $ipaddr)); } else { DXCommandmode::send_chats($main::me, $target, $text); } diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index 2aa8b3df..600bfd8f 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -49,7 +49,7 @@ use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restim $eph_pc15_restime $pc9x_past_age $pc9x_dupe_age $pc10_dupe_age $pc92_slug_changes $last_pc92_slug $pc92Ain $pc92Cin $pc92Din $pc92Kin $pc9x_time_tolerance - $pc92filterdef $senderverify $pc11_dwell_time $pc11_extract_route + $pc92filterdef $senderverify $pc11_dwell_time $pc11_extract_route $pc92_ad_enabled $pc92c_ipaddr_enable ); $pc9x_dupe_age = 60; # catch loops of circular (usually) D records @@ -141,7 +141,9 @@ sub handle_10 } # convert this to a PC93, coming from mycall with origin set and process it as such - $main::me->normal(pc93($to, $from, $via, $pc->[3], $pc->[6])); + my $ref = Route::get($pc->[6]); + my $ip = $ref->ip; + $main::me->normal(pc93($to, $from, $via, $pc->[3], $pc->[6]), $ip); } my %pc11_saved; # delayed PC11s @@ -258,42 +260,11 @@ sub handle_11 } # Populate the routing table - my $rn = Route::Node::get($pc->[7]); - unless ($rn) { - $rn = Route::Node->new($pc->[7]); - dbg("ROUTE $self->{call}: ADD NEW node: $pc->[7]") if isdbg('pc11'); - } + $self->populate_routing_table($pc->[7], $pc->[6], $pc->[8]); my $r = Route::User::get($pc->[6]); - unless ($r) { - $rn->add_user($pc->[6], 0, undef); - dbg("ROUTE $self->{call}: ADD NEW user: $pc->[6] -> $pc->[7]") if isdbg('pc11'); - $r = Route::User::get($pc->[6]); - } - - # Add/Change any IP address info if ($pcno == 61) { - - # as we have a route to a user, if it (or the node) does not exist then create them - # link the user to the node if not already done. - # then add or alter the IP address - if ($pc->[8]) { - my $new = $pc->[8]; - if ($r) { - if ($r->ip ne $new) { - if ($r->ip) { - my $old = $r->ip; - $r->ip($new); - dbg("ROUTE $self->{call}: ALTER IP node: $pc->[7] user: $pc->[6] old IP: '$old'-> new IP: '$new'") if isdbg('pc11'); - } else{ - $r->ip($new); - dbg("ROUTE $self->{call}: NEW IP node: $pc->[7] user: $pc->[6] IP: '$new'") if isdbg('pc11'); - } - } - } else { - dbg("ROUTE $self->{call}: ADD Failed for node $pc->[7] user $pc->[6]") if isdbg('pc11'); - } - } else { - dbg("PCPROT: ROUTE $self->{call} NO IP ADDRESS in '$line'!"); + unless ($pc->[8] && is_ipaddr($pc->[8])) { + dbg("PCPROT: ROUTE $self->{call} NO IP ADDRESS in '$line'!"); } } @@ -2351,7 +2322,7 @@ sub handle_92 } # broadcast it if we get here - $self->broadcast_route_pc9x($pcall, undef, $line, 0); + $self->broadcast_route_pc9x($pcall, undef, $line, 0) unless !$pc92_ad_enabled && ($sort eq 'A' || $sort eq 'D'); } # get all the routes for a thing, bearing in mind that the thing (e.g. a user) @@ -2418,7 +2389,9 @@ sub handle_93 my $via = uc $pc->[5]; my $text = $pc->[6]; my $onode = uc $pc->[7]; - $onode = $pcall if @$pc <= 8; + my $ipaddr = $pc->[8]; + + $onode //= $pcall; # this is catch loops caused by bad software ... if (eph_dup("PC93|$from|$text|$onode", $pc10_dupe_age)) { @@ -2457,6 +2430,8 @@ sub handle_93 } } + $self->populate_routing_table($onode, $from, $ipaddr); + # if it is routeable then then treat it like a talk my $ref = Route::get($to); if ($ref) { @@ -2535,4 +2510,48 @@ sub handle_default } } +sub populate_routing_table +{ + my ($self, $node, $user, $ip) = @_; + + my $rn = Route::Node::get($node); + unless ($rn) { + $rn = Route::Node->new($node); + dbg("ROUTE $self->{call}: ADD NEW node: $node") if isdbg('pc11'); + } + + my $ru; + if ($user ne $node) { + $ru = Route::User::get($user); + unless ($ru) { + $rn->add_user($user, 0, undef); + dbg("ROUTE $self->{call}: ADD NEW user: $user -> $node") if isdbg('pc11'); + } + $ru = Route::User::get($user); + } + + # Add/Change any IP address info + + # as we have a route to a user, if it (or the node) does not exist then create them + # link the user to the node if not already done. + # then add or alter the IP address + if ($ip && is_ipaddr($ip)) { + my $new = $ip; + if ($ru) { + if ($ru->ip ne $new) { + if ($ru->ip) { + my $old = $ru->ip; + $ru->ip($new); + dbg("ROUTE $self->{call}: ALTER IP node: $node user: $user old IP: '$old'-> new IP: '$new'") if isdbg('pc11'); + } else{ + $ru->ip($new); + dbg("ROUTE $self->{call}: NEW IP node: $node user: $user IP: '$new'") if isdbg('pc11'); + } + } + } else { + dbg("ROUTE $self->{call}: ADD Failed for node $node user $user") if isdbg('pc11'); + } + } +} + 1; diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 7629ca16..acb53882 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -19,7 +19,7 @@ use DXDebug; use strict; -use vars qw($sentencelth $pc19_version $pc9x_nodupe_first_slot); +use vars qw($sentencelth $pc19_version $pc9x_nodupe_first_slot $pc92c_ipaddr_enable); $sentencelth = 180; $pc9x_nodupe_first_slot = 1; @@ -396,7 +396,8 @@ sub _gen_pc92 } for (@_) { $s .= '^' . _encode_pc92_call($_, $ext); - $ext = 0 unless $sort eq 'A'; # only the first slot has an ext. + $ext = 0 unless $sort eq 'A '; # only the first slot has an ext except A + $ext = 2 if $pc92c_ipaddr_enable && $sort eq 'C'; } return $s . '^H99^'; } @@ -433,7 +434,7 @@ sub pc92d # send a config sub pc92c { - return _gen_pc92('C', 1, @_); + return _gen_pc92('C', $pc92c_ipaddr_enable ? 2 : 1, @_); } # send a keep alive @@ -472,11 +473,17 @@ sub pc93 my $via = shift || '*'; # *, node call my $line = shift; # the text my $origin = shift; # this will be present on proxying from PC10 + my $ipaddr = shift; $line = unpad($line); $line =~ s/\^/~/g; # remove any ^ characters my $s = "PC93^$main::mycall^" . gen_pc9x_t() . "^$to^$from^$via^$line"; $s .= "^$origin" if $origin; + if ($ipaddr) { + $s .= ' ^' unless $origin; + $ipaddr =~ s/:/,/; + $s .= "^$ipaddr"; + } $s .= "^H99^"; return $s; } diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index af01a1d2..69d043d8 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -401,7 +401,7 @@ sub TO_JSON { return { %{ shift() } }; } sub write_cache { my $json = DXJSON->new; - $json->canonical(isdbg('routecache')); + $json->canonical(isdbg('routecache')||0); my $ta = [ gettimeofday ]; my @s; diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 2c988f1d..6c91d3e2 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -103,7 +103,7 @@ sub TO_JSON { return { %{ shift() } }; } sub write_cache { my $json = DXJSON->new; - $json->canonical(isdbg('routecache')); + $json->canonical(isdbg('routecache')||0); my $ta = [ gettimeofday ]; my @s; diff --git a/perl/cluster.pl b/perl/cluster.pl index 7c84dbc3..b6c38166 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -872,7 +872,7 @@ sub per_minute sub per_10_minute { RBN::per_10_minute(); - Route::write_cache(); + Route::write_cache() if $save_route_cache; } sub per_hour -- 2.34.1