From a48eea32af123b571889f70a3e7cef8e157cf389 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Mon, 26 May 2008 16:58:15 +0100 Subject: [PATCH] Limit depth of recursion for route finding The limit is 20 levels, which should be enough for anybody. Add CTY-1804 data Start the process of allowing filtering on PC92 (w.i.p) --- Changes | 3 +++ cmd/export_users.pl | 7 +++++-- data/cty.dat | 30 +++++++++++++++--------------- data/prefix_data.pl | 8 +++++++- perl/DXChannel.pm | 2 ++ perl/DXProt.pm | 11 ++++------- perl/DXProtHandle.pm | 10 ++++++++++ perl/DXUser.pm | 38 +++++++++++++++++++++++--------------- perl/Route.pm | 6 +++++- perl/Version.pm | 2 +- 10 files changed, 75 insertions(+), 42 deletions(-) diff --git a/Changes b/Changes index 96505795..27b0764c 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +26May08======================================================================= +1. Put a hard limit on the depth of searching for routes +2. Add CTY-1804 prefix changes 13May08======================================================================= 1. add disc users|nodes|all so that each of these classes can be disconnected in one command. From a request by Luigi IK5ZUK. diff --git a/cmd/export_users.pl b/cmd/export_users.pl index 95b09e52..a8cec7de 100644 --- a/cmd/export_users.pl +++ b/cmd/export_users.pl @@ -4,6 +4,9 @@ # # my $self = shift; -return (1, $self->msg('e5')) unless $self->priv >= 9; my $line = shift || "$main::data/user_asc"; -return (1, DXUser::export($line)); +return (1, $self->msg('e5')) unless $self->priv >= 9; + +my ($fn, $flag) = split /\s+/, $line; +my $strip = $flag eq 'strip'; +return (1, DXUser::export($fn, $strip)); diff --git a/data/cty.dat b/data/cty.dat index c719c8ad..71d71cb6 100644 --- a/data/cty.dat +++ b/data/cty.dat @@ -46,7 +46,7 @@ ITU HQ Geneva: 14: 28: EU: 46.20: -6.20: -1.0: 4U1I: United Nations HQ: 05: 08: NA: 40.80: 74.00: 5.0: 4U1U: 4U0UN,4U1UN,4U2UN,4U3UN,4U4UN,4U5UN,4U6UN; Vienna Intl Ctr: 15: 28: EU: 48.20: -16.30: -1.0: *4U1V: - 4U1VIC; + 4U1VIC,4U1WED; Timor-Leste: 28: 54: OC: -8.60: -125.50: -8.0: 4W: 4W; Israel: 20: 39: AS: 31.80: -35.20: -2.0: 4X: @@ -104,7 +104,7 @@ Kuwait: 21: 39: AS: 29.50: -47.80: -3.0: 9K: Sierra Leone: 35: 46: AF: 8.50: 13.20: 0.0: 9L: 9L; West Malaysia: 28: 54: AS: 3.20: -101.60: -7.5: 9M2: - 9M2,9M4,9M50,9W2,9W4; + 9M1,9M2,9M4,9M50,9W2,9W4; East Malaysia: 28: 54: OC: 5.80: -118.10: -7.5: 9M6: 9M6,9M8,9W6,9W8,9M50MS; Nepal: 22: 42: AS: 27.70: -85.30: -5.75: 9N: @@ -262,7 +262,7 @@ France: 14: 27: EU: 48.80: -2.30: -1.0: F: F,HW,HX,HY,TH,TM,TP,TQ,TV,TW; Guadeloupe: 08: 11: NA: 16.00: 61.70: 4.0: FG: FG,TO1T,TO1USB,TO2ANT,TO2FG,TO2OOO,TO4T,TO5BG,TO5C,TO5G,TO5GI,TO5ROM,TO5S, - TO6T,TO7ACR,TO7AES,TO7DSR,TO7GAS,TO7T,TO8CW,TO8RR,TO9T; + TO6T,TO7ACR,TO7AES,TO7DSR,TO7GAS,TO7T,TO8CW,TO8RR,TO8S,TO9T; Mayotte: 39: 53: AF: -13.00: -45.30: -3.0: FH: FH,TO8MZ,TX0P,TX5M,TX5NK,TX5T,TX6A; Saint Barthelemy: 08: 11: NA: 17.90: 62.90: 4.0: FJ: @@ -311,9 +311,9 @@ Isle of Man: 14: 27: EU: 54.30: 4.50: 0.0: GD: GB2WB,GB3GD,GB4IOM,GB4MNH,GB4WXM/P,GB50UN,GB5MOB,GB6SPC; Northern Ireland: 14: 27: EU: 54.60: 5.90: 0.0: GI: 2I,2N,GI,GN,MI,MN,GB0BTC,GB0BVC,GB0CI,GB0CSC,GB0DDF,GB0GPF,GB0MFD,GB0PSM, - GB0REL,GB0SHC,GB0SIC,GB0SPD,GB0TCH,GB0WOA,GB1SPD,GB2IL,GB2LL,GB2MGY, - GB2MRI,GB2NIC,GB2NTU,GB2TCA,GB3MNI,GB4CSC,GB4ES,GB4SPD,GB50AAD,GB5BIG, - GB5BL,GB5SPD,GB90SOM; + GB0REL,GB0SHC,GB0SIC,GB0SPD,GB0TCH,GB0WOA,GB1SPD,GB1SRI,GB2IL,GB2LL, + GB2MGY,GB2MRI,GB2NIC,GB2NTU,GB2TCA,GB3MNI,GB4CSC,GB4ES,GB4SPD,GB50AAD, + GB5BIG,GB5BL,GB5SPD,GB90SOM; Jersey: 14: 27: EU: 49.30: 2.20: 0.0: GJ: 2H,2J,GH,GJ,MH,MJ,GB0CLR,GB0GUD,GB0JSA,GB0SHL,GB2BYL,GB2JSA,GB4BHF, GB50JSA; @@ -344,12 +344,12 @@ Wales: 14: 27: EU: 51.50: 3.20: 0.0: GW: 2C,2W,2X,2Y,GC,GW,MC,MW,GB0CCE,GB0CLC,GB0CVA,GB0GCR,GB0GIW,GB0GLV,GB0HEL, GB0HMT,GB0ML,GB0MPA,GB0MWL,GB0NEW,GB0PSG,GB0RPO,GB0RSC,GB0SDD,GB0SH, GB0SOA,GB0SPS,GB0SRH,GB0TD,GB0TTT,GB0WRC,GB100BD,GB100FI,GB100LP,GB1CCC, - GB1LSG,GB1SL,GB1SSL,GB1TDS,GB2000SET,GB200A,GB200HNT,GB2ANG,GB2CPC,GB2GGM, - GB2GLS,GB2GOL,GB2GSG,GB2GSS,GB2HDG,GB2IMD,GB2LNP,GB2LSA,GB2MIL,GB2MLM, - GB2MOP,GB2RFS,GB2RSC,GB2RTB,GB2SDD,GB2SIP,GB2TD,GB2TTA,GB2VK,GB2WDS, - GB2WFF,GB2WHO,GB2WSF,GB4BPL,GB4CI,GB4DPS,GB4HMD,GB4HMM,GB4LSG,GB4MD, - GB4MDI,GB4MUU,GB4NDG,GB4SA,GB4SDD,GB4SMM,GB4SNF,GB4XXX,GB5BS/J,GB5FI, - GB5SIP,GB60VLY,GB6AR,GB6GW,GB6OQA,GB750CC,GB8OQE; + GB1LSG,GB1SL,GB1SSL,GB1TDS,GB2000SET,GB200A,GB200HNT,GB2ANG,GB2CI,GB2CPC, + GB2GGM,GB2GLS,GB2GOL,GB2GSG,GB2GSS,GB2HDG,GB2IMD,GB2LNP,GB2LSA,GB2MIL, + GB2MLM,GB2MOP,GB2RFS,GB2RSC,GB2RTB,GB2SDD,GB2SIP,GB2TD,GB2TTA,GB2VK, + GB2WDS,GB2WFF,GB2WHO,GB2WSF,GB4BPL,GB4CI,GB4DPS,GB4HMD,GB4HMM,GB4LSG, + GB4MD,GB4MDI,GB4MUU,GB4NDG,GB4SA,GB4SDD,GB4SMM,GB4SNF,GB4XXX,GB5BS/J, + GB5FI,GB5SIP,GB60VLY,GB6AR,GB6GW,GB6OQA,GB750CC,GB8OQE; Solomon Islands: 28: 51: OC: -9.40: -160.00: -11.0: H4: H4; Temotu: 32: 51: OC: -10.70: -165.80: -11.0: H40: @@ -504,7 +504,7 @@ Swains Island: 32: 62: OC: -11.05: 171.25: 11.0: KH8/s: Wake I.: 31: 65: OC: 19.30: -166.60: -12.0: KH9: AH9,KH9,NH9,WH9; Alaska: 01: 01: NA: 61.20: 150.00: 9.0: KL: - AL,KL,NL,WL,KW1W; + AL,KL,NL,WL,K7A,KW1W; Navassa I.: 08: 11: NA: 18.40: 75.00: 5.0: KP1: KP1,NP1,WP1; Virgin Is.: 08: 11: NA: 18.30: 64.90: 5.0: KP2: @@ -554,7 +554,7 @@ Peru: 10: 12: SA: -12.10: 77.10: 5.0: OA: Lebanon: 20: 39: AS: 33.90: -35.50: -2.0: OD: OD; Austria: 15: 28: EU: 48.20: -16.30: -1.0: OE: - OE,4U1VIC; + OE,4U1VIC,4U1WED; Finland: 15: 18: EU: 60.20: -25.00: -2.0: OH: OF,OG,OH,OI,OJ; Aland Is.: 15: 18: EU: 60.20: -20.00: -2.0: OH0: @@ -767,7 +767,7 @@ Canada: 05: 09: NA: 45.00: 80.00: 4.0: VE: VE2III(2),VE2IM(2),VE2KK(2),VE2MTA(2),VE2MTB(2),VE2NN(2),VE2NRK(2), VE2PR(2),VE2QRZ(2),VE2RB(2),VE2TVU(2),VE2UA(2),VE2VH(2),VE2WDX(2), VE2WT(2),VE2XAA/2(2),VE2XY(2),VE2YM(2),VE2Z(2),VE2ZC(5),VE2ZM(5),VE2ZV(5), - VE3EY/2(2),VE3NE/2(2),VE3RHJ/2(2),VE8AJ(2),VE8PW(2),VE8RCS(2),VER20080422, + VE3EY/2(2),VE3NE/2(2),VE3RHJ/2(2),VE8AJ(2),VE8PW(2),VE8RCS(2),VER20080523, VY0AA(4)[3],VY0PW(4)[3],VY2MGY/3(4)[4]; Australia: 30: 59: OC: -22.00: -135.00: -10.0: VK: AX,VH,VI,VJ,VK,VL,VM,VN,VZ; diff --git a/data/prefix_data.pl b/data/prefix_data.pl index 0ae2ea7c..191202dc 100644 --- a/data/prefix_data.pl +++ b/data/prefix_data.pl @@ -100,6 +100,7 @@ '4U1V' => '400', '4U1VIC' => '400', '4U1WB' => '514', + '4U1WED' => '400', '4U1WRC' => '274', '4U2ITU' => '274', '4U2UN' => '275', @@ -264,6 +265,7 @@ '9K' => '300', '9L' => '301', '9M0' => '261', + '9M1' => '302', '9M2' => '302', '9M4' => '302', '9M50' => '302', @@ -967,6 +969,7 @@ 'GB1LSG' => '66', 'GB1SL' => '66', 'GB1SPD' => '62', + 'GB1SRI' => '62', 'GB1SSL' => '66', 'GB1TDS' => '66', 'GB2000SET' => '66', @@ -978,6 +981,7 @@ 'GB2AYR' => '64,353', 'GB2BYL' => '63', 'GB2CHG' => '64,353', + 'GB2CI' => '66', 'GB2CPC' => '66', 'GB2DHS' => '64,353', 'GB2ECG' => '65', @@ -1413,6 +1417,7 @@ 'K6EID' => '220', 'K6XT' => '220', 'K7' => '464,476,489,496,500,507,510,513', + 'K7A' => '394', 'K7ABV' => '220', 'K7BG' => '220', 'K7CMZ' => '220', @@ -3095,6 +3100,7 @@ 'TO8CW' => '43', 'TO8MZ' => '44', 'TO8RR' => '43', + 'TO8S' => '43', 'TO9A' => '46', 'TO9T' => '43', 'TP' => '42', @@ -3405,7 +3411,7 @@ 'VE8PW' => '191', 'VE8RCS' => '191', 'VE9' => '438', - 'VER20080422' => '191', + 'VER20080523' => '191', 'VERSION' => '538', 'VF' => '436', 'VF0' => '191', diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 69a72abe..958fe618 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -80,11 +80,13 @@ $count = 0; wcyfilter => '5,WCY Filt-out', spotsfilter => '5,Spot Filt-out', routefilter => '5,Route Filt-out', + pc92filter => '5,PC92 Route Filt-out', inannfilter => '5,Ann Filt-inp', inwwvfilter => '5,WWV Filt-inp', inwcyfilter => '5,WCY Filt-inp', inspotsfilter => '5,Spot Filt-inp', inroutefilter => '5,Route Filt-inp', + inpc92filter => '5,PC92 Route Filt-inp', passwd => '9,Passwd List,yesno', pingint => '5,Ping Interval ', nopings => '5,Ping Obs Count', diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 69eb2228..e0144349 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -311,7 +311,8 @@ sub start $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0); $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; - $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ; + $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate}; + $self->{pc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ; # get the INPUT filters (these only pertain to Clusters) @@ -320,12 +321,8 @@ sub start $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate}; - # if there is no route input filter then specify a default one. - # obviously this can be changed later by the sysop. - if (!$self->{inroutefilter}) { - my $dxcc = $self->dxcc; - $Route::filterdef->cmd($self, 'route', 'accept', "input by_dxcc $dxcc" ); - } + $self->{inpc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ; + # set unbuffered and no echo $self->send_now('B',"0"); diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index f2d5b559..cb13e37c 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -46,6 +46,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 ); $pc9x_dupe_age = 60; # catch loops of circular (usually) D records @@ -57,6 +58,15 @@ $pc9x_past_age = (122*60)+ # maximum age in the past of a px9x (a config record $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 ([ + # tag, sort, field, priv, special parser + ['call', 'c', 0], + ['by', 'c', 0], + ['dxcc', 'nc', 1], + ['itu', 'ni', 2], + ['zone', 'nz', 3], + ], 'Filter::Cmd'); + # incoming talk commands sub handle_10 diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 34870a95..3bc4218c 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -302,13 +302,11 @@ sub put my $self = shift; confess "Trying to put nothing!" unless $self && ref $self; my $call = $self->{call}; - # delete all instances of this -# for ($dbm->get_dup($call)) { -# $dbm->del_dup($call, $_); -# } + $dbm->del($call); delete $self->{annok} if $self->{annok}; delete $self->{dxok} if $self->{dxok}; + $lru->put($call, $self); my $ref = $self->encode; $dbm->put($call, $ref); @@ -335,7 +333,20 @@ sub decode sub asc_encode { my $self = shift; - return dd($self); + my $strip = shift; + my $p; + + if ($strip) { + my $ref = bless {}, ref $self; + foreach my $k (qw(qth lat long qra sort call homenode node lastoper lastin)) { + $ref->{$k} = $self->{$k} if exists $self->{$k}; + } + $ref->{name} = $self->{name} if exists $self->{name} && $self->{name} !~ /selfspot/i; + $p = dd($ref); + } else { + $p = dd($self); + } + return $p; } # @@ -362,10 +373,6 @@ sub del { my $self = shift; my $call = $self->{call}; - # delete all instances of this -# for ($dbm->get_dup($call)) { -# $dbm->del_dup($call, $_); -# } $lru->remove($call); $dbm->del($call); } @@ -407,13 +414,14 @@ sub fields sub export { my $fn = shift; + my $basic_info_only = shift; # save old ones - rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo"; - rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo"; - rename "$fn.oo", "$fn.ooo" if -e "$fn.oo"; - rename "$fn.o", "$fn.oo" if -e "$fn.o"; - rename "$fn", "$fn.o" if -e "$fn"; + rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo"; + rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo"; + rename "$fn.oo", "$fn.ooo" if -e "$fn.oo"; + rename "$fn.o", "$fn.oo" if -e "$fn.o"; + rename "$fn", "$fn.o" if -e "$fn"; my $count = 0; my $err = 0; @@ -514,7 +522,7 @@ print "There are $count user records and $err errors\n"; } } # only store users that are reasonably active or have useful information - print $fh "$key\t" . $ref->asc_encode . "\n"; + print $fh "$key\t" . $ref->asc_encode($basic_info_only) . "\n"; ++$count; } else { LogDbg('DXCommand', "Export Error3: $key\t$val"); diff --git a/perl/Route.pm b/perl/Route.pm index 868317a9..769aefe8 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -295,8 +295,12 @@ sub findroutes dbg("findroutes: $call level: $level calls: " . join(',', @_)) if isdbg('routec'); - # recursion detector + # recursion detector (no point in recursing that deeply) return () if $seen->{$call}; + if ($level >= 20) { + dbg("Route::findroutes: recursion limit reached looking for $call"); + return (); + } # return immediately if we are directly connected if (my $dxchan = DXChannel::get($call)) { diff --git a/perl/Version.pm b/perl/Version.pm index 90107854..222ef120 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -11,6 +11,6 @@ use vars qw($version $subversion $build); $version = '1.55'; $subversion = '0'; -$build = '9'; +$build = '10'; 1; -- 2.34.1