From ab10b5e76b152d41273281b30b019e4c82ed22d8 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Sat, 24 May 2003 17:55:59 +0000
Subject: [PATCH] start PC90 development

---
 cmd/set/wantpc90.pl   |  28 +++++
 cmd/unset/wantpc90.pl |  28 +++++
 perl/DXProt.pm        | 233 ++++++++++++++++++++++++++++++++----------
 perl/DXUser.pm        |  23 +++++
 4 files changed, 258 insertions(+), 54 deletions(-)
 create mode 100644 cmd/set/wantpc90.pl
 create mode 100644 cmd/unset/wantpc90.pl

diff --git a/cmd/set/wantpc90.pl b/cmd/set/wantpc90.pl
new file mode 100644
index 00000000..81cd2e12
--- /dev/null
+++ b/cmd/set/wantpc90.pl
@@ -0,0 +1,28 @@
+#
+# set the want PC90 flag
+#
+# Copyright (c) 2002 - Dirk Koopman
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $call;
+my @out;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+foreach $call (@args) {
+	return (1, $self->msg('e12')) unless is_callsign($call);
+
+	my $user = DXUser->get_current($call);
+	if ($user) {
+		$user->wantpc90(1);
+		$user->put;
+		push @out, $self->msg('wpc90s', $call);
+	} else {
+		push @out, $self->msg('e3', "set/wantpc90", $call);
+	}
+}
+return (1, @out);
diff --git a/cmd/unset/wantpc90.pl b/cmd/unset/wantpc90.pl
new file mode 100644
index 00000000..a4684c13
--- /dev/null
+++ b/cmd/unset/wantpc90.pl
@@ -0,0 +1,28 @@
+#
+# unset the want PC90 flag
+#
+# Copyright (c) 2002 - Dirk Koopman
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $call;
+my @out;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+foreach $call (@args) {
+	return (1, $self->msg('e12')) unless is_callsign($call);
+
+	my $user = DXUser->get_current($call);
+	if ($user) {
+		$user->wantpc90(0);
+		$user->put;
+		push @out, $self->msg('wpc90u', $call);
+	} else {
+		push @out, $self->msg('e3', "unset/wantpc90", $call);
+	}
+}
+return (1, @out);
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index a3049ee3..5028e2f9 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -74,48 +74,48 @@ $chatdupeage = 20 * 60 * 60;
 
 @checklist = 
 (
- [ qw(c c m bp bc c) ],			# pc10
- [ qw(f m d t m c c h) ],		# pc11
- [ qw(c bm m bm bm p h) ],		# pc12
- [ qw(c h) ],					# 
- [ qw(c h) ],					# 
- [ qw(c m h) ],					# 
+ [ qw(i c c m bp bc c) ],			# pc10
+ [ qw(i f m d t m c c h) ],		# pc11
+ [ qw(i c bm m bm bm p h) ],		# pc12
+ [ qw(i c h) ],					# 
+ [ qw(i c h) ],					# 
+ [ qw(i c m h) ],					# 
  undef ,						# pc16 has to be validated manually
- [ qw(c c h) ],					# pc17
- [ qw(m n) ],					# pc18
+ [ qw(i c c h) ],					# pc17
+ [ qw(i m n) ],					# pc18
  undef ,						# pc19 has to be validated manually
  undef ,						# pc20 no validation
- [ qw(c m h) ],					# pc21
+ [ qw(i c m h) ],					# pc21
  undef ,						# pc22 no validation
- [ qw(d n n n n m c c h) ],		# pc23
- [ qw(c p h) ],					# pc24
- [ qw(c c n n) ],				# pc25
- [ qw(f m d t m c c bc) ],		# pc26
- [ qw(d n n n n m c c bc) ],	# pc27
- [ qw(c c m c d t p m bp n p bp bc) ], # pc28
- [ qw(c c n m) ],				# pc29
- [ qw(c c n) ],					# pc30
- [ qw(c c n) ],					# pc31
- [ qw(c c n) ],					# pc32
- [ qw(c c n) ],					# pc33
- [ qw(c c m) ],					# pc34
- [ qw(c c m) ],					# pc35
- [ qw(c c m) ],					# pc36
- [ qw(c c n m) ],				# pc37
+ [ qw(i d n n n n m c c h) ],		# pc23
+ [ qw(i c p h) ],					# pc24
+ [ qw(i c c n n) ],				# pc25
+ [ qw(i f m d t m c c bc) ],		# pc26
+ [ qw(i d n n n n m c c bc) ],	# pc27
+ [ qw(i c c m c d t p m bp n p bp bc) ], # pc28
+ [ qw(i c c n m) ],				# pc29
+ [ qw(i c c n) ],					# pc30
+ [ qw(i c c n) ],					# pc31
+ [ qw(i c c n) ],					# pc32
+ [ qw(i c c n) ],					# pc33
+ [ qw(i c c m) ],					# pc34
+ [ qw(i c c m) ],					# pc35
+ [ qw(i c c m) ],					# pc36
+ [ qw(i c c n m) ],				# pc37
  undef,							# pc38 not interested
- [ qw(c m) ],					# pc39
- [ qw(c c m p n) ],				# pc40
- [ qw(c n m h) ],				# pc41
- [ qw(c c n) ],					# pc42
+ [ qw(i c m) ],					# pc39
+ [ qw(i c c m p n) ],				# pc40
+ [ qw(i c n m h) ],				# pc41
+ [ qw(i c c n) ],					# pc42
  undef,							# pc43 don't handle it
- [ qw(c c n m m c) ],			# pc44
- [ qw(c c n m) ],				# pc45
- [ qw(c c n) ],					# pc46
+ [ qw(i c c n m m c) ],			# pc44
+ [ qw(i c c n m) ],				# pc45
+ [ qw(i c c n) ],					# pc46
  undef,							# pc47
  undef,							# pc48
- [ qw(c m h) ],					# pc49
- [ qw(c n h) ],					# pc50
- [ qw(c c n) ],					# pc51
+ [ qw(i c m h) ],					# pc49
+ [ qw(i c n h) ],					# pc50
+ [ qw(i c c n) ],					# pc51
  undef,
  undef,
  undef,
@@ -137,7 +137,7 @@ $chatdupeage = 20 * 60 * 60;
  undef,							# pc70
  undef,
  undef,
- [ qw(d n n n n n n m m m c c h) ],	# pc73
+ [ qw(i d n n n n n n m m m c c h) ],	# pc73
  undef,
  undef,
  undef,
@@ -148,8 +148,13 @@ $chatdupeage = 20 * 60 * 60;
  undef,
  undef,
  undef,
- [ qw(c c c m) ],				# pc84
- [ qw(c c c m) ],				# pc85
+ [ qw(i c c c m) ],				# pc84
+ [ qw(i c c c m) ],				# pc85
+ undef,
+ undef,
+ undef,
+ undef,
+ [ qw(i c n) ],					# pc90
 );
 
 # use the entry in the check list to check the field list presented
