basic raw PC base NP added

diff --git a/Changes b/Changes
index 658b403c6d0c8beaf3cdfd0e78dab2bd2afe14fe..0d27216b74c54ae71c20d0592b4855e981e1c066 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,11 @@
+21Jan03=======================================================================
+1. Started the structural changes to the code for new protocol
+2. added Storable support for DXUser to increase speed and reduce cputime.
+3. Moved lock files to /spider/local.
+4. Changed hop modification so that rehopping only happens if the hops are
+currently too large (this will annoy, but I don't think I shall change it).
+I have made this change to try to stem some of the PC41 and other storms that
+occur, largely because the hops will never decrement to 0 otherwise.
 20Jan03=======================================================================
 1. changed sh/c so that, by default, it only shows the caller's country nodes
 sh/c all will show the old style full list. "sh/c sk gb" will show the config

diff --git a/cmd/announce.pl b/cmd/announce.pl
index 6b66d68eb9947dfb2c181bdac6bfb0d1863e1abb..f2251530dbcd3b22707a7182a49a7e93ef91842f 100644 (file)
--- a/cmd/announce.pl
+++ b/cmd/announce.pl
@@ -26,9 +26,8 @@ my @locals = DXCommandmode->get_all();
 my $to;
 my $from = $self->call;
 my $t = ztime(time);
-my $tonode;
-my $toflag = '*';
-my $sysopflag;
+my $tonode = '*';
+my $sysopflag = ' ';
 
 if ($sort eq "FULL") {
   $line =~ s/^$f[0]\s+//;    # remove it
@@ -57,12 +56,13 @@ if (@bad = BadWords::check($line)) {
        return (1, ());
 }
 
-return (1, $self->msg('dup')) if $self->priv < 5 && AnnTalk::dup($from, $toflag, $line);
+return (1, $self->msg('dup')) if $self->priv < 5 && AnnTalk::dup($from, $tonode, $line);
 Log('ann', $to, $from, $line);
-DXChannel::broadcast_list("To $to de $from ($t): $line\a", 'ann', undef, @locals);
 if ($to ne "LOCAL") {
-  my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0);
-  DXChannel::broadcast_nodes($pc);
+       my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0);
+       DXProt::send_announce($main::me, $pc, $from, $tonode, $line, $sysopflag, $main::mycall, '0' );
+} else {
+       DXChannel::broadcast_list("To $to de $from ($t): $line\a", 'ann', undef, @locals);
 }
 
 return (1, ());

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 9e9a708e367bd66baf4c6e0a87a6b9d46264d6a5..a72b0232aed11b5235547200014e7ed946202244 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -770,6 +770,7 @@ sub talk
 sub announce
 {
        my $self = shift;
+       my $origin = shift;
        my $line = shift;
        my $isolate = shift;
        my $to = shift;
@@ -801,6 +802,7 @@ sub announce
 sub dx_spot
 {
        my $self = shift;
+       my $origin = shift;
        my $line = shift;
        my $isolate = shift;
        my ($filter, $hops);
@@ -827,6 +829,7 @@ sub dx_spot
 sub wwv
 {
        my $self = shift;
+       my $origin = shift;
        my $line = shift;
        my $isolate = shift;
        my ($filter, $hops);
@@ -846,6 +849,7 @@ sub wwv
 sub wcy
 {
        my $self = shift;
+       my $origin = shift;
        my $line = shift;
        my $isolate = shift;
        my ($filter, $hops);

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 9f9ffd4ae17c240f0f7c0485cd847f72fcecd127..63d8bb6f011bd1834dda323ef7e7a3b60b75748c 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -1141,7 +1141,7 @@ sub handle_25
                my @in = reverse Spot::search(1, undef, undef, 0, $_[3]);
                my $in;
                foreach $in (@in) {
-                       $self->send(pc26(@{$in}[0..4], $_[2]));
+                       $self->send_frame($main::me, pc26(@{$in}[0..4], $_[2]));
                }
        }
 
@@ -1150,7 +1150,7 @@ sub handle_25
                my @in = reverse Geomag::search(0, $_[4], time, 1);
                my $in;
                foreach $in (@in) {
-                       $self->send(pc27(@{$in}[0..5], $_[2]));
+                       $self->send_frame($main::me, pc27(@{$in}[0..5], $_[2]));
                }
        }
 }
@@ -1364,7 +1364,7 @@ sub handle_51
        # is it for us?
        if ($to eq $main::mycall) {
                if ($flag == 1) {
-                       $self->send(pc51($from, $to, '0'));
+                       $self->send_frame($main::me, pc51($from, $to, '0'));
                } else {
                        # it's a reply, look in the ping list for this one
                        my $ref = $pings{$from};
@@ -1521,7 +1521,7 @@ sub process
                next if $dxchan == $main::me;
 
                # send the pc50 or PC90
-               $dxchan->send($pc50s) if $pc50s;
+               $dxchan->send_frame($main::me, $pc50s) if $pc50s;
                
                # send a ping out on this channel
                if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
@@ -1552,9 +1552,17 @@ sub process
 }
 
 #
-# finish up a pc context
+# wrap send up so that we can tell where this came from
+# new prot will need this
 #
 
+sub send_frame
+{
+       my $to = shift;
+       my $from = shift;
+       $to->send(@_);
+}
+
 #
 # some active measures
 #
@@ -1572,13 +1580,14 @@ sub send_dx_spot
        foreach $dxchan (@dxchan) {
                next if $dxchan == $main::me;
                next if $dxchan == $self && $self->is_node;
-               $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call});
+               $dxchan->dx_spot($self, $line, $self->{isolate}, @_, $self->{call});
        }
 }
 
 sub dx_spot
 {
        my $self = shift;
+       my $origin = shift;
        my $line = shift;
        my $isolate = shift;
        my ($filter, $hops);
@@ -1587,12 +1596,12 @@ sub dx_spot
                ($filter, $hops) = $self->{spotsfilter}->it(@_);
                return unless $filter;
        }
