X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=blobdiff_plain;f=perl%2FDXMsg.pm;h=153a2c1b1dc998379fd3e69ea999d7bd3f6a47d9;hp=65577607be6d30635f2053e417df6b98b3de7fa0;hb=48f0cb90d0cfbe3037f353fc25adfc33561634fa;hpb=c3c5abeef9492faf2759af04df966311fab43302 diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 65577607..153a2c1b 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -4,7 +4,7 @@ # # Copyright (c) 1998 Dirk Koopman G1TLH # -# $Id$ +# # # # Notes for implementors:- @@ -15,13 +15,10 @@ package DXMsg; -@ISA = qw(DXProt DXChannel); - use DXUtil; use DXChannel; use DXUser; use DXM; -use DXCluster; use DXProtVars; use DXProtout; use DXDebug; @@ -29,10 +26,16 @@ use DXLog; use IO::File; use Fcntl; +eval { + require Net::SMTP; +}; + use strict; -use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean + +use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean $residencetime @badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime - $queueinterval $lastq $importfn $minchunk $maxchunk); + $email_server $email_prog $email_from + $queueinterval $lastq $importfn $minchunk $maxchunk $bulltopriv); %work = (); # outstanding jobs @msg = (); # messages we have @@ -50,6 +53,11 @@ $lastq = 0; $minchunk = 4800; # minimum chunk size for a split message $maxchunk = 6000; # maximum chunk size +$bulltopriv = 1; # convert msgs with callsigns to private if they are bulls +$residencetime = 2*86400; # keep deleted messages for this amount of time +$email_server = undef; # DNS address of smtp server if 'smtp' +$email_prog = undef; # program name + args for sending mail +$email_from = undef; # the from address the email will appear to be from $badmsgfn = "$msgdir/badmsg.pl"; # list of TO address we wont store $forwardfn = "$msgdir/forward.pl"; # the forwarding table @@ -58,35 +66,38 @@ $importfn = "$msgdir/import"; # import directory %valid = ( - fromnode => '5,From Node', - tonode => '5,To Node', - to => '0,To', - from => '0,From', - t => '0,Msg Time,cldatetime', - private => '5,Private', - subject => '0,Subject', - linesreq => '0,Lines per Gob', - rrreq => '5,Read Confirm', - origin => '0,Origin', - lines => '5,Data', - stream => '9,Stream No', + 'read' => '5,Times read', count => '5,Gob Linecnt', + delete => '5,Awaiting Delete,yesno', + deletetime => '5,Deletion Time,cldatetime', file => '5,File?,yesno', + from => '0,From', + fromnode => '5,From Node', 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', + lines => '5,Data', + lines => '5,Lines,parray', + linesreq => '0,Lines per Gob', + msgno => '0,Msgno', + origin => '0,Origin', + private => '5,Private,yesno', + rrreq => '5,Read Confirm,yesno', + size => '0,Size', + stream => '9,Stream No', + subject => '0,Subject', + t => '0,Msg Time,cldatetime', + to => '0,To', + tonode => '5,To Node', waitt => '5,Wait until,cldatetime', ); -sub DESTROY -{ - my $self = shift; - undef $self->{lines}; - undef $self->{gotit}; +# fix up the default sendmail if available +for (qw(/usr/sbin/sendmail /usr/lib/sendmail /usr/sbin/sendmail)) { + if (-e $_) { + $email_prog = $_; + last; + } } # allocate a new object @@ -100,7 +111,6 @@ sub alloc # $to =~ s/-\d+$//o; $self->{to} = ($to eq $main::mycall) ? $main::myalias : $to; my $from = shift; - $from =~ s/-\d+$//o; $self->{from} = uc $from; $self->{t} = shift; $self->{private} = shift; @@ -108,297 +118,405 @@ sub alloc $self->{origin} = shift; $self->{'read'} = shift; $self->{rrreq} = shift; + $self->{delete} = shift; + $self->{deletetime} = shift || ($self->{t} + $maxage); + $self->{keep} = shift; $self->{gotit} = []; - $self->{lastt} = $main::systime; +# $self->{lastt} = $main::systime; + $self->{lines} = []; + $self->{private} = 1 if $bulltopriv && DXUser::get_current($self->{to}); return $self; } -sub workclean -{ - my $ref = shift; - delete $ref->{lines}; - delete $ref->{linesreq}; - 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}; - 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); + if ($main::systime >= $lastq + $queueinterval) { - # import any messages in the import directory - import_msgs(); - - $lastq = $main::systime; - } + # 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; + # clean the message queue + if ($main::systime >= $last_clean+3600) { + clean_old(); + $last_clean = $main::systime; } + + # actual remove all the 'deleted' messages in one hit. + # this has to be delayed until here otherwise it only does one at + # a time because @msg is rewritten everytime del_msg is called. + my @del = grep {!$_->{tonode} && $_->{delete} && !$_->{keep} && $_->{deletetime} < $main::systime} @msg; + for (@del) { + $_->del_msg; + } + +} + +# incoming message +sub handle_28 +{ + my $dxchan = shift; + my ($tonode, $fromnode) = @_[1..2]; - my @f = split /\^/, $line; - my ($pcno) = $f[0] =~ /^PC(\d\d)/; # just get the number + # sort out various extant protocol errors that occur + my $origin = $_[13]; + $origin = $dxchan->call unless $origin && $origin gt ' '; - 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 - # 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 $ref = get_busy($fromnode); + if ($ref) { + my $otonode = $ref->{tonode} || "unknown"; + dbg("Busy, stopping msgno: $ref->{msgno} $fromnode->$otonode") if isdbg('msg'); + $ref->stop_msg($fromnode); + } - 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]); + my $t = cltounix($_[5], $_[6]); + my $stream = next_transno($fromnode); + $ref = DXMsg->alloc($stream, uc $_[3], $_[4], $t, $_[7], $_[8], $origin, '0', $_[11]); - # fill in various forwarding state variables - $ref->{fromnode} = $f[2]; - $ref->{tonode} = $f[1]; - $ref->{rrreq} = $f[11]; - $ref->{linesreq} = $f[10]; - $ref->{stream} = $stream; - $ref->{count} = 0; # no of lines between PC31s - dbg('msg', "new message from $f[4] to $f[3] '$f[8]' stream $stream\n"); - Log('msg', "Incoming message $f[4] to $f[3] '$f[8]'" ); - $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; - } - - if ($pcno == 29) { # incoming text - my $ref = $work{"$f[2]$f[3]"}; - if ($ref) { - push @{$ref->{lines}}, $f[4]; - $ref->{count}++; - if ($ref->{count} >= $ref->{linesreq}) { - $self->send(DXProt::pc31($f[2], $f[1], $f[3])); - 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; - } + # fill in various forwarding state variables + $ref->{fromnode} = $fromnode; + $ref->{tonode} = $tonode; + $ref->{rrreq} = $_[11]; + $ref->{linesreq} = $_[10]; + $ref->{stream} = $stream; + $ref->{count} = 0; # no of lines between PC31s + dbg("new message from $_[4] to $_[3] '$_[8]' stream $fromnode/$stream\n") if isdbg('msg'); + Log('msg', "Incoming message $_[4] to $_[3] '$_[8]' origin: $origin" ); + set_fwq($fromnode, $stream, $ref); # store in work + set_busy($fromnode, $ref); # set interlock + $dxchan->send(DXProt::pc30($fromnode, $tonode, $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 (is_callsign($ref->{to}) && !$ref->{private} && $uref && $uref->homenode) { + $ref->{private} = 1; + dbg("set bull to $ref->{to} to private") if isdbg('msg'); + Log('msg', "set bull to $ref->{to} to private"); + } +} - if ($pcno == 30) { # this is a incoming subject ack - my $ref = $work{$f[2]}; # note no stream at this stage - if ($ref) { - delete $work{$f[2]}; - $ref->{stream} = $f[3]; - $ref->{count} = 0; - $ref->{linesreq} = 5; - $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; +# incoming text +sub handle_29 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + $_[4] =~ s/\%5E/^/g; + if (@{$ref->{lines}}) { + push @{$ref->{lines}}, $_[4]; + } else { + # temporarily store any R: lines so that we end up with + # only the first and last ones stored. + if ($_[4] =~ m|^R:\d{6}/\d{4}|) { + push @{$ref->{tempr}}, $_[4]; } else { - dbg('msg', "PC30 from unknown stream $f[3] from $f[2]" ); - $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream + if (exists $ref->{tempr}) { + push @{$ref->{lines}}, shift @{$ref->{tempr}}; + push @{$ref->{lines}}, pop @{$ref->{tempr}} if @{$ref->{tempr}}; + delete $ref->{tempr}; + } + push @{$ref->{lines}}, $_[4]; } - last SWITCH; } - - if ($pcno == 31) { # acknowledge a tranche of lines - my $ref = $work{"$f[2]$f[3]"}; - 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; + $ref->{count}++; + if ($ref->{count} >= $ref->{linesreq}) { + $dxchan->send(DXProt::pc31($fromnode, $tonode, $stream)); + dbg("stream $stream: $ref->{count} lines received\n") if isdbg('msg'); + $ref->{count} = 0; } + $ref->{lastt} = $main::systime; + } else { + dbg("PC29 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } +} + +# this is a incoming subject ack +sub handle_30 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + my $ref = get_fwq($fromnode); # note no stream at this stage + if ($ref) { + del_fwq($fromnode); + $ref->{stream} = $stream; + $ref->{count} = 0; + $ref->{linesreq} = 5; + set_fwq($fromnode, $stream, $ref); # new ref + set_busy($fromnode, $ref); # interlock + dbg("incoming subject ack stream $stream\n") if isdbg('msg'); + $ref->{lines} = [ $ref->read_msg_body ]; + $ref->send_tranche($dxchan); + $ref->{lastt} = $main::systime; + } else { + dbg("PC30 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } +} + +# acknowledge a tranche of lines +sub handle_31 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + dbg("tranche ack stream $stream\n") if isdbg('msg'); + $ref->send_tranche($dxchan); + $ref->{lastt} = $main::systime; + } else { + dbg("PC31 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } +} - if ($pcno == 32) { # incoming EOM - dbg('msg', "stream $f[3]: EOM received\n"); - my $ref = $work{"$f[2]$f[3]"}; - if ($ref) { - $self->send(DXProt::pc33($f[2], $f[1], $f[3])); # acknowledge it +# incoming EOM +sub handle_32 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + dbg("stream $stream: EOM received\n") if isdbg('msg'); + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + $dxchan->send(DXProt::pc33($fromnode, $tonode, $stream)); # acknowledge it - # get the next msg no - note that this has NOTHING to do with the stream number in PC protocol - # store the file or message - # remove extraneous rubbish from the hash - # remove it from the work in progress vector - # stuff it on the msg queue - if ($ref->{lines}) { - if ($ref->{file}) { - $ref->store($ref->{lines}); - } else { - - # 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->{to} eq $m->{to}) { - $ref->stop_msg($self->call); - my $msgno = $m->{msgno}; - dbg('msg', "duplicate message from $ref->{from} -> $ref->{to} to $msgno"); - Log('msg', "duplicate message from $ref->{from} -> $ref->{to} to $msgno"); - return; - } - } - - # swop addresses - $ref->swop_it($self->call); + # get the next msg no - note that this has NOTHING to do with the stream number in PC protocol + # store the file or message + # remove extraneous rubbish from the hash + # remove it from the work in progress vector + # stuff it on the msg queue + if ($ref->{lines}) { + if ($ref->{file}) { + $ref->store($ref->{lines}); + } else { + + # is it too old + if ($ref->{t}+$maxage < $main::systime ) { + $ref->stop_msg($fromnode); + dbg("old message from $ref->{from} -> $ref->{to} " . atime($ref->{t}) . " ignored") if isdbg('msg'); + Log('msg', "old message from $ref->{from} -> $ref->{to} " . cldatetime($ref->{t}) . " ignored"); + return; + } + + # does an identical message already exist? + my $m; + for $m (@msg) { + if (substr($ref->{subject},0,28) eq substr($m->{subject},0,28) && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from} && $ref->{to} eq $m->{to}) { + $ref->stop_msg($fromnode); + my $msgno = $m->{msgno}; + dbg("duplicate message from $ref->{from} -> $ref->{to} to msg: $msgno") if isdbg('msg'); + Log('msg', "duplicate message from $ref->{from} -> $ref->{to} to msg: $msgno"); + return; + } + } + + # swop addresses + $ref->swop_it($dxchan->call); - # look for 'bad' to addresses -# 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; - } - - $ref->{msgno} = next_transno("Msgno"); - push @{$ref->{gotit}}, $f[2]; # mark this up as being received - $ref->store($ref->{lines}); - add_dir($ref); - my $dxchan = DXChannel->get($ref->{to}); - $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}"); + # look for 'bad' to addresses + if ($ref->dump_it($dxchan->call)) { + $ref->stop_msg($fromnode); + dbg("'Bad' message $ref->{to}") if isdbg('msg'); + Log('msg', "'Bad' message $ref->{to}"); + return; + } + + # check the message for bad words + my @bad; + my @words; + @bad = BadWords::check($ref->{subject}); + push @words, [$ref->{subject}, @bad] if @bad; + for (@{$ref->{lines}}) { + @bad = BadWords::check($_); + push @words, [$_, @bad] if @bad; + } + if (@words) { + LogDbg('msg',"$ref->{from} swore: $ref->{to} origin: $ref->{origin} via " . $dxchan->call); + LogDbg('msg',"subject: $ref->{subject}"); + for (@words) { + my $r = $_; + my $line = shift @$r; + LogDbg('msg', "line: $line (using words: ". join(',', @$r).")"); } + $ref->stop_msg($fromnode); + 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 + + $ref->{msgno} = next_transno("Msgno"); + push @{$ref->{gotit}}, $fromnode; # mark this up as being received + $ref->store($ref->{lines}); + $ref->notify; + add_dir($ref); + Log('msg', "Message $ref->{msgno} from $ref->{from} received from $fromnode for $ref->{to}"); } - # queue_msg(0); - last SWITCH; } + $ref->stop_msg($fromnode); + } else { + dbg("PC32 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } + # queue_msg(0); +} - if ($pcno == 33) { # acknowledge the end of message - my $ref = $work{"$f[2]$f[3]"}; - if ($ref) { - if ($ref->{private}) { # remove it if it private and gone off site# - Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $f[2] and deleted"); - $ref->del_msg; - } else { - Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $f[2]"); - push @{$ref->{gotit}}, $f[2]; # mark this up as being received - $ref->store($ref->{lines}); # re- store the file - } - $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; +# acknowledge the end of message +sub handle_33 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + if ($ref->{private}) { # remove it if it private and gone off site# + Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $fromnode and deleted"); + $ref->mark_delete; + } else { + Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $fromnode"); + push @{$ref->{gotit}}, $fromnode; # mark this up as being received + $ref->store($ref->{lines}); # re- store the file } + $ref->stop_msg($fromnode); + } else { + dbg("PC33 from unknown stream $stream from $fromnode") if isdbg('msg'); + $dxchan->send(DXProt::pc42($fromnode, $tonode, $stream)); # unknown stream + } + + # send next one if present + queue_msg(0); +} - if ($pcno == 40) { # this is a file request - $f[3] =~ s/\\/\//og; # change the slashes - $f[3] =~ s/\.//og; # remove dots - $f[3] =~ s/^\///o; # remove the leading / - $f[3] = lc $f[3]; # to lower case; - dbg('msg', "incoming file $f[3]\n"); - $f[3] = 'packclus/' . $f[3] unless $f[3] =~ /^packclus\//o; - - # create any directories - my @part = split /\//, $f[3]; - my $part; - my $fn = "$main::root"; - pop @part; # remove last part - foreach $part (@part) { - $fn .= "/$part"; - next if -e $fn; - last SWITCH if !mkdir $fn, 0777; - dbg('msg', "created directory $fn\n"); - } - my $stream = next_transno($f[2]); - my $ref = DXMsg->alloc($stream, "$main::root/$f[3]", $self->call, time, !$f[4], $f[3], ' ', '0', '0'); +# this is a file request +sub handle_40 +{ + my $dxchan = shift; + my ($tonode, $fromnode) = @_[1..2]; + + $_[3] =~ s/\\/\//og; # change the slashes + $_[3] =~ s/\.//og; # remove dots + $_[3] =~ s/^\///o; # remove the leading / + $_[3] = lc $_[3]; # to lower case; + dbg("incoming file $_[3]\n") if isdbg('msg'); + $_[3] = 'packclus/' . $_[3] unless $_[3] =~ /^packclus\//o; - # forwarding variables - $ref->{fromnode} = $f[1]; - $ref->{tonode} = $f[2]; - $ref->{linesreq} = $f[5]; - $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 + # create any directories + my @part = split /\//, $_[3]; + my $part; + my $fn = "$main::root"; + pop @part; # remove last part + foreach $part (@part) { + $fn .= "/$part"; + next if -e $fn; + last SWITCH if !mkdir $fn, 0777; + dbg("created directory $fn\n") if isdbg('msg'); + } + my $stream = next_transno($fromnode); + my $ref = DXMsg->alloc($stream, "$main::root/$_[3]", $dxchan->call, time, !$_[4], $_[3], ' ', '0', '0'); - last SWITCH; - } + # forwarding variables + $ref->{fromnode} = $tonode; + $ref->{tonode} = $fromnode; + $ref->{linesreq} = $_[5]; + $ref->{stream} = $stream; + $ref->{count} = 0; # no of lines between PC31s + $ref->{file} = 1; + $ref->{lastt} = $main::systime; + set_fwq($fromnode, $stream, $ref); # store in work + $dxchan->send(DXProt::pc30($fromnode, $tonode, $stream)); # send ack +} - if ($pcno == 42) { # abort transfer - dbg('msg', "stream $f[3]: abort received\n"); - my $ref = $work{"$f[2]$f[3]"}; - if ($ref) { - $ref->stop_msg($self->call); - $ref = undef; - } - last SWITCH; +# abort transfer +sub handle_42 +{ + my $dxchan = shift; + my ($tonode, $fromnode, $stream) = @_[1..3]; + + dbg("stream $stream: abort received\n") if isdbg('msg'); + my $ref = get_fwq($fromnode, $stream); + if ($ref) { + $ref->stop_msg($fromnode); + $ref = undef; + } +} + +# global delete on subject +sub handle_49 +{ + my $dxchan = shift; + my $line = shift; + + for (@msg) { + if ($_->{from} eq $_[1] && $_->{subject} eq $_[2]) { + $_->mark_delete; + Log('msg', "Message $_->{msgno} from $_->{from} ($_->{subject}) fully deleted"); + DXChannel::broadcast_nodes($line, $dxchan); } + } +} - if ($pcno == 49) { # global delete on subject - for (@msg) { - if ($_->{from} eq $f[1] && $_->{subject} eq $f[2]) { - $_->del_msg(); - Log('msg', "Message $_->{msgno} from $_->{from} ($_->{subject}) fully deleted"); - DXProt::broadcast_ak1a($line, $self); + + +sub notify +{ + my $ref = shift; + my $to = $ref->{to}; + my $uref = DXUser::get_current($to); + my $dxchan = DXChannel::get($to); + if (((*Net::SMTP && $email_server) || $email_prog) && $uref && $uref->wantemail) { + my $email = $uref->email; + if ($email) { + my @rcpt = ref $email ? @{$email} : $email; + my $fromaddr = $email_from || $main::myemail; + my @headers = ("To: $ref->{to}", + "From: $fromaddr", + "Subject: [DXSpider: $ref->{from}] $ref->{subject}", + "X-DXSpider-To: $ref->{to}", + "X-DXSpider-From: $ref->{from}\@$ref->{origin}", + "X-DXSpider-Gateway: $main::mycall" + ); + my @data = ("Msgno: $ref->{msgno} To: $to From: $ref->{from}\@$ref->{origin} Gateway: $main::mycall", + "", + $ref->read_msg_body + ); + my $msg; + undef $!; + if (*Net::SMTP && $email_server) { + $msg = Net::SMTP->new($email_server); + if ($msg) { + $msg->mail($fromaddr); + $msg->to(@rcpt); + $msg->data(map {"$_\n"} @headers, '', @data); + $msg->quit; + } + } elsif ($email_prog) { + $msg = new IO::File "|$email_prog " . join(' ', @rcpt); + if ($msg) { + print $msg map {"$_\r\n"} @headers, '', @data, '.'; + $msg->close; } } + dbg("email forwarding error $!") if isdbg('msg') && !$msg && defined $!; } } + $dxchan->send($dxchan->msg('m9')) if $dxchan && $dxchan->is_user; } - # store a message away on disc or whatever # # NOTE the second arg is a REFERENCE not a list @@ -406,14 +524,9 @@ 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"); + dbg("To be stored in $ref->{to}\n") if isdbg('msg'); my $fh = new IO::File "$ref->{to}", "w"; if (defined $fh) { @@ -422,7 +535,7 @@ sub store print $fh "$line\n"; } $fh->close; - dbg('msg', "file $ref->{to} stored\n"); + dbg("file $ref->{to} stored\n") if isdbg('msg'); Log('msg', "file $ref->{to} from $ref->{from} stored" ); } else { confess "can't open file $ref->{to} $!"; @@ -432,45 +545,79 @@ sub store # attempt to open the message file my $fn = filename($ref->{msgno}); - dbg('msg', "To be stored in $fn\n"); + dbg("To be stored in $fn\n") if isdbg('msg'); # now save the file, overwriting what's there, YES I KNOW OK! (I will change it if it's a problem) my $fh = new IO::File "$fn", "w"; if (defined $fh) { my $rr = $ref->{rrreq} ? '1' : '0'; my $priv = $ref->{private} ? '1': '0'; - print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr\n"; + my $del = $ref->{delete} ? '1' : '0'; + my $delt = $ref->{deletetime} || ($ref->{t} + $maxage); + my $keep = $ref->{keep} || '0'; + print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr^$del^$delt^$keep\n"; print $fh "=== ", join('^', @{$ref->{gotit}}), "\n"; my $line; $ref->{size} = 0; foreach $line (@{$lines}) { + $line =~ s/[\x00-\x08\x0a-\x1f\x80-\x9f]/./g; $ref->{size} += (length $line) + 1; print $fh "$line\n"; } $fh->close; - dbg('msg', "msg $ref->{msgno} stored\n"); + dbg("msg $ref->{msgno} stored\n") if isdbg('msg'); Log('msg', "msg $ref->{msgno} from $ref->{from} to $ref->{to} stored" ); } else { confess "can't open msg file $fn $!"; } } + } # delete a message sub del_msg { my $self = shift; + my $dxchan = shift; + my $call = ''; + $call = ' by ' . $dxchan->call if $dxchan; - # remove it from the active message list - @msg = map { $_ != $self ? $_ : () } @msg; + if ($self->{tonode}) { + $self->{delete}++; + $self->{deletetime} = 0; + dbg("Msgno $self->{msgno} but marked as expunged$call") if isdbg('msg'); + } else { + # remove it from the active message list + @msg = grep { $_ != $self } @msg; + + Log('msg', "Msgno $self->{msgno} expunged$call"); + dbg("Msgno $self->{msgno} expunged$call") if isdbg('msg'); + + # remove the file + unlink filename($self->{msgno}); + } +} + +sub mark_delete +{ + my $ref = shift; + my $t = shift; + + return if $ref->{keep}; - # belt and braces (one day I will ask someone if this is REALLY necessary) - delete $self->{gotit}; - delete $self->{list}; + $t = $main::systime + $residencetime unless defined $t; - # remove the file - unlink filename($self->{msgno}); - dbg('msg', "deleting $self->{msgno}\n"); + $ref->{delete}++; + $ref->{deletetime} = $t; + $ref->store( [$ref->read_msg_body] ); +} + +sub unmark_delete +{ + my $ref = shift; + my $t = shift; + $ref->{delete} = 0; + $ref->{deletetime} = 0; } # clean out old messages from the message queue @@ -480,18 +627,13 @@ sub clean_old # mark old messages for deletion foreach $ref (@msg) { - if (!$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"); + if (ref($ref) && !$ref->{keep} && $ref->{deletetime} < $main::systime) { + + # this is for IMMEDIATE destruction + $ref->{delete}++; + $ref->{deletetime} = 0; } } - - # remove them all from the active message list - @msg = map { $_->{deleteme} ? () : $_ } @msg; - $last_clean = $main::systime; } # read in a message header @@ -506,16 +648,21 @@ sub read_msg_header $file = new IO::File "$fn"; if (!$file) { - dbg('err', "Error reading $fn $!"); + dbg("Error reading $fn $!"); Log('err', "Error reading $fn $!"); return undef; } $size = -s $fn; $line = <$file>; # first line + if ($size == 0 || !$line) { + dbg("Empty $fn $!"); + Log('err', "Empty $fn $!"); + return undef; + } chomp $line; $size -= length $line; if (! $line =~ /^===/o) { - dbg('err', "corrupt first line in $fn ($line)"); + dbg("corrupt first line in $fn ($line)"); Log('err', "corrupt first line in $fn ($line)"); return undef; } @@ -527,7 +674,7 @@ sub read_msg_header chomp $line; $size -= length $line; if (! $line =~ /^===/o) { - dbg('err', "corrupt second line in $fn ($line)"); + dbg("corrupt second line in $fn ($line)"); Log('err', "corrupt second line in $fn ($line)"); return undef; } @@ -554,9 +701,9 @@ sub read_msg_body $file = new IO::File; if (!open($file, $fn)) { - dbg('err' ,"Error reading $fn $!"); + dbg("Error reading $fn $!"); Log('err' ,"Error reading $fn $!"); - return undef; + return (); } @out = map {chomp; $_} <$file>; close($file); @@ -591,18 +738,15 @@ sub send_tranche sub queue_msg { my $sort = shift; - 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"); + dbg("queue msg ($sort)\n") if isdbg('msg'); + 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}) { @@ -610,41 +754,72 @@ sub queue_msg delete $ref->{waitt}; } + # any time outs? + if (exists $ref->{lastt} && $main::systime >= $ref->{lastt} + $timeout) { + my $node = $ref->{tonode}; + dbg("Timeout, stopping msgno: $ref->{msgno} -> $node") if isdbg('msg'); + Log('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node"); + $ref->stop_msg($node); + + # delay any outgoing messages that fail + $ref->{waitt} = $main::systime + $waittime + int rand(120) if $node ne $main::mycall; + delete $ref->{lastt}; + next; + } + + # is it being sent anywhere currently? + next if $ref->{tonode}; # ignore it if it already being processed + + # is it awaiting deletion? + next if $ref->{delete}; + + # 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 $noderef; + my $dxchan; if ($ref->{private}) { 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; + $clref = Route::get($ref->{to}); + if ($clref) { + $dxchan = $clref->dxchan; + if ($dxchan) { + if ($dxchan->is_node) { + next if $clref->call eq $main::mycall; # i.e. it lives here + $ref->start_msg($dxchan) if !get_busy($dxchan->call) && $dxchan->state eq 'normal'; + } + } else { + dbg("Route: No dxchan for $ref->{to} " . ref($clref) ) if isdbg('msg'); + } } - 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'; + } else { + + # 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 $dxchan (@nodelist) { + 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 + next if $ref->{tonode}; # ignore it if it already being processed + + # if we are here we have a node that doesn't have this message + if (!get_busy($call) && $dxchan->state eq 'normal') { + $ref->start_msg($dxchan); + 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; } + + } # is there a message for me? @@ -652,14 +827,15 @@ sub for_me { my $call = uc shift; my $ref; + my $count; foreach $ref (@msg) { # is it for me, private and unread? if ($ref->{to} eq $call && $ref->{private}) { - return 1 if !$ref->{'read'}; + $count++ unless $ref->{'read'} || $ref->{delete}; } } - return 0; + return $count; } # start the message off on its travels with a PC28 @@ -667,15 +843,19 @@ sub start_msg { my ($self, $dxchan) = @_; - dbg('msg', "start msg $self->{msgno}\n"); - $self->{linesreq} = 5; + confess("trying to start started msg $self->{msgno} nodes: $self->{fromnode} -> $self->{tonode}") if $self->{tonode}; + dbg("start msg $self->{msgno}\n") if isdbg('msg'); + $self->{linesreq} = 10; $self->{count} = 0; $self->{tonode} = $dxchan->call; $self->{fromnode} = $main::mycall; - $busy{$self->{tonode}} = $self; - $work{$self->{tonode}} = $self; + set_busy($self->{tonode}, $self); + set_fwq($self->{tonode}, undef, $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 ($fromnode, $origin); + $fromnode = $self->{fromnode}; + $origin = $self->{origin}; + $dxchan->send(DXProt::pc28($self->{tonode}, $fromnode, $self->{to}, $self->{from}, $self->{t}, $self->{private}, $self->{subject}, $origin, $self->{rrreq})); } # get the ref of a busy node @@ -685,16 +865,52 @@ sub get_busy return $busy{$call}; } -# get the busy queue +sub set_busy +{ + my $call = shift; + return $busy{$call} = shift; +} + +sub del_busy +{ + my $call = shift; + return delete $busy{$call}; +} + +# get the whole busy queue sub get_all_busy { - return values %busy; + return keys %busy; } -# get the forwarding queue +# get a forwarding queue entry sub get_fwq { - return values %work; + my $call = shift; + my $stream = shift || '0'; + return $work{"$call,$stream"}; +} + +# delete a forwarding queue entry +sub del_fwq +{ + my $call = shift; + my $stream = shift || '0'; + return delete $work{"$call,$stream"}; +} + +# set a fwq entry +sub set_fwq +{ + my $call = shift; + my $stream = shift || '0'; + return $work{"$call,$stream"} = shift; +} + +# get the whole forwarding queue +sub get_all_fwq +{ + return keys %work; } # stop a message from continuing, clean it out, unlock interlocks etc @@ -702,14 +918,28 @@ sub stop_msg { my $self = shift; my $node = shift; - my $stream = $self->{stream} if exists $self->{stream}; + my $stream = $self->{stream}; - dbg('msg', "stop msg $self->{msgno} -> node $node\n"); - delete $work{$node}; - delete $work{"$node$stream"} if $stream; + dbg("stop msg $self->{msgno} -> node $node\n") if isdbg('msg'); + del_fwq($node, $stream); $self->workclean; - delete $busy{$node}; + del_busy($node); +} + +sub workclean +{ + my $ref = shift; + delete $ref->{lines}; + delete $ref->{linesreq}; + delete $ref->{tonode}; + delete $ref->{fromnode}; + delete $ref->{stream}; + delete $ref->{file}; + delete $ref->{count}; + delete $ref->{tempr}; + delete $ref->{lastt}; + delete $ref->{waitt}; } # get a new transaction number from the file specified @@ -723,12 +953,12 @@ sub next_transno my $fh = new IO::File; if (sysopen($fh, $fn, O_RDWR|O_CREAT, 0666)) { $fh->autoflush(1); - $msgno = $fh->getline; + $msgno = $fh->getline || '0'; chomp $msgno; $msgno++; seek $fh, 0, 0; $fh->print("$msgno\n"); - dbg('msg', "msgno $msgno allocated for $name\n"); + dbg("msgno $msgno allocated for $name\n") if isdbg('msg'); $fh->close; } else { confess "can't open $fn $!"; @@ -744,9 +974,9 @@ sub init my $ref; # load various control files - dbg('err', "load badmsg: " . (load_badmsg() or "Ok")); - dbg('err', "load forward: " . (load_forward() or "Ok")); - dbg('err', "load swop: " . (load_swop() or "Ok")); + dbg("load badmsg: " . (load_badmsg() or "Ok")); + dbg("load forward: " . (load_forward() or "Ok")); + dbg("load swop: " . (load_swop() or "Ok")); # read in the directory opendir($dir, $msgdir) or confess "can't open $msgdir $!"; @@ -755,14 +985,19 @@ 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("Deleting $_"); + Log('err', "Deleting $_"); + unlink "$msgdir/$_"; + next; + } # delete any messages to 'badmsg.pl' places - if (grep $ref->{to} eq $_, @badmsg) { - dbg('msg', "'Bad' TO address $ref->{to}"); + if ($ref->dump_it('')) { + dbg("'Bad' TO address $ref->{to}") if isdbg('msg'); Log('msg', "'Bad' TO address $ref->{to}"); $ref->del_msg; next; @@ -835,6 +1070,11 @@ sub do_send_stuff # $DB::single = 1; confess "local var gone missing" if !ref $self->{loc}; my $loc = $self->{loc}; + if (my @ans = BadWords::check($line)) { + $self->{badcount} += @ans; + Log('msg', $self->call . " used badwords: @ans to @{$loc->{to}} in msg"); + $loc->{reject}++; + } $loc->{subject} = $line; $loc->{lines} = []; $self->state('sendbody'); @@ -845,33 +1085,31 @@ sub do_send_stuff my $loc = $self->{loc}; if ($line eq "\032" || $line eq '%1A' || uc $line eq "/EX") { my $to; - - 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')); - } + unless ($loc->{reject}) { + 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"; + $ref->notify; } + } else { + LogDbg('msg', $self->call . " swore to @{$loc->{to}} subject: '$loc->{subject}' in msg, REJECTED"); } - + delete $loc->{lines}; delete $loc->{to}; delete $self->{loc}; @@ -886,22 +1124,69 @@ sub do_send_stuff delete $self->{loc}; $self->func(undef); $self->state('prompt'); + } elsif ($line =~ m|^/+\w+|) { + # this is a command that you want display for your own reference + # or if it has TWO slashes is a command + $line =~ s|^/||; + my $store = $line =~ s|^/+||; + my @in = $self->run_cmd($line); + push @out, @in; + if ($store) { + foreach my $l (@in) { + if (my @ans = BadWords::check($l)) { + $self->{badcount} += @ans; + Log('msg', $self->call . " used badwords: @ans to @{$loc->{to}} subject: '$loc->{subject}' in msg") unless $loc->{reject}; + Log('msg', "line: $l"); + $loc->{reject}++; + } + push @{$loc->{lines}}, length($l) > 0 ? $l : " "; + } + } } else { + if (my @ans = BadWords::check($line)) { + $self->{badcount} += @ans; + Log('msg', $self->call . " used badwords: @ans to @{$loc->{to}} subject: '$loc->{subject}' in msg") unless $loc->{reject}; + Log('msg', "line: $line"); + $loc->{reject}++; + } + + if ($loc->{lines} && @{$loc->{lines}}) { + push @{$loc->{lines}}, length($line) > 0 ? $line : " "; + } else { + # temporarily store any R: lines so that we end up with + # only the first and last ones stored. + if ($line =~ m|^R:\d{6}/\d{4}|) { + push @{$loc->{tempr}}, $line; + } else { + if (exists $loc->{tempr}) { + push @{$loc->{lines}}, shift @{$loc->{tempr}}; + push @{$loc->{lines}}, pop @{$loc->{tempr}} if @{$loc->{tempr}}; + delete $loc->{tempr}; + } + push @{$loc->{lines}}, length($line) > 0 ? $line : " "; + } + } # i.e. it ain't and end or abort, therefore store the line - push @{$loc->{lines}}, length($line) > 0 ? $line : " "; } } - return (1, @out); + return @out; } # return the standard directory line for this ref sub dir { my $ref = shift; - return sprintf "%6d%s%s%5d %8.8s %8.8s %-6.6s %5.5s %-30.30s", - $ref->msgno, $ref->read ? '-' : ' ', $ref->private ? 'p' : ' ', $ref->size, - $ref->to, $ref->from, cldate($ref->t), ztime($ref->t), $ref->subject; + my $flag = $ref->{private} && $ref->{read} ? '-' : ' '; + if ($ref->{keep}) { + $flag = '!'; + } elsif ($ref->{delete}) { + $flag = $ref->{deletetime} > $main::systime ? 'D' : 'E'; + } + return sprintf("%6d%s%s%5d %8.8s %8.8s %-6.6s %5.5s %-30.30s", + $ref->{msgno}, $flag, $ref->{private} ? 'p' : ' ', + $ref->{size}, $ref->{to}, $ref->{from}, cldate($ref->{t}), + ztime($ref->{t}), $ref->{subject}); } # load the forward table @@ -973,6 +1258,32 @@ sub forward_it return 0; } +# +# look down the forward table to see whether this is a valid bull +# or not (ie it will forward somewhere even if it is only here) +# +sub valid_bull_addr +{ + my $call = shift; + my $i; + + unless (@forward) { + return 1 if $call =~ /^ALL/; + return 1 if $call =~ /^DX/; + return 0; + } + + for ($i = 0; $i < @forward; $i += 5) { + my ($sort, $field, $pattern, $action, $bbs) = @forward[$i..($i+4)]; + if ($field eq 'T') { + if (!$pattern || $call =~ m{$pattern}i) { + return 1; + } + } + } + return 0; +} + sub dump_it { my $ref = shift; @@ -992,6 +1303,7 @@ sub dump_it $tested = $ref->{from} if $field eq 'F'; $tested = $ref->{origin} if $field eq 'O'; $tested = $ref->{subject} if $field eq 'S'; + $tested = $call if $field eq 'I'; if (!$pattern || $tested =~ m{$pattern}i) { return 1; @@ -1055,7 +1367,7 @@ 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 $!"); + dbg("can\'t open $importfn $!") if isdbg('msg'); Log('msg', "can\'t open $importfn $!"); return; } @@ -1069,7 +1381,7 @@ sub import_msgs my $fn = "$importfn/$name"; next unless -f $fn; unless (open(MSG, $fn)) { - dbg('msg', "can\'t open import file $fn $!"); + dbg("can\'t open import file $fn $!") if isdbg('msg'); Log('msg', "can\'t open import file $fn $!"); unlink($fn); next; @@ -1077,7 +1389,7 @@ sub import_msgs my @msg = map { chomp; $_ } ; close(MSG); unlink($fn); - my @out = import_one($DXProt::me, \@msg, $splitit); + my @out = import_one($main::me, \@msg, $splitit); Log('msg', @out); } } @@ -1099,10 +1411,12 @@ sub import_one # first line; my $line = shift @$ref; - my @f = split /\s+/, $line; + my @f = split /([\s\@\$])/, $line; + @f = map {s/\s+//g; length $_ ? $_ : ()} @f; + unless (@f && $f[0] =~ /^(:?S|SP|SB|SEND)$/ ) { my $m = "invalid first line in import '$line'"; - dbg('MSG', $m ); + dbg($m) if isdbg('msg'); return (1, $m); } while (@f) { @@ -1116,16 +1430,16 @@ sub import_one ; } elsif ($notincalls && ($f eq 'RR')) { $rr = '1'; - } elsif ($f eq '@' && @f) { # this is bbs syntax, for origin - $origin = uc shift @f; + } elsif (($f =~ /^[\@\.\#\$]$/ || $f eq '.#') && @f) { # this is bbs syntax, for AT + 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+)$/; + } elsif ($f =~ /^<(\S+)/) { # this is bbs syntax for from call + $from = $1; + } elsif ($f =~ /^\$\S+/) { # this is bbs syntax for bid + ; } else { # callsign ? @@ -1185,7 +1499,18 @@ sub import_one } else { push @chunk, $ref; } - + + # does an identical message already exist? + my $m; + for $m (@msg) { + if (substr($subject,0,28) eq substr($m->{subject},0,28) && $from eq $m->{from} && grep $m->{to} eq $_, @to) { + my $msgno = $m->{msgno}; + dbg("duplicate message from $from -> $m->{to} to msg: $msgno") if isdbg('msg'); + Log('msg', "duplicate message from $from -> $m->{to} to msg: $msgno"); + return; + } + } + # write all the messages away my $i; for ( $i = 0; $i < @chunk; $i++) { @@ -1215,27 +1540,25 @@ sub import_one $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')); - } - } + $mref->notify; } } return @out; } -no strict; +#no strict; sub AUTOLOAD { - my $self = shift; + no strict; my $name = $AUTOLOAD; return if $name =~ /::DESTROY$/; - $name =~ s/.*:://o; + $name =~ s/^.*:://o; confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; - @_ ? $self->{$name} = shift : $self->{$name} ; + # this clever line of code creates a subroutine which takes over from autoload + # from OO Perl - Conway + *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + goto &$AUTOLOAD; } 1;