X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=e6662b59472fce0d46e8496235f3c52f271133e4;hb=ab811a0c902225075a9bd69749f65594079433a9;hp=04ef99cb8ecffccfb21d7215b590a886497d2a8d;hpb=e26fa9333c620e741da9398478c4ad0a656f1ae7;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 04ef99cb..e6662b59 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -4,7 +4,7 @@ # # Copyright (c) 1998 Dirk Koopman G1TLH # -# $Id$ +# # # # Notes for implementors:- @@ -32,12 +32,6 @@ eval { use strict; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean $residencetime @badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime $email_server $email_prog $email_from @@ -130,7 +124,7 @@ sub alloc $self->{gotit} = []; # $self->{lastt} = $main::systime; $self->{lines} = []; - $self->{private} = 1 if $bulltopriv && DXUser->get_current($self->{to}); + $self->{private} = 1 if $bulltopriv && DXUser::get_current($self->{to}); return $self; } @@ -151,7 +145,10 @@ sub process } # clean the message queue - clean_old() if $main::systime - $last_clean > 3600 ; + 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 @@ -161,7 +158,6 @@ sub process $_->del_msg; } - $last_clean = $main::systime; } # incoming message @@ -204,7 +200,7 @@ sub handle_28 $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}); + 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'); @@ -312,6 +308,14 @@ sub handle_32 $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) { @@ -336,17 +340,21 @@ sub handle_32 } # 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}}) { - push @words, BadWords::check($_); + @bad = BadWords::check($_); + push @words, [$_, @bad] if @bad; } - push @words, BadWords::check($ref->{subject}); if (@words) { - dbg("$ref->{from} swore: '@words' -> $ref->{to} '$ref->{subject}' origin: $ref->{origin} via " . $dxchan->call) if isdbg('msg'); - Log('msg',"$ref->{from} swore: '@words' -> $ref->{to} origin: $ref->{origin} via " . $dxchan->call); - Log('msg',"subject: $ref->{subject}"); - for (@{$ref->{lines}}) { - Log('msg', "line: $_"); + 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; @@ -468,8 +476,8 @@ sub notify { my $ref = shift; my $to = $ref->{to}; - my $uref = DXUser->get_current($to); - my $dxchan = DXChannel->get($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) { @@ -1099,7 +1107,7 @@ sub do_send_stuff $ref->notify; } } else { - Log('msg', $self->call . " swore to @{$loc->{to}} subject: '$loc->{subject}' in msg, REJECTED"); + LogDbg('msg', $self->call . " swore to @{$loc->{to}} subject: '$loc->{subject}' in msg, REJECTED"); } delete $loc->{lines};