-       send_prot_line($self, $filter, $hops, $isolate, $line);
+       send_prot_line($self, $origin, $filter, $hops, $isolate, $line);
 }
 
 sub send_prot_line
 {
-       my ($self, $filter, $hops, $isolate, $line) = @_;
+       my ($self, $origin, $filter, $hops, $isolate, $line) = @_;
        my $routeit;
        
        if ($hops) {
@@ -1603,9 +1612,9 @@ sub send_prot_line
                return unless $routeit;
        }
        if ($filter) {
-               $self->send($routeit);
+               $self->send_frame($origin, $routeit);
        } else {
-               $self->send($routeit) unless $self->{isolate} || $isolate;
+               $self->send_frame($origin, $routeit) unless $self->{isolate} || $isolate;
        }
 }
 
@@ -1638,7 +1647,7 @@ sub send_wwv_spot
                my $routeit;
                my ($filter, $hops);
 
-               $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->wwv($self, $line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
        }
        
 }
@@ -1646,6 +1655,7 @@ sub send_wwv_spot
 sub wwv
 {
        my $self = shift;
+       my $origin = shift;
        my $line = shift;
        my $isolate = shift;
        my ($filter, $hops);
@@ -1654,7 +1664,7 @@ sub wwv
                ($filter, $hops) = $self->{wwvfilter}->it(@_);
                return unless $filter;
        }
-       send_prot_line($self, $filter, $hops, $isolate, $line)
+       send_prot_line($self, $origin, $filter, $hops, $isolate, $line)
 }
 
 sub send_wcy_spot
@@ -1683,13 +1693,14 @@ sub send_wcy_spot
                next if $dxchan == $main::me;
                next if $dxchan == $self;
 
-               $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->wcy($self, $line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
        }
 }
 
 sub wcy
 {
        my $self = shift;
+       my $origin = shift;
        my $line = shift;
        my $isolate = shift;
        my ($filter, $hops);
@@ -1698,7 +1709,7 @@ sub wcy
                ($filter, $hops) = $self->{wcyfilter}->it(@_);
                return unless $filter;
        }
-       send_prot_line($self, $filter, $hops, $isolate, $line) if $self->is_clx || $self->is_spider || $self->is_dxnet;
+       send_prot_line($self, $origin,$filter, $hops, $isolate, $line) if $self->is_clx || $self->is_spider || $self->is_dxnet;
 }
 
 # send an announce
@@ -1767,13 +1778,14 @@ sub send_announce
        foreach $dxchan (@dxchan) {
                next if $dxchan == $main::me;
                next if $dxchan == $self && $self->is_node;
-               $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->announce($self, $line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
        }
 }
 
 sub announce
 {
        my $self = shift;
+       my $origin = shift;
        my $line = shift;
        my $isolate = shift;
        my $to = shift;
@@ -1785,7 +1797,7 @@ sub announce
                ($filter, $hops) = $self->{annfilter}->it(@_);
                return unless $filter;
        }
