From 82de56e409a19a05761794c9588713160b51144e Mon Sep 17 00:00:00 2001 From: djk Date: Fri, 22 Oct 1999 18:58:57 +0000 Subject: [PATCH] put in input filter for ann and output filters for ann/wwv/spots allow lower case names for filters fixed all issues on console.pl added some eye candy to console --- Changes | 10 ++++ cmd/dx.pl | 6 -- perl/Console.pm | 2 + perl/DXChannel.pm | 13 +++++ perl/DXCommandmode.pm | 2 - perl/DXProt.pm | 130 ++++++++++++++++++++++++++++-------------- perl/DXUtil.pm | 2 +- perl/Filter.pm | 15 ++++- perl/console.pl | 8 ++- 9 files changed, 133 insertions(+), 55 deletions(-) diff --git a/Changes b/Changes index afc01334..3611fa06 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,13 @@ +22Oct99======================================================================= +1. allow filter names to be in upper or lower case. +2. create the concept of input and output filters, input filters are of the +form "in_$call.pl" eg: "in_g1tlh.pl", output filters are "g1tlh.pl". +3. all users can now filter on spots, ann and wwv (assuming the sysop has set +the filters up - still no user creatable filters. Nodes can filter on both +input and output for all of these. +4. added callsign and length of history/position of screen stats to console. +DO REMEMBER to copy /spider/perl/Console.pm to /spider/local (doing any changes +on the way as it has extra data items in it now). 21Oct99======================================================================= 1. fixed reply so that reply b or reply nop generate a bulletin with the correct address. diff --git a/cmd/dx.pl b/cmd/dx.pl index 0ebfb167..98338ec6 100644 --- a/cmd/dx.pl +++ b/cmd/dx.pl @@ -101,12 +101,6 @@ if (grep $_ eq $spotted, @DXProt::baddx) { if (@spot) { # send orf to the users DXProt::send_dx_spot($self, DXProt::pc11($spotter, $freq, $spotted, $line), @spot); - -# my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter); -# DXProt::broadcast_users("$buf\a\a", 'dx', $spot[0]); - - # send it orf to the cluster (hang onto your tin helmets) -# DXProt::broadcast_all_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line), $DXProt::me); } } diff --git a/perl/Console.pm b/perl/Console.pm index 052d1073..494392a7 100644 --- a/perl/Console.pm +++ b/perl/Console.pm @@ -29,6 +29,7 @@ if ($ENV{'TERM'} =~ /(xterm|ansi)/) { $ENV{'TERM'} = 'color_xterm'; $foreground = COLOR_BLACK(); $background = COLOR_WHITE(); + $mycallcolor = COLOR_PAIR(1); @colors = ( [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ], [ '^DX', COLOR_PAIR(5) ], @@ -43,6 +44,7 @@ if ($ENV{'TERM'} =~ /(xterm|ansi)/) { if ($ENV{'TERM'} =~ /(console|linux)/) { $foreground = COLOR_WHITE(); $background = COLOR_BLACK(); + $mycallcolor = COLOR_PAIR(1); @colors = ( [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ], [ '^DX', COLOR_PAIR(4) ], diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index f577ded8..3ccadeaf 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -29,6 +29,7 @@ use Msg; use DXM; use DXUtil; use DXDebug; +use Filter; use Carp; use strict; @@ -73,6 +74,9 @@ use vars qw(%channels %valid); annfilter => '5,Announce Filter', wwvfilter => '5,WWV Filter', spotfilter => '5,Spot Filter', + inannfilter => '5,Input Ann Filter', + inwwvfilter => '5,Input WWV Filter', + inspotfilter => '5,Input Spot Filter', passwd => '9,Passwd List,parray', ); @@ -89,6 +93,9 @@ sub DESTROY undef $self->{annfilter}; undef $self->{wwvfilter}; undef $self->{spotfilter}; + undef $self->{inannfilter}; + undef $self->{inwwvfilter}; + undef $self->{inspotfilter}; undef $self->{passwd}; } @@ -113,6 +120,12 @@ sub alloc $self->{oldstate} = 0; $self->{lang} = $main::lang if !$self->{lang}; $self->{func} = ""; + + # get the filters + $self->{spotfilter} = Filter::read_in('spots', $call, 0); + $self->{wwvfilter} = Filter::read_in('wwv', $call, 0); + $self->{annfilter} = Filter::read_in('ann', $call, 0); + bless $self, $pkg; return $channels{$call} = $self; } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 44c2728c..f2ba3745 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -94,8 +94,6 @@ sub start $self->send($self->msg('hnodee1')) if !$user->qth; $self->send($self->msg('m9')) if DXMsg::for_me($call); - # get the filters - $self->{spotfilter} = Filter::read_in('spots', $call); $self->send($self->msg('pr', $call)); } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 6ecf0e79..c7e2abdb 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -114,10 +114,10 @@ sub start $self->{consort} = $line; # save the connection type $self->{here} = 1; - # get the filters - $self->{spotfilter} = Filter::read_in('spots', $call); - $self->{wwvfilter} = Filter::read_in('wwv', $call); - $self->{annfilter} = Filter::read_in('ann', $call); + # get the INPUT filters (these only pertain to Clusters) + $self->{inspotfilter} = Filter::read_in('spots', $call, 1); + $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1); + $self->{inannfilter} = Filter::read_in('ann', $call, 1); # set unbuffered and no echo $self->send_now('B',"0"); @@ -271,41 +271,19 @@ sub normal } $anndup{$dupkey} = $main::systime; - # global ann filtering on INPUT - my ($filter, $hops) = Filter::it($self->{annfilter}, @field[1..6], $self->{call} ) if $self->{annfilter}; - if ($self->{annfilter} && !$filter) { - dbg('chan', "Rejected by filter"); - return; - } - if ($field[2] eq '*' || $field[2] eq $main::mycall) { - # strip leading and trailing stuff - my $text = unpad($field[3]); - my $target; - my $to = 'To '; - my @list; - - if ($field[4] eq '*') { # sysops - $target = "SYSOP"; - @list = map { $_->priv >= 5 ? $_ : () } get_all_users(); - } elsif ($field[4] gt ' ') { # speciality list handling - my ($name) = split /\./, $field[4]; - $target = "$name"; # put the rest in later (if bothered) - } - - if ($field[6] eq '1') { - $target = "WX"; - $to = ''; - } - $target = "All" if !$target; - - if (@list > 0) { - broadcast_list("$to$target de $field[1]: $text", 'ann', undef, @list); - } else { - broadcast_users("$target de $field[1]: $text", 'ann', undef); + # global ann filtering on INPUT + if ($self->{inannfilter}) { + my ($filter, $hops) = Filter::it($self->{inannfilter}, @field[1..6], $self->{call} ); + unless ($filter) { + dbg('chan', "Rejected by filter"); + return; + } } - Log('ann', $target, $field[1], $text); + + # send it + $self->send_announce($line, @field[1..6]); if ($decode_dk0wcy && $field[1] eq $decode_dk0wcy) { my ($hour, $k, $next, $a, $r, $sfi, $alarm) = $field[3] =~ /^Aurora Beacon\s+(\d+)UTC,\s+Kiel\s+K=(\d+),.*ed\s+K=(\d+),\s+A=(\d+),\s+R=(\d+),\s+SFI=(\d+),.*larm:\s+(\w+)/; @@ -842,15 +820,14 @@ sub send_dx_spot $dxchan->send($routeit) if $routeit; } else { $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; - } } elsif ($dxchan->is_user && $dxchan->{dx}) { my $buf = Spot::formatb($_[0], $_[1], $_[2], $_[3], $_[4]); $buf .= "\a\a" if $dxchan->{beep}; if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { - $dxchan->send($buf) if !$hops || ($hops && $filter); + $dxchan->send($buf); } else { - $dxchan->delay($buf) if !$hops || ($hops && $filter); + $dxchan->delay($buf); } } } @@ -867,7 +844,12 @@ sub send_wwv_spot # taking into account filtering and so on foreach $dxchan (@dxchan) { my $routeit; - my ($filter, $hops) = Filter::it($dxchan->{wwvfilter}, @_, $self->{call} ) if $dxchan->{wwvfilter}; + my ($filter, $hops); + + if ($dxchan->{spotfilter}) { + ($filter, $hops) = Filter::it($dxchan->{wwvfilter}, @_, $self->{call} ); + next unless $filter; + } if ($dxchan->is_ak1a) { next if $dxchan == $self; if ($hops) { @@ -887,9 +869,73 @@ sub send_wwv_spot my $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; $buf .= "\a\a" if $dxchan->{beep}; if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { - $dxchan->send($buf) if !$hops || ($hops && $filter); + $dxchan->send($buf); + } else { + $dxchan->delay($buf); + } + } + } +} + +# send an announce +sub send_announce +{ + my $self = shift; + my $line = shift; + my @dxchan = DXChannel->get_all(); + my $dxchan; + my $text = unpad($_[2]); + my $target; + my $to = 'To '; + + if ($_[3] eq '*') { # sysops + $target = "SYSOP"; + } elsif ($_[3] gt ' ') { # speciality list handling + my ($name) = split /\./, $_[3]; + $target = "$name"; # put the rest in later (if bothered) + } + + if ($_[5] eq '1') { + $target = "WX"; + $to = ''; + } + $target = "All" if !$target; + + Log('ann', $target, $_[0], $text); + + # send it if it isn't the except list and isn't isolated and still has a hop count + # taking into account filtering and so on + foreach $dxchan (@dxchan) { + my $routeit; + my ($filter, $hops); + + if ($dxchan->{annfilter}) { + ($filter, $hops) = Filter::it($dxchan->{annfilter}, @_, $self->{call} ); + return unless $filter; + } + if ($dxchan->is_ak1a) { + next if $dxchan == $self; + if ($hops) { + $routeit = $line; + $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; + } else { + $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name + next unless $routeit; + } + if ($filter) { + $dxchan->send($routeit) if $routeit; + } else { + $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; + + } + } elsif ($dxchan->is_user && $dxchan->{ann}) { + next if $target eq 'SYSOP' && $dxchan->{priv} < 5; + my $buf = "$to$target de $_[0]: $text"; + $buf .= "\a\a" if $dxchan->{beep}; + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + $dxchan->send($buf); } else { - $dxchan->delay($buf) if !$hops || ($hops && $filter); + $dxchan->delay($buf); } } } diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index c4abc15b..86dc9199 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -167,7 +167,7 @@ sub print_all_fields my @fields = $ref->fields; my $field; - foreach $field (sort @fields) { + foreach $field (sort {$ref->field_prompt($a) cmp $ref->field_prompt($b)} @fields) { if (defined $ref->{$field}) { my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field}); push @out, $ans if ($self->priv >= $priv); diff --git a/perl/Filter.pm b/perl/Filter.pm index 2981a7b7..aefa9224 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -106,9 +106,20 @@ sub it # sub read_in { - my ($sort, $call) = @_; - my $fn = "$filterbasefn/$sort/$call.pl"; + my ($sort, $call, $flag) = @_; + + # first uppercase + $flag = ($flag) ? "in_" : ""; + $call = uc $call; + my $fn = "$filterbasefn/$sort/$flag$call.pl"; + + # otherwise lowercase + unless (-e $fn) { + $call = lc $call; + $fn = "$filterbasefn/$sort/$flag$call.pl"; + } + # load it if (-e $fn) { do "$fn"; dbg('conn', "$@") if $@; diff --git a/perl/console.pl b/perl/console.pl index 97c0864c..8a1c8719 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -81,6 +81,7 @@ sub do_initscr $scr->refresh(); $pagel = LINES()-4; + $mycallcolor = COLOR_PAIR(1) unless $mycallcolor; } sub do_resize @@ -174,8 +175,11 @@ sub show_screen $spos = @shistory if $spos > @shistory; } my $shl = @shistory; - my $add = "$call-$spos-$shl"; - $scr->addstr(LINES()-4, 0, '-' x (COLS() - length $add)); + my $add = "-$spos-$shl"; + $scr->addstr(LINES()-4, 0, '-' x (COLS() - (length($call) + length($add)))); + $scr->attrset($mycallcolor) if $has_colors; + $scr->addstr("$call"); + $scr->attrset(COLOR_PAIR(0)) if $has_colors; $scr->addstr($add); $scr->refresh(); # $top->refresh(); -- 2.34.1