From de987b900c04d852acec5e1af9a4326b16533253 Mon Sep 17 00:00:00 2001 From: djk Date: Fri, 31 Mar 2000 20:04:37 +0000 Subject: [PATCH] allow kill msg with range 1-n to kill from 1-n and not 1->n-1 added autosplit for msgs dumped into the import directory starting with 'split' as the filename. --- Changes | 6 +++ cmd/kill.pl | 2 +- perl/DXMsg.pm | 109 +++++++++++++++++++++++++++++++----------------- perl/DXProt.pm | 10 +++-- perl/cluster.pl | 2 +- 5 files changed, 86 insertions(+), 43 deletions(-) diff --git a/Changes b/Changes index 581d0660..8c844115 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,9 @@ +31Mar00======================================================================= +1. fixed nnn-mmm in kill (erase/delete) msgs so that mmm is also deleted and +not just nnn -> mmm-1. +2. Added an autosplit to message importing so that messages are split +automagically into bits if the filename used in the import directory starts +with "split". This will add a [1/5] type string on the the end of the subject. 30Mar00======================================================================= 1. altered client.pl connect code so that it doesn't falsely recognise /spider/src/client as a 'client' instruction. diff --git a/cmd/kill.pl b/cmd/kill.pl index c2062ba4..dd476059 100644 --- a/cmd/kill.pl +++ b/cmd/kill.pl @@ -40,7 +40,7 @@ while (@f) { my $from = $1; my $to = $2; @refs = grep { !($self->priv < 5 && $_->to ne $call && $_->from ne $call) } DXMsg::get_all() unless @refs; - @refs = grep { $_->msgno >= $from && $_->msgno < $to } @refs; + @refs = grep { $_->msgno >= $from && $_->msgno <= $to } @refs; } elsif ($f =~ /^fr/io) { $f = shift @f; if ($f) { diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 168a9782..9e4893b2 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -33,7 +33,7 @@ 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 +49,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 @@ -552,7 +554,7 @@ sub read_msg_body print "Error reading $fn $!\n"; return undef; } - chomp (@out = <$file>); + @out = map {chomp; $_} <$file>; close($file); shift @out if $out[0] =~ /^=== /; @@ -614,7 +616,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'; @@ -1049,8 +1051,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; } @@ -1059,18 +1061,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); } } @@ -1081,6 +1084,7 @@ sub import_one { my $dxchan = shift; my $ref = shift; + my $splitit = shift; my $private = '1'; my $rr = '0'; my $notincalls = 1; @@ -1092,7 +1096,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); @@ -1140,52 +1144,81 @@ sub import_one } } } - + if (grep $_ eq $f, @DXMsg::badmsg) { push @out, $dxchan->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->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')); + 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; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 6a82cb16..3d3894d1 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -31,7 +31,7 @@ use Carp; use strict; use vars qw($me $pc11_max_age $pc23_max_age $pc11_dup_age $pc23_dup_age - %spotdup %wwvdup $last_hour %pings %rcmds + %spotdup %wwvdup $last_hour %pings %rcmds $pc11duptext %nodehops @baddx $baddxfn $pc12_dup_age %anndup $allowzero $pc12_dup_lth $decode_dk0wcy); @@ -43,6 +43,8 @@ $pc11_dup_age = 3*3600; # the maximum time to keep the spot dup list for $pc23_dup_age = 3*3600; # the maximum time to keep the wwv dup list for $pc12_dup_age = 24*3600; # the maximum time to keep the ann dup list for $pc12_dup_lth = 60; # the length of ANN text to save for deduping +$pc11duptext = 27; # maximum lth of the text field in PC11 to use for duduping + %spotdup = (); # the pc11 and 26 dup hash %wwvdup = (); # the pc23 and 27 dup hash %anndup = (); # the PC12 dup hash @@ -79,7 +81,8 @@ sub init # now prime the wwv duplicates file with just this month's data my @wwv = Geomag::readfile(time); for (@wwv) { - my $dupkey = "$_->[1].$_->[2]$_->[3]$_->[4]"; + my $duptext = substr $_->[3], 0, $pc11duptext; + my $dupkey = "$_->[1].$_->[2]$duptext$_->[4]"; $wwvdup{$dupkey} = $_->[1]; } @@ -238,7 +241,8 @@ sub normal # do some de-duping my $freq = $field[1] - 0; - my $dupkey = "$freq$field[2]$d$text$spotter"; + my $duptext = substr $text, 0, $pc11duptext; + my $dupkey = "$freq$field[2]$d$duptext$spotter"; if ($spotdup{$dupkey}) { dbg('chan', "Duplicate Spot ignored\n"); return; diff --git a/perl/cluster.pl b/perl/cluster.pl index 373e595c..3ea1d6a5 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -70,7 +70,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.39"; # the version no of the software +$version = "1.40"; # the version no of the software $starttime = 0; # the starting time of the cluster $lockfn = "cluster.lock"; # lock file name @outstanding_connects = (); # list of outstanding connects -- 2.43.0