From a8b7d0b77fd3cefb1943ce7548f8c803aa83ff39 Mon Sep 17 00:00:00 2001 From: djk Date: Wed, 24 Nov 1999 15:27:38 +0000 Subject: [PATCH] added swop file extended badmsg file to allow regexes on various fields detail changes to all load/* commands --- cmd/load/aliases.pl | 2 +- cmd/load/baddx.pl | 2 +- cmd/load/badmsg.pl | 2 +- cmd/load/bands.pl | 2 +- cmd/load/forward.pl | 2 +- cmd/load/hops.pl | 2 +- cmd/load/messages.pl | 2 +- cmd/load/prefixes.pl | 2 +- cmd/load/swop.pl | 7 +++ msg/badmsg.pl.issue | 36 +++++++++++--- msg/swop.pl.issue | 40 +++++++++++++++ perl/DXMsg.pm | 115 ++++++++++++++++++++++++++++++++++++++----- 12 files changed, 187 insertions(+), 27 deletions(-) create mode 100644 cmd/load/swop.pl create mode 100644 msg/swop.pl.issue diff --git a/cmd/load/aliases.pl b/cmd/load/aliases.pl index 45a3c165..41f28211 100644 --- a/cmd/load/aliases.pl +++ b/cmd/load/aliases.pl @@ -2,7 +2,7 @@ # load the Command Aliases file after changing it # my $self = shift; -return (0, $self->msg('e5')) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; my @out = CmdAlias::load($self); @out = ($self->msg('ok')) if !@out; return (1, @out); diff --git a/cmd/load/baddx.pl b/cmd/load/baddx.pl index 3a1dbef3..64a54c9d 100644 --- a/cmd/load/baddx.pl +++ b/cmd/load/baddx.pl @@ -1,7 +1,7 @@ # reload the baddx file my $self = shift; my @out; -return (0, $self->msg('e5')) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; do "$main::data/baddx.pl" if -e "$main::data/baddx.pl"; push @out, $@ if $@; @out = ($self->msg('ok')) unless @out; diff --git a/cmd/load/badmsg.pl b/cmd/load/badmsg.pl index 5a5cbc38..18eb747f 100644 --- a/cmd/load/badmsg.pl +++ b/cmd/load/badmsg.pl @@ -1,7 +1,7 @@ # reload the badmsg file my $self = shift; my @out; -return (0, $self->msg('e5')) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; push @out, (DXMsg::load_badmsg()); @out = ($self->msg('ok')) unless @out; return (1, @out); diff --git a/cmd/load/bands.pl b/cmd/load/bands.pl index cd184f68..856aebc5 100644 --- a/cmd/load/bands.pl +++ b/cmd/load/bands.pl @@ -2,7 +2,7 @@ # load the bands file after changing it # my $self = shift; -return (0, $self->msg('e5')) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; my @out = Bands::load($self); @out = ($self->msg('ok')) if !@out; return (1, @out); diff --git a/cmd/load/forward.pl b/cmd/load/forward.pl index 27fa48da..8f1ed58d 100644 --- a/cmd/load/forward.pl +++ b/cmd/load/forward.pl @@ -1,7 +1,7 @@ # reload the message forward file my $self = shift; my @out; -return (0, $self->msg('e5')) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; push @out, (DXMsg::load_forward()); @out = ($self->msg('ok')) unless @out; return (1, @out); diff --git a/cmd/load/hops.pl b/cmd/load/hops.pl index 592b7920..a4a1aafe 100644 --- a/cmd/load/hops.pl +++ b/cmd/load/hops.pl @@ -2,7 +2,7 @@ # load the node hop count table after changing it # my $self = shift; -return (0, $self->msg('e5')) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; my @out = DXProt::load_hops($self); @out = ($self->msg('ok')) if !@out; return (1, @out); diff --git a/cmd/load/messages.pl b/cmd/load/messages.pl index b8f0dd37..8db34e7c 100644 --- a/cmd/load/messages.pl +++ b/cmd/load/messages.pl @@ -2,7 +2,7 @@ # load the the Messages file after changing it # my $self = shift; -return (0, $self->msg('e5')) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; my @out = DXM::load($self); @out = ($self->msg('ok')) if !@out; return (1, @out); diff --git a/cmd/load/prefixes.pl b/cmd/load/prefixes.pl index cd211ba8..bf29b256 100644 --- a/cmd/load/prefixes.pl +++ b/cmd/load/prefixes.pl @@ -2,7 +2,7 @@ # load the prefix_data file after changing it # my $self = shift; -return (0, $self->msg('e5')) if $self->priv < 9; +return (1, $self->msg('e5')) if $self->priv < 9; my $out = Prefix::load(); return (1, $out ? $out : $self->msg('ok')); diff --git a/cmd/load/swop.pl b/cmd/load/swop.pl new file mode 100644 index 00000000..a9e0e50d --- /dev/null +++ b/cmd/load/swop.pl @@ -0,0 +1,7 @@ +# reload the swop file +my $self = shift; +my @out; +return (1, $self->msg('e5')) if $self->priv < 9; +push @out, (DXMsg::load_swop()); +@out = ($self->msg('ok')) unless @out; +return (1, @out); diff --git a/msg/badmsg.pl.issue b/msg/badmsg.pl.issue index 7a1b3fea..3b13e3bf 100644 --- a/msg/badmsg.pl.issue +++ b/msg/badmsg.pl.issue @@ -1,14 +1,36 @@ # -# the list of TO addresses for messages that we won't store having +# the list of regexes for messages that we won't store having # received them (bear in mind that we must receive them fully before # we can bin them) # +# +# The format of each line is as follows +# +# type source pattern +# P/B/F T/F/O/S regex +# +# type: P - private, B - bulletin (msg), F - file (ak1a bull) +# source: T - to field, F - from field, O - origin, S - subject +# pattern: a perl regex on the field requested +# +# Currently only type B and P msgs are affected by this code. +# +# The list is read from the top down, the first pattern that matches +# causes the action to be taken. +# +# The pattern can be undef or 0 in which case it will always be selected +# for the action specified +# + package DXMsg; -@badmsg = qw -( - SALE - FORSALE - WANTED -); +@badmsg = ( +'B', 'T', 'SALE', +'B', 'T', 'WANTED', +'B', 'S', 'WANTED', +'B', 'S', 'SALE', +'B', 'S', 'WTB', +'B', 'S', 'WTS', +); + diff --git a/msg/swop.pl.issue b/msg/swop.pl.issue new file mode 100644 index 00000000..cc8697f9 --- /dev/null +++ b/msg/swop.pl.issue @@ -0,0 +1,40 @@ +# +# the list of regexes for messages that we won't store having +# received them (bear in mind that we must receive them fully before +# we can bin them) +# +# +# The format of each line is as follows +# +# type source pattern tofield to +# P/B/F T/F/O/S regex T/F/O/S expression +# +# type: P - private, B - bulletin (msg), F - file (ak1a bull) +# source: T - to field, F - from field, O - origin, S - subject +# pattern: a perl regex on the field requested +# tofield: T - to field, F - from field, O - origin, S - subject +# to: what you want this field changed to +# +# Currently only type B and P msgs are affected by this code. +# +# The list is read from the top down, the first pattern that matches +# causes the action to be taken. +# +# Basically this will take all the headers in turn and shove them thru the +# rewrite engine, starting at the top. +# +# The result is then passed thru the rest of the system as though it came in +# like that. +# +# You can either swop a field for another another value or set a field to +# value after regexing another field - useful in europe where we are paranoid +# about for sale notices - you can check subject for suspicious words and +# the swop the TO field. +# + +package DXMsg; + +@swap = ( + +); + diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index a3c0798e..10857152 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -32,7 +32,7 @@ use Carp; use strict; use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean - @badmsg $badmsgfn $forwardfn @forward $timeout $waittime + @badmsg @swop $swopfn $badmsgfn $forwardfn @forward $timeout $waittime $queueinterval $lastq); %work = (); # outstanding jobs @@ -42,6 +42,8 @@ $msgdir = "$main::root/msg"; # directory contain the msgs $maxage = 30 * 86400; # the maximum age that a message shall live for if not marked $last_clean = 0; # last time we did a clean @forward = (); # msg forward table +@badmsg = (); # bad message table +@swop = (); # swop table $timeout = 30*60; # forwarding timeout $waittime = 30*60; # time an aborted outgoing message waits before trying again $queueinterval = 1*60; # run the queue every 1 minute @@ -50,6 +52,7 @@ $lastq = 0; $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 %valid = ( fromnode => '5,From Node', @@ -276,12 +279,16 @@ sub process return; } } - + + # swop addresses + $ref->swop_it($self->call); + # look for 'bad' to addresses - if (grep $ref->{to} eq $_, @badmsg) { +# if (grep $ref->{to} eq $_, @badmsg) { + if ($ref->dump_it($self->call)) { $ref->stop_msg($self->call); - dbg('msg', "'Bad' TO address $ref->{to}"); - Log('msg', "'Bad' TO address $ref->{to}"); + dbg('msg', "'Bad' message $ref->{to}"); + Log('msg', "'Bad' message $ref->{to}"); return; } @@ -594,6 +601,7 @@ sub queue_msg # deal with routed private messages my $noderef; if ($ref->{private}) { + next if $ref->{'read'}; # if it is read, it is stuck here $clref = DXCluster->get_exact($ref->{to}); unless ($clref) { # otherwise look for a homenode my $uref = DXUser->get($ref->{to}); @@ -722,12 +730,11 @@ sub init my $dir = new IO::File; my @dir; my $ref; - + # load various control files - my @in = load_badmsg(); - print "@in\n" if @in; - @in = load_forward(); - print "@in\n" if @in; + print "load badmsg: ", (load_badmsg() or "Ok"), "\n"; + print "load forward: ", (load_forward() or "Ok"), "\n"; + print "load swop: ", (load_swop() or "Ok"), "\n"; # read in the directory opendir($dir, $msgdir) or confess "can't open $msgdir $!"; @@ -909,6 +916,18 @@ sub load_badmsg return @out; } +# load the swop message table +sub load_swop +{ + my @out; + my $s = readfilestr($swopfn); + if ($s) { + eval $s; + push @out, $@ if $@; + } + return @out; +} + # # forward that message or not according to the forwarding table # returns 1 for forward, 0 - to ignore @@ -930,8 +949,6 @@ sub forward_it # 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'; @@ -944,6 +961,80 @@ sub forward_it return 0; } +sub dump_it +{ + my $ref = shift; + my $call = shift; + my $i; + + for ($i = 0; $i < @badmsg; $i += 3) { + my ($sort, $field, $pattern) = @badmsg[$i..($i+2)]; + my $tested; + + # are we interested? + next if $ref->{private} && $sort ne 'P'; + next if !$ref->{private} && $sort ne 'B'; + + # select field + $tested = $ref->{to} if $field eq 'T'; + $tested = $ref->{from} if $field eq 'F'; + $tested = $ref->{origin} if $field eq 'O'; + $tested = $ref->{subject} if $field eq 'S'; + + if (!$pattern || $tested =~ m{$pattern}i) { + return 1; + } + } + return 0; +} + +sub swop_it +{ + my $ref = shift; + my $call = shift; + my $i; + my $count = 0; + + for ($i = 0; $i < @swop; $i += 5) { + my ($sort, $field, $pattern, $tfield, $topattern) = @swop[$i..($i+4)]; + my $tested; + my $swop; + my $old; + + # are we interested? + next if $ref->{private} && $sort ne 'P'; + next if !$ref->{private} && $sort ne 'B'; + + # select field + $tested = $ref->{to} if $field eq 'T'; + $tested = $ref->{from} if $field eq 'F'; + $tested = $ref->{origin} if $field eq 'O'; + $tested = $ref->{subject} if $field eq 'S'; + + # select swop field + $old = $swop = $ref->{to} if $tfield eq 'T'; + $old = $swop = $ref->{from} if $tfield eq 'F'; + $old = $swop = $ref->{origin} if $tfield eq 'O'; + $old = $swop = $ref->{subject} if $tfield eq 'S'; + + if ($tested =~ m{$pattern}i) { + if ($tested eq $swop) { + $swop =~ s{$pattern}{$topattern}i; + } else { + $swop = $topattern; + } + Log('msg', "Msg $ref->{msgno}: $tfield $old -> $swop"); + Log('dbg', "Msg $ref->{msgno}: $tfield $old -> $swop"); + $ref->{to} = $swop if $tfield eq 'T'; + $ref->{from} = $swop if $tfield eq 'F'; + $ref->{origin} = $swop if $tfield eq 'O'; + $ref->{subject} = $swop if $tfield eq 'S'; + ++$count; + } + } + return $count; +} + no strict; sub AUTOLOAD { -- 2.34.1