1. Added msg command to allow the changing of To, From, Subject and so on the
[spider.git] / perl / DXMsg.pm
index c1f0ae7a2ac8ef3ef970edda16f733485721f90c..3262a44df98f7c13af304c97c8ece3d735154b0c 100644 (file)
@@ -32,7 +32,8 @@ use Carp;
 
 use strict;
 use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
-                       @badmsg $badmsgfn $forwardfn @forward $timeout $waittime);
+                       @badmsg $badmsgfn $forwardfn @forward $timeout $waittime
+                   $queueinterval $lastq);
 
 %work = ();                                            # outstanding jobs
 @msg = ();                                             # messages we have
@@ -43,33 +44,36 @@ $last_clean = 0;                            # last time we did a clean
 @forward = ();                  # msg forward 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
+$lastq = 0;
+
 
 $badmsgfn = "$msgdir/badmsg.pl";  # list of TO address we wont store
 $forwardfn = "$msgdir/forward.pl";  # the forwarding table
 
 %valid = (
-                 fromnode => '9,From Node',
-                 tonode => '9,To Node',
+                 fromnode => '5,From Node',
+                 tonode => '5,To Node',
                  to => '0,To',
                  from => '0,From',
                  t => '0,Msg Time,cldatetime',
-                 private => '9,Private',
+                 private => '5,Private',
                  subject => '0,Subject',
                  linesreq => '0,Lines per Gob',
-                 rrreq => '9,Read Confirm',
+                 rrreq => '5,Read Confirm',
                  origin => '0,Origin',
                  lines => '5,Data',
                  stream => '9,Stream No',
-                 count => '9,Gob Linecnt',
-                 file => '9,File?,yesno',
-                 gotit => '9,Got it Nodes,parray',
-                 lines => '9,Lines,parray',
-                 'read' => '9,Times read',
+                 count => '5,Gob Linecnt',
+                 file => '5,File?,yesno',
+                 gotit => '5,Got it Nodes,parray',
+                 lines => '5,Lines,parray',
+                 'read' => '5,Times read',
                  size => '0,Size',
                  msgno => '0,Msgno',
                  keep => '0,Keep this?,yesno',
-                 lastt => '9,Last processed,cldatetime',
-                 waitt => '9,Wait until,cldatetime',
+                 lastt => '5,Last processed,cldatetime',
+                 waitt => '5,Wait until,cldatetime',
                 );
 
 sub DESTROY
@@ -124,20 +128,27 @@ sub process
        my ($self, $line) = @_;
 
        # this is periodic processing
-       if (undef $self || undef $line) {
+       if (!$self || !$line) {
 
                # wander down the work queue stopping any messages that have timed out
-               for (keys %work) {
-                       my $ref = $work{$_};
-                       if ($main::systime > $ref->{lastt} + $timeout) {
-                               my $tonode = $ref->{tonode};
-                               $ref->stop_msg();
+               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 if $tonode ne $main::mycall;
+                               $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_msg(0);
+                       $lastq = $main::systime;
+               }
+
                # clean the message queue
                clean_old() if $main::systime - $last_clean > 3600 ;
                return;
@@ -155,7 +166,8 @@ sub process
                        if (exists $busy{$f[2]}) {
                                my $ref = $busy{$f[2]};
                                my $tonode = $ref->{tonode};
-                               $ref->stop_msg();
+                               dbg('msg', "Busy, stopping msgno: $ref->{msgno} -> $f[2]");
+                               $ref->stop_msg($self->call);
                        }
 
                        my $t = cltounix($f[5], $f[6]);
@@ -173,6 +185,14 @@ sub process
                        $work{"$f[2]$stream"} = $ref; # store in work
                        $busy{$f[2]} = $ref; # set interlock
                        $self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack
+                       $ref->{lastt} = $main::systime;
+
+                       # look to see whether this is a non private message sent to a known callsign
+                       my $uref = DXUser->get_current($ref->{to});
+                       if (iscallsign($ref->{to}) && !$ref->{private} && $uref && $uref->homenode) {
+                               $ref->{private} = 1;
+                               dbg('msg', "set bull to $ref->{to} to private");
+                       }
                        last SWITCH;
                }
                
@@ -187,6 +207,9 @@ sub process
                                        $ref->{count} = 0;
                                }
                                $ref->{lastt} = $main::systime;
+                       } else {
+                               dbg('msg', "PC29 from unknown stream $f[3] from $f[2]" );
+                               $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        }
                        last SWITCH;
                }
@@ -206,6 +229,7 @@ sub process
                                $ref->send_tranche($self);
                                $ref->{lastt} = $main::systime;
                        } else {
+                               dbg('msg', "PC30 from unknown stream $f[3] from $f[2]" );
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        } 
                        last SWITCH;
@@ -218,6 +242,7 @@ sub process
                                $ref->send_tranche($self);
                                $ref->{lastt} = $main::systime;
                        } else {
+                               dbg('msg', "PC31 from unknown stream $f[3] from $f[2]" );
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        } 
                        last SWITCH;
