X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=dd6d178e1f523acd79a6f9e9f023c001b2a416c2;hb=0165dda006167dda28c20bd415c91cf029da0edb;hp=262a4155c92cd4deab28b8f832cec1ac8e519cf4;hpb=cce161221036760959ff1d0b7628a55942bf558a;p=spider.git

diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index 262a4155..dd6d178e 100644
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -5,7 +5,12 @@
 # Copyright (c) 1998 Dirk Koopman G1TLH
 #
 # $Id$
-# 
+#
+#
+# Notes for implementors:-
+#
+# PC28 field 11 is the RR required flag
+# PC28 field 12 is a VIA routing (ie it is a node call) 
 
 package DXMsg;
 
@@ -24,7 +29,8 @@ use FileHandle;
 use Carp;
 
 use strict;
-use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean);
+use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
+			@badmsg $badmsgfn $forwardfn @forward);
 
 %work = ();						# outstanding jobs
 @msg = ();						# messages we have
@@ -32,6 +38,10 @@ use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean);
 $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
+
+$badmsgfn = "$msgdir/badmsg.pl";  # list of TO address we wont store
+$forwardfn = "$msgdir/forward.pl";  # the forwarding table
 
 %valid = (
 		  fromnode => '9,From Node',
@@ -96,7 +106,7 @@ sub workclean
 sub process
 {
 	my ($self, $line) = @_;
-	my @f = split /[\^\~]/, $line;
+	my @f = split /\^/, $line;
 	my ($pcno) = $f[0] =~ /^PC(\d\d)/; # just get the number
 	
  SWITCH: {
@@ -190,13 +200,21 @@ sub process
 								return;
 							}
 						}
+							
+						# look for 'bad' to addresses 
+						if (grep $ref->{to} eq $_, @badmsg) {
+							$ref->stop_msg($self);
+							dbg('msg', "'Bad' TO address $ref->{to}");
+							Log('msg', "'Bad' TO address $ref->{to}");
+							return;
+						}
 
 						$ref->{msgno} = next_transno("Msgno");
 						push @{$ref->{gotit}}, $f[2]; # mark this up as being received
 						$ref->store($ref->{lines});
 						add_dir($ref);
 						my $dxchan = DXChannel->get($ref->{to});
-						$dxchan->send("New mail has arrived for you") if $dxchan;
+						$dxchan->send($dxchan->msg('msgnew')) if $dxchan;
 						Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}");
 					}
 				}
@@ -492,9 +510,14 @@ sub queue_msg
 		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 $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
+					$ref->start_msg($dxchan) if $dxchan && $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
 				}
 			}
 		} elsif (!$sort) {
@@ -505,8 +528,10 @@ sub queue_msg
 			my $noderef;
 			foreach $noderef (@nodelist) {
 				next if $noderef->call eq $main::mycall;
-				next if $noderef->isolate;               # maybe add code for stuff originated here?
 				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
 				$ref->start_msg($noderef) if !get_busy($noderef->call)  && $noderef->state eq 'normal';
@@ -519,6 +544,21 @@ sub queue_msg
 	}
 }
 
+# is there a message for me?
+sub for_me
+{
+	my $call = uc shift;
+	my $ref;
+	
+	foreach $ref (@msg) {
+		# is it for me, private and unread? 
+		if ($ref->{to} eq $call && $ref->{private}) {
+			return 1 if !$ref->{'read'};
+		}
+	}
+	return 0;
+}
+
 # start the message off on its travels with a PC28
 sub start_msg
 {
@@ -596,22 +636,35 @@ sub init
 	my $dir = new FileHandle;
 	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;
+
 	# read in the directory
 	opendir($dir, $msgdir) or confess "can't open $msgdir $!";
 	@dir = readdir($dir);
 	closedir($dir);
-	
+
+	@msg = ();
 	for (sort @dir) {
-		next if /^\./o;
-		next if ! /^m\d+/o;
+		next unless /^m\d+$/o;
 		
 		$ref = read_msg_header("$msgdir/$_");
-		next if !$ref;
+		next unless $ref;
 		
+		# delete any messages to 'badmsg.pl' places
+		if (grep $ref->{to} eq $_, @badmsg) {
+			dbg('msg', "'Bad' TO address $ref->{to}");
+			Log('msg', "'Bad' TO address $ref->{to}");
+			$ref->del_msg;
+			next;
+		}
+
 		# add the message to the available queue
 		add_dir($ref); 
-		
 	}
 }
 
@@ -717,9 +770,9 @@ sub do_send_stuff
 			delete $loc->{lines};
 			delete $loc->{to};
 			delete $self->{loc};
-			$self->state('prompt');
 			$self->func(undef);
 			DXMsg::queue_msg(0);
+			$self->state('prompt');
 		} elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
 			#push @out, $self->msg('sendabort');
 			push @out, "aborted";
@@ -746,6 +799,57 @@ sub dir
 			$ref->to, $ref->from, cldate($ref->t), ztime($ref->t), $ref->subject;
 }
 
+# load the forward table
+sub load_forward
+{
+	my @out;
+	do "$forwardfn" if -e "$forwardfn";
+	push @out, $@ if $@;
+	return @out;
+}
+
+# load the bad message table
+sub load_badmsg
+{
+	my @out;
+	do "$badmsgfn" if -e "$badmsgfn";
+	push @out, $@ if $@;
+	return @out;
+}
+
+#
+# forward that message or not according to the forwarding table
+# returns 1 for forward, 0 - to ignore
+#
+
+sub forward_it
+{
+	my $ref = shift;
+	my $call = shift;
+	my $i;
+	
+	for ($i = 0; $i < @forward; $i += 5) {
+		my ($sort, $field, $pattern, $action, $bbs) = @forward[$i..($i+4)]; 
+		my $tested;
+		
+		# are we interested?
+		last if $ref->{private} && $sort ne 'P';
+		last 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 0 if $action eq 'I';
+			return 1 if !$bbs || grep $_ eq $call, @{$bbs};
+		}
+	}
+	return 0;
+}
+
 no strict;
 sub AUTOLOAD
 {