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)

diff --git a/Changes b/Changes
index 96505795fabb0102fa014e10a4e19689f20c6f02..27b0764c76eb6a9465424715050d117ff6148a34 100644 (file)
--- 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 95b09e52d24e7bdadbd94df4560f875ddf59a001..a8cec7de3b074614b5a2f4add19b3b3c944d3df8 100644 (file)
--- 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 c719c8adb28b9df5f5e3433fd381a0002e746704..71d71cb6b7c9ec64b7c068e5e1c1cef2180e446e 100644 (file)
--- 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 0ae2ea7ca3037b101aac56ad4bc50ac455b59ebb..191202dce26a38c54b81959b42b87457ddad8989 100644 (file)
--- 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 69a72abe9e1d4438118f991b5e3b86f515206099..958fe61860b3cb69122df0101fe8741c6afcc805 100644 (file)
--- 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 69eb2228a194f4323638bf0b32cd6b7b005df6b1..e01443490c174f5279b813e7ac0a198c160fdb9a 100644 (file)
--- 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 f2d5b55946366deb2789f950d3e087ce974ea8bd..cb13e37c652b77ba86d7b5ab0332a6c482c8a5fe 100644 (file)
--- 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 34870a953dc91311ae9b10bc216b28b2e88113a8..3bc4218ce289363e458be4f28fb6e1c14a472a56 100644 (file)
--- 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 868317a9646234b9093a2598048a3a795f71e8d3..769aefe8c01525e2d576540deb150432459bbbbd 100644 (file)
--- 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 9010785448b62879263c607c3d7ee191f7c6044e..222ef1203ecac8442ba1842f60dc6d62dbabc2aa 100644 (file)
--- 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;