From 26bef9a106b74abceabc68cab21c9b9e9284266d Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Tue, 21 Jan 2003 14:50:18 +0000
Subject: [PATCH] basic raw PC base NP added

---
 Changes               |  8 ++++++
 cmd/announce.pl       | 14 +++++------
 perl/DXCommandmode.pm |  4 +++
 perl/DXProt.pm        | 57 ++++++++++++++++++++++++++-----------------
 perl/QXProt.pm        | 47 +++++++++++++----------------------
 5 files changed, 71 insertions(+), 59 deletions(-)

diff --git a/Changes b/Changes
index 658b403c..0d27216b 100644
--- 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 6b66d68e..f2251530 100644
--- 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 9e9a708e..a72b0232 100644
--- 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 9f9ffd4a..63d8bb6f 100644
--- 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 b9cf952c..38d878ed 100644
--- 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;
-- 
2.34.1