X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=bd6baf2fd5935d2bbf3f7bc91047583610537fb5;hb=647730580f6fe6ad14ee8445f0d5d583390cb130;hp=5c990177330ddc26c55fd20ccd7a0fcf242e49b1;hpb=4e5b3de7a26563d94678fb790b8a1e2c4daaac8d;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 5c990177..bd6baf2f 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -110,6 +110,7 @@ sub alloc $self->{rrreq} = shift; $self->{gotit} = []; $self->{lastt} = $main::systime; + $self->{lines} = []; return $self; } @@ -122,7 +123,6 @@ sub workclean delete $ref->{tonode}; delete $ref->{fromnode}; delete $ref->{stream}; - delete $ref->{lines}; delete $ref->{file}; delete $ref->{count}; delete $ref->{lastt} if exists $ref->{lastt}; @@ -183,6 +183,7 @@ sub process my $t = cltounix($f[5], $f[6]); my $stream = next_transno($f[2]); + $f[13] = $self->call unless $f[13] && $f[13] gt ' '; my $ref = DXMsg->alloc($stream, uc $f[3], $f[4], $t, $f[7], $f[8], $f[13], '0', $f[11]); # fill in various forwarding state variables @@ -211,6 +212,7 @@ sub process if ($pcno == 29) { # incoming text my $ref = $work{"$f[2]$f[3]"}; if ($ref) { + $f[4] =~ s/\%5E/^/g; push @{$ref->{lines}}, $f[4]; $ref->{count}++; if ($ref->{count} >= $ref->{linesreq}) { @@ -236,7 +238,6 @@ sub process $work{"$f[2]$f[3]"} = $ref; # new ref dbg('msg', "incoming subject ack stream $f[3]\n"); $busy{$f[2]} = $ref; # interlock - $ref->{lines} = []; push @{$ref->{lines}}, ($ref->read_msg_body); $ref->send_tranche($self); $ref->{lastt} = $main::systime; @@ -406,12 +407,7 @@ sub store { my $ref = shift; my $lines = shift; - - # we only proceed if there are actually any lines in the file -# if (!$lines || @{$lines} == 0) { -# return; -# } - + if ($ref->{file}) { # a file dbg('msg', "To be stored in $ref->{to}\n"); @@ -462,7 +458,7 @@ sub del_msg my $self = shift; # remove it from the active message list - @msg = map { $_ != $self ? $_ : () } @msg; + @msg = grep { ref($_) && $_ != $self } @msg; # belt and braces (one day I will ask someone if this is REALLY necessary) delete $self->{gotit}; @@ -480,7 +476,7 @@ sub clean_old # mark old messages for deletion foreach $ref (@msg) { - if (!$ref->{keep} && $ref->{t} < $main::systime - $maxage) { + if (ref($ref) && !$ref->{keep} && $ref->{t} < $main::systime - $maxage) { $ref->{deleteme} = 1; delete $ref->{gotit}; delete $ref->{list}; @@ -490,7 +486,7 @@ sub clean_old } # remove them all from the active message list - @msg = map { $_->{deleteme} ? () : $_ } @msg; + @msg = grep { ref($_) && !$_->{deleteme} } @msg; $last_clean = $main::systime; } @@ -512,6 +508,11 @@ sub read_msg_header } $size = -s $fn; $line = <$file>; # first line + if ($size == 0 || !$line) { + dbg('err', "Empty $fn $!"); + Log('err', "Empty $fn $!"); + return undef; + } chomp $line; $size -= length $line; if (! $line =~ /^===/o) { @@ -594,12 +595,12 @@ sub queue_msg my $call = shift; my $ref; my $clref; - 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. 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? @@ -611,7 +612,7 @@ sub queue_msg } # deal with routed private messages - my $noderef; + my $dxchan; if ($ref->{private}) { next if $ref->{'read'}; # if it is read, it is stuck here $clref = DXCluster->get_exact($ref->{to}); @@ -620,10 +621,10 @@ sub queue_msg my $hnode = $uref->homenode if $uref; $clref = DXCluster->get_exact($hnode) if $hnode; } - if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all()) { + 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'; + $dxchan = $clref->dxchan; + $ref->start_msg($dxchan) if $dxchan && !get_busy($dxchan->call) && $dxchan->state eq 'normal'; } } @@ -632,13 +633,13 @@ sub queue_msg # 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 + 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 # 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'; + $ref->start_msg($dxchan) if !get_busy($dxchan->call) && $dxchan->state eq 'normal'; last; } @@ -755,10 +756,15 @@ sub init @msg = (); for (sort @dir) { - next unless /^m\d+$/o; + next unless /^m\d\d\d\d\d\d$/; $ref = read_msg_header("$msgdir/$_"); - next unless $ref; + unless ($ref) { + dbg('err', "Deleting $_"); + Log('err', "Deleting $_"); + unlink "$msgdir/$_"; + next; + } # delete any messages to 'badmsg.pl' places if (grep $ref->{to} eq $_, @badmsg) {