X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=428f87e958523dfd5adaf884aecd2da38b4d2540;hb=42032b193f4411c08979c2cd8d1f39818d5de235;hp=0bd27bbfa430d3d8f74ae472ff67fc4a16a98cea;hpb=1566a1eefdf276e28698fc0e94b1cf3113fc25d5;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 0bd27bbf..428f87e9 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -15,8 +15,6 @@ package DXMsg; -@ISA = qw(DXProt DXChannel); - use DXUtil; use DXChannel; use DXUser; @@ -32,7 +30,7 @@ use Fcntl; use strict; use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean @badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime - $queueinterval $lastq $importfn $minchunk $maxchunk); + $queueinterval $lastq $importfn $minchunk $maxchunk $bulltopriv); %work = (); # outstanding jobs @msg = (); # messages we have @@ -50,6 +48,8 @@ $lastq = 0; $minchunk = 4800; # minimum chunk size for a split message $maxchunk = 6000; # maximum chunk size +$bulltopriv = 1; # convert msgs with callsigns to private if they are bulls + $badmsgfn = "$msgdir/badmsg.pl"; # list of TO address we wont store $forwardfn = "$msgdir/forward.pl"; # the forwarding table @@ -82,13 +82,6 @@ $importfn = "$msgdir/import"; # import directory waitt => '5,Wait until,cldatetime', ); -sub DESTROY -{ - my $self = shift; - undef $self->{lines}; - undef $self->{gotit}; -} - # allocate a new object # called fromnode, tonode, from, to, datetime, private?, subject, nolinesper sub alloc @@ -109,8 +102,9 @@ sub alloc $self->{'read'} = shift; $self->{rrreq} = shift; $self->{gotit} = []; - $self->{lastt} = $main::systime; +# $self->{lastt} = $main::systime; $self->{lines} = []; + $self->{private} = 1 if $bulltopriv && DXUser->get_current($self->{to}); return $self; } @@ -138,19 +132,6 @@ sub process if ($main::systime >= $lastq + $queueinterval) { - # 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 queue_msg(0); @@ -202,7 +183,7 @@ sub process # 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) { + if (is_callsign($ref->{to}) && !$ref->{private} && $uref && $uref->homenode) { $ref->{private} = 1; dbg('msg', "set bull to $ref->{to} to private"); } @@ -293,8 +274,7 @@ sub process $ref->swop_it($self->call); # look for 'bad' to addresses -# if (grep $ref->{to} eq $_, @badmsg) { - if ($ref->dump_it($self->call)) { + if ($ref->dump_it) { $ref->stop_msg($self->call); dbg('msg', "'Bad' message $ref->{to}"); Log('msg', "'Bad' message $ref->{to}"); @@ -458,15 +438,13 @@ sub del_msg my $self = shift; # remove it from the active message list - @msg = grep { ref($_) && $_ != $self } @msg; - - # belt and braces (one day I will ask someone if this is REALLY necessary) - delete $self->{gotit}; - delete $self->{list}; + dbg('msg', "\@msg = " . scalar @msg . " before delete"); + @msg = grep { $_ != $self } @msg; # remove the file unlink filename($self->{msgno}); dbg('msg', "deleting $self->{msgno}\n"); + dbg('msg', "\@msg = " . scalar @msg . " after delete"); } # clean out old messages from the message queue @@ -475,18 +453,18 @@ sub clean_old my $ref; # mark old messages for deletion + dbg('msg', "\@msg = " . scalar @msg . " before delete"); foreach $ref (@msg) { if (ref($ref) && !$ref->{keep} && $ref->{t} < $main::systime - $maxage) { $ref->{deleteme} = 1; - delete $ref->{gotit}; - delete $ref->{list}; unlink filename($ref->{msgno}); dbg('msg', "deleting old $ref->{msgno}\n"); } } # remove them all from the active message list - @msg = grep { ref($_) && !$_->{deleteme} } @msg; + @msg = grep { !$_->{deleteme} } @msg; + dbg('msg', "\@msg = " . scalar @msg . " after delete"); $last_clean = $main::systime; } @@ -602,8 +580,6 @@ sub queue_msg dbg('msg', "queue msg ($sort)\n"); my @nodelist = DXChannel::get_all_nodes; foreach $ref (@msg) { - # firstly, is it private and unread? if so can I find the recipient - # in my cluster node list offsite? # ignore 'delayed' messages until their waiting time has expired if (exists $ref->{waitt}) { @@ -611,6 +587,22 @@ sub queue_msg delete $ref->{waitt}; } + # any time outs? + if (exists $ref->{lastt} && $main::systime >= $ref->{lastt} + $timeout) { + my $node = $ref->{tonode}; + dbg('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node"); + Log('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; + delete $ref->{lastt}; + next; + } + + # firstly, is it private and unread? if so can I find the recipient + # in my cluster node list offsite? + # deal with routed private messages my $dxchan; if ($ref->{private}) { @@ -634,12 +626,14 @@ sub queue_msg # then start sending it - what happens when we get loops is anyone's # guess, use (to, from, time, subject) tuple? foreach $dxchan (@nodelist) { - next if $dxchan->call eq $main::mycall; - next if grep { $_ eq $dxchan->call } @{$ref->{gotit}}; - next unless $ref->forward_it($dxchan->call); # check the forwarding file + my $call = $dxchan->call; + next unless $call; + next if $call eq $main::mycall; + next if ref $ref->{gotit} && grep $_ eq $call, @{$ref->{gotit}}; + next unless $ref->forward_it($call); # check the forwarding file # if we are here we have a node that doesn't have this message - $ref->start_msg($dxchan) if !get_busy($dxchan->call) && $dxchan->state eq 'normal'; + $ref->start_msg($dxchan) if !get_busy($call) && $dxchan->state eq 'normal'; last; } @@ -767,7 +761,7 @@ sub init } # delete any messages to 'badmsg.pl' places - if (grep $ref->{to} eq $_, @badmsg) { + if ($ref->dump_it) { dbg('msg', "'Bad' TO address $ref->{to}"); Log('msg', "'Bad' TO address $ref->{to}"); $ref->del_msg; @@ -982,7 +976,6 @@ sub forward_it sub dump_it { my $ref = shift; - my $call = shift; my $i; for ($i = 0; $i < @badmsg; $i += 3) {