X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=168a978280e56337e8b17db7de48e894b92347c1;hb=7575fa5f2154933e2c80f8fbfc4539e2b40d4b87;hp=13af2cc02eac81e6bb85369add0fa39b3ce4a75e;hpb=97315924f561c56cef3b581691409d4217f5c1b5;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 13af2cc0..168a9782 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -32,7 +32,8 @@ use Carp; use strict; use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean - @badmsg $badmsgfn $forwardfn @forward); + @badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime + $queueinterval $lastq $importfn); %work = (); # outstanding jobs @msg = (); # messages we have @@ -41,31 +42,43 @@ $msgdir = "$main::root/msg"; # directory contain the msgs $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 = 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 + +$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 +$importfn = "$msgdir/import"; # import directory + %valid = ( - fromnode => '9,From Node', - tonode => '9,To Node', + fromnode => '5,From Node', + tonode => '5,To Node', to => '0,To', from => '0,From', t => '0,Msg Time,cldatetime', - private => '9,Private', + private => '5,Private', subject => '0,Subject', linesreq => '0,Lines per Gob', - rrreq => '9,Read Confirm', + rrreq => '5,Read Confirm', origin => '0,Origin', lines => '5,Data', stream => '9,Stream No', - count => '9,Gob Linecnt', - file => '9,File?,yesno', - gotit => '9,Got it Nodes,parray', - lines => '9,Lines,parray', - 'read' => '9,Times read', + count => '5,Gob Linecnt', + file => '5,File?,yesno', + gotit => '5,Got it Nodes,parray', + lines => '5,Lines,parray', + 'read' => '5,Times read', size => '0,Size', msgno => '0,Msgno', keep => '0,Keep this?,yesno', + lastt => '5,Last processed,cldatetime', + waitt => '5,Wait until,cldatetime', ); sub DESTROY @@ -95,6 +108,7 @@ sub alloc $self->{'read'} = shift; $self->{rrreq} = shift; $self->{gotit} = []; + $self->{lastt} = $main::systime; return $self; } @@ -110,16 +124,62 @@ sub workclean delete $ref->{lines}; delete $ref->{file}; delete $ref->{count}; + delete $ref->{lastt} if exists $ref->{lastt}; + delete $ref->{waitt} if exists $ref->{waitt}; } sub process { my ($self, $line) = @_; + + # this is periodic processing + if (!$self || !$line) { + + 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); + + # import any messages in the import directory + import_msgs(); + + $lastq = $main::systime; + } + + # clean the message queue + clean_old() if $main::systime - $last_clean > 3600 ; + return; + } + my @f = split /\^/, $line; my ($pcno) = $f[0] =~ /^PC(\d\d)/; # just get the number - + SWITCH: { if ($pcno == 28) { # incoming message + + # first look for any messages in the busy queue + # and cancel them this should both resolve timed out incoming messages + # and crossing of message between nodes, incoming messages have priority + 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); + } + my $t = cltounix($f[5], $f[6]); my $stream = next_transno($f[2]); my $ref = DXMsg->alloc($stream, uc $f[3], $f[4], $t, $f[7], $f[8], $f[13], '0', $f[11]); @@ -135,6 +195,14 @@ sub process $work{"$f[2]$stream"} = $ref; # store in work $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; } @@ -148,6 +216,10 @@ sub process dbg('msg', "stream $f[3]: $ref->{count} lines received\n"); $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; } @@ -165,7 +237,9 @@ sub process $ref->{lines} = []; push @{$ref->{lines}}, ($ref->read_msg_body); $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; @@ -176,7 +250,9 @@ sub process if ($ref) { dbg('msg', "tranche ack stream $f[3]\n"); $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; @@ -193,7 +269,7 @@ sub process # remove extraneous rubbish from the hash # remove it from the work in progress vector # stuff it on the msg queue - if ($ref->{lines} && @{$ref->{lines}} > 0) { # ignore messages with 0 lines + if ($ref->{lines}) { if ($ref->{file}) { $ref->store($ref->{lines}); } else { @@ -201,20 +277,24 @@ sub process # 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}) { - $ref->stop_msg($self); + 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"); Log('msg', "duplicate message to $msgno"); return; } } - + + # swop addresses + $ref->swop_it($self->call); + # look for 'bad' to addresses - if (grep $ref->{to} eq $_, @badmsg) { - $ref->stop_msg($self); - dbg('msg', "'Bad' TO address $ref->{to}"); - Log('msg', "'Bad' TO address $ref->{to}"); +# if (grep $ref->{to} eq $_, @badmsg) { + if ($ref->dump_it($self->call)) { + $ref->stop_msg($self->call); + dbg('msg', "'Bad' message $ref->{to}"); + Log('msg', "'Bad' message $ref->{to}"); return; } @@ -223,16 +303,16 @@ sub process $ref->store($ref->{lines}); add_dir($ref); my $dxchan = DXChannel->get($ref->{to}); - $dxchan->send($dxchan->msg('msgnew')) if $dxchan; + $dxchan->send($dxchan->msg('m9')) if $dxchan && $dxchan->is_user; Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}"); } } - $ref->stop_msg($self); - queue_msg(0); + $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); + # queue_msg(0); last SWITCH; } @@ -247,10 +327,13 @@ sub process push @{$ref->{gotit}}, $f[2]; # mark this up as being received $ref->store($ref->{lines}); # re- store the file } - $ref->stop_msg($self); + $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 } + + # send next one if present queue_msg(0); last SWITCH; } @@ -284,6 +367,7 @@ sub process $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 @@ -294,24 +378,22 @@ sub process dbg('msg', "stream $f[3]: abort received\n"); my $ref = $work{"$f[2]$f[3]"}; if ($ref) { - $ref->stop_msg($self); + $ref->stop_msg($self->call); $ref = undef; } - last SWITCH; } if ($pcno == 49) { # global delete on subject for (@msg) { - if ($_->{subject} eq $f[2]) { + if ($_->{from} eq $f[1] && $_->{subject} eq $f[2]) { $_->del_msg(); - Log('msg', "Message $_->{msgno} fully deleted by $f[1]"); + Log('msg', "Message $_->{msgno} from $_->{from} ($_->{subject}) fully deleted"); + DXProt::broadcast_ak1a($line, $self); } } } } - - clean_old() if $main::systime - $last_clean > 3600 ; # clean the message queue } @@ -324,9 +406,9 @@ sub store 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"); @@ -506,8 +588,7 @@ sub queue_msg 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. @@ -516,38 +597,45 @@ sub queue_msg 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}) { + 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; } @@ -578,8 +666,9 @@ sub start_msg $self->{count} = 0; $self->{tonode} = $dxchan->call; $self->{fromnode} = $main::mycall; - $busy{$dxchan->call} = $self; - $work{"$self->{tonode}"} = $self; + $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})); } @@ -605,12 +694,14 @@ sub get_fwq # stop a message from continuing, clean it out, unlock interlocks etc sub stop_msg { - my ($self, $dxchan) = @_; - my $node = $dxchan->call; + my $self = shift; + my $node = shift; + my $stream = $self->{stream} if exists $self->{stream}; + - dbg('msg', "stop msg $self->{msgno} stream $self->{stream}\n"); + dbg('msg', "stop msg $self->{msgno} -> node $node\n"); delete $work{$node}; - delete $work{"$node$self->{stream}"}; + delete $work{"$node$stream"} if $stream; $self->workclean; delete $busy{$node}; } @@ -645,12 +736,11 @@ sub init 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 $!"; @@ -743,48 +833,48 @@ sub do_send_stuff $loc->{lines} = []; $self->state('sendbody'); #push @out, $self->msg('sendbody'); - push @out, "Enter Message /EX (^Z) to send or /ABORT (^Y) to exit"; + push @out, $self->msg('m8'); } 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) { - foreach $to (@{$loc->{to}}) { - my $ref; - my $systime = $main::systime; - my $mycall = $main::mycall; - $ref = DXMsg->alloc(DXMsg::next_transno('Msgno'), - uc $to, - $self->call, - $systime, - $loc->{private}, - $loc->{subject}, - $mycall, - '0', - $loc->{rrreq}); - $ref->store($loc->{lines}); - $ref->add_dir(); - #push @out, $self->msg('sendsent', $to); - push @out, "msgno $ref->{msgno} sent to $to"; - my $dxchan = DXChannel->get(uc $to); - if ($dxchan) { - if ($dxchan->is_user()) { - $dxchan->send("New mail has arrived for you"); - } + foreach $to (@{$loc->{to}}) { + my $ref; + my $systime = $main::systime; + my $mycall = $main::mycall; + $ref = DXMsg->alloc(DXMsg::next_transno('Msgno'), + uc $to, + exists $loc->{from} ? $loc->{from} : $self->call, + $systime, + $loc->{private}, + $loc->{subject}, + exists $loc->{origin} ? $loc->{origin} : $mycall, + '0', + $loc->{rrreq}); + $ref->swop_it($self->call); + $ref->store($loc->{lines}); + $ref->add_dir(); + push @out, $self->msg('m11', $ref->{msgno}, $to); + #push @out, "msgno $ref->{msgno} sent to $to"; + my $dxchan = DXChannel->get(uc $to); + if ($dxchan) { + if ($dxchan->is_user()) { + $dxchan->send($dxchan->msg('m9')); } } } + delete $loc->{lines}; delete $loc->{to}; delete $self->{loc}; $self->func(undef); - DXMsg::queue_msg(0); + $self->state('prompt'); } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") { #push @out, $self->msg('sendabort'); - push @out, "aborted"; + push @out, $self->msg('m10'); delete $loc->{lines}; delete $loc->{to}; delete $self->{loc}; @@ -812,8 +902,11 @@ sub dir 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; } @@ -821,8 +914,23 @@ sub load_forward 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; } @@ -842,8 +950,8 @@ sub forward_it 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'; @@ -859,6 +967,228 @@ sub forward_it 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; +} + +# import any msgs in the import directory +# the messages are in BBS format (but may have cluster extentions +# so SB UK < GB7TLH is legal +sub import_msgs +{ + # are there any to do in this directory? + return unless -d $importfn; + unless (opendir(DIR, $importfn)) { + dbg('msg', "can't open $importfn $!"); + Log('msg', "can't open $importfn $!"); + return; + } + + my @names = readdir(DIR); + closedir(DIR); + my $name; + foreach $name (@names) { + next if $name =~ /^\./; + my $fn = "$importfn/$name"; + next unless -f $fn; + unless (open(MSG, $fn)) { + dbg('msg', "can't open import file $fn $!"); + Log('msg', "can't open import file $fn $!"); + unlink($fn); + next; + } + my @msg = map { chomp; $_ } ; + close(MSG); + unlink($fn); + my @out = import_one($DXProt::me, \@msg); + Log('msg', @out); + } +} + +# import one message as a list in bbs (as extended) mode +# takes a reference to an array containing the whole message +sub import_one +{ + my $dxchan = shift; + my $ref = shift; + my $private = '1'; + my $rr = '0'; + my $notincalls = 1; + my $from = $dxchan->call; + my $origin = $main::mycall; + my @to; + my @out; + + # first line; + my $line = shift @$ref; + my @f = split /\s+/, $line; + unless ($f[0] =~ /^(:?S|SP|SB|SEND)$/ ) { + my $m = "invalid first line in import '$line'"; + dbg('MSG', $m ); + return (1, $m); + } + while (@f) { + my $f = uc shift @f; + next if $f eq 'SEND'; + + # private / noprivate / rr + if ($notincalls && ($f eq 'B' || $f eq 'SB' || $f =~ /^NOP/oi)) { + $private = '0'; + } elsif ($notincalls && ($f eq 'P' || $f eq 'SP' || $f =~ /^PRI/oi)) { + ; + } elsif ($notincalls && ($f eq 'RR')) { + $rr = '1'; + } elsif ($f eq '@' && @f) { # this is bbs syntax, for origin + $origin = uc shift @f; + } elsif ($f eq '<' && @f) { # this is bbs syntax for from call + $from = uc shift @f; + } elsif ($f =~ /^\$/) { # this is bbs syntax for a bid + next; + } elsif ($f =~ /^<\S+/) { # this is bbs syntax for from call + ($from) = $f =~ /^<(\S+)$/; + } elsif ($f =~ /^\@\S+/) { # this is bbs syntax for origin + ($origin) = $f =~ /^\@(\S+)$/; + } else { + + # callsign ? + $notincalls = 0; + + # is this callsign a distro? + my $fn = "$msgdir/distro/$f.pl"; + if (-e $fn) { + my $fh = new IO::File $fn; + if ($fh) { + local $/ = undef; + my $s = <$fh>; + $fh->close; + my @call; + @call = eval $s; + return (1, "Error in Distro $f.pl:", $@) if $@; + if (@call > 0) { + push @f, @call; + next; + } + } + } + + if (grep $_ eq $f, @DXMsg::badmsg) { + push @out, $dxchan->msg('m3', $f); + } else { + push @to, $f; + } + } + } + + # subject is the next line + my $subject = shift @$ref; + + # strip off trailing lines + pop @$ref while (@$ref && ($$ref[-1] eq '' || $$ref[-1] =~ /^\s+$/)); + + # strip off /EX or /ABORT + return ("aborted") if (@$ref && $$ref[-1] =~ m{^/ABORT$}i); + pop @$ref if (@$ref && $$ref[-1] =~ m{^/EX$}i); + + # write all the messages away + my $to; + foreach $to (@to) { + my $systime = $main::systime; + my $mycall = $main::mycall; + my $mref = DXMsg->alloc(DXMsg::next_transno('Msgno'), + $to, + $from, + $systime, + $private, + $subject, + $origin, + '0', + $rr); + $mref->swop_it($main::mycall); + $mref->store($ref); + $mref->add_dir(); + push @out, $dxchan->msg('m11', $mref->{msgno}, $to); + #push @out, "msgno $ref->{msgno} sent to $to"; + my $todxchan = DXChannel->get(uc $to); + if ($todxchan) { + if ($todxchan->is_user()) { + $todxchan->send($todxchan->msg('m9')); + } + } + } + + return @out; +} + no strict; sub AUTOLOAD {