use strict;
use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
- @badmsg $badmsgfn $forwardfn @forward $timeout $waittime
+ @badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime
$queueinterval $lastq);
%work = (); # outstanding jobs
$maxage = 30 * 86400; # the maximum age that a message shall live for if not marked
$last_clean = 0; # last time we did a clean
@forward = (); # msg forward table
+@badmsg = (); # bad message table
+@swop = (); # swop table
$timeout = 30*60; # forwarding timeout
-$waittime = 60*60; # time an aborted outgoing message waits before trying again
-$queueinterval = 5*60; # run the queue every 5 minutes
+$waittime = 30*60; # time an aborted outgoing message waits before trying again
+$queueinterval = 1*60; # run the queue every 1 minute
$lastq = 0;
$badmsgfn = "$msgdir/badmsg.pl"; # list of TO address we wont store
$forwardfn = "$msgdir/forward.pl"; # the forwarding table
+$swopfn = "$msgdir/swop.pl"; # the swopping table
%valid = (
fromnode => '5,From Node',
# 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) {
- $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;
}
if (exists $busy{$f[2]}) {
my $ref = $busy{$f[2]};
my $tonode = $ref->{tonode};
+ dbg('msg', "Busy, stopping msgno: $ref->{msgno} -> $f[2]");
$ref->stop_msg($self->call);
}
$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;
}
$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;
}
$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;
$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;
# 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");
return;
}
}
-
+
+ # swop addresses
+ $ref->swop_it($self->call);
+
# look for 'bad' to addresses
- if (grep $ref->{to} eq $_, @badmsg) {
+# if (grep $ref->{to} eq $_, @badmsg) {
+ if ($ref->dump_it($self->call)) {
$ref->stop_msg($self->call);
- dbg('msg', "'Bad' TO address $ref->{to}");
- Log('msg', "'Bad' TO address $ref->{to}");
+ dbg('msg', "'Bad' message $ref->{to}");
+ Log('msg', "'Bad' message $ref->{to}");
return;
}
}
$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);
}
$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
}
$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
$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.
# 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};
}
-
+
+ # 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';
- }
+ next if $ref->{'read'}; # if it is read, it is stuck here
+ $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;
}
$self->{fromnode} = $main::mycall;
$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}));
}
my $dir = new IO::File;
my @dir;
my $ref;
-
+
# load various control files
- my @in = load_badmsg();
- print "@in\n" if @in;
- @in = load_forward();
- print "@in\n" if @in;
+ print "load badmsg: ", (load_badmsg() or "Ok"), "\n";
+ print "load forward: ", (load_forward() or "Ok"), "\n";
+ print "load swop: ", (load_swop() or "Ok"), "\n";
# read in the directory
opendir($dir, $msgdir) or confess "can't open $msgdir $!";
} 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;
+}
+
+# load the swop message table
+sub load_swop
+{
+ my @out;
+ my $s = readfilestr($swopfn);
+ 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';
return 0;
}
+sub dump_it
+{
+ my $ref = shift;
+ my $call = shift;
+ my $i;
+
+ for ($i = 0; $i < @badmsg; $i += 3) {
+ my ($sort, $field, $pattern) = @badmsg[$i..($i+2)];
+ my $tested;
+
+ # are we interested?
+ next if $ref->{private} && $sort ne 'P';
+ next if !$ref->{private} && $sort ne 'B';
+
+ # select field
+ $tested = $ref->{to} if $field eq 'T';
+ $tested = $ref->{from} if $field eq 'F';
+ $tested = $ref->{origin} if $field eq 'O';
+ $tested = $ref->{subject} if $field eq 'S';
+
+ if (!$pattern || $tested =~ m{$pattern}i) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub swop_it
+{
+ my $ref = shift;
+ my $call = shift;
+ my $i;
+ my $count = 0;
+
+ for ($i = 0; $i < @swop; $i += 5) {
+ my ($sort, $field, $pattern, $tfield, $topattern) = @swop[$i..($i+4)];
+ my $tested;
+ my $swop;
+ my $old;
+
+ # are we interested?
+ next if $ref->{private} && $sort ne 'P';
+ next if !$ref->{private} && $sort ne 'B';
+
+ # select field
+ $tested = $ref->{to} if $field eq 'T';
+ $tested = $ref->{from} if $field eq 'F';
+ $tested = $ref->{origin} if $field eq 'O';
+ $tested = $ref->{subject} if $field eq 'S';
+
+ # select swop field
+ $old = $swop = $ref->{to} if $tfield eq 'T';
+ $old = $swop = $ref->{from} if $tfield eq 'F';
+ $old = $swop = $ref->{origin} if $tfield eq 'O';
+ $old = $swop = $ref->{subject} if $tfield eq 'S';
+
+ if ($tested =~ m{$pattern}i) {
+ if ($tested eq $swop) {
+ $swop =~ s{$pattern}{$topattern}i;
+ } else {
+ $swop = $topattern;
+ }
+ Log('msg', "Msg $ref->{msgno}: $tfield $old -> $swop");
+ Log('dbg', "Msg $ref->{msgno}: $tfield $old -> $swop");
+ $ref->{to} = $swop if $tfield eq 'T';
+ $ref->{from} = $swop if $tfield eq 'F';
+ $ref->{origin} = $swop if $tfield eq 'O';
+ $ref->{subject} = $swop if $tfield eq 'S';
+ ++$count;
+ }
+ }
+ return $count;
+}
+
no strict;
sub AUTOLOAD
{
projects / spider.git / blobdiff