From: djk <djk>
Date: Wed, 24 Nov 1999 15:27:38 +0000 (+0000)
Subject: added swop file
X-Git-Tag: R_1_36~4
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=a8b7d0b77fd3cefb1943ce7548f8c803aa83ff39;p=spider.git

added swop file
extended badmsg file to allow regexes on various fields
detail changes to all load/* commands
---

diff --git a/cmd/load/aliases.pl b/cmd/load/aliases.pl
index 45a3c165..41f28211 100644
--- a/cmd/load/aliases.pl
+++ b/cmd/load/aliases.pl
@@ -2,7 +2,7 @@
 # load the Command Aliases file after changing it
 #
 my $self = shift;
-return (0, $self->msg('e5')) if $self->priv < 9;
+return (1, $self->msg('e5')) if $self->priv < 9;
 my @out = CmdAlias::load($self);
 @out = ($self->msg('ok')) if !@out;
 return (1, @out); 
diff --git a/cmd/load/baddx.pl b/cmd/load/baddx.pl
index 3a1dbef3..64a54c9d 100644
--- a/cmd/load/baddx.pl
+++ b/cmd/load/baddx.pl
@@ -1,7 +1,7 @@
 # reload the baddx file
 my $self = shift;
 my @out;
-return (0, $self->msg('e5')) if $self->priv < 9;
+return (1, $self->msg('e5')) if $self->priv < 9;
 do "$main::data/baddx.pl" if -e "$main::data/baddx.pl";
 push @out, $@ if $@;
 @out = ($self->msg('ok')) unless @out;
diff --git a/cmd/load/badmsg.pl b/cmd/load/badmsg.pl
index 5a5cbc38..18eb747f 100644
--- a/cmd/load/badmsg.pl
+++ b/cmd/load/badmsg.pl
@@ -1,7 +1,7 @@
 # reload the badmsg file
 my $self = shift;
 my @out;
-return (0, $self->msg('e5')) if $self->priv < 9;
+return (1, $self->msg('e5')) if $self->priv < 9;
 push @out, (DXMsg::load_badmsg());
 @out = ($self->msg('ok')) unless @out;
 return (1, @out); 
diff --git a/cmd/load/bands.pl b/cmd/load/bands.pl
index cd184f68..856aebc5 100644
--- a/cmd/load/bands.pl
+++ b/cmd/load/bands.pl
@@ -2,7 +2,7 @@
 # load the bands  file after changing it
 #
 my $self = shift;
-return (0, $self->msg('e5')) if $self->priv < 9;
+return (1, $self->msg('e5')) if $self->priv < 9;
 my @out = Bands::load($self);
 @out = ($self->msg('ok')) if !@out;
 return (1, @out); 
diff --git a/cmd/load/forward.pl b/cmd/load/forward.pl
index 27fa48da..8f1ed58d 100644
--- a/cmd/load/forward.pl
+++ b/cmd/load/forward.pl
@@ -1,7 +1,7 @@
 # reload the message forward file
 my $self = shift;
 my @out;
-return (0, $self->msg('e5')) if $self->priv < 9;
+return (1, $self->msg('e5')) if $self->priv < 9;
 push @out, (DXMsg::load_forward());
 @out = ($self->msg('ok')) unless @out;
 return (1, @out); 
diff --git a/cmd/load/hops.pl b/cmd/load/hops.pl
index 592b7920..a4a1aafe 100644
--- a/cmd/load/hops.pl
+++ b/cmd/load/hops.pl
@@ -2,7 +2,7 @@
 # load the node hop count table after changing it
 #
 my $self = shift;
-return (0, $self->msg('e5')) if $self->priv < 9;
+return (1, $self->msg('e5')) if $self->priv < 9;
 my @out = DXProt::load_hops($self);
 @out = ($self->msg('ok')) if !@out;
 return (1, @out); 
diff --git a/cmd/load/messages.pl b/cmd/load/messages.pl
index b8f0dd37..8db34e7c 100644
--- a/cmd/load/messages.pl
+++ b/cmd/load/messages.pl
@@ -2,7 +2,7 @@
 # load the the Messages file after changing it
 #
 my $self = shift;
-return (0, $self->msg('e5')) if $self->priv < 9;
+return (1, $self->msg('e5')) if $self->priv < 9;
 my @out = DXM::load($self);
 @out = ($self->msg('ok')) if !@out;
 return (1, @out); 
diff --git a/cmd/load/prefixes.pl b/cmd/load/prefixes.pl
index cd211ba8..bf29b256 100644
--- a/cmd/load/prefixes.pl
+++ b/cmd/load/prefixes.pl
@@ -2,7 +2,7 @@
 # load the prefix_data  file after changing it
 #
 my $self = shift;
-return (0, $self->msg('e5')) if $self->priv < 9;
+return (1, $self->msg('e5')) if $self->priv < 9;
 my $out = Prefix::load();
 return (1, $out ? $out : $self->msg('ok'));
 
diff --git a/cmd/load/swop.pl b/cmd/load/swop.pl
new file mode 100644
index 00000000..a9e0e50d
--- /dev/null
+++ b/cmd/load/swop.pl
@@ -0,0 +1,7 @@
+# reload the swop file
+my $self = shift;
+my @out;
+return (1, $self->msg('e5')) if $self->priv < 9;
+push @out, (DXMsg::load_swop());
+@out = ($self->msg('ok')) unless @out;
+return (1, @out); 
diff --git a/msg/badmsg.pl.issue b/msg/badmsg.pl.issue
index 7a1b3fea..3b13e3bf 100644
--- a/msg/badmsg.pl.issue
+++ b/msg/badmsg.pl.issue
@@ -1,14 +1,36 @@
 #
-# the list of TO addresses for messages that we won't store having
+# the list of regexes for messages that we won't store having
 # received them (bear in mind that we must receive them fully before
 # we can bin them)
 #
+#
+# The format of each line is as follows
+#
+#     type      source             pattern 
+#     P/B/F     T/F/O/S            regex  
+#
+# type: P - private, B - bulletin (msg), F - file (ak1a bull)
+# source: T - to field, F - from field,  O - origin, S - subject 
+# pattern: a perl regex on the field requested
+#
+# Currently only type B and P msgs are affected by this code.
+# 
+# The list is read from the top down, the first pattern that matches
+# causes the action to be taken.
+#
+# The pattern can be undef or 0 in which case it will always be selected
+# for the action specified
+#
+
 
 package DXMsg;
 
-@badmsg = qw
-(
- SALE
- FORSALE
- WANTED
-);
+@badmsg = (
+'B', 	'T',	'SALE',	
+'B', 	'T',	'WANTED',
+'B', 	'S',	'WANTED',
+'B', 	'S',	'SALE',	
+'B',    'S',    'WTB',
+'B',    'S',    'WTS',
+); 
+
diff --git a/msg/swop.pl.issue b/msg/swop.pl.issue
new file mode 100644
index 00000000..cc8697f9
--- /dev/null
+++ b/msg/swop.pl.issue
@@ -0,0 +1,40 @@
+#
+# the list of regexes for messages that we won't store having
+# received them (bear in mind that we must receive them fully before
+# we can bin them)
+#
+#
+# The format of each line is as follows
+#
+#     type      source       pattern   tofield   to 
+#     P/B/F     T/F/O/S      regex     T/F/O/S   expression
+#
+# type: P - private, B - bulletin (msg), F - file (ak1a bull)
+# source: T - to field, F - from field,  O - origin, S - subject 
+# pattern: a perl regex on the field requested
+# tofield: T - to field, F - from field,  O - origin, S - subject 
+# to: what you want this field changed to
+#
+# Currently only type B and P msgs are affected by this code.
+# 
+# The list is read from the top down, the first pattern that matches
+# causes the action to be taken.
+#
+# Basically this will take all the headers in turn and shove them thru the
+# rewrite engine, starting at the top. 
+#
+# The result is then passed thru the rest of the system as though it came in
+# like that.
+#
+# You can either swop a field for another another value or set a field to
+# value after regexing another field - useful in europe where we are paranoid
+# about for sale notices - you can check subject for suspicious words and
+# the swop the TO field.
+#
+
+package DXMsg;
+
+@swap = (
+
+); 
+
diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index a3c0798e..10857152 100644
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -32,7 +32,7 @@ use Carp;
 
 use strict;
 use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
-			@badmsg $badmsgfn $forwardfn @forward $timeout $waittime
+			@badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime
 		    $queueinterval $lastq);
 
 %work = ();						# outstanding jobs
@@ -42,6 +42,8 @@ $msgdir = "$main::root/msg";	# directory contain the msgs
 $maxage = 30 * 86400;			# the maximum age that a message shall live for if not marked 
 $last_clean = 0;				# last time we did a clean
 @forward = ();                  # msg forward table
+@badmsg = ();					# bad message table
+@swop = ();						# swop table
 $timeout = 30*60;               # forwarding timeout
 $waittime = 30*60;              # time an aborted outgoing message waits before trying again
 $queueinterval = 1*60;          # run the queue every 1 minute
@@ -50,6 +52,7 @@ $lastq = 0;
 
 $badmsgfn = "$msgdir/badmsg.pl";  # list of TO address we wont store
 $forwardfn = "$msgdir/forward.pl";  # the forwarding table
+$swopfn = "$msgdir/swop.pl";  # the swopping table
 
 %valid = (
 		  fromnode => '5,From Node',
@@ -276,12 +279,16 @@ sub process
 								return;
 							}
 						}
-							
+
+						# swop addresses
+						$ref->swop_it($self->call);
+						
 						# look for 'bad' to addresses 
-						if (grep $ref->{to} eq $_, @badmsg) {
+#						if (grep $ref->{to} eq $_, @badmsg) {
+						if ($ref->dump_it($self->call)) {
 							$ref->stop_msg($self->call);
-							dbg('msg', "'Bad' TO address $ref->{to}");
-							Log('msg', "'Bad' TO address $ref->{to}");
+							dbg('msg', "'Bad' message $ref->{to}");
+							Log('msg', "'Bad' message $ref->{to}");
 							return;
 						}
 
@@ -594,6 +601,7 @@ sub queue_msg
 		# deal with routed private messages
 		my $noderef;
 		if ($ref->{private}) {
+			next if $ref->{'read'};           # if it is read, it is stuck here
 			$clref = DXCluster->get_exact($ref->{to});
 			unless ($clref) {             # otherwise look for a homenode
 				my $uref = DXUser->get($ref->{to});
@@ -722,12 +730,11 @@ sub init
 	my $dir = new IO::File;
 	my @dir;
 	my $ref;
-
+		
 	# load various control files
-	my @in = load_badmsg();
-	print "@in\n" if @in;
-	@in = load_forward();
-	print "@in\n" if @in;
+	print "load badmsg: ", (load_badmsg() or "Ok"), "\n";
+	print "load forward: ", (load_forward() or "Ok"), "\n";
+	print "load swop: ", (load_swop() or "Ok"), "\n";
 
 	# read in the directory
 	opendir($dir, $msgdir) or confess "can't open $msgdir $!";
@@ -909,6 +916,18 @@ sub load_badmsg
 	return @out;
 }
 
+# load the swop message table
+sub load_swop
+{
+	my @out;
+	my $s = readfilestr($swopfn);
+	if ($s) {
+		eval $s;
+		push @out, $@ if $@;
+	}
+	return @out;
+}
+
 #
 # forward that message or not according to the forwarding table
 # returns 1 for forward, 0 - to ignore
@@ -930,8 +949,6 @@ sub forward_it
 		
 		# select field
 		$tested = $ref->{to} if $field eq 'T';
-		my $at = $ref->{to} =~ /\@\s*(\S+)/;
-		$tested = $at if $field eq '\@';
 		$tested = $ref->{from} if $field eq 'F';
 		$tested = $ref->{origin} if $field eq 'O';
 		$tested = $ref->{subject} if $field eq 'S';
@@ -944,6 +961,80 @@ sub forward_it
 	return 0;
 }
 
+sub dump_it
+{
+	my $ref = shift;
+	my $call = shift;
+	my $i;
+	
+	for ($i = 0; $i < @badmsg; $i += 3) {
+		my ($sort, $field, $pattern) = @badmsg[$i..($i+2)]; 
+		my $tested;
+		
+		# are we interested?
+		next if $ref->{private} && $sort ne 'P';
+		next if !$ref->{private} && $sort ne 'B';
+		
+		# select field
+		$tested = $ref->{to} if $field eq 'T';
+		$tested = $ref->{from} if $field eq 'F';
+		$tested = $ref->{origin} if $field eq 'O';
+		$tested = $ref->{subject} if $field eq 'S';
+
+		if (!$pattern || $tested =~ m{$pattern}i) {
+			return 1;
+		}
+	}
+	return 0;
+}
+
+sub swop_it
+{
+	my $ref = shift;
+	my $call = shift;
+	my $i;
+	my $count = 0;
+	
+	for ($i = 0; $i < @swop; $i += 5) {
+		my ($sort, $field, $pattern, $tfield, $topattern) = @swop[$i..($i+4)]; 
+		my $tested;
+		my $swop;
+		my $old;
+		
+		# are we interested?
+		next if $ref->{private} && $sort ne 'P';
+		next if !$ref->{private} && $sort ne 'B';
+		
+		# select field
+		$tested = $ref->{to} if $field eq 'T';
+		$tested = $ref->{from} if $field eq 'F';
+		$tested = $ref->{origin} if $field eq 'O';
+		$tested = $ref->{subject} if $field eq 'S';
+
+		# select swop field
+		$old = $swop = $ref->{to} if $tfield eq 'T';
+		$old = $swop = $ref->{from} if $tfield eq 'F';
+		$old = $swop = $ref->{origin} if $tfield eq 'O';
+		$old = $swop = $ref->{subject} if $tfield eq 'S';
+
+		if ($tested =~ m{$pattern}i) {
+			if ($tested eq $swop) {
+				$swop =~ s{$pattern}{$topattern}i;
+			} else {
+				$swop = $topattern;
+			}
+			Log('msg', "Msg $ref->{msgno}: $tfield $old -> $swop");
+			Log('dbg', "Msg $ref->{msgno}: $tfield $old -> $swop");
+			$ref->{to} = $swop if $tfield eq 'T';
+			$ref->{from} = $swop if $tfield eq 'F';
+			$ref->{origin} = $swop if $tfield eq 'O';
+			$ref->{subject} = $swop if $tfield eq 'S';
+			++$count;
+		}
+	}
+	return $count;
+}
+
 no strict;
 sub AUTOLOAD
 {