X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=d5631904971148fae3c246cbff338d4033b4cb2b;hb=fdc49835d7dc5573453567bd41e52c5e580ad8e7;hp=dce9c04f28f0b8df2b902ece0ba6c12d145968a9;hpb=20a1e972197e2d479bd35da2deb2bce22209a10e;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index dce9c04f..d5631904 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; @@ -82,13 +80,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 @@ -138,20 +129,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"); - 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; - } - } - # queue some message if the interval timer has gone off queue_msg(0); @@ -294,8 +271,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}"); @@ -459,15 +435,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 @@ -476,18 +450,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; } @@ -603,8 +577,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}) { @@ -612,6 +584,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}) { @@ -635,12 +623,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 ref $ref->{gotit} && 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; } @@ -768,7 +758,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; @@ -983,7 +973,6 @@ sub forward_it sub dump_it { my $ref = shift; - my $call = shift; my $i; for ($i = 0; $i < @badmsg; $i += 3) {