X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=5773c7e966b463b6f43397f525a2d3ad828f1e42;hb=7b616aeabce92e3cb416a5fe6640a288adfe5410;hp=bb80e6c1908183ffbb16bf027a34e76c30478243;hpb=ea3457ff6eb2cd525cdfb022301b4ede224e3010;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index bb80e6c1..5773c7e9 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -34,7 +34,7 @@ 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; +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; $main::branch += $BRANCH; @@ -125,7 +125,8 @@ sub alloc $self->{'read'} = shift; $self->{rrreq} = shift; $self->{delete} = shift; - $self->{deletetime} = shift; + $self->{deletetime} = shift || ($self->{t} + $maxage); + $self->{keep} = shift; $self->{gotit} = []; # $self->{lastt} = $main::systime; $self->{lines} = []; @@ -155,6 +156,15 @@ sub process # clean the message queue clean_old() if $main::systime - $last_clean > 3600 ; + + # 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; + } + $last_clean = $main::systime; return; } @@ -435,7 +445,7 @@ sub notify { my $ref = shift; my $to = $ref->{to}; - my $uref = DXUser->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; @@ -512,13 +522,14 @@ sub store my $rr = $ref->{rrreq} ? '1' : '0'; my $priv = $ref->{private} ? '1': '0'; my $del = $ref->{delete} ? '1' : '0'; - my $delt = $ref->{deletetime} || '0'; - print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr^$del^$delt\n"; + 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\xf0-\xff]/./g; + $line =~ s/[\x00-\x08\x0a-\x1f\x80-\x9f]/./g; $ref->{size} += (length $line) + 1; print $fh "$line\n"; } @@ -530,13 +541,6 @@ sub store } } - # 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} && $_->{deletetime} < $main::systime} @msg; - for (@del) { - $_->del_msg; - } } # delete a message @@ -567,6 +571,9 @@ sub mark_delete { my $ref = shift; my $t = shift; + + return if $ref->{keep}; + $t = $main::systime + $residencetime unless defined $t; $ref->{delete}++; @@ -578,8 +585,8 @@ sub unmark_delete { my $ref = shift; my $t = shift; - delete $ref->{delete}; - delete $ref->{deletetime}; + $ref->{delete} = 0; + $ref->{deletetime} = 0; } # clean out old messages from the message queue @@ -589,7 +596,7 @@ sub clean_old # mark old messages for deletion foreach $ref (@msg) { - if (ref($ref) && !$ref->{keep} && $ref->{t} < $main::systime - $maxage) { + if (ref($ref) && !$ref->{keep} && $ref->{deletetime} < $main::systime) { # this is for IMMEDIATE destruction $ref->{delete}++; @@ -724,7 +731,7 @@ sub queue_msg $ref->stop_msg($node); # delay any outgoing messages that fail - $ref->{waitt} = $main::systime + $waittime + rand(120) if $node ne $main::mycall; + $ref->{waitt} = $main::systime + $waittime + int rand(120) if $node ne $main::mycall; delete $ref->{lastt}; next; } @@ -1086,6 +1093,24 @@ 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; @@ -1122,7 +1147,9 @@ sub dir { my $ref = shift; my $flag = $ref->{private} && $ref->{read} ? '-' : ' '; - if ($ref->{delete}) { + 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", @@ -1488,19 +1515,19 @@ sub import_one 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}; # 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}} ; - @_ ? $self->{$name} = shift : $self->{$name} ; + *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + goto &$AUTOLOAD; } 1;