From: djk Date: Sun, 29 Aug 1999 20:18:29 +0000 (+0000) Subject: 1. Added msg command to allow the changing of To, From, Subject and so on the X-Git-Tag: R_1_31~1 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=8aa1d223307c50d8bbaa0ed4ef915f8c7365bc6e;p=spider.git 1. Added msg command to allow the changing of To, From, Subject and so on the messages. This seems particularly important just now as a whole raft of G3's seem to be putting out non private bulls to callsigns. 2. While I am at set messages to TO fields that appear to be users to private if they have been sent as bulls. 3. Add DISTROs, if a callsign field appears in /spider/msg/distro in upper use that as a list of callsigns to send further. Note this is potentially recursive as callsigns in a distro can be distros. --- diff --git a/Changes b/Changes index 04752f0e..c574a340 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,12 @@ +29Aug99======================================================================= +1. Added msg command to allow the changing of To, From, Subject and so on the +messages. This seems particularly important just now as a whole raft of G3's +seem to be putting out non private bulls to callsigns. +2. While I am at set messages to TO fields that appear to be users to private +if they have been sent as bulls. +3. Add DISTROs, if a callsign field appears in /spider/msg/distro in upper +use that as a list of callsigns to send further. Note this is potentially +recursive as callsigns in a distro can be distros. 25Aug99======================================================================= 1. check the date of a WWV much more carefully. 24Aug99======================================================================= diff --git a/cmd/debug.pl b/cmd/debug.pl index 9b71d53c..5e69d098 100644 --- a/cmd/debug.pl +++ b/cmd/debug.pl @@ -9,7 +9,7 @@ # my $self = shift; -return (0) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; $DB::single = 1; diff --git a/cmd/msg.pl b/cmd/msg.pl new file mode 100644 index 00000000..0f68779b --- /dev/null +++ b/cmd/msg.pl @@ -0,0 +1,98 @@ +# +# a universal message mangling routine which allows the sysop +# tinker with the properties of a message +# +# Copyright (c) 1999 Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +return (1, $self->msg('e5')) if $self->priv < 9; + +# a line is cmd, msgno, data +my @f = split /\s+/, $line, 3; +my $cmd; +my $msgno; +my $data; + +#$DB::single = 1; + +$cmd = shift @f if $f[0] =~ /^\w+$/; +$msgno = shift @f if $f[0] =~ /^\d+$/; + +# handle queuing +if ($cmd =~ /^qu/i && !$msgno) { + DXMsg::queue_msg(0); + return (1, $self->msg('msg1')); +} +if ($cmd =~ /^qu/i) { + DXMsg::queue_msg(1); + return (1, $self->msg('msg2')); +} + +return (1, $self->msg('msgu')) unless $cmd && $msgno; +$data = shift @f; + +# get me message +my $ref = DXMsg::get($msgno); +return (1, $self->msg('m13', $msgno)) unless $ref; + +my $old; +my $new; +my $m; +if ($cmd =~ /^to/i) { + $m = 'To'; + $old = $ref->to; + $new = $ref->to(uc $data); +} elsif ($cmd =~ /^fr/i) { + $m = 'From'; + $old = $ref->from; + $new = $ref->from(uc $data); +} elsif ($cmd =~ /^pr/i) { + $m = 'Msg Type'; + $old = $ref->private ? 'P' : 'B'; + $new = 'P'; + $ref->private(1); +} elsif ($cmd =~ /^nop/i || $cmd =~ /^bu/i) { + $m = 'Msg Type'; + $old = $ref->private ? 'P' : 'B'; + $new = 'B'; + $ref->private(0); +} elsif ($cmd =~ /^rr/i) { + $m = 'RR Req'; + $old = $ref->rrreq ? 'RR Req' : 'No RR Req'; + $new = 'RR Req'; + $ref->rrreq(1); +} elsif ($cmd =~ /^norr/i) { + $m = 'RR Req'; + $old = $ref->rrreq ? 'RR Req' : 'No RR Req'; + $new = 'No RR Req'; + $ref->rrreq(0); +} elsif ($cmd =~ /^ke/i) { + $m = 'Keep'; + $old = $ref->keep ? 'Keep' : 'No Keep'; + $new = 'Keep'; + $ref->keep(1); +} elsif ($cmd =~ /^noke/i) { + $m = 'Keep'; + $old = $ref->keep ? 'Keep' : 'No Keep'; + $new = 'No Keep'; + $ref->keep(0); +} elsif ($cmd =~ /^su/i) { + $m = 'Subject'; + $old = $ref->subject; + $new = $ref->subject($data); +} elsif ($cmd =~ /^wa/i) { + $m = 'Wait Time'; + $old = cldatetime($ref->waitt) || 'None'; + $new = 'None'; + $ref->waitt(0); +} + +# store changes and return +$ref->store( [ $ref->read_msg_body() ] ); +return(1, $self->msg('msg3', $msgno, $m, $old, $new)); + + + diff --git a/cmd/send.pl b/cmd/send.pl index ade1dce0..14913eab 100644 --- a/cmd/send.pl +++ b/cmd/send.pl @@ -20,7 +20,7 @@ my ($self, $line) = @_; my @out; my $loc; -#$DB::single = 1; +# $DB::single = 1; if ($self->state eq "prompt") { @@ -100,13 +100,32 @@ if ($self->state eq "prompt") { delete $self->{loc}; return (1, $self->msg('e6')); } - + # now save all the 'to' callsigns for later # first check the 'to' addresses for 'badness' my $t; my @to; - foreach $t (@f[ $i..$#f ]) { + splice @f, 0, $i-1 if $i > 0; + foreach $t (@f) { $t = uc $t; + + # 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; + } + } + } if (grep $_ eq $t, @DXMsg::badmsg) { # push @out, "Sorry, $t is an unacceptable TO address"; push @out, $self->msg('m3', $t); diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 5ab8d4af..3262a44d 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -186,6 +186,13 @@ sub process $busy{$f[2]} = $ref; # set interlock $self->send(DXProt::pc30($f[2], $f[1], $stream)); # send ack $ref->{lastt} = $main::systime; + + # look to see whether this is a non private message sent to a known callsign + my $uref = DXUser->get_current($ref->{to}); + if (iscallsign($ref->{to}) && !$ref->{private} && $uref && $uref->homenode) { + $ref->{private} = 1; + dbg('msg', "set bull to $ref->{to} to private"); + } last SWITCH; } @@ -581,7 +588,7 @@ sub queue_msg # ignore 'delayed' messages until their waiting time has expired if (exists $ref->{waitt}) { - next if $ref->{waitt} < $main::systime; + next if $ref->{waitt} > $main::systime; delete $ref->{waitt}; } diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 1291db39..7a81ac23 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -15,7 +15,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs shellregex - print_all_fields cltounix + print_all_fields cltounix iscallsign ); @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); @@ -182,5 +182,14 @@ sub shellregex { my $in = shift; $in =~ s{(.)} { $patmap{$1} || "\Q$1" }ge; - return '^' . $in . '$'; + return '^' . $in . "\$"; +} + +# start an attempt at determining whether this string might be a callsign +sub iscallsign +{ + my $call = shift; + return 1 if $call =~ /^\w+\s+/; + return 1 if $call =~ /^\d+\w+/; + return undef; } diff --git a/perl/Messages b/perl/Messages index 38fd802b..a9afbad2 100644 --- a/perl/Messages +++ b/perl/Messages @@ -87,6 +87,10 @@ package DXM; m14 => 'Message no $_[0] marked as sent to $_[1]', m15 => 'Message no $_[0] unmarked as sent to $_[1]', m16 => 'Need a Message number', + msg1 => 'Bulletin Messages Queued', + msg2 => 'Private Messages Queued', + msg3 => 'Msg $_[0]: $_[1] changed from $_[2] to $_[3]', + msgu => 'usage: msg data...', merge1 => 'Merge request for $_[1] spots and $_[2] WWV sent to $_[0]', namee1 => 'Please enter your name, set/name ', namee2 => 'Can\'t find user $_[0]!',