X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=10857152475e9524311f9c48514916e5389e846b;hb=661d49731a7ac57ce2883ef5d757c7a8144fb6ff;hp=d5f56c330a59945e944ad9b0a608bea0d0d65c7e;hpb=16b9415f38bf1b7eab1a9d2dc72abce9a643be09;p=spider.git

diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index d5f56c33..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,14 +42,17 @@ $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 = 60*60;              # time an aborted outgoing message waits before trying again
-$queueinterval = 2*60;          # run the queue every 2 minutes
+$waittime = 30*60;              # time an aborted outgoing message waits before trying again
+$queueinterval = 1*60;          # run the queue every 1 minute
 $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',
@@ -130,21 +133,22 @@ sub process
 	# this is periodic processing
 	if (!$self || !$line) {
 
-		# wander down the work queue stopping any messages that have timed out
-		for (keys %busy) {
-			my $node = $_;
-			my $ref = $busy{$_};
-			if (exists $ref->{lastt} && $main::systime > $ref->{lastt} + $timeout) {
-				dbg('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
-				$ref->stop_msg($node);
+		if ($main::systime > $lastq + $queueinterval) {
 
-				# delay any outgoing messages that fail
-				$ref->{waitt} = $main::systime + $waittime + rand(120) if $node ne $main::mycall;
+			# wander down the work queue stopping any messages that have timed out
+			for (keys %busy) {
+				my $node = $_;
+				my $ref = $busy{$_};
+				if (exists $ref->{lastt} && $main::systime >= $ref->{lastt} + $timeout) {
+					dbg('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
+					$ref->stop_msg($node);
+					
+					# delay any outgoing messages that fail
+					$ref->{waitt} = $main::systime + $waittime + rand(120) if $node ne $main::mycall;
+				}
 			}
-		}
 
-		# queue some message if the interval timer has gone off
-		if ($main::systime > $lastq + $queueinterval) {
+			# queue some message if the interval timer has gone off
 			queue_msg(0);
 			$lastq = $main::systime;
 		}
@@ -275,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;
 						}
 
@@ -367,7 +375,6 @@ sub process
 				$ref->stop_msg($self->call);
 				$ref = undef;
 			}
-			
 			last SWITCH;
 		}
 
@@ -575,8 +582,7 @@ sub queue_msg
 	my $call = shift;
 	my $ref;
 	my $clref;
-	my $dxchan;
-	my @nodelist = DXProt::get_all_ak1a();
+	my @nodelist = DXChannel::get_all_ak1a();
 	
 	# bat down the message list looking for one that needs to go off site and whose
 	# nearest node is not busy.
@@ -591,39 +597,39 @@ sub queue_msg
 			next if $ref->{waitt} > $main::systime;
 			delete $ref->{waitt};
 		} 
-		
+
+		# deal with routed private messages
+		my $noderef;
 		if ($ref->{private}) {
-			if ($ref->{'read'} == 0) {
-				$clref = DXCluster->get_exact($ref->{to});
-				unless ($clref) {             # otherwise look for a homenode
-					my $uref = DXUser->get($ref->{to});
-					my $hnode =  $uref->homenode if $uref;
-					$clref = DXCluster->get_exact($hnode) if $hnode;
-				}
-				if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
-					$dxchan = $clref->{dxchan};
-					$ref->start_msg($dxchan) if $dxchan && $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
-				}
+			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});
+				my $hnode =  $uref->homenode if $uref;
+				$clref = DXCluster->get_exact($hnode) if $hnode;
 			}
-		} elsif (!$sort) {
-			# otherwise we are dealing with a bulletin, compare the gotit list with
-			# the nodelist up above, if there are sites that haven't got it yet
-			# then start sending it - what happens when we get loops is anyone's
-			# guess, use (to, from, time, subject) tuple?
-			my $noderef;
-			foreach $noderef (@nodelist) {
-				next if $noderef->call eq $main::mycall;
-				next if grep { $_ eq $noderef->call } @{$ref->{gotit}};
-				next unless $ref->forward_it($noderef->call);           # check the forwarding file
-				# next if $noderef->isolate;               # maybe add code for stuff originated here?
-				# next if DXUser->get( ${$ref->{gotit}}[0] )->isolate;  # is the origin isolated?
-				
-				# if we are here we have a node that doesn't have this message
+			if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
+				next if $clref->call eq $main::mycall;  # i.e. it lives here
+				$noderef = $clref->{dxchan};
 				$ref->start_msg($noderef) if !get_busy($noderef->call)  && $noderef->state eq 'normal';
-				last;
 			}
 		}
 		
+		# otherwise we are dealing with a bulletin or forwarded private message
+		# compare the gotit list with
+		# the nodelist up above, if there are sites that haven't got it yet
+		# then start sending it - what happens when we get loops is anyone's
+		# guess, use (to, from, time, subject) tuple?
+		foreach $noderef (@nodelist) {
+			next if $noderef->call eq $main::mycall;
+			next if grep { $_ eq $noderef->call } @{$ref->{gotit}};
+			next unless $ref->forward_it($noderef->call);           # check the forwarding file
+
+			# if we are here we have a node that doesn't have this message
+			$ref->start_msg($noderef) if !get_busy($noderef->call)  && $noderef->state eq 'normal';
+			last;
+		}
+
 		# if all the available nodes are busy then stop
 		last if @nodelist == scalar grep { get_busy($_->call) } @nodelist;
 	}
@@ -724,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 $!";
@@ -826,7 +831,7 @@ sub do_send_stuff
 	} elsif ($self->state eq 'sendbody') {
 		confess "local var gone missing" if !ref $self->{loc};
 		my $loc = $self->{loc};
-		if ($line eq "\032" || uc $line eq "/EX") {
+		if ($line eq "\032" || $line eq '%1A' || uc $line eq "/EX") {
 			my $to;
 			
 			if (@{$loc->{lines}} > 0) {
@@ -891,8 +896,11 @@ sub dir
 sub load_forward
 {
 	my @out;
-	do "$forwardfn" if -e "$forwardfn";
-	push @out, $@ if $@;
+	my $s = readfilestr($forwardfn);
+	if ($s) {
+		eval $s;
+		push @out, $@ if $@;
+	}
 	return @out;
 }
 
@@ -900,8 +908,23 @@ sub load_forward
 sub load_badmsg
 {
 	my @out;
-	do "$badmsgfn" if -e "$badmsgfn";
-	push @out, $@ if $@;
+	my $s = readfilestr($badmsgfn);
+	if ($s) {
+		eval $s;
+		push @out, $@ if $@;
+	}
+	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;
 }
 
@@ -921,8 +944,8 @@ sub forward_it
 		my $tested;
 		
 		# are we interested?
-		last if $ref->{private} && $sort ne 'P';
-		last if !$ref->{private} && $sort ne 'B';
+		next if $ref->{private} && $sort ne 'P';
+		next if !$ref->{private} && $sort ne 'B';
 		
 		# select field
 		$tested = $ref->{to} if $field eq 'T';
@@ -938,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
 {