-       send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall;
+       send_prot_line($self, $origin, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall;
 }
 
 
@@ -1818,13 +1830,13 @@ sub send_local_config
        }
        
 
-       $self->send_route(\&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes);
+       $self->send_route($main::me, \&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes);
        
        # get all the users connected on the above nodes and send them out
        foreach $node (@localnodes, @remotenodes) {
                if ($node) {
                        my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users;
-                       $self->send_route(\&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
+                       $self->send_route($main::me, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
                } else {
                        dbg("sent a null value") if isdbg('chanerr');
                }
@@ -1860,7 +1872,7 @@ sub route
        if ($dxchan) {
                my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
                if ($routeit) {
-                       $dxchan->send($routeit) unless $dxchan == $main::me;
+                       $dxchan->send_frame($self, $routeit) unless $dxchan == $main::me;
                }
        } else {
                dbg("PCPROT: No route available, dropped") if isdbg('chanerr');
@@ -1900,7 +1912,7 @@ sub adjust_hops
                        return "" if defined $newhops && $newhops == 0;
                        $newhops = $ref->{default} unless $newhops;
                        return "" if defined $newhops && $newhops == 0;
-                       $newhops = $hops if !$newhops;
+                       $newhops = $hops if !$newhops || $hops < $newhops;
                        $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops;
                } else {
                        # simply decrement it
@@ -2115,6 +2127,7 @@ sub talk
 sub send_route
 {
        my $self = shift;
+       my $origin = shift;
        my $generate = shift;
        my $no = shift;     # the no of things to filter on 
        my $routeit;
@@ -2149,7 +2162,7 @@ sub send_route
                                $routeit = adjust_hops($self, $line);  # adjust its hop count by node name
                                next unless $routeit;
                        }
-                       $self->send($routeit);
+                       $self->send_frame($origin, $routeit);
                }
        }
 }
@@ -2169,7 +2182,7 @@ sub broadcast_route
                        next unless $dxchan->isa('DXProt');
                        next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16;
  
-                       $dxchan->send_route($generate, @_);
+                       $dxchan->send_route($self, $generate, @_);
                }
        }
 }

diff --git a/perl/QXProt.pm b/perl/QXProt.pm
index b9cf952cb497a553d4fed6aa0069f09d7d20e2f5..38d878ed3b73be1ffcac23e0807a319219af0952 100644 (file)
--- a/perl/QXProt.pm
+++ b/perl/QXProt.pm
@@ -149,6 +149,15 @@ sub frame
        return "$line^$cs";
 }
 
+sub send_frame
+{
+       my $self = shift;
+       my $origin = shift;
+       for (@_) {
+               $self->send(frame('X', undef, $origin == $main::me || $origin->is_user ? '' : $origin->call, $_));
+       }
+}
+
 sub handleI
 {
        my $self = shift;
@@ -208,39 +217,17 @@ sub genP
 
 }
 
-sub gen2
+sub handleX
 {
        my $self = shift;
-       
-       my $node = shift;
-       my $sort = shift;
-       my @out;
-       my $dxchan;
-       
-       while (@_) {
-               my $str = '';
-               for (; @_ && length $str <= 230;) {
-                       my $ref = shift;
-                       my $call = $ref->call;
-                       my $flag = 0;
-                       
-                       $flag += 1 if $ref->here;
-                       $flag += 2 if $ref->conf;
-                       if ($ref->is_node) {
-                               my $ping = int($ref->pingave * 10);
-                               $str .= "^N$flag$call,$ping";
-                               my $v = $ref->build || $ref->version;
-                               $str .= ",$v" if defined $v;
-                       } else {
-                               $str .= "^U$flag$call";
-                       }
-               }
-               push @out, $str if $str;
+       my ($tonode, $fromnode, $msgid, $line) = @_[0..3];
+       my ($origin, $l) = split /\^/, $line, 2;
+
+       my ($pcno) = $l =~ /^PC(\d\d)/;
+       if ($pcno) {
+               DXProt::normal($self, $l);
        }
-       my $n = @out;
-       my $h = get_hops(90);
-       @out = map { sprintf "PC90^%s^%X^%s%d%s^%s^", $node->call, $main::systime, $sort, --$n, $_, $h } @out;
-       return @out;
 }
 
+
 1;