From ed8842a3d38de2c171329e51612d2dc520ffcc99 Mon Sep 17 00:00:00 2001 From: djk Date: Sat, 8 Jan 2000 14:32:48 +0000 Subject: [PATCH] took out limit on msglength (ie 0 length messages are allowed) added a prototype message importing system --- Changes | 6 ++ perl/DXMsg.pm | 198 +++++++++++++++++++++++++++++++++++++++++++------- perl/Msg.pm | 1 + 3 files changed, 178 insertions(+), 27 deletions(-) diff --git a/Changes b/Changes index 60122d84..442a4d87 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,9 @@ +08Jan00======================================================================= +1. really removed the restriction on 0 length messages. +2. added a periodic msg file import system a la FBB. Stick one or more files +into /spider/msg/import with a suitable SEND line, subject and the text and +it will import it. The importer will accept some BBS syntax (eg < GB7TLH) to +allow you to customise the 'from' callsign. 03Jan00======================================================================= 1. changed the copyright statement in sh/version! 2. added sh/date with special "be compatible with ak1a" syntax for the output diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 10857152..88371ed7 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); + $queueinterval $lastq $importfn); %work = (); # outstanding jobs @msg = (); # messages we have @@ -50,9 +50,11 @@ $queueinterval = 1*60; # run the queue every 1 minute $lastq = 0; -$badmsgfn = "$msgdir/badmsg.pl"; # list of TO address we wont store +$badmsgfn = "$msgdir/badmsg.pl"; # list of TO address we wont store $forwardfn = "$msgdir/forward.pl"; # the forwarding table -$swopfn = "$msgdir/swop.pl"; # the swopping table +$swopfn = "$msgdir/swop.pl"; # the swopping table +$importfn = "$msgdir/import"; # import directory + %valid = ( fromnode => '5,From Node', @@ -150,6 +152,10 @@ sub process # 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; } @@ -263,7 +269,7 @@ sub process # remove extraneous rubbish from the hash # remove it from the work in progress vector # stuff it on the msg queue - if ($ref->{lines} && @{$ref->{lines}} > 0) { # ignore messages with 0 lines + if ($ref->{lines}) { if ($ref->{file}) { $ref->store($ref->{lines}); } else { @@ -834,32 +840,31 @@ sub do_send_stuff if ($line eq "\032" || $line eq '%1A' || uc $line eq "/EX") { my $to; - if (@{$loc->{lines}} > 0) { - foreach $to (@{$loc->{to}}) { - my $ref; - my $systime = $main::systime; - my $mycall = $main::mycall; - $ref = DXMsg->alloc(DXMsg::next_transno('Msgno'), - uc $to, - $self->call, - $systime, - $loc->{private}, - $loc->{subject}, - $mycall, - '0', - $loc->{rrreq}); - $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')); - } + foreach $to (@{$loc->{to}}) { + my $ref; + my $systime = $main::systime; + my $mycall = $main::mycall; + $ref = DXMsg->alloc(DXMsg::next_transno('Msgno'), + uc $to, + $self->call, + $systime, + $loc->{private}, + $loc->{subject}, + $mycall, + '0', + $loc->{rrreq}); + $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')); } } } + delete $loc->{lines}; delete $loc->{to}; delete $self->{loc}; @@ -1035,6 +1040,145 @@ sub swop_it return $count; } +# import any msgs in the import directory +# the messages are in BBS format (but may have cluster extentions +# so SB UK < GB7TLH is legal +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 $!"); + return; + } + + my @names = readdir(DIR); + closedir(DIR); + my $name; + foreach $name (@names) { + next if $name =~ /^./; + 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 $!"); + unlink($fn); + next; + } + my @msg = map { chomp } ; + close(MSG); + unlink($fn); + my @out = import_one($DXProt::me, \@msg); + Log('msg', @out); + } +} + +# import one message as a list in bbs (as extended) mode +# takes a reference to an array containing the whole message +sub import_one +{ + my $dxchan = shift; + my $ref = shift; + my $private = '1'; + my $rr = '0'; + my $notincalls = 1; + my $from = $dxchan->call; + my $origin = $main::mycall; + my @to; + my @out; + + # first line; + my @f = split /\s+/, shift @$ref; + while (@f) { + my $f = uc shift @f; + next if $f eq 'SEND'; + + # private / noprivate / rr + if ($notincalls && ($f eq 'B' || $f eq 'SB' || $f =~ /^NOP/oi)) { + $private = '0'; + } elsif ($notincalls && ($f eq 'P' || $f eq 'SP' || $f =~ /^PRI/oi)) { + ; + } elsif ($notincalls && ($f eq 'RR')) { + $rr = '1'; + } elsif ($f eq '@' && @f) { # this is bbs syntax, for origin + $origin = uc shift @f; + } elsif ($f =~ /^\$/) { # this is bbs syntax for a bid + next; + } elsif ($f =~ /^; + $fh->close; + my @call; + @call = eval $s; + return (1, "Error in Distro $f.pl:", $@) if $@; + if (@call > 0) { + push @f, @call; + next; + } + } + } + + if (grep $_ eq $f, @DXMsg::badmsg) { + push @out, $dxchan->msg('m3', $f); + } else { + 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+$/)); + + # strip off /EX or /ABORT + return () if (@$ref && $$ref[-1] =~ m{^/ABORT$}i); + pop @$ref if (@$ref && $$ref[-1] =~ m{^/EX$}i); + + # 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', $ref->{msgno}, $to); + #push @out, "msgno $ref->{msgno} sent to $to"; + my $todxchan = DXChannel->get(uc $to); + if ($todxchan) { + if ($todxchan->is_user()) { + $todxchan->send($dxchan->msg('m9')); + } + } + } + + return @out; +} + no strict; sub AUTOLOAD { diff --git a/perl/Msg.pm b/perl/Msg.pm index e1ece5b9..9df7640e 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -166,6 +166,7 @@ sub set_blocking { fcntl ($_[0], F_SETFL(), $flags); } } + sub handle_send_err { # For more meaningful handling of send errors, subclass Msg and # rebless $conn. -- 2.34.1