$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
+$waittime = 30*60; # time an aborted outgoing message waits before trying again
+$queueinterval = 1*60; # run the queue every 1 minute
$lastq = 0;
# this is periodic processing
if (!$self || !$line) {
- # 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);
+ if ($main::systime > $lastq + $queueinterval) {
- # delay any outgoing messages that fail
- $ref->{waitt} = $main::systime + $waittime + rand(120) if $node ne $main::mycall;
+ # 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
- if ($main::systime > $lastq + $queueinterval) {
+ # queue some message if the interval timer has gone off
queue_msg(0);
$lastq = $main::systime;
}
# does an identical message already exist?
my $m;
for $m (@msg) {
- if ($ref->{subject} eq $m->{subject} && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from}) {
+ if ($ref->{subject} eq $m->{subject} && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from} && $ref->{to} eq $m->{to}) {
$ref->stop_msg($self->call);
my $msgno = $m->{msgno};
dbg('msg', "duplicate message to $msgno\n");
$ref->stop_msg($self->call);
$ref = undef;
}
-
last SWITCH;
}
my $lines = shift;
# we only proceed if there are actually any lines in the file
- if (!$lines || @{$lines} == 0) {
- return;
- }
+# if (!$lines || @{$lines} == 0) {
+# return;
+# }
if ($ref->{file}) { # a file
dbg('msg', "To be stored in $ref->{to}\n");
my $call = shift;
my $ref;
my $clref;
- my $dxchan;
- my @nodelist = DXProt::get_all_ak1a();
+ 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.
next if $ref->{waitt} > $main::systime;
delete $ref->{waitt};
}
-
+
+ # deal with routed private messages
+ my $noderef;
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 $dxchan && $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
- }
+ $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;
}
- } elsif (!$sort) {
- # otherwise we are dealing with a bulletin, compare the gotit list with
- # 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?
- my $noderef;
- 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
- # 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
+ 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';
- last;
}
}
+ # otherwise we are dealing with a bulletin or forwarded private message
+ # compare the gotit list with
+ # 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
+
+ # 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';
+ last;
+ }
+
# if all the available nodes are busy then stop
last if @nodelist == scalar grep { get_busy($_->call) } @nodelist;
}
} elsif ($self->state eq 'sendbody') {
confess "local var gone missing" if !ref $self->{loc};
my $loc = $self->{loc};
- if ($line eq "\032" || uc $line eq "/EX") {
+ if ($line eq "\032" || $line eq '%1A' || uc $line eq "/EX") {
my $to;
if (@{$loc->{lines}} > 0) {
sub load_forward
{
my @out;
- do "$forwardfn" if -e "$forwardfn";
- push @out, $@ if $@;
+ my $s = readfilestr($forwardfn);
+ if ($s) {
+ eval $s;
+ push @out, $@ if $@;
+ }
return @out;
}
sub load_badmsg
{
my @out;
- do "$badmsgfn" if -e "$badmsgfn";
- push @out, $@ if $@;
+ my $s = readfilestr($badmsgfn);
+ if ($s) {
+ eval $s;
+ push @out, $@ if $@;
+ }
return @out;
}
my $tested;
# are we interested?
- last if $ref->{private} && $sort ne 'P';
- last if !$ref->{private} && $sort ne 'B';
+ next if $ref->{private} && $sort ne 'P';
+ next if !$ref->{private} && $sort ne 'B';
# select field
$tested = $ref->{to} if $field eq 'T';
+ my $at = $ref->{to} =~ /\@\s*(\S+)/;
+ $tested = $at if $field eq '\@';
$tested = $ref->{from} if $field eq 'F';
$tested = $ref->{origin} if $field eq 'O';
$tested = $ref->{subject} if $field eq 'S';