Add hub tools and hpt filter

This commit is contained in:
Deon George 2021-04-23 22:55:34 +10:00
parent b8a5bdd50d
commit 88725ad9a2
8 changed files with 1352 additions and 250 deletions

View File

@ -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" ]

View File

@ -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
View File

@ -0,0 +1,3 @@
#!/bin/bash
(echo -e \\x01CHRS: CP437 2 && echo -e \\x01TZUTC: 1000 && cat)

506
tools/filter.pl Executable file
View 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
View 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;

View 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;

View 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
View File

@ -0,0 +1,3 @@
#!/bin/sh
/usr/local/tools/lib/showold.pl /etc/ftn/config $@