7. rewrote send so that an SB doesn't send a buckshee bull to NOPRIVATE!
authordjk <djk>
Wed, 20 Oct 1999 20:51:05 +0000 (20:51 +0000)
committerdjk <djk>
Wed, 20 Oct 1999 20:51:05 +0000 (20:51 +0000)
8. Changed default colouration on console so that all spots >= 50Mhz are red
9. Fixed init command so that PC21s are sent down non-initted channels
10. Allow forwarding of unknown private mail. This means that you can set up
forwarding of 'foreign' mail across to and by gateways using the same
mechanism as bulletins (/spider/msg/forward.pl).

Changes
cmd/msg.pl
cmd/send.pl
perl/DXMsg.pm

diff --git a/Changes b/Changes
index 0cec4e69eebc34909b69eaccbe595eba0a317b01..3262fb30b9be6bef38f163336a6b786d4f4237c8 100644 (file)
--- a/Changes
+++ b/Changes
@@ -6,11 +6,14 @@
 4. reduced necessary privilege to use 'MSG' command to 6.
 5. Correct the count of spots and wwv for a merge.
 6. Allow decodes of DK0WCY-3 WWV data beacon announces
+7. rewrote send so that an SB doesn't send a buckshee bull to NOPRIVATE!
+8. Changed default colouration on console so that all spots >= 50Mhz are red
 18Oct99=======================================================================
 1. changed help command so that it works correctly with multiple title lines.
 2. added to address to the list of things a message checks to see whether it
 is a duplicate (how on earth did it take _this_ long to find this one?).
-3. Changes S CC so that the callsign it says it has sent to is the real one.
+3. Changes S CC so that the callsign it says it has sent to is the real one
+(request from G8TIC)
 21Sep99=======================================================================
 1. allow zero messages to be stored (request from G4PDQ)
 2. make DX more flexible and change spotter syntax to be consistant with
index 70c99b01f688b5f5b4378695f28e93d2307aa6ec..36b75dc7a9f116a824b2f22e4a8a566d76a155cd 100644 (file)
@@ -18,8 +18,8 @@ my $data;
 
 #$DB::single = 1;
 
