Add hub tools and hpt filter
This commit is contained in:
Deon George
parent
b8a5bdd50d
commit
88725ad9a2
@ -104,6 +104,7 @@ COPY ftn.orig /etc/ftn.orig/
|
||||
COPY init /sbin/init
|
||||
COPY golded /usr/local/bin
|
||||
COPY goldkeys.cfg /etc
|
||||
COPY tools/* /usr/local/bin/
|
||||
|
||||
EXPOSE 119 24553 24554 60177 60179
|
||||
VOLUME [ "/var/lib/zerotier-one" ]
|
||||
|
||||
@ -1,250 +0,0 @@
|
||||
# $Id$
|
||||
# Template for perl hook
|
||||
#
|
||||
# API functions:
|
||||
#
|
||||
# w_log([level, ]str);
|
||||
# outputs a string to hpt log
|
||||
# no printf() format, use sprintf()!
|
||||
#
|
||||
# crc32(str)
|
||||
# returns CRC-32 of string
|
||||
#
|
||||
# alike(s1, s2)
|
||||
# return Levenstein distance between parameters (smaller -> more alike)
|
||||
#
|
||||
# putMsgInArea(area, fromname, toname, fromaddr, toaddr,
|
||||
# subject, date, attr, text, addkludges);
|
||||
# post to first netmail area if area eq "";
|
||||
# set current date if date eq "";
|
||||
# set fromaddr to ouraka if fromaddr eq "";
|
||||
# attr -- binary or text string (i.e. "pvt loc k/s") (text form DEPRECATED!);
|
||||
# date -- unixtime, as in time()
|
||||
# addkludges can be:
|
||||
# 0 not to add any kludges
|
||||
# 1 to add required kludges (will add duplicates if they exist)
|
||||
# 2 to add missing kludges (will never modify existing ones)
|
||||
# 3 to update or add required kludges corresponding to addresses and flags
|
||||
# required kludges are: (netmail) INTL, TOPT, FMPT; (all) FLAGS, MSGID
|
||||
#
|
||||
# myaddr()
|
||||
# returns array of our addresses
|
||||
# DEPRECATED! use @{$config{addr}} instead
|
||||
#
|
||||
# nodelistDir()
|
||||
# returns nodelistDir from config
|
||||
# DEPRECATED! use $config{nodelistDir} instead
|
||||
#
|
||||
# str2attr(att)
|
||||
# converts attribute string to binary message attributes
|
||||
#
|
||||
# attr2str(attr)
|
||||
# converts binary flags to string representation (Pvt Loc K/s)
|
||||
#
|
||||
# flv2str(flavour)
|
||||
# converts binary flag, corresponding to flavour, to string (direct, crash)
|
||||
#
|
||||
# date2fts(time)
|
||||
# converts unixtime to fts-1 format string ("dd mmm yy hh:mm:ss")
|
||||
#
|
||||
# fts2date(fts1)
|
||||
# converts date in fts-1 format string to unixtime
|
||||
#
|
||||
# mktime(sec, min, hour, wday, mon, year[, wday, yday[, dst]])
|
||||
# makes unixtime like POSIX mktime, but year:
|
||||
# year 0..69 -> 2000..2069, 70..1900 -> 1970..3800, other -> as-is
|
||||
# month'es: 0 - January, 1 - February, ..., 11 - December (as in POSIX)
|
||||
# dst - daylight saving time flag (1 or 0)
|
||||
# WARNING: dst can result in +/-1 hour mismatch; use mktime(localtime) for
|
||||
# correct unixtime
|
||||
#
|
||||
# strftime(format, unixtime)
|
||||
# strftime(format, sec, min, hour, wday, mon, year[, wday, yday[, dst]])
|
||||
# converts unixtime or a time structure to string according to format
|
||||
# man strftime() for details
|
||||
#
|
||||
# gmtoff([unixtime])
|
||||
# returns difference between local time and UTC in hours (e.g., can be +4.5)
|
||||
# if unixtime is omitted, current time used
|
||||
#
|
||||
# WARNING: Don't redefine already predefined variable via my() or local().
|
||||
# otherwise their values will not be put back into hpt.
|
||||
#
|
||||
|
||||
sub filter
|
||||
{
|
||||
# predefined variables:
|
||||
# $fromname, $fromaddr, $toname,
|
||||
# $toaddr (for netmail),
|
||||
# $area (for echomail),
|
||||
# $subject, $text, $pktfrom, $date, $attr
|
||||
# $secure (defined if message from secure link)
|
||||
# return "" or reason for moving to badArea
|
||||
# set $kill for kill the message (not move to badarea)
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr, $date
|
||||
return "";
|
||||
}
|
||||
|
||||
sub put_msg
|
||||
{
|
||||
# predefined variables:
|
||||
# $fromname, $fromaddr, $toname, $toaddr,
|
||||
# $area (areatag in config),
|
||||
# $subject, $text, $date, $attr
|
||||
# return:
|
||||
# 0 not to put message in base
|
||||
# 1 to put message as usual
|
||||
# 2 to put message without recoding
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr, $date
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub scan
|
||||
{
|
||||
# predefined variables:
|
||||
# $area, $fromname, $fromaddr, $toname,
|
||||
# $toaddr (for netmail),
|
||||
# $subject, $text, $date, $attr
|
||||
# return "" or reason for dont packing to downlinks
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr, $date
|
||||
# set $kill to 1 to delete message after processing (even if it's not sent)
|
||||
# set $addvia to 0 not to add via string when packing
|
||||
return "";
|
||||
}
|
||||
|
||||
sub export
|
||||
{
|
||||
# predefined variables:
|
||||
# $area, $fromname, $toname, $subject, $text, $date, $attr,
|
||||
# $toaddr (address of link to export this message to),
|
||||
# return "" or reason for dont exporting message to this link
|
||||
# set $change to update $text, $subject, $fromname, $toname, $attr, $date
|
||||
return "";
|
||||
}
|
||||
|
||||
sub route
|
||||
{
|
||||
# $addr = dest addr
|
||||
# $from = orig addr
|
||||
# $fromname = from user name
|
||||
# $toname = to user name
|
||||
# $date = message date and time
|
||||
# $subj = subject line
|
||||
# $text = message text
|
||||
# $attr = message attributes
|
||||
# $route = default route address (by config rules)
|
||||
# $flavour = default route flavour (by config rules)
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr
|
||||
# set $flavour to flag, corresponding to flavour,
|
||||
# or string hold|normal|crash|direct|immediate
|
||||
# set $addvia to 0 not to add via string when packing
|
||||
# return route addr or "" for default routing
|
||||
|
||||
return "";
|
||||
}
|
||||
|
||||
sub tossbad
|
||||
{
|
||||
# $fromname, $fromaddr, $toname,
|
||||
# $toaddr (for netmail),
|
||||
# $area (for echomail),
|
||||
# $subject, $text, $pktfrom, $date, $attr
|
||||
# $reason
|
||||
# return non-empty string for kill the message
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr
|
||||
return "";
|
||||
}
|
||||
|
||||
sub hpt_start
|
||||
{
|
||||
}
|
||||
|
||||
sub hpt_exit
|
||||
{
|
||||
}
|
||||
|
||||
sub process_pkt
|
||||
{
|
||||
# $pktname - name of pkt
|
||||
# $secure - defined for secure pkt
|
||||
# return non-empty string for rejecting pkt (don't process, rename to *.flt)
|
||||
return "";
|
||||
}
|
||||
|
||||
sub pkt_done
|
||||
{
|
||||
# $pktname - name of pkt
|
||||
# $rc - exit code (0 - OK)
|
||||
# $res - reason (text line)
|
||||
# 0 - OK ($res undefined)
|
||||
# 1 - Security violation
|
||||
# 2 - Can't open pkt
|
||||
# 3 - Bad pkt format
|
||||
# 4 - Not to us
|
||||
# 5 - Msg tossing problem
|
||||
}
|
||||
|
||||
sub after_unpack
|
||||
{
|
||||
}
|
||||
|
||||
sub before_pack
|
||||
{
|
||||
}
|
||||
|
||||
sub on_echolist
|
||||
{
|
||||
# $_[0] - type (0: %list, 1: %query, 2: %unlinked)
|
||||
# $_[1] - reference to array of echotags
|
||||
# $_[2] - link aka
|
||||
# $_[3] - max tag length in @{$_[1]}
|
||||
# return:
|
||||
# 0 to generate hpt-standard list
|
||||
# 1 to return $report value as result
|
||||
# 2 to use $report value as list and append hpt standard footer
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_afixcmd
|
||||
{
|
||||
# $_[0] - command code (see #define's in areafix.h)
|
||||
# $_[1] - link aka
|
||||
# $_[2] - request line
|
||||
# return:
|
||||
# 0 to process command by hpt logic
|
||||
# 1 to skip hpt logic and return $report value as result
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_afixreq
|
||||
{
|
||||
# predefined variables:
|
||||
# $fromname, $fromaddr, $toname, $toaddr. $subject, $text, $pktfrom
|
||||
# return:
|
||||
# 0 to ignore any changes
|
||||
# 1 to update request parameters from above-mentioned variables
|
||||
# (note: only $fromaddr and $text are meaningful for processing)
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_robotmsg
|
||||
{
|
||||
# process messages generated by robots
|
||||
# predefined variables:
|
||||
# $type, $fromname, $fromaddr, $toname, $toaddr. $subject, $text
|
||||
#
|
||||
# $type is one of the following: "afix", "ffix", "tosysop", or undef
|
||||
# for messages from areafix, filefix, messages generated to sysop
|
||||
# and of unknown origin, respectively.
|
||||
#
|
||||
# return:
|
||||
# 0 to ignore any changes
|
||||
# 1 to update message fields
|
||||
|
||||
return 0;
|
||||
}
|
||||
3
tools/cp437-tz.sh
Executable file
3
tools/cp437-tz.sh
Executable file
@ -0,0 +1,3 @@
|
||||
#!/bin/bash
|
||||
|
||||
(echo -e \\x01CHRS: CP437 2 && echo -e \\x01TZUTC: 1000 && cat)
|
||||
506
tools/filter.pl
Executable file
506
tools/filter.pl
Executable file
@ -0,0 +1,506 @@
|
||||
# $Id$
|
||||
# Template for perl hook
|
||||
#
|
||||
# API functions:
|
||||
#
|
||||
# w_log([level, ]str);
|
||||
# outputs a string to hpt log
|
||||
# no printf() format, use sprintf()!
|
||||
#
|
||||
# crc32(str)
|
||||
# returns CRC-32 of string
|
||||
#
|
||||
# alike(s1, s2)
|
||||
# return Levenstein distance between parameters (smaller -> more alike)
|
||||
#
|
||||
# putMsgInArea(area, fromname, toname, fromaddr, toaddr,
|
||||
# subject, date, attr, text, addkludges);
|
||||
# post to first netmail area if area eq "";
|
||||
# set current date if date eq "";
|
||||
# set fromaddr to ouraka if fromaddr eq "";
|
||||
# attr -- binary or text string (i.e. "pvt loc k/s") (text form DEPRECATED!);
|
||||
# date -- unixtime, as in time()
|
||||
# addkludges can be:
|
||||
# 0 not to add any kludges
|
||||
# 1 to add required kludges (will add duplicates if they exist)
|
||||
# 2 to add missing kludges (will never modify existing ones)
|
||||
# 3 to update or add required kludges corresponding to addresses and flags
|
||||
# required kludges are: (netmail) INTL, TOPT, FMPT; (all) FLAGS, MSGID
|
||||
#
|
||||
# myaddr()
|
||||
# returns array of our addresses
|
||||
# DEPRECATED! use @{$config{addr}} instead
|
||||
#
|
||||
# nodelistDir()
|
||||
# returns nodelistDir from config
|
||||
# DEPRECATED! use $config{nodelistDir} instead
|
||||
#
|
||||
# str2attr(att)
|
||||
# converts attribute string to binary message attributes
|
||||
#
|
||||
# attr2str(attr)
|
||||
# converts binary flags to string representation (Pvt Loc K/s)
|
||||
#
|
||||
# flv2str(flavour)
|
||||
# converts binary flag, corresponding to flavour, to string (direct, crash)
|
||||
#
|
||||
# date2fts(time)
|
||||
# converts unixtime to fts-1 format string ("dd mmm yy hh:mm:ss")
|
||||
#
|
||||
# fts2date(fts1)
|
||||
# converts date in fts-1 format string to unixtime
|
||||
#
|
||||
# mktime(sec, min, hour, wday, mon, year[, wday, yday[, dst]])
|
||||
# makes unixtime like POSIX mktime, but year:
|
||||
# year 0..69 -> 2000..2069, 70..1900 -> 1970..3800, other -> as-is
|
||||
# month'es: 0 - January, 1 - February, ..., 11 - December (as in POSIX)
|
||||
# dst - daylight saving time flag (1 or 0)
|
||||
# WARNING: dst can result in +/-1 hour mismatch; use mktime(localtime) for
|
||||
# correct unixtime
|
||||
#
|
||||
# strftime(format, unixtime)
|
||||
# strftime(format, sec, min, hour, wday, mon, year[, wday, yday[, dst]])
|
||||
# converts unixtime or a time structure to string according to format
|
||||
# man strftime() for details
|
||||
#
|
||||
# gmtoff([unixtime])
|
||||
# returns difference between local time and UTC in hours (e.g., can be +4.5)
|
||||
# if unixtime is omitted, current time used
|
||||
#
|
||||
# WARNING: Don't redefine already predefined variable via my() or local().
|
||||
# otherwise their values will not be put back into hpt.
|
||||
#
|
||||
|
||||
#use strict;
|
||||
|
||||
#== GLOBAL CONFIGURATION PARAMETERS - DO NOT CHANGE ==#
|
||||
#http://ftsc.org/docs/fsc-0036.001
|
||||
|
||||
$DEBUG_MODE = 1;
|
||||
$MSG_PRIVATE = 0x0001; #/ Private Message
|
||||
$MSG_CRASH = 0x0002; #/ Crash Priority Message
|
||||
$MSG_READ = 0x0004; #/ Read by addressee
|
||||
$MSG_SENT = 0x0008; #/ Sent Okay
|
||||
$MSG_FILE = 0x0010; #/ File Attached
|
||||
$MSG_FWD = 0x0020; #/ Being forwarded
|
||||
$MSG_ORPHAN = 0x0040; #/ Unknown destination
|
||||
$MSG_KILL = 0x0080; #/ Kill after mailing
|
||||
$MSG_LOCAL = 0x0100; #/ Message originated here
|
||||
$MSG_HOLD = 0x0200; #/ Hold for pickup
|
||||
$MSG_X2 = 0x0400; #/ Reserved - Sent
|
||||
$MSG_FREQ = 0x0800; #/ Requesting a file
|
||||
$MSG_RREQ = 0x1000; #/ Return RCPT requested
|
||||
$MSG_RRCT = 0x2000; #/ Return RCPT
|
||||
$MSG_RAUD = 0x4000; #/ Request Audit Trail
|
||||
$MSG_UREQ = 0x8000; #/ Request File Update
|
||||
|
||||
#== LOCAL CONFIGURATION ==#
|
||||
|
||||
# Message area to post route messages.
|
||||
$ROUTE_NOTICE = 'PVT_TEST';
|
||||
$FILTER_ORIGIN = 'Alterant MailHUB at your service'; # Text to add to tearline
|
||||
$FILTER_TEARLINE = 'HPT-perl hook';
|
||||
$FILTER_FROM = 'Hub Robot';
|
||||
$SEMAFORE_DIR = '/fido/semafore';
|
||||
|
||||
@MY_POINTS = (
|
||||
'618:510/1.1',
|
||||
'10:999/1.1'
|
||||
);
|
||||
|
||||
sub bounce
|
||||
{
|
||||
my($fromname,$fromaddr,$toname,$toaddr,$date,$subject,$text,$reason,$myaddr) = @_;
|
||||
my($bouncetext);
|
||||
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1',"filter-hub.pl: bounce: Bouncing message back to [$fromaddr]");
|
||||
}
|
||||
|
||||
$text =~ tr/\r/\n/;
|
||||
$text =~ s/\n\x01/\n\@/gs;
|
||||
$text =~ s/^\x01/\@/s;
|
||||
$bouncetext = <<EOF;
|
||||
Hello $fromname.
|
||||
|
||||
Your message failed to be processed at this hub with reason:
|
||||
|
||||
$reason
|
||||
|
||||
Is this incorrect? If so let me know via netmail or deon\@leenooks.net
|
||||
|
||||
Orignal message:
|
||||
|
||||
============================================================================
|
||||
FROM: $fromname ($fromaddr)
|
||||
TO : $toname ($toaddr)
|
||||
SUBJ: $subject
|
||||
DATE: $date
|
||||
============================================================================
|
||||
$text
|
||||
============================================================================
|
||||
--- $FILTER_TEARLINE
|
||||
* Origin: $FILTER_ORIGIN ($myaddr)
|
||||
EOF
|
||||
$attr = ($MSG_LOCAL | $MSG_KILL | $MSG_PRIVATE | $MSG_RRCPT);
|
||||
putMsgInArea('',$FILTER_FROM,$fromname,$myaddr,$fromaddr,'Unable to deliver your Netmail','',$attr,add_tz($bouncetext),1);
|
||||
|
||||
if ($ROUTE_NOTICE) {
|
||||
putMsgInArea($ROUTE_NOTICE,$FILTER_FROM,$fromname,$toaddr,$fromaddr,$subject,$date,$MSG_LOCAL,
|
||||
add_tz("Unable to deliver Netmail\rhpt> $reason.\r\r".$text),0);
|
||||
$newecho = 1;
|
||||
}
|
||||
|
||||
$newnet = 1;
|
||||
return $reason;
|
||||
}
|
||||
|
||||
sub testmsg_config
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter-hub.pl: testmsg_config');
|
||||
}
|
||||
|
||||
# Work out origin address to use.
|
||||
# testarea list, value "1" for ordinary areas, value "2" for passthrough areas.
|
||||
if ($pktfrom =~ /^10:/) {
|
||||
$myaddr = '10:1/1'; # Robot address
|
||||
$testarea{'PVT_TEST'} = 1; # Echobase is exists
|
||||
$testarea{'DOVE-OPS'} = 1; # Echobase is exists
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
w_log('1',"filter.pl: testmail_config: PRIVATE NET source using [$myaddr]");
|
||||
}
|
||||
|
||||
} elsif ($pktfrom =~ /^21:/) {
|
||||
$myaddr = '21:3/100';
|
||||
$testarea{'FSX_TST'} = 1;
|
||||
|
||||
} elsif ($pktfrom =~ /^24:/) {
|
||||
$myaddr = '24:24/1';
|
||||
$testarea{'SN_CHAT'} = 1;
|
||||
|
||||
} elsif ($pktfrom =~ /^516:/) {
|
||||
$myaddr = '516:516/0';
|
||||
$testarea{'VTX_TEST'} = 1;
|
||||
|
||||
} elsif ($pktfrom =~ /^618:/) {
|
||||
$myaddr = '618:510/1';
|
||||
$testarea{'MIN_R15TEST'} = 1;
|
||||
$testarea{'MIN_TEST'} = 1;
|
||||
|
||||
} elsif ($pktfrom =~ /^1337:/) {
|
||||
$myaddr = '1337:2/100';
|
||||
$testarea{'TQW_TEST'} = 1;
|
||||
|
||||
} else {
|
||||
w_log('1',"filter.pl: testmail_config: DEFAULT packet source ($pktfrom) using default [$config{addr}[0]]");
|
||||
|
||||
$myaddr=$config{addr}[0];
|
||||
}
|
||||
}
|
||||
|
||||
sub route_config
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1',"filter-hub.pl: route_config for [$toaddr]");
|
||||
}
|
||||
|
||||
if ($toaddr =~ /^10:/) {
|
||||
$check_exists = 1;
|
||||
$myaddr = '10:1/1';
|
||||
|
||||
} elsif ($toaddr =~ /^21:3\//) {
|
||||
$check_exists = 1;
|
||||
$myaddr = '21:3/100';
|
||||
|
||||
} elsif ($toaddr =~ /^24:/) {
|
||||
$check_exists = 1;
|
||||
$myaddr = '24:24/1';
|
||||
|
||||
} elsif ($toaddr =~ /^618:510\//) {
|
||||
$check_exists = 1;
|
||||
$myaddr = '618:510/1';
|
||||
|
||||
} elsif ($toaddr =~ /^1337:2\//) {
|
||||
$check_exists = 1;
|
||||
$myaddr = '1337:2/100';
|
||||
|
||||
} else {
|
||||
w_log('1',"filter.pl: route_config: DEFAULT packet toddr ($toaddr) using default [$config{addr}[0]]");
|
||||
$check_exists = 0;
|
||||
$myaddr=$config{addr}[0];
|
||||
}
|
||||
}
|
||||
|
||||
# == LOCAL FUNCTIONS ==
|
||||
sub add_tz
|
||||
{
|
||||
my ($msg) = @_;
|
||||
$TZ = strftime("%z",localtime());
|
||||
$TZ =~ s/^\+//;
|
||||
|
||||
# Add a TZ kludge
|
||||
return "\x01TZUTC: $TZ\r".$msg;
|
||||
}
|
||||
|
||||
BEGIN{
|
||||
require "/usr/local/tools/filters/filter-testmsg.pl";
|
||||
require "/usr/local/tools/filters/filter-hub.pl";
|
||||
require "/usr/local/tools/filters/filter-route.pl";
|
||||
}
|
||||
|
||||
sub filter
|
||||
{
|
||||
# predefined variables:
|
||||
# $fromname, $fromaddr, $toname,
|
||||
# $toaddr (for netmail),
|
||||
# $area (for echomail),
|
||||
# $subject, $text, $pktfrom, $date, $attr
|
||||
# $secure (defined if message from secure link)
|
||||
# return "" or reason for moving to badArea
|
||||
# set $kill for kill the message (not move to badarea)
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr, $date
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: filter');
|
||||
}
|
||||
testmsg();
|
||||
|
||||
my $r=filter_hub();
|
||||
w_log('1',"filter.pl: filter_hub [$r].");
|
||||
return $r if (length($r)>0);
|
||||
|
||||
my $r=validate_route();
|
||||
w_log('1',"filter.pl: validate_route [$r].");
|
||||
return $r if (length($r)>0);
|
||||
|
||||
# If we get here, and a netmail, we'll trigger a pack
|
||||
if (! $area && $toaddr)
|
||||
{
|
||||
$newnet = 1;
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub put_msg
|
||||
{
|
||||
# predefined variables:
|
||||
# $fromname, $fromaddr, $toname, $toaddr,
|
||||
# $area (areatag in config),
|
||||
# $subject, $text, $date, $attr
|
||||
# return:
|
||||
# 0 not to put message in base
|
||||
# 1 to put message as usual
|
||||
# 2 to put message without recoding
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr, $date
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: put_msg');
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub scan
|
||||
{
|
||||
# predefined variables:
|
||||
# $area, $fromname, $fromaddr, $toname,
|
||||
# $toaddr (for netmail),
|
||||
# $subject, $text, $date, $attr
|
||||
# return "" or reason for dont packing to downlinks
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr, $date
|
||||
# set $kill to 1 to delete message after processing (even if it's not sent)
|
||||
# set $addvia to 0 not to add via string when packing
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: scan');
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub export
|
||||
{
|
||||
# predefined variables:
|
||||
# $area, $fromname, $toname, $subject, $text, $date, $attr,
|
||||
# $toaddr (address of link to export this message to),
|
||||
# return "" or reason for dont exporting message to this link
|
||||
# set $change to update $text, $subject, $fromname, $toname, $attr, $date
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: export');
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub route
|
||||
{
|
||||
# $addr = dest addr
|
||||
# $from = orig addr
|
||||
# $fromname = from user name
|
||||
# $toname = to user name
|
||||
# $date = message date and time
|
||||
# $subj = subject line
|
||||
# $text = message text
|
||||
# $attr = message attributes
|
||||
# $route = default route address (by config rules)
|
||||
# $flavour = default route flavour (by config rules)
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr
|
||||
# set $flavour to flag, corresponding to flavour,
|
||||
# or string hold|normal|crash|direct|immediate
|
||||
# set $addvia to 0 not to add via string when packing
|
||||
# return route addr or "" for default routing
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub tossbad
|
||||
{
|
||||
# $fromname, $fromaddr, $toname,
|
||||
# $toaddr (for netmail),
|
||||
# $area (for echomail),
|
||||
# $subject, $text, $pktfrom, $date, $attr
|
||||
# $reason
|
||||
# return non-empty string for kill the message
|
||||
# set $change to update $text, $subject, $fromaddr, $toaddr,
|
||||
# $fromname, $toname, $attr
|
||||
return '';
|
||||
}
|
||||
|
||||
sub hpt_start
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: hpt_start');
|
||||
}
|
||||
}
|
||||
|
||||
sub hpt_exit
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: hpt_end');
|
||||
}
|
||||
|
||||
local(*F);
|
||||
untie %nodelist if $nltied;
|
||||
untie %msg if $msgtied;
|
||||
|
||||
$nltied = $msgtied = 0;
|
||||
close(F) if $newnet && open(F,">$SEMAFORE_DIR/newnet.now");
|
||||
close(F) if $newecho && open(F,">$SEMAFORE_DIR/newecho.now");
|
||||
close(F) if $newhtick && open(F,">$SEMAFORE_DIR/newhtick.now");
|
||||
}
|
||||
|
||||
sub process_pkt
|
||||
{
|
||||
# $pktname - name of pkt
|
||||
# $secure - defined for secure pkt
|
||||
# return non-empty string for rejecting pkt (don't process, rename to *.flt)
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: process_pkt');
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub pkt_done
|
||||
{
|
||||
# $pktname - name of pkt
|
||||
# $rc - exit code (0 - OK)
|
||||
# $res - reason (text line)
|
||||
# 0 - OK ($res undefined)
|
||||
# 1 - Security violation
|
||||
# 2 - Can't open pkt
|
||||
# 3 - Bad pkt format
|
||||
# 4 - Not to us
|
||||
# 5 - Msg tossing problem
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: pkt_done');
|
||||
}
|
||||
}
|
||||
|
||||
sub after_unpack
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: after_unpack');
|
||||
}
|
||||
}
|
||||
|
||||
sub before_pack
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: before_pack');
|
||||
}
|
||||
}
|
||||
|
||||
sub on_echolist
|
||||
{
|
||||
# $_[0] - type (0: %list, 1: %query, 2: %unlinked)
|
||||
# $_[1] - reference to array of echotags
|
||||
# $_[2] - link aka
|
||||
# $_[3] - max tag length in @{$_[1]}
|
||||
# return:
|
||||
# 0 to generate hpt-standard list
|
||||
# 1 to return $report value as result
|
||||
# 2 to use $report value as list and append hpt standard footer
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: on_echolist');
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_afixcmd
|
||||
{
|
||||
# $_[0] - command code (see #define's in areafix.h)
|
||||
# $_[1] - link aka
|
||||
# $_[2] - request line
|
||||
# return:
|
||||
# 0 to process command by hpt logic
|
||||
# 1 to skip hpt logic and return $report value as result
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: on_afixcmd');
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_afixreq
|
||||
{
|
||||
# predefined variables:
|
||||
# $fromname, $fromaddr, $toname, $toaddr. $subject, $text, $pktfrom
|
||||
# return:
|
||||
# 0 to ignore any changes
|
||||
# 1 to update request parameters from above-mentioned variables
|
||||
# (note: only $fromaddr and $text are meaningful for processing)
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter.pl: on_afixreq');
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub on_robotmsg
|
||||
{
|
||||
# process messages generated by robots
|
||||
# predefined variables:
|
||||
# $type, $fromname, $fromaddr, $toname, $toaddr. $subject, $text
|
||||
#
|
||||
# $type is one of the following: "afix", "ffix", "tosysop", or undef
|
||||
# for messages from areafix, filefix, messages generated to sysop
|
||||
# and of unknown origin, respectively.
|
||||
#
|
||||
# return:
|
||||
# 0 to ignore any changes
|
||||
# 1 to update message fields
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1',"filter.pl: on_robotmsg [$type]");
|
||||
}
|
||||
|
||||
if ($type eq "areafix") {
|
||||
$newnet = 1;
|
||||
} elsif ($type eq "filefix") {
|
||||
$newhtick = 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
212
tools/filters/filter-hub.pl
Normal file
212
tools/filters/filter-hub.pl
Normal file
@ -0,0 +1,212 @@
|
||||
# Local defines
|
||||
|
||||
# The filter_hub() subroutine should
|
||||
#
|
||||
# usage example:
|
||||
# ==============
|
||||
# BEGIN{ require "filter-hub.pl" }
|
||||
# sub filter() {
|
||||
# my $r=filter_hub();
|
||||
# return $r if( length($r)>0 );
|
||||
# ...some other functions...
|
||||
# }
|
||||
# sub process_pkt{}
|
||||
# sub after_unpack{}
|
||||
# sub before_pack{}
|
||||
# sub pkt_done{}
|
||||
# sub scan{}
|
||||
# sub route{}
|
||||
# sub hpt_exit{}
|
||||
# ==============
|
||||
|
||||
#use strict;
|
||||
|
||||
# predefined variables
|
||||
#my($fromname, $toname, $fromaddr, $toaddr, $subject, $date, $text, $attr);
|
||||
#my($secure, $pktname, $rc, $res, $area, $pktfrom, $addr, $from);
|
||||
#my($kill, $change, $flavour);
|
||||
|
||||
# My global variables
|
||||
|
||||
sub filter_hub
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter-hub.pl: filter_hub()');
|
||||
}
|
||||
|
||||
# EchoMail Processing
|
||||
if (defined($area)) {
|
||||
w_log('J','No checking for echomail!');
|
||||
return '';
|
||||
}
|
||||
|
||||
# Validate netmail routing
|
||||
w_log('L',"Netmail: From [$fromaddr] to [$toaddr]");
|
||||
|
||||
# Check if Netmail is to me or a point of mine
|
||||
if (grep(/^$toaddr$/,@{$config{addr}}))
|
||||
{
|
||||
w_log('1',"Netmail: To the HUB address [$toaddr] (To:$toname <- From:$fromname).");
|
||||
|
||||
# Ping messages
|
||||
if ($toname =~ /^ping$/i) {
|
||||
w_log('L',"Netmail: PING from [$fromaddr].");
|
||||
|
||||
if ($attr & $MSG_RRCT) {
|
||||
putMsgInArea('BADMAIL',$fromname,$toname,$fromaddr,$toaddr,$subject,$date,($MSG_SENT | $MSG_READ | $MSG_PRIVATE),
|
||||
"hpt> Ping request with RRC\r".$text,0);
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return 'Ping request with RRC';
|
||||
}
|
||||
|
||||
$text =~ s/\r\x01/\r\@/gs;
|
||||
$text =~ s/^\x01/\@/s;
|
||||
$time = localtime;
|
||||
$text = <<EOF;
|
||||
Hello $fromname,
|
||||
|
||||
Your PING message received by my system at $time.
|
||||
|
||||
Original message:
|
||||
============================================================================
|
||||
From : $fromname ($fromaddr)
|
||||
To : $toname ($toaddr)
|
||||
Subject: $subject
|
||||
Date : $date
|
||||
----------------------------------------------------------------------------
|
||||
$text
|
||||
============================================================================
|
||||
EOF
|
||||
|
||||
putMsgInArea('',$FILTER_FROM,$fromname,$toaddr,$fromaddr,'Ping Reply','',($MSG_PRIVATE | $MSG_LOCAL | $MSG_RRCT),add_tz($text),1);
|
||||
$newnet = 1;
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "Ping from $fromaddr";
|
||||
|
||||
} elsif ($toname =~ /^(area|file)fix$/i) {
|
||||
w_log('L',"Netmail: *FIX. [$fromaddr]");
|
||||
|
||||
if ($attr & $MSG_RRCT) {
|
||||
putMsgInArea('BADMAIL',$fromname,$toname,$fromaddr,$toaddr,$subject,$date,($MSG_SENT | $MSG_READ | $MSG_PRIVATE),
|
||||
"hpt> $toname request with RRC\r" . $text, 0);
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "$toname request with RRC";
|
||||
}
|
||||
|
||||
if (lc($toname) eq 'filefix')
|
||||
{
|
||||
putMsgInArea('robots',$fromname,$toname,$fromaddr,$toaddr,$subject,$date,($MSG_PRIVATE),
|
||||
$text, 0);
|
||||
w_log('L',"Netmail: *FIX. Copied to robots [$fromaddr]");
|
||||
|
||||
$newhtick = 1;
|
||||
|
||||
$kill = 1;
|
||||
}
|
||||
|
||||
# Messages to *fix are OK
|
||||
return '';
|
||||
|
||||
} elsif ($fromname =~ /^rexfix$/i) {
|
||||
w_log('L',"Netmail: From REXFIX. [$fromaddr]");
|
||||
|
||||
# Messages from rexfix are OK
|
||||
return '';
|
||||
|
||||
} elsif ($toname =~ /^(coordinator)$/i) {
|
||||
w_log('L',"Netmail: MAKENL Processing. [$fromaddr] ($attr)");
|
||||
|
||||
if ($ROUTE_NOTICE) {
|
||||
putMsgInArea($ROUTE_NOTICE,$fromname,$toname,$fromaddr,$toaddr,$subject,$date,($MSG_READ|$MSG_SENT),
|
||||
add_tz("Unable to deliver Netmail\rhpt> Unprotected message from unlisted system.\r\r".$text),0);
|
||||
$newecho = 1;
|
||||
}
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "$toname reply from MakeNL";
|
||||
|
||||
} elsif ($toname =~ /^$FILTER_FROM$/i) {
|
||||
w_log('L',"Netmail: Message to me, how nice... [$fromaddr] ($attr)");
|
||||
|
||||
if ($ROUTE_NOTICE) {
|
||||
putMsgInArea($ROUTE_NOTICE,$fromname,$toname,$fromaddr,$toaddr,$subject,$date,($MSG_READ|$MSG_SENT),
|
||||
add_tz("I have friends!\rhpt> Netmail to me on the hub.\r\r".$text),0);
|
||||
$newecho = 1;
|
||||
}
|
||||
|
||||
# Messages to the Robot are OK
|
||||
return '';
|
||||
|
||||
} else {
|
||||
if (($attr & $MSG_RREQ) || ($attr & $MSG_RAUD)) {
|
||||
w_log('L',"Netmail: RRQ ARQ.");
|
||||
receipt($fromaddr, $toaddr, $fromname, $toname, $subject, $date);
|
||||
}
|
||||
|
||||
w_log('L',"Netmail: To user on Hub - but nobody here? [$attr]");
|
||||
bounce($fromname,$fromaddr,$toname,$toaddr,$date,$subject,$text,'Sorry, the HUB is unattended',$toaddr);
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "Message to HUB";
|
||||
}
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
# ========================================================================
|
||||
# local functions
|
||||
# ========================================================================
|
||||
|
||||
sub receipt
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1',"filter-hub.pl: receipt()");
|
||||
}
|
||||
|
||||
my($fromaddr,$toaddr,$fromname,$toname,$subject,$date) = @_;
|
||||
my($text);
|
||||
$text = <<EOF;
|
||||
Hello $fromname!
|
||||
|
||||
Your message to $toname successfully delivered.
|
||||
|
||||
Original message header:
|
||||
=============================================================
|
||||
From : $fromname ($fromaddr)
|
||||
To : $toname ($toaddr)
|
||||
Subject: $subject
|
||||
Date : $date
|
||||
=============================================================
|
||||
EOF
|
||||
|
||||
putMsgInArea('',$FILTER_FROM,$fromname,$toaddr,$fromaddr,'Return Receipt Response','',($MSG_PRIVATE | $MSG_KILL | $MSG_LOCAL | $MSG_RRCT),
|
||||
add_tz($text),1);
|
||||
$newnet = 1;
|
||||
}
|
||||
|
||||
w_log('U',"filter-hub is LOADED");
|
||||
1;
|
||||
506
tools/filters/filter-route.pl
Normal file
506
tools/filters/filter-route.pl
Normal file
@ -0,0 +1,506 @@
|
||||
# Local defines
|
||||
|
||||
# The validate_route() subroutine should
|
||||
#
|
||||
# usage example:
|
||||
# ==============
|
||||
# BEGIN{ require "filter-route.pl" }
|
||||
# sub filter() {
|
||||
# my $r=validate_route();
|
||||
# return $r if( length($r)>0 );
|
||||
# ...some other functions...
|
||||
# }
|
||||
# sub process_pkt{}
|
||||
# sub after_unpack{}
|
||||
# sub before_pack{}
|
||||
# sub pkt_done{}
|
||||
# sub scan{}
|
||||
# sub route{}
|
||||
# sub hpt_exit{}
|
||||
# ==============
|
||||
|
||||
sub nldb { return "/fido/nodelist/nodelist.db"; }
|
||||
sub history { return "/fido/dupes/history"; }
|
||||
|
||||
use DB_File;
|
||||
use Fcntl ":flock";
|
||||
use POSIX;
|
||||
|
||||
#use strict;
|
||||
|
||||
# predefined variables
|
||||
#my($fromname, $toname, $fromaddr, $toaddr, $subject, $date, $text, $attr);
|
||||
#my($secure, $pktname, $rc, $res, $area, $pktfrom, $addr, $from);
|
||||
#my($kill, $change, $flavour);
|
||||
|
||||
# My global variables
|
||||
my(%nodelist, $nltied);
|
||||
my(%pkt, %msg, $msgtied);
|
||||
my($processpktname, $pktkey, $pktval, %msgpkt, $curnodelist);
|
||||
|
||||
sub validate_route
|
||||
{
|
||||
local(*F);
|
||||
local $check_exists; # Should routing checking be done
|
||||
local $myaddr; # Robot address
|
||||
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter-route.pl: validate_route()');
|
||||
}
|
||||
|
||||
# EchoMail Processing
|
||||
if (defined($area)) {
|
||||
w_log('J','No routing for echomail!');
|
||||
return '';
|
||||
}
|
||||
|
||||
# Validate netmail routing
|
||||
$fromaddr =~ s/\.0$//;
|
||||
$toaddr =~ s/\.0$//;
|
||||
$fromboss = $fromaddr;
|
||||
$fromboss =~ s/\.\d+$//;
|
||||
$toboss = $toaddr;
|
||||
$toboss =~ s/\.\d+$//;
|
||||
w_log('L',"Netmail: From [$fromaddr] ($fromboss) to [$toaddr] ($toboss)");
|
||||
|
||||
route_config();
|
||||
|
||||
# Message from secure link
|
||||
if ($secure) {
|
||||
w_log('L',"Netmail: From secure link.");
|
||||
|
||||
compileNL() unless $nltied;
|
||||
|
||||
# Netmail to node not listed rejected
|
||||
if ($check_exists && $nltied && !defined($nodelist{$toboss})) {
|
||||
w_log('1',"Netmail: Bouncing netmail from [$fromaddr], [$toaddr] not in nodelist.");
|
||||
bounce($fromname,$fromaddr,$toname,$toaddr,$date,$subject,$text,"Node $toboss missing in NODELIST",$myaddr);
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "Node $toboss missing in NODELIST";
|
||||
}
|
||||
|
||||
} else {
|
||||
w_log('L',"Netmail: NOT from secure link.");
|
||||
|
||||
# Dont accept file attaches from unsecure links.
|
||||
#if (isattr("att",$attr)) {
|
||||
# putMsgInArea("PVT_TEST", $fromname, $toname, $fromaddr, $toaddr, $subject, $date, "pvt sent read", "hpt> FileAttach from unsecure link\r" . $text, 0);
|
||||
#
|
||||
# if ($DEBUG_MODE) {
|
||||
# return '';
|
||||
# }
|
||||
#
|
||||
# $kill = 1;
|
||||
# return "FileAttach from unsecure link";
|
||||
#}
|
||||
|
||||
# Check if any messages from my systems which havent been secured
|
||||
#if ($fromaddr =~ /^(2:463\/68|2:46\/128)(\.\d+)?$/) {
|
||||
# putMsgInArea("PVT_TEST", $fromname, $toname, $fromaddr, $toaddr, $subject, $date, "pvt sent read", "hpt> Unprotected message from my system\r" . $text, 0);
|
||||
#
|
||||
# if ($DEBUG_MODE) {
|
||||
# return '';
|
||||
# }
|
||||
#
|
||||
# $kill = 1;
|
||||
# return "Unprotected message from my system";
|
||||
#}
|
||||
|
||||
compileNL() unless $nltied;
|
||||
|
||||
# Message from system not listed in the nodelist
|
||||
if ($check_exists && $nltied && !defined($nodelist{$fromboss})) {
|
||||
if ($ROUTE_NOTICE) {
|
||||
putMsgInArea($ROUTE_NOTICE,$fromname,$toname,$fromaddr,$toaddr,$subject,$date,($MSG_READ|$MSG_SENT),
|
||||
add_tz("Unable to deliver Netmail\rhpt> Unprotected message from unlisted system.\r\r".$text),0);
|
||||
$newecho = 1;
|
||||
}
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "Unprotected message from unlisted system";
|
||||
|
||||
#} unless ($toaddr =~ /^(2:463\/68(\.\d+)?|2:46\/128(\.\d+)?|2:463\/59\.4|17:.*)$/) {
|
||||
#bounce($fromname,$fromaddr,$toname,$toaddr,$date,$subject,$text,"Unprotected outgoing message",$myaddr);
|
||||
##putMsgInArea("PVT_TEST", $fromname, $toname, $fromaddr, $toaddr, $subject, $date, "pvt sent read", "hpt> Unprotected outgoing message\r" . $text, 0);
|
||||
#
|
||||
#if ($DEBUG_MODE) {
|
||||
# return '';
|
||||
#}
|
||||
#
|
||||
#$kill = 1;
|
||||
#return "Unprotected outgoing message";
|
||||
}
|
||||
}
|
||||
|
||||
# --> Message is from a known system <--
|
||||
|
||||
# Check if Netmail is to me or a point of mine
|
||||
if (grep(/^$toboss$/,@{$config{addr}}))
|
||||
{
|
||||
w_log('1',"Netmail: BOSS addresses [@{$config{addr}}] points [@MY_POINTS].");
|
||||
|
||||
# Netmail is to a point
|
||||
if (! grep(/^$toaddr$/,@{$config{addr}}))
|
||||
{
|
||||
w_log('1',"Netmail: TOBOSS [$toboss] TOADDR [$toaddr] [@MY_POINTS].");
|
||||
|
||||
$knownpoint = 0;
|
||||
foreach(@MY_POINTS) {
|
||||
$knownpoint = 1 if $_ eq $toaddr;
|
||||
|
||||
} unless ($knownpoint) {
|
||||
bounce($fromname,$fromaddr,$toname,$toaddr,$date,$subject,$text,"Node not defined here $toaddr.",$myaddr);
|
||||
|
||||
if ($ROUTE_NOTICE) {
|
||||
putMsgInArea($ROUTE_NOTICE,$fromname,$toname,$fromaddr,$toaddr,$subject,$date,$MSG_LOCAL,add_tz("hpt> Node not defined here $toaddr\r".$text),0);
|
||||
$newecho = 1;
|
||||
}
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "Node node defined here $toaddr";
|
||||
}
|
||||
|
||||
# Netmail is to me
|
||||
}
|
||||
}
|
||||
|
||||
# Transit message
|
||||
w_log('L','Netmail: In Transit.');
|
||||
|
||||
# Dupe- and loop- check
|
||||
opendupe();
|
||||
@lines = split('\r',$text);
|
||||
|
||||
if ($msgtied) {
|
||||
($msgid) = grep(/^\x01MSGID:/,@lines);
|
||||
w_log('L',"Loop check for [$msgid]");
|
||||
|
||||
if ($msgid) {
|
||||
$msgid =~ s/^\x01MSGID:\s*//;
|
||||
$msgid =~ tr/A-Z/a-z/;
|
||||
|
||||
} else {
|
||||
$msgid = sprintf('C%s %08x',$fromaddr,crc32($date.join(' ',grep(!/^(\x01(Via|Recd|Forwarded))(:|\s)/,@lines))));
|
||||
}
|
||||
|
||||
$key = sprintf('NETMAIL|%s|%s|%08x',$msgid,$toaddr,crc32($fromname.$toname.$subject));
|
||||
$path = $lastpath = '';
|
||||
|
||||
foreach(grep(/^\x01(Via|Recd|Forwarded):?\s/,@lines)) {
|
||||
next unless m#(\d+:\d+/\d+(?:\.\d+)?)(\@|\s)#;
|
||||
next if $lastpath eq $1;
|
||||
$lastpath = $1;
|
||||
$path .= ' ' if $path;
|
||||
$path .= $1;
|
||||
}
|
||||
|
||||
$curtime = time();
|
||||
w_log('L',"DEBUG: Loop check path [$path] key ($key)");
|
||||
|
||||
# Dupe or Loop
|
||||
if ($oldval=checkdupe($key)) {
|
||||
$dupetext = $text;
|
||||
$dupetext =~ s/\r\n?/\n/gs;
|
||||
($oldtime, $oldpath, $oldpktfrom) = split(/\|/, $oldval);
|
||||
$oldtime = localtime($oldtime);
|
||||
w_log('L',"DEBUG: Loop check oldpath [$oldpath] pktfrom ($pktfrom) oldpktfrom ($oldpktfrom)");
|
||||
|
||||
# Dupe
|
||||
if ($path eq $oldpath && $oldpktfrom eq $pktfrom) {
|
||||
w_log('L','Netmail: In Transit Dupe.');
|
||||
$dupetext = <<EOF;
|
||||
Pkt from: $pktfrom
|
||||
Original msg arrived: $oldtime
|
||||
$dupetext
|
||||
EOF
|
||||
|
||||
if ($ROUTE_NOTICE) {
|
||||
putMsgInArea($ROUTE_NOTICE,$fromname,$toname,$fromaddr,'',$subject,$date,($MSG_LOCAL|$MSG_READ),
|
||||
add_tz("hpt> Duplicate netmail in transit to $toaddr\r".$dupetext),0);
|
||||
$newecho = 1;
|
||||
}
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "Duplicate netmail in transit to $toaddr";
|
||||
|
||||
# Loop
|
||||
} else {
|
||||
w_log('L',"Netmail: In Transit Loop.");
|
||||
|
||||
bounce($fromname,$fromaddr,$toname,$toaddr,$date,$subject,$text,"Netmail looping to $toaddr",$myaddr);
|
||||
$newnet = 1;
|
||||
|
||||
if ($ROUTE_NOTICE) {
|
||||
putMsgInArea($ROUTE_NOTICE,$fromname,$toname,$fromaddr,'',$subject,$date,($MSG_LOCAL|$MSG_READ),
|
||||
add_tz("hpt> Netmail looping to $toaddr\r".$text),0);
|
||||
$newecho = 1;
|
||||
}
|
||||
|
||||
if ($DEBUG_MODE) {
|
||||
return '';
|
||||
}
|
||||
|
||||
$kill = 1;
|
||||
return "Netmail looping to $toaddr";
|
||||
}
|
||||
}
|
||||
|
||||
adddupe($key,"$curtime|$path|$pktfrom");
|
||||
}
|
||||
|
||||
# ARQ
|
||||
if ($attr & $MSG_RAUD)
|
||||
{
|
||||
w_log('L','Netmail: ARQ.');
|
||||
arqcpt($fromaddr,$toaddr,$fromname,$toname,$subject,$date,$attr,$text);
|
||||
}
|
||||
|
||||
$newnet = 1;
|
||||
return '';
|
||||
}
|
||||
|
||||
# ========================================================================
|
||||
# local functions
|
||||
# ========================================================================
|
||||
|
||||
sub opendupe
|
||||
{
|
||||
return if $msgtied;
|
||||
unless (open(H,'+<'.history) || open(H,'+>'.history))
|
||||
{
|
||||
writeLogEntry(2,"Can't open history: $!");
|
||||
return;
|
||||
}
|
||||
|
||||
flock(H,&LOCK_EX);
|
||||
seek(H,0,2);
|
||||
unless ($msgtied=tie(%msg,'DB_File',history.'.db',O_RDWR|O_CREAT,0644))
|
||||
{
|
||||
writeLogEntry(2,"Can't open dupebase: $!");
|
||||
flock(H,&LOCK_UN);
|
||||
close(H);
|
||||
return;
|
||||
}
|
||||
|
||||
# new dupebase
|
||||
if (!defined($msg{pack('L',0)}))
|
||||
{
|
||||
my($sec,$min,$hour,$mday) = localtime();
|
||||
$msg{pack('L',0)} = pack('C',$mday);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub checkdupe
|
||||
{
|
||||
my($key,$val) = @_;
|
||||
my($crckey,$binkey,$oldkey,$oldval);
|
||||
|
||||
$crckey = crc32($key);
|
||||
$binkey = pack('L',$crckey);
|
||||
w_log('L',"checkdupe: DEBUG: binkey [$binkey] msg (".defined($msg{$binkey}).") crc ($crckey) key ($key)");
|
||||
while (defined($msg{$binkey}))
|
||||
{
|
||||
seek(H,unpack('L',$msg{$binkey}),0);
|
||||
$_ = <H>;
|
||||
w_log('L',"checkdupe: DEBUG: _ [$_]");
|
||||
seek(H,0,2); # not often -- only if crc32 collision or real dupe
|
||||
($oldkey,$oldval) = split(/[\t\n]/,$_);
|
||||
w_log('L',"checkdupe: DEBUG: oldkey [$oldkey] oldval ($oldval)");
|
||||
return $oldval if $oldkey eq $key;
|
||||
$binkey = pack('L',++$crckey);
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub adddupe
|
||||
{
|
||||
my($key,$val) = @_;
|
||||
my($crckey,$binkey);
|
||||
|
||||
$crckey = crc32($key);
|
||||
$binkey = pack('L',$crckey);
|
||||
while (defined($msg{$binkey}))
|
||||
{
|
||||
$binkey = pack('L',++$crckey);
|
||||
}
|
||||
|
||||
$msg{$binkey}=pack('L',tell(H));
|
||||
print H "$key\t$val\n";
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
sub compileNL
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1',"filter-route.pl: compile_NL() [$config{nodelistDir}]");
|
||||
}
|
||||
|
||||
my(@nlfiles,$mtime,$ctime,$curtime,$curmtime,$curctime);
|
||||
my($zone,$region,$net,$hub,$node,$flag);
|
||||
local(*F);
|
||||
opendir(F, $config{nodelistDir}) || return;
|
||||
@nlfiles = grep(/^[a-zA-Z]+\.\d{3}$/i, readdir(F));
|
||||
closedir(F);
|
||||
|
||||
w_log('V',"Node List Files: @nlfiles");
|
||||
return unless @nlfiles;
|
||||
|
||||
# Work out if the DB is out of date
|
||||
$curmtime = $curctime = 0;
|
||||
foreach (@nlfiles)
|
||||
{
|
||||
($mtime,$ctime) = (stat($config{nodelistDir}."/$_"))[9,10];
|
||||
if (! $curmtime || $mtime > $curmtime)
|
||||
{
|
||||
$curmtime = $mtime;
|
||||
$curctime = $ctime;
|
||||
$curnodelist = $_;
|
||||
}
|
||||
}
|
||||
|
||||
w_log('V',"Node List Files MTIME: $curmtime");
|
||||
($mtime,$ctime) = (stat(nldb))[9,10];
|
||||
w_log('V',"NLDB MTIME [$mtime]");
|
||||
if (! defined($mtime) || $mtime < $curmtime)
|
||||
{
|
||||
unlink(nldb);
|
||||
tie(%nodelist,'DB_File',nldb,O_RDWR|O_CREAT,0644) || return;
|
||||
|
||||
w_log('V','Compiling Nodelist...');
|
||||
foreach (@nlfiles)
|
||||
{
|
||||
unless (open(F,'<'.$config{nodelistDir}."/$_"))
|
||||
{
|
||||
untie(%nodelist);
|
||||
return;
|
||||
}
|
||||
|
||||
$zone = $region = $net = $hub = '';
|
||||
|
||||
while (<F>)
|
||||
{
|
||||
chomp();
|
||||
next if /^(;.*)?$/;
|
||||
|
||||
($flag,$node) = split(/,/);
|
||||
if ($flag eq 'Zone')
|
||||
{
|
||||
$zone = $net = $node;
|
||||
$node = 0;
|
||||
$region = $hub = "$zone:$net/$node";
|
||||
|
||||
} elsif ($flag eq 'Region') {
|
||||
$net = $node;
|
||||
$node = 0;
|
||||
$region = $hub = "$zone:$net/$node";
|
||||
|
||||
} elsif ($flag eq 'Host') {
|
||||
$net = $node;
|
||||
$node = 0;
|
||||
$hub = "$zone:$net/$node";
|
||||
|
||||
} elsif ($flag eq 'Hub') {
|
||||
$hub = "$zone:$net/$node";
|
||||
}
|
||||
|
||||
$nodelist{"$zone:$net/$node"}="$region,$hub";
|
||||
}
|
||||
close(F);
|
||||
}
|
||||
|
||||
untie(%nodelist);
|
||||
w_log('V','Compiling Nodelist...DONE');
|
||||
}
|
||||
|
||||
tie(%nodelist,'DB_File',nldb,O_RDONLY) && ($nltied=1);
|
||||
return;
|
||||
}
|
||||
|
||||
sub zbounce
|
||||
{
|
||||
my($fromname,$fromaddr,$toname,$toaddr,$date,$subject,$text,$reason) = @_;
|
||||
my($bouncetext);
|
||||
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1',"filter-route.pl: bounce: Bouncing message back to [$toaddr]");
|
||||
}
|
||||
|
||||
$text =~ tr/\r/\n/;
|
||||
$text =~ s/\n\x01/\n\@/gs;
|
||||
$text =~ s/^\x01/\@/s;
|
||||
$bouncetext = <<EOF;
|
||||
Hello $fromname.
|
||||
|
||||
Your message failed to be processed at this hub with reason:
|
||||
|
||||
$reason
|
||||
|
||||
Is this incorrect? If so let me know alterego\@21:2/116 or deon\@leenooks.net
|
||||
|
||||
Orignal message:
|
||||
|
||||
============================================================================
|
||||
FROM: $fromname ($fromaddr)
|
||||
TO : $toname ($toaddr)
|
||||
SUBJ: $subject
|
||||
DATE: $date
|
||||
============================================================================
|
||||
$text
|
||||
============================================================================
|
||||
EOF
|
||||
$attr = ($MSG_LOCAL | $MSG_KILL | $MSG_PRIVAte | $MSG_RRCPT);
|
||||
putMsgInArea('','Mail Robot',$fromname,'',$toaddr,'Unable to deliver your Netmail','',$attr,add_tz($bouncetext),1);
|
||||
$newnet = 1;
|
||||
return $reason;
|
||||
}
|
||||
|
||||
sub arqcpt
|
||||
{
|
||||
if ($DEBUG_MODE==1) {
|
||||
w_log('1','filter-route.pl: arqcpt()');
|
||||
}
|
||||
|
||||
my($fromaddr,$toaddr,$fromname,$toname,$subject,$date,$attr,$origtext) = @_;
|
||||
my($text);
|
||||
$text = <<EOF;
|
||||
Hello $fromname!
|
||||
|
||||
Your message with ARQ passed through my system.
|
||||
|
||||
Original message header:
|
||||
=============================================================
|
||||
From : $fromname ($fromaddr)
|
||||
To : $toname ($toaddr)
|
||||
Subject: $subject
|
||||
Date : $date
|
||||
=============================================================
|
||||
EOF
|
||||
|
||||
putMsgInArea('',$FILTER_FROM,$fromname,'',$fromaddr,'Audit Receipt Response','',($MSG_PRIVATE | $MSG_KILL | $MSG_LOCAL | $MSG_RRCT),
|
||||
add_tz($text),1);
|
||||
$newnet = 1;
|
||||
}
|
||||
|
||||
w_log('U','filter-route is LOADED');
|
||||
1;
|
||||
121
tools/filters/filter-testmsg.pl
Normal file
121
tools/filters/filter-testmsg.pl
Normal file
@ -0,0 +1,121 @@
|
||||
# $Id$
|
||||
# Mirror robot for HPT
|
||||
# (c) 2006 Gremlin
|
||||
# (c) 2006 Grumbler
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
|
||||
# Look messages in specified (echo)aread. Check toname for "All" and robot name
|
||||
# (now "Mirror robot"), check subject for specified (now "test"), (see
|
||||
# "Configuration" below). If matchs then post reply with original message text
|
||||
# and invalidated cludges.
|
||||
#
|
||||
# usage example:
|
||||
# ==============
|
||||
# BEGIN{ require "testmsg.tpl" }
|
||||
# sub filter() { &testmsg; }
|
||||
# sub process_pkt{}
|
||||
# sub after_unpack{}
|
||||
# sub before_pack{}
|
||||
# sub pkt_done{}
|
||||
# sub scan{}
|
||||
# sub route{}
|
||||
# sub hpt_exit{}
|
||||
# ==============
|
||||
|
||||
sub testmsg()
|
||||
{
|
||||
if ($DEBUG_MODE) {
|
||||
w_log('1',"filter-testmsg.pl: begin [$area]");
|
||||
}
|
||||
|
||||
# Configuration set in testmsg_config()
|
||||
local %testarea; # Area configuration
|
||||
local $myaddr; # Robot address
|
||||
|
||||
testmsg_config;
|
||||
|
||||
#== CONFIGURATION ==#
|
||||
my $check_toname = 'all'; # Act on messages addressed to
|
||||
my $check_subject = 'test'; # Lower case!
|
||||
my $myname = $FILTER_FROM; # Robot name, uses in reply and check "to" name
|
||||
my $report_subj = "$myname Report"; # Subject of report message
|
||||
my $report_tearline = "$myname: HPT-perl hook"; # Origin of report message
|
||||
my $report_origin = $FILTER_ORIGIN;
|
||||
|
||||
my $txt2pkt = '/usr/local/bin/txt2pkt'; # txt2pkt program (with path) uses for post
|
||||
# into passthrough areas
|
||||
my $pkt_dir = '/fido/mailer/in.loc'; # Directory to write PKT for
|
||||
# passtrough areas
|
||||
my @ignore_from_regexp=( # if these regexp's is matched with $fromname
|
||||
'hustler', # then message will be ignored.
|
||||
'steve wolf'
|
||||
);
|
||||
#== END CONFIGURATION ==#
|
||||
|
||||
if (($testarea{$area})
|
||||
&& (lc($toname) eq $check_toname)
|
||||
&& (lc($subject) eq $check_subject))
|
||||
{
|
||||
foreach my $ignore_from (@ignore_from_regexp)
|
||||
{
|
||||
return "" if( $fromname =~ /$ignore_from/i );
|
||||
}
|
||||
|
||||
# $text contains original message and must be left as is
|
||||
my $msgtext = $text;
|
||||
|
||||
# invalidate control stuff
|
||||
$msgtext =~ s/\x01/@/gm;
|
||||
$msgtext =~ s/\n/\\x0A/gm;
|
||||
$msgtext =~ s/\rSEEN-BY/\rSEEN+BY/gm;
|
||||
$msgtext =~ s/\r--- /\r=== /gm;
|
||||
$msgtext =~ s/\r \* Origin: /\r + Origin: /gm;
|
||||
$msgtext="$date $fromname ($fromaddr) wrote:\r\r"
|
||||
."..............| -BEGIN MESSAGE- |..............\r"
|
||||
."$msgtext"
|
||||
."..............| -END MESSAGE- |..............\r"
|
||||
." \r"
|
||||
."(The original tear line has been replaced with ===, and the original asterisk used in the Origin line ' * Origin' has been replaced with plus (+).)\r";
|
||||
|
||||
if ($testarea{$area}==1)
|
||||
{
|
||||
$msgtext = $msgtext."--- $report_tearline\r * Origin: $report_origin ($myaddr)\r";
|
||||
putMsgInArea($area,$myname,$fromname,$myaddr,$myaddr,$report_subj,'',($MSG_LOCAL),add_tz($msgtext),1);
|
||||
$newecho = 1;
|
||||
w_log('E',"Responding to test in [$area].");
|
||||
|
||||
} else {
|
||||
$msgtext =~ s/\r/\n/gm;
|
||||
|
||||
my $cmd="$txt2pkt -e $area -xf $myaddr -xt $myaddr -nf '$myname'"
|
||||
." -nt '$fromname' -s '$report_subj' -t '$report_tearline'"
|
||||
." -o '$report_origin' -d '$pkt_dir' -";
|
||||
|
||||
if (open(PIPE,"|$cmd"))
|
||||
{
|
||||
print PIPE $msgtext;
|
||||
close PIPE;
|
||||
|
||||
w_log('7',"PKT with reply is created from $myname using txt2pkt");
|
||||
|
||||
} else {
|
||||
w_log('1',"Can't open pipe to txt2pkt");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return '';
|
||||
}
|
||||
|
||||
w_log('U','filter-testmsg is LOADED');
|
||||
1;
|
||||
3
tools/show-queue
Executable file
3
tools/show-queue
Executable file
@ -0,0 +1,3 @@
|
||||
#!/bin/sh
|
||||
|
||||
/usr/local/tools/lib/showold.pl /etc/ftn/config $@
|
||||
Reference in New Issue
Block a user