@@ -243,7 +268,7 @@ sub process
                                                my $m;
                                                for $m (@msg) {
                                                        if ($ref->{subject} eq $m->{subject} && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from}) {
-                                                               $ref->stop_msg();
+                                                               $ref->stop_msg($self->call);
                                                                my $msgno = $m->{msgno};
                                                                dbg('msg', "duplicate message to $msgno\n");
                                                                Log('msg', "duplicate message to $msgno");
@@ -253,7 +278,7 @@ sub process
                                                        
                                                # look for 'bad' to addresses 
                                                if (grep $ref->{to} eq $_, @badmsg) {
-                                                       $ref->stop_msg();
+                                                       $ref->stop_msg($self->call);
                                                        dbg('msg', "'Bad' TO address $ref->{to}");
                                                        Log('msg', "'Bad' TO address $ref->{to}");
                                                        return;
@@ -264,16 +289,16 @@ sub process
                                                $ref->store($ref->{lines});
                                                add_dir($ref);
                                                my $dxchan = DXChannel->get($ref->{to});
-                                               $dxchan->send($dxchan->msg('m9')) if $dxchan;
+                                               $dxchan->send($dxchan->msg('m9')) if $dxchan && $dxchan->is_user;
                                                Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}");
                                        }
                                }
-                               $ref->stop_msg();
-                               queue_msg(0);
+                               $ref->stop_msg($self->call);
                        } else {
+                               dbg('msg', "PC32 from unknown stream $f[3] from $f[2]" );
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        }
-                       queue_msg(0);
+                       queue_msg(0);
                        last SWITCH;
                }
                
@@ -288,10 +313,13 @@ sub process
                                        push @{$ref->{gotit}}, $f[2]; # mark this up as being received
                                        $ref->store($ref->{lines});     # re- store the file
                                }
-                               $ref->stop_msg();
+                               $ref->stop_msg($self->call);
                        } else {
+                               dbg('msg', "PC33 from unknown stream $f[3] from $f[2]" );
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        } 
+
+                       # send next one if present
                        queue_msg(0);
                        last SWITCH;
                }
@@ -325,6 +353,7 @@ sub process
                        $ref->{stream} = $stream;
                        $ref->{count} = 0;      # no of lines between PC31s
                        $ref->{file} = 1;
+                       $ref->{lastt} = $main::systime;
                        $work{"$f[2]$stream"} = $ref; # store in work
                        $self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack 
                        
@@ -335,7 +364,7 @@ sub process
                        dbg('msg', "stream $f[3]: abort received\n");
                        my $ref = $work{"$f[2]$f[3]"};
                        if ($ref) {
-                               $ref->stop_msg();
+                               $ref->stop_msg($self->call);
                                $ref = undef;
                        }
                        
@@ -344,9 +373,10 @@ sub process
 
                if ($pcno == 49) {      # global delete on subject
                        for (@msg) {
-                               if ($_->{subject} eq $f[2]) {
+                               if ($_->{from} eq $f[1] && $_->{subject} eq $f[2]) {
                                        $_->del_msg();
-                                       Log('msg', "Message $_->{msgno} fully deleted by $f[1]");
+                                       Log('msg', "Message $_->{msgno} from $_->{from} ($_->{subject}) fully deleted");
+                                       DXProt::broadcast_ak1a($line, $self);
                                }
                        }
                }
@@ -558,7 +588,7 @@ sub queue_msg
 
                # ignore 'delayed' messages until their waiting time has expired
                if (exists $ref->{waitt}) {
-                       next if $ref->{waitt} < $main::systime;
+                       next if $ref->{waitt} > $main::systime;
                        delete $ref->{waitt};
                } 
                
@@ -624,8 +654,9 @@ sub start_msg
        $self->{count} = 0;
        $self->{tonode} = $dxchan->call;
        $self->{fromnode} = $main::mycall;
-       $busy{$dxchan->call} = $self;
-       $work{"$self->{tonode}"} = $self;
+       $busy{$self->{tonode}} = $self;
+       $work{$self->{tonode}} = $self;
+       $self->{lastt} = $main::systime;
        $dxchan->send(DXProt::pc28($self->{tonode}, $self->{fromnode}, $self->{to}, $self->{from}, $self->{t}, $self->{private}, $self->{subject}, $self->{origin}, $self->{rrreq}));
 }
 
@@ -651,8 +682,8 @@ sub get_fwq
 # stop a message from continuing, clean it out, unlock interlocks etc
 sub stop_msg
 {
-       my ($self, $dxchan) = @_;
-       my $node = $self->{tonode}
+       my $self = shift;
+       my $node = shift;
        my $stream = $self->{stream} if exists $self->{stream};
        
        
@@ -791,7 +822,7 @@ sub do_send_stuff
                $loc->{lines} = [];
                $self->state('sendbody');
                #push @out, $self->msg('sendbody');
-               push @out, $self->msg('m8');)
+               push @out, $self->msg('m8');
        } elsif ($self->state eq 'sendbody') {
                confess "local var gone missing" if !ref $self->{loc};
                my $loc = $self->{loc};
@@ -829,7 +860,6 @@ sub do_send_stuff
                        delete $self->{loc};
                        $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');