X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXMsg.pm;h=65577607be6d30635f2053e417df6b98b3de7fa0;hb=c3c5abeef9492faf2759af04df966311fab43302;hp=7cef3adb4f8f5bb7a8415e8a3cf196d8c20e53a4;hpb=866bd5c7cd0fd6c8167d6e6a0c9acfe5feb0ba65;p=spider.git diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 7cef3adb..65577607 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -28,12 +28,11 @@ use DXDebug; use DXLog; use IO::File; use Fcntl; -use Carp; use strict; use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean @badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime - $queueinterval $lastq $importfn); + $queueinterval $lastq $importfn $minchunk $maxchunk); %work = (); # outstanding jobs @msg = (); # messages we have @@ -49,6 +48,8 @@ $waittime = 30*60; # time an aborted outgoing message waits before $queueinterval = 1*60; # run the queue every 1 minute $lastq = 0; +$minchunk = 4800; # minimum chunk size for a split message +$maxchunk = 6000; # maximum chunk size $badmsgfn = "$msgdir/badmsg.pl"; # list of TO address we wont store $forwardfn = "$msgdir/forward.pl"; # the forwarding table @@ -192,6 +193,7 @@ sub process $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 @@ -280,8 +282,8 @@ sub process 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"); + dbg('msg', "duplicate message from $ref->{from} -> $ref->{to} to $msgno"); + Log('msg', "duplicate message from $ref->{from} -> $ref->{to} to $msgno"); return; } } @@ -502,9 +504,10 @@ sub read_msg_header my @f; my $size; - $file = new IO::File; - if (!open($file, $fn)) { - print "Error reading $fn $!\n"; + $file = new IO::File "$fn"; + if (!$file) { + dbg('err', "Error reading $fn $!"); + Log('err', "Error reading $fn $!"); return undef; } $size = -s $fn; @@ -512,7 +515,8 @@ sub read_msg_header chomp $line; $size -= length $line; if (! $line =~ /^===/o) { - print "corrupt first line in $fn ($line)\n"; + dbg('err', "corrupt first line in $fn ($line)"); + Log('err', "corrupt first line in $fn ($line)"); return undef; } $line =~ s/^=== //o; @@ -523,7 +527,8 @@ sub read_msg_header chomp $line; $size -= length $line; if (! $line =~ /^===/o) { - print "corrupt second line in $fn ($line)\n"; + dbg('err', "corrupt second line in $fn ($line)"); + Log('err', "corrupt second line in $fn ($line)"); return undef; } $line =~ s/^=== //o; @@ -549,10 +554,11 @@ sub read_msg_body $file = new IO::File; if (!open($file, $fn)) { - print "Error reading $fn $!\n"; + dbg('err' ,"Error reading $fn $!"); + Log('err' ,"Error reading $fn $!"); return undef; } - chomp (@out = <$file>); + @out = map {chomp; $_} <$file>; close($file); shift @out if $out[0] =~ /^=== /; @@ -614,7 +620,7 @@ sub queue_msg my $hnode = $uref->homenode if $uref; $clref = DXCluster->get_exact($hnode) if $hnode; } - if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) { + 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'; @@ -738,9 +744,9 @@ sub init my $ref; # load various control files - print "load badmsg: ", (load_badmsg() or "Ok"), "\n"; - print "load forward: ", (load_forward() or "Ok"), "\n"; - print "load swop: ", (load_swop() or "Ok"), "\n"; + dbg('err', "load badmsg: " . (load_badmsg() or "Ok")); + dbg('err', "load forward: " . (load_forward() or "Ok")); + dbg('err', "load swop: " . (load_swop() or "Ok")); # read in the directory opendir($dir, $msgdir) or confess "can't open $msgdir $!"; @@ -846,13 +852,14 @@ sub do_send_stuff my $mycall = $main::mycall; $ref = DXMsg->alloc(DXMsg::next_transno('Msgno'), uc $to, - $self->call, + exists $loc->{from} ? $loc->{from} : $self->call, $systime, $loc->{private}, $loc->{subject}, - $mycall, + 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); @@ -1048,8 +1055,8 @@ 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 $!"); + dbg('msg', "can\'t open $importfn $!"); + Log('msg', "can\'t open $importfn $!"); return; } @@ -1058,18 +1065,19 @@ sub import_msgs my $name; foreach $name (@names) { next if $name =~ /^\./; + my $splitit = $name =~ /^split/; 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 $!"); + 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); + my @out = import_one($DXProt::me, \@msg, $splitit); Log('msg', @out); } } @@ -1080,6 +1088,7 @@ sub import_one { my $dxchan = shift; my $ref = shift; + my $splitit = shift; my $private = '1'; my $rr = '0'; my $notincalls = 1; @@ -1091,7 +1100,7 @@ sub import_one # first line; my $line = shift @$ref; my @f = split /\s+/, $line; - unless ($f[0] =~ /^(:?S|SP|SB|SEND)$/ ) { + unless (@f && $f[0] =~ /^(:?S|SP|SB|SEND)$/ ) { my $m = "invalid first line in import '$line'"; dbg('MSG', $m ); return (1, $m); @@ -1109,12 +1118,14 @@ sub import_one $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 =~ /^msg('m3', $f); } else { - push @to, $f; + 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+$/)); - + pop @$ref while (@$ref && $$ref[-1] =~ /^\s*$/); + # strip off /EX or /ABORT - return ("aborted") if (@$ref && $$ref[-1] =~ m{^/ABORT$}i); + return ("aborted") if @$ref && $$ref[-1] =~ m{^/ABORT$}i; pop @$ref if (@$ref && $$ref[-1] =~ m{^/EX$}i); + # sort out any splitting that needs to be done + my @chunk; + if ($splitit) { + my $lth = 0; + my $lines = []; + for (@$ref) { + if ($lth >= $maxchunk || ($lth > $minchunk && /^\s*$/)) { + push @chunk, $lines; + $lines = []; + $lth = 0; + } + push @$lines, $_; + $lth += length; + } + push @chunk, $lines if @$lines; + } else { + push @chunk, $ref; + } + # 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->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')); + my $i; + for ( $i = 0; $i < @chunk; $i++) { + my $chunk = $chunk[$i]; + my $ch_subject; + if (@chunk > 1) { + my $num = " [" . ($i+1) . "/" . scalar @chunk . "]"; + $ch_subject = substr($subject, 0, 27 - length $num) . $num; + } else { + $ch_subject = $subject; + } + 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, + $ch_subject, + $origin, + '0', + $rr); + $mref->swop_it($main::mycall); + $mref->store($chunk); + $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; }