From 76027e074b381b0cdc76b3c23ac751802ee174fe Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Mon, 6 Mar 2023 21:20:35 +0000 Subject: [PATCH] fix filter error handling and error counting --- Changes | 5 +++++ cmd/accept/announce.pl | 3 ++- cmd/accept/rbn.pl | 3 ++- cmd/accept/route.pl | 3 ++- cmd/accept/spots.pl | 3 ++- cmd/accept/wcy.pl | 3 ++- cmd/accept/wwv.pl | 3 ++- cmd/reject/announce.pl | 3 ++- cmd/reject/rbn.pl | 3 ++- cmd/reject/route.pl | 3 ++- cmd/reject/spots.pl | 3 ++- cmd/reject/wcy.pl | 3 ++- cmd/reject/wwv.pl | 3 ++- perl/DXCommandmode.pm | 6 +++++- perl/DXMsg.pm | 2 +- perl/DXUtil.pm | 2 +- perl/Filter.pm | 6 +++--- perl/Messages | 2 +- 18 files changed, 40 insertions(+), 19 deletions(-) diff --git a/Changes b/Changes index 65575f39..9fcdc27a 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +06Mar23======================================================================= +1. Fix filter error reporting, including incrementing concurrent error count + if there are actually any detected parse errors. +2. Fix warnings on difft. +3. Add the origin of any incoming SP if it is emailed to the recipient. 04Mar23======================================================================= 1. Fixed regression caused by too many command errors in (startup) script files. This is caused by much stricter checking of commands entered both diff --git a/cmd/accept/announce.pl b/cmd/accept/announce.pl index de956ed4..9ea20a76 100644 --- a/cmd/accept/announce.pl +++ b/cmd/accept/announce.pl @@ -11,4 +11,5 @@ my $type = 'accept'; my $sort = 'ann'; my ($r, $filter, $fno) = $AnnTalk::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/accept/rbn.pl b/cmd/accept/rbn.pl index 69b39e6b..40173762 100644 --- a/cmd/accept/rbn.pl +++ b/cmd/accept/rbn.pl @@ -11,4 +11,5 @@ my $type = 'accept'; my $sort = 'rbn'; my ($r, $filter, $fno) = $RBN::filterdef->cmd($self, $sort, $type, $line); -return (1, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/accept/route.pl b/cmd/accept/route.pl index 94a91396..fd335fa4 100644 --- a/cmd/accept/route.pl +++ b/cmd/accept/route.pl @@ -11,4 +11,5 @@ my $type = 'accept'; my $sort = 'route'; my ($r, $filter, $fno) = $Route::filterdef->cmd($self, $sort, $type, $line); -return (1, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/accept/spots.pl b/cmd/accept/spots.pl index b7920d3f..eb0a010a 100644 --- a/cmd/accept/spots.pl +++ b/cmd/accept/spots.pl @@ -11,4 +11,5 @@ my $type = 'accept'; my $sort = 'spots'; my ($r, $filter, $fno) = $Spot::filterdef->cmd($self, $sort, $type, $line); -return (1, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/accept/wcy.pl b/cmd/accept/wcy.pl index 013c1e75..00309727 100644 --- a/cmd/accept/wcy.pl +++ b/cmd/accept/wcy.pl @@ -11,4 +11,5 @@ my $type = 'accept'; my $sort = 'wcy'; my ($r, $filter, $fno) = $WCY::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/accept/wwv.pl b/cmd/accept/wwv.pl index ff9906ed..00c0dc44 100644 --- a/cmd/accept/wwv.pl +++ b/cmd/accept/wwv.pl @@ -11,4 +11,5 @@ my $type = 'accept'; my $sort = 'wwv'; my ($r, $filter, $fno) = $Geomag::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/reject/announce.pl b/cmd/reject/announce.pl index 7cbe9905..e56720b4 100644 --- a/cmd/reject/announce.pl +++ b/cmd/reject/announce.pl @@ -11,4 +11,5 @@ my $type = 'reject'; my $sort = 'ann'; my ($r, $filter, $fno) = $AnnTalk::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/reject/rbn.pl b/cmd/reject/rbn.pl index de1ebd20..36b36a8a 100644 --- a/cmd/reject/rbn.pl +++ b/cmd/reject/rbn.pl @@ -11,4 +11,5 @@ my $type = 'reject'; my $sort = 'rbn'; my ($r, $filter, $fno) = $RBN::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/reject/route.pl b/cmd/reject/route.pl index 3d0873de..f7ddc786 100644 --- a/cmd/reject/route.pl +++ b/cmd/reject/route.pl @@ -11,4 +11,5 @@ my $type = 'reject'; my $sort = 'route'; my ($r, $filter, $fno) = $Route::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/reject/spots.pl b/cmd/reject/spots.pl index 55abdbb7..6ef988f3 100644 --- a/cmd/reject/spots.pl +++ b/cmd/reject/spots.pl @@ -11,4 +11,5 @@ my $type = 'reject'; my $sort = 'spots'; my ($r, $filter, $fno) = $Spot::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/reject/wcy.pl b/cmd/reject/wcy.pl index 90a4b8b6..ed94a752 100644 --- a/cmd/reject/wcy.pl +++ b/cmd/reject/wcy.pl @@ -11,4 +11,5 @@ my $type = 'reject'; my $sort = 'wcy'; my ($r, $filter, $fno) = $WCY::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/reject/wwv.pl b/cmd/reject/wwv.pl index 23a30a3d..a01d28ec 100644 --- a/cmd/reject/wwv.pl +++ b/cmd/reject/wwv.pl @@ -11,4 +11,5 @@ my $type = 'reject'; my $sort = 'wwv'; my ($r, $filter, $fno) = $Geomag::filterdef->cmd($self, $sort, $type, $line); -return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); +my $ok = $r ? 0 : 1; +return ($ok, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 8720e940..c4d2b147 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -598,7 +598,11 @@ sub run_cmd if ($ok) { delete $self->{errors}; } else { - return $self->_error_out('e26'); + if (++$self->{errors} > $DXChannel::maxerrors) { + $self->send($self->msg('e26')); + $self->disconnect; + return (); + } } return map {s/([^\s])\s+$/$1/; $_} @ans; } diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index a3b5e983..bf7494a7 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -485,7 +485,7 @@ sub notify my $fromaddr = $email_from || $main::myemail; my @headers = ("To: $ref->{to}", "From: $fromaddr", - "Subject: [DXSpider: $ref->{from}] $ref->{subject}", + "Subject: [DXSpider: $ref->{from}\@$ref->{origin}] $ref->{subject}", "X-DXSpider-To: $ref->{to}", "X-DXSpider-From: $ref->{from}\@$ref->{origin}", "X-DXSpider-Gateway: $main::mycall" diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 30f12733..207d2771 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -578,7 +578,7 @@ sub difft $t -= $h * 3600; $m = int $t / 60; $out .= sprintf ("%s${m}m", $adds?' ':'') if $m; - if ($d == 0 && $adds || $adds == 2) { + if (($d == 0 && $adds) || (int $adds && $adds == 2)) { $s = int $t % 60; $out .= sprintf ("%s${s}s", $adds?' ':'') if $s; $out ||= sprintf ("%s0s", $adds?' ':''); diff --git a/perl/Filter.pm b/perl/Filter.pm index 7119ed13..10021a4e 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -559,7 +559,7 @@ sub parse } return (1, $dxchan->msg('e20', $lasttok)) unless $found; } else { - my $s = '{' . decode_regex($tok) . '}' if $tok =~ /^{.*}$/; + $s = $tok =~ /^{.*}$/ ? '{' . decode_regex($tok) . '}' : $tok; return (1, $dxchan->msg('filter2', $s)); } $lasttok = $tok; @@ -606,8 +606,8 @@ sub cmd $filter->{$fn}->{$type}->{user} = $user; $filter->{$fn}->{$type}->{asc} = $s; - $r = $filter->compile($fn, $type); - return (1,$r) if $r; + $r = $filter->compile($fn, $type); # NOTE: returns an ERROR, therefore 0 = success + return (0,$r) if $r; $r = $filter->write; return (1,$r) if $r; diff --git a/perl/Messages b/perl/Messages index f10cb5e7..a78e0955 100644 --- a/perl/Messages +++ b/perl/Messages @@ -127,7 +127,7 @@ package DXM; export2 => q{$_[3] has error exporting msg $_[0] to $_[1] ($_[2])}, export3 => q{$_[2 ] exported msg $_[0] to $_[1]}, filter1 => q{Filter $_[0] updated for $_[1]}, - filter2 => q{Unknown filter keyword $_[0]}, + filter2 => q{Parse error on '$_[0]'}, filter3 => q{No filters defined for $_[0]}, filter4 => q{$_[0]$_[1] Filter $_[2] deleted for $_[3]}, filter5 => q{need some filter commands...}, -- 2.43.0