]> dxcluster.org Git - spider.git/commitdiff
added swop file
authordjk <djk>
Wed, 24 Nov 1999 15:27:38 +0000 (15:27 +0000)
committerdjk <djk>
Wed, 24 Nov 1999 15:27:38 +0000 (15:27 +0000)
extended badmsg file to allow regexes on various fields
detail changes to all load/* commands

12 files changed:
cmd/load/aliases.pl
cmd/load/baddx.pl
cmd/load/badmsg.pl
cmd/load/bands.pl
cmd/load/forward.pl
cmd/load/hops.pl
cmd/load/messages.pl
cmd/load/prefixes.pl
cmd/load/swop.pl [new file with mode: 0644]
msg/badmsg.pl.issue
msg/swop.pl.issue [new file with mode: 0644]
perl/DXMsg.pm

index 45a3c165f887d6c78ce5db453302907a3bae44c1..41f28211444209de4e14c2272ff5696d77feb27e 100644 (file)
@@ -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); 
index 3a1dbef33862b9301210b66b552368a32a808467..64a54c9d973923655d642c5f632a6d5448d5e846 100644 (file)
@@ -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;
index 5a5cbc3829dab56fc3ed05e30b05216f2bb299f4..18eb747f26a795650936909b3109cfc413552979 100644 (file)
@@ -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); 
index cd184f68087e8cab89fdff3d6f75d78bae32c0b1..856aebc568e7224dbb17ad83cd1bca4b2398fb6c 100644 (file)
@@ -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); 
index 27fa48dac0d083b25f68398e6399b4f8d2878934..8f1ed58dd53ab4b6946bc9f3707556c59a9e3383 100644 (file)
@@ -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); 
index 592b7920ff99157109a159335a2c590beb7e32cf..a4a1aafea50ae149b284d08233b00d6342835448 100644 (file)
@@ -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); 
index b8f0dd3790566e3052597534a9bd5837da46e5ff..8db34e7c141d7010e496cef6195922620cd893f2 100644 (file)
@@ -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); 
index cd211ba81b8b58cf5ad0e034d6f43f8904ff5cc5..bf29b256b111b4c190a972b07aed8b60494f75a5 100644 (file)
@@ -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 (file)
index 0000000..a9e0e50
--- /dev/null
@@ -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); 
index 7a1b3fea0a3f711781e3ec282159fadfb0ef5216..3b13e3bfc14c887eb7134129fa26a64539c26bd0 100644 (file)
@@ -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 (file)
index 0000000..cc8697f
--- /dev/null
@@ -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 = (
+
+); 
+
index a3c0798e73f948cfcebdf74665da8b069dc243fd..10857152475e9524311f9c48514916e5389e846b 100644 (file)
@@ -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
 {