@@ -163,28 +168,29 @@ sub check
 	return 0 unless ref $ref;
 	
 	my $i;
-	shift;    # not interested in the first field
-	for ($i = 0; $i < @$ref; $i++) {
+	for ($i = 1; $i < @$ref; $i++) {
 		my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/;
 		return 0 unless $act;
 		next if $blank && $_[$i] =~ /^[ \*]$/;
 		if ($act eq 'c') {
-			return $i+1 unless is_callsign($_[$i]);
+			return $i unless is_callsign($_[$i]);
+		} elsif ($act eq 'i') {			
+			;					# do nothing
 		} elsif ($act eq 'm') {
-			return $i+1 unless is_pctext($_[$i]);
+			return $i unless is_pctext($_[$i]);
 		} elsif ($act eq 'p') {
-			return $i+1 unless is_pcflag($_[$i]);
+			return $i unless is_pcflag($_[$i]);
 		} elsif ($act eq 'f') {
-			return $i+1 unless is_freq($_[$i]);
+			return $i unless is_freq($_[$i]);
 		} elsif ($act eq 'n') {
-			return $i+1 unless $_[$i] =~ /^[\d ]+$/;
+			return $i unless $_[$i] =~ /^[\d ]+$/;
 		} elsif ($act eq 'h') {
-			return $i+1 unless $_[$i] =~ /^H\d\d?$/;
+			return $i unless $_[$i] =~ /^H\d\d?$/;
 		} elsif ($act eq 'd') {
-			return $i+1 unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
+			return $i unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
 		} elsif ($act eq 't') {
-			return $i+1 unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
-		}
+			return $i unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
+		} 
 	}
 	return 0;
 }
@@ -295,6 +301,40 @@ sub sendinit
 	$self->send(pc18());
 }
 
