From 0165dda006167dda28c20bd415c91cf029da0edb Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 15 Feb 1999 16:10:24 +0000 Subject: [PATCH] added message forwarding code --- Changes | 8 ++++++++ msg/forward.pl.issue | 39 +++++++++++++++++++++++++++++++++++++++ perl/DXMsg.pm | 38 ++++++++++++++++++++++++++++++++++++-- 3 files changed, 83 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 68bd6d15..081db095 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,11 @@ +15Feb99======================================================================== +1. Added msg forwarding code which uses $main::root/msg/forward.pl. +14Feb99======================================================================== +1. Changed A & K in WWV to be the other way around (I am told by G3IOR that +this will mean that we won't have pole to pole aurora nor all the power lines +overloading everywhere as well as a result of having values of K > 10). +2. allow the '~' character in message bodies. +3. Moved $main::data/badmsg.pl to $main::root/msg/badmsg.pl. 11Feb99======================================================================== 1. Fixed a problem with isolated nodes' configurations being sent on sending local configs to new connections. diff --git a/msg/forward.pl.issue b/msg/forward.pl.issue index e69de29b..bfee2cb8 100644 --- a/msg/forward.pl.issue +++ b/msg/forward.pl.issue @@ -0,0 +1,39 @@ +# +# this is an example message forwarding file for the system +# +# The format of each line is as follows +# +# type to/from/at pattern action destinations +# P/B/F T/F/A regex I/F [ call [, call ...] ] +# +# type: P - private, B - bulletin (msg), F - file (ak1a bull) +# to/from/at: T - to field, F - from field, A - home bbs, O - origin +# pattern: a perl regex on the field requested +# action: I - ignore, F - forward +# destinations: a reference to an array containing node callsigns +# +# if it is non-private and isn't in here then it won't get forwarded +# +# Currently only type B 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 +# +# If the BBS list is undef or 0 and the action is 'F' (and it matches the +# pattern) then it will always be forwarded to every node that doesn't have +# it (I strongly recommend you don't use this unless you REALLY mean it, if +# you allow a new link with this on EVERY bull will be forwarded immediately +# on first connection) +# + +package DXMsg; + +@forward = ( +'B', 'O', 'K1XX', 'I', 0, +'B', 'T', 'LOCAL', 'F', [ qw(GB7TLH GB7DJK-1) ], +'B', 'T', 'ALL', 'F', [ qw(GB7TLH GB7DJK-1 GB7BAA) ], +'B', 'T', 'UK', 'F', [ qw(GB7TLH GB7DJK-1 GB7BAA) ], +); diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 39bd3065..dd6d178e 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -528,9 +528,10 @@ sub queue_msg my $noderef; foreach $noderef (@nodelist) { next if $noderef->call eq $main::mycall; - next if $noderef->isolate; # maybe add code for stuff originated here? next if grep { $_ eq $noderef->call } @{$ref->{gotit}}; - next if DXUser->get( ${$ref->{gotit}}[0] )->isolate; # is the origin isolated? + next unless $ref->forward_it($noderef->call); # check the forwarding file + # next if $noderef->isolate; # maybe add code for stuff originated here? + # next if DXUser->get( ${$ref->{gotit}}[0] )->isolate; # is the origin isolated? # if we are here we have a node that doesn't have this message $ref->start_msg($noderef) if !get_busy($noderef->call) && $noderef->state eq 'normal'; @@ -816,6 +817,39 @@ sub load_badmsg return @out; } +# +# forward that message or not according to the forwarding table +# returns 1 for forward, 0 - to ignore +# + +sub forward_it +{ + my $ref = shift; + my $call = shift; + my $i; + + for ($i = 0; $i < @forward; $i += 5) { + my ($sort, $field, $pattern, $action, $bbs) = @forward[$i..($i+4)]; + my $tested; + + # are we interested? + last if $ref->{private} && $sort ne 'P'; + last 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 0 if $action eq 'I'; + return 1 if !$bbs || grep $_ eq $call, @{$bbs}; + } + } + return 0; +} + no strict; sub AUTOLOAD { -- 2.43.0