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 init /sbin/init
|
||||||
COPY golded /usr/local/bin
|
COPY golded /usr/local/bin
|
||||||
COPY goldkeys.cfg /etc
|
COPY goldkeys.cfg /etc
|
||||||
|
COPY tools/* /usr/local/bin/
|
||||||
|
|
||||||
EXPOSE 119 24553 24554 60177 60179
|
EXPOSE 119 24553 24554 60177 60179
|
||||||
VOLUME [ "/var/lib/zerotier-one" ]
|
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