+sub removepc90
+{
+	$_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
+}
+
+sub send
+{
+	my $self = shift;
+	my $line = shift;
+	if ($self->user->wantpc90) {
+		$line = mungepc90($line);
+	} else {
+		removepc90($line);
+	}
+	$self->SUPER::send($line);
+}
+
+my $pc90msgid = 0;
+
+sub nextpc90
+{
+	$pc90msgid = 0 if $pc90msgid > 9999;
+	return $pc90msgid++;
+}
+
+sub mungepc90
+{
+	unless ($_[0] =~ /^PC90/) {
+		my $id = nextpc90();
+		return "PC90^$main::mycall^$id^" . $_[0]; 
+	} 
+	return $_[0];
+}
+
 #
 # This is the normal pcxx despatcher
 #
@@ -321,6 +361,58 @@ sub normal
 		return;
 	}
 
+	# handle PC90 frames in a special way.
+    # 
+	# PC90 frames are normal frames that that are wrapped in inside a PC90 
+    # The extra fields are "originating node" and a sequence number.
+    # The sequence number is checked against the nodes 'last one' to see if
+	# it is a duplicate and, if so, is dropped at this stage; before any
+	# other processing.
+	#
+	# This is done here simply for efficiency. Adding another function would
+	# add more copying and so on.
+	#
+
+	my $origin = $self->call;
+	
+	if ($pcno >= 90) {
+		$origin = $field[1];
+		if ($origin eq $main::mycall) {
+			dbg("PCPROT: loop dupe") if isdbg('chanerr');
+			return;
+		}
+		my $seq = $field[2];
+		my $node = Route::Node::get($origin);
+		if ($node) {
+			if (my $lid = $node->lid) {
+				my $cmp = $seq >= $lid ? $seq : $seq + 9999;
+				if ($cmp <= $lid) {
+					dbg("PCPROT: sequence dupe $seq ($cmp) <= $lid") if isdbg('chanerr');
+					return;
+				}
+			}
+			$node->lid($seq);
+		}
+
+		# do a recheck on the contents of the PC90
+		if ($pcno == 90) {
+			shift @field;
+			shift @field;
+			shift @field;
+			
+			($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
+			return unless $pcno;
+			return if $pcno < 10 || $pcno > 99;
+			
+			# check for and dump bad protocol messages
+			my $n = check($pcno, @field);
+			if ($n) {
+				dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
+				return;
+			}
+		}
+	}
+
 	# local processing 1
 	my $pcr;
 	eval {
@@ -331,10 +423,14 @@ sub normal
 
 	no strict 'subs';
 	my $sub = "handle_$pcno";
+
+	# add missing PC90 if not present (for ongoing distribution)
+	$line = mungepc90($line) if $pcno < 90;
+
 	if ($self->can($sub)) {
-		$self->$sub($pcno, $line, @field);
+		$self->$sub($pcno, $line, $origin, @field);
 	} else {
-		$self->handle_default($pcno, $line, @field);
+		$self->handle_default($pcno, $line, $origin, @field);
 	}
 }
 	
@@ -344,8 +440,9 @@ sub handle_10
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
-			# rsfp check
+	# rsfp check
 	return if $rspfcheck and !$self->rspfcheck(0, $_[6], $_[1]);
 			
 	# will we allow it at all?
@@ -425,6 +522,7 @@ sub handle_11
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	# route 'foreign' pc26s 
 	if ($pcno == 26) {
@@ -577,6 +675,7 @@ sub handle_12
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	#			return if $rspfcheck and !$self->rspfcheck(1, $_[5], $_[1]);
 
@@ -645,7 +744,7 @@ sub handle_16
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
-
+	my $origin = shift;
 
 	if (eph_dup($line)) {
 		dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
@@ -790,6 +889,7 @@ sub handle_17
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $dxchan;
 	my $ncall = $_[2];
 	my $ucall = $_[1];
@@ -842,6 +942,7 @@ sub handle_18
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->state('init');	
 
 	# record the type and version offered
@@ -875,6 +976,7 @@ sub handle_19
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	my $i;
 	my $newline = "PC19^";
@@ -983,6 +1085,7 @@ sub handle_20
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->send_local_config();
 	$self->send(pc22());
 	$self->state('normal');
@@ -995,6 +1098,7 @@ sub handle_21
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = uc $_[1];
 
 	eph_del_regex("^PC1[679].*$call");
@@ -1051,6 +1155,7 @@ sub handle_22
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->state('normal');
 	$self->{lastping} = 0;
 }
@@ -1061,6 +1166,7 @@ sub handle_23
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 			
 	# route foreign' pc27s 
 	if ($pcno == 27) {
@@ -1111,6 +1217,7 @@ sub handle_24
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = uc $_[1];
 	my ($nref, $uref);
 	$nref = Route::Node::get($call);
@@ -1136,6 +1243,7 @@ sub handle_25
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	if ($_[1] ne $main::mycall) {
 		$self->route($_[1], $line);
 		return;
@@ -1175,6 +1283,7 @@ sub handle_28
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	if ($_[1] eq $main::mycall) {
 		no strict 'refs';
 		my $sub = "DXMsg::handle_$pcno";
@@ -1195,6 +1304,7 @@ sub handle_34
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	if (eph_dup($line, $eph_pc34_restime)) {
 		dbg("PCPROT: dupe PC34, ignored") if isdbg('chanerr');
 	} else {
@@ -1208,6 +1318,7 @@ sub handle_35
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	eph_del_regex("^PC35\\^$_[2]\\^$_[1]\\^");
 	$self->process_rcmd_reply($_[1], $_[2], $_[1], $_[3]);
 }
@@ -1220,6 +1331,7 @@ sub handle_37
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	DXDb::process($self, $line);
 }
 
@@ -1229,6 +1341,7 @@ sub handle_38
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 }
 		
 # incoming disconnect
@@ -1237,6 +1350,7 @@ sub handle_39
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	if ($_[1] eq $self->{call}) {
 		$self->disconnect(1);
 	} else {
@@ -1252,6 +1366,7 @@ sub handle_41
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = $_[1];
 
 	my $l = $line;
@@ -1328,6 +1443,7 @@ sub handle_49
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	if (eph_dup($line)) {
 		dbg("PCPROT: Dup PC49 ignored\n") if isdbg('chanerr');
@@ -1347,6 +1463,7 @@ sub handle_50
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	my $call = $_[1];
 	my $node = Route::Node::get($call);
@@ -1367,6 +1484,7 @@ sub handle_51
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $to = $_[1];
 	my $from = $_[2];
 	my $flag = $_[3];
@@ -1429,6 +1547,7 @@ sub handle_75
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = $_[1];
 	if ($call ne $main::mycall) {
 		$self->route($call, $line);
@@ -1441,6 +1560,7 @@ sub handle_73
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = $_[1];
 			
 	# do some de-duping
@@ -1474,6 +1594,7 @@ sub handle_84
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->process_rcmd($_[1], $_[2], $_[3], $_[4]);
 }
 
@@ -1483,9 +1604,10 @@ sub handle_85
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->process_rcmd_reply($_[1], $_[2], $_[3], $_[4]);
 }
-	
+
 # if get here then rebroadcast the thing with its Hop count decremented (if
 # there is one). If it has a hop count and it decrements to zero then don't
 # rebroadcast it.
@@ -1499,6 +1621,7 @@ sub handle_default
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	if (eph_dup($line)) {
 		dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr');
@@ -1603,7 +1726,8 @@ sub send_prot_line
 {
 	my ($self, $filter, $hops, $isolate, $line) = @_;
 	my $routeit;
-	
+
+
 	if ($hops) {
 		$routeit = $line;
 		$routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
@@ -2334,6 +2458,7 @@ sub eph_dup
 
 	# chop the end off
 	$s =~ s/\^H\d\d?\^?\~?$//;
+	removepc90($s);
 	$r = 1 if exists $eph{$s};    # pump up the dup if it keeps circulating
 	$eph{$s} = $main::systime + $t;
 	return $r;
diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index e62123bf..b254ae5a 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -592,6 +592,8 @@ sub sort
 }
 
 # some accessors
+
+# want is default = 1
 sub _want
 {
 	my $n = shift;
@@ -602,6 +604,17 @@ sub _want
 	return exists $self->{$s} ? $self->{$s} : 1;
 }
 
+# wantnot is default = 0
+sub _wantnot
+{
+	my $n = shift;
+	my $self = shift;
+	my $val = shift;
+	my $s = "want$n";
+	$self->{$s} = $val if defined $val;
+	return exists $self->{$s} ? $self->{$s} : 0;
+}
+
 sub wantbeep
 {
 	return _want('beep', @_);
@@ -662,6 +675,11 @@ sub wantpc16
 	return _want('pc16', @_);
 }
 
+sub wantpc90
+{
+	return _wantnot('pc90', @_);
+}
+
 sub wantsendpc16
 {
 	return _want('sendpc16', @_);
@@ -687,6 +705,11 @@ sub wantdxitu
 	return _want('dxitu', @_);
 }
 
+sub wantnp
+{
+	return _wantnot('np', @_);
+}
+
 sub wantlogininfo
 {
 	my $self = shift;
-- 
2.43.0