-$cmd = shift @f if $f[0] =~ /^\w+$/;
-$msgno = shift @f if $f[0] =~ /^\d+$/;
+$cmd = shift @f if @f && $f[0] =~ /^\w+$/;
+$msgno = shift @f if @f && $f[0] =~ /^\d+$/;
 
 # handle queuing
 if ($cmd =~ /^qu/i && !$msgno) {
index 1ff843859e3d5b17cf800dc0c037dadc6d1fb5b1..3c08ddbbb483bac93a733cfe4f7e81ccb64613c5 100644 (file)
 # $Id$
 #
 my ($self, $line) = @_;
+return (1, $self->msg('e5')) if $self->remotecmd;
+
 my @out;
-my $loc;
+my $loc = $self->{loc} = {};
+my $notincalls = 1;
+my @to;
+
+# set up defaults
+$loc->{private} = '1';
+$loc->{rrreq} = '0';
 
 # $DB::single = 1;
 
@@ -28,114 +36,99 @@ if ($self->state eq "prompt") {
 
        # any thing after send?
        return (1, $self->msg('e6')) if !@f;
-  
-       $f[0] = uc $f[0];
-  
-       # first deal with copies
-       if ($f[0] eq 'C' || $f[0] eq 'CC' || $f[0] eq 'COPY') {
-               my $i = 1;
-               my $rr = '0';
-               if (uc $f[$i] eq 'RR') {
-                       $rr = '1';
-                       $i++;
-               }
-               my $oref = DXMsg::get($f[$i]);
-               #return (0, $self->msg('esend1', $f[$i])) if !$oref;
-               #return (0, $self->msg('esend2')) if $i+1 >  @f;
-               return (0, "msgno $f[$i] not found") if !$oref;
-               return (0, "need a callsign") if $i+1 >  @f;
-      
-               # separate copy to everyone listed
-               for ($i++ ; $i < @f; $i++) {
-                       my $msgno = DXMsg::next_transno('Msgno');
-                       my $newsubj = "CC: " . $oref->subject;
-                       my $newcall = uc $f[$i];
-                       my $nref = DXMsg->alloc($msgno, 
-                                                                       $newcall, 
-                                                                       $self->call,  
-                                                                       $main::systime, 
-                                                                       '1',  
-                                                                       $newsubj, 
-                                                                       $main::mycall,
-                                                                       '0',
-                                                                       $rr);
-                       my @list;
-                       my $from = $oref->from;
-                       my $to = $oref->to;
-                       my $date = cldate($oref->t);
-                       my $time = ztime($oref->t);
-                       my $buf = "Original from: $from To: $to Date: $date $time";
-                       push @list, $buf; 
-                       push @list, $oref->read_msg_body();
-                       $nref->store(\@list);
-                       $nref->add_dir();
-                       push @out, $self->msg('m2', $oref->msgno, $newcall);
+
+       while (@f) {
+               my $f = uc shift @f; 
+
+               # first deal with copies
+               if ($f eq 'C' || $f eq 'CC' || $f eq 'COPY') {
+                       my $rr = '0';
+                       if (@f && uc $f[0] eq 'RR') {
+                               shift @f;
+                               $rr = '1';
+                       }
+                       
+                       if (@f) {
+                               my $m = shift @f;
+                               my $oref = DXMsg::get($m);
+                               return (0, $self->msg('m4', $m)) unless $oref;
+                               return (0, $self->msg('m16')) unless @f;
+                       
+                               # separate copy to everyone listed
+                               while (@f) {
+                                       my $newcall = uc shift @f;
+                                       my $msgno = DXMsg::next_transno('Msgno');
+                                       my $newsubj = "CC: " . $oref->subject;
+                                       my $nref = DXMsg->alloc($msgno, 
+                                                                                       $newcall, 
+                                                                                       $self->call,  
+                                                                                       $main::systime, 
+                                                                                       '1',  
+                                                                                       $newsubj, 
+                                                                                       $main::mycall,
+                                                                                       '0',
+                                                                                       $rr);
+                                       my @list;
+                                       my $from = $oref->from;
+                                       my $to = $oref->to;
+                                       my $date = cldate($oref->t);
+                                       my $time = ztime($oref->t);
+                                       my $buf = "Original from: $from To: $to Date: $date $time";
+                                       push @list, $buf; 
+                                       push @list, $oref->read_msg_body();
+                                       $nref->store(\@list);
+                                       $nref->add_dir();
+                                       push @out, $self->msg('m2', $oref->msgno, $newcall);
+                               } 
+                       }
+                       DXMsg::queue_msg();
+                       return (1, @out);
                }
-               DXMsg::queue_msg();
-               return (1, @out);
-       }
 
-       # now deal with real message inputs 
-       # parse out send line for various possibilities
-       $loc = $self->{loc} = {};
-  
-       my $i = 0;
-       $f[0] = uc $f[0];
-       $loc->{private} = '1';
-       if ($f[0] eq 'B' || $f[0] =~ /^NOP/oi) {
-               $loc->{private} = '0';
-               $i += 1;
-       } elsif ($f[0] eq 'P' || $f[0] =~ /^PRI/oi) {
-               $i += 1;
-       }
-  
-       $loc->{rrreq} = '0';
-       if (uc $f[$i] eq 'RR') {
-               $loc->{rrreq} = '1';
-               $i++;
-       }
-  
-       # check we have some callsigns
-       if ($i  >=  @f) {
-               delete $self->{loc};
-               return (1, $self->msg('e6'));
-       }
+               # private / noprivate / rr
+               if ($notincalls && ($f eq 'B' || $f =~ /^NOP/oi)) {
+                       $loc->{private} = '0';
+               } elsif ($notincalls && ($f eq 'P' || $f =~ /^PRI/oi)) {
+                       ;
+               } elsif ($notincalls && ($f eq 'RR')) {
+                       $loc->{rrreq} = '1';
+               } else {
 
-       # now save all the 'to' callsigns for later
-       # first check the 'to' addresses for 'badness'
-    my $t;
-       my @to;
-       splice @f, 0, $i-1 if $i > 0;
-       foreach  $t (@f) {
-               $t = uc $t;
+                       # callsign ?
+                       $notincalls = 0;
 
-        # is this callsign a distro?
-               my $fn = "/spider/msg/distro/$t.pl";
-               if (-e $fn) {
-                       my $fh = new IO::File $fn;
-                       if ($fh) {
-                               local $/ = undef;
-                               my $s = <$fh>;
-                               $fh->close;
-                               my @call;
-                @call = eval $s;
-                               return (1, "Error in Distro $t.pl:", $@) if $@;
-                               if (@call > 0) {
-                                       push @f, @call;
-                                       next;
+                       # is this callsign a distro?
+                       my $fn = "/spider/msg/distro/$f.pl";
+                       if (-e $fn) {
+                               my $fh = new IO::File $fn;
+                               if ($fh) {
+                                       local $/ = undef;
+                                       my $s = <$fh>;
+                                       $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 $t, @DXMsg::badmsg) {
-                       push @out, $self->msg('m3', $t);
-               } else {
-                       push @to, $t;
+
+                       if (grep $_ eq $f, @DXMsg::badmsg) {
+                               push @out, $self->msg('m3', $f);
+                       } else {
+                               push @to, $f;
+                       }
                }
        }
+
+       # check we have some callsigns
        if (@to) {
                $loc->{to} = \@to;
        } else {
-               return (1, @out);
+               delete $self->{loc};
+               return (1, $self->msg('e6'));
        }
 
        # find me and set the state and the function on my state variable to
index d5f56c330a59945e944ad9b0a608bea0d0d65c7e..b2665df8f0a6cf5786782e1f85035e93b3d91723 100644 (file)
@@ -575,7 +575,6 @@ sub queue_msg
        my $call = shift;
        my $ref;
        my $clref;
-       my $dxchan;
        my @nodelist = DXProt::get_all_ak1a();
        
        # bat down the message list looking for one that needs to go off site and whose
@@ -591,39 +590,38 @@ sub queue_msg
                        next if $ref->{waitt} > $main::systime;
                        delete $ref->{waitt};
                } 
-               
+
+               # deal with routed private messages
+               my $noderef;
                if ($ref->{private}) {
-                       if ($ref->{'read'} == 0) {
-                               $clref = DXCluster->get_exact($ref->{to});
-                               unless ($clref) {             # otherwise look for a homenode
-                                       my $uref = DXUser->get($ref->{to});
-                                       my $hnode =  $uref->homenode if $uref;
-                                       $clref = DXCluster->get_exact($hnode) if $hnode;
-                               }
-                               if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
-                                       $dxchan = $clref->{dxchan};
-                                       $ref->start_msg($dxchan) if $dxchan && $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
-                               }
+                       $clref = DXCluster->get_exact($ref->{to});
+                       unless ($clref) {             # otherwise look for a homenode
+                               my $uref = DXUser->get($ref->{to});
+                               my $hnode =  $uref->homenode if $uref;
+                               $clref = DXCluster->get_exact($hnode) if $hnode;
                        }
-               } elsif (!$sort) {
-                       # otherwise we are dealing with a bulletin, compare the gotit list with
-                       # the nodelist up above, if there are sites that haven't got it yet
-                       # then start sending it - what happens when we get loops is anyone's
-                       # guess, use (to, from, time, subject) tuple?
-                       my $noderef;
-                       foreach $noderef (@nodelist) {
-                               next if $noderef->call eq $main::mycall;
-                               next if grep { $_ eq $noderef->call } @{$ref->{gotit}};
-                               next unless $ref->forward_it($noderef->call);           # check the forwarding file
-                               # next if $noderef->isolate;               # maybe add code for stuff originated here?
-                               # next if DXUser->get( ${$ref->{gotit}}[0] )->isolate;  # is the origin isolated?
-                               
-                               # if we are here we have a node that doesn't have this message
+                       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';
-                               last;
                        }
                }
                
+               # otherwise we are dealing with a bulletin or forwarded private message
+               # compare the gotit list with
+               # the nodelist up above, if there are sites that haven't got it yet
+               # then start sending it - what happens when we get loops is anyone's
+               # guess, use (to, from, time, subject) tuple?
+               foreach $noderef (@nodelist) {
+                       next if $noderef->call eq $main::mycall;
+                       next if grep { $_ eq $noderef->call } @{$ref->{gotit}};
+                       next unless $ref->forward_it($noderef->call);           # check the forwarding file
+
+                       # if we are here we have a node that doesn't have this message
+                       $ref->start_msg($noderef) if !get_busy($noderef->call)  && $noderef->state eq 'normal';
+                       last;
+               }
+
                # if all the available nodes are busy then stop
                last if @nodelist == scalar grep { get_busy($_->call) } @nodelist;
        }
@@ -921,11 +919,13 @@ sub forward_it
                my $tested;
                
                # are we interested?
-               last if $ref->{private} && $sort ne 'P';
-               last if !$ref->{private} && $sort ne 'B';
+               next if $ref->{private} && $sort ne 'P';
+               next if !$ref->{private} && $sort ne 'B';
                
                # select field
                $tested = $ref->{to} if $field eq 'T';
+               my $at = $ref->{to} =~ /\@\s*(\S+)/;
+               $tested = $at if $field eq '\@';
                $tested = $ref->{from} if $field eq 'F';
                $tested = $ref->{origin} if $field eq 'O';
                $tested = $ref->{subject} if $field eq 'S';