diff --git a/Dockerfile b/Dockerfile index 066410b..0c0f73b 100644 --- a/Dockerfile +++ b/Dockerfile @@ -104,6 +104,7 @@ COPY ftn.orig /etc/ftn.orig/ COPY init /sbin/init COPY golded /usr/local/bin COPY goldkeys.cfg /etc +COPY tools/* /usr/local/bin/ EXPOSE 119 24553 24554 60177 60179 VOLUME [ "/var/lib/zerotier-one" ] diff --git a/ftn.orig/filter.pl b/ftn.orig/filter.pl deleted file mode 100644 index 799b39b..0000000 --- a/ftn.orig/filter.pl +++ /dev/null @@ -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; -} diff --git a/tools/cp437-tz.sh b/tools/cp437-tz.sh new file mode 100755 index 0000000..d003640 --- /dev/null +++ b/tools/cp437-tz.sh @@ -0,0 +1,3 @@ +#!/bin/bash + +(echo -e \\x01CHRS: CP437 2 && echo -e \\x01TZUTC: 1000 && cat) diff --git a/tools/filter.pl b/tools/filter.pl new file mode 100755 index 0000000..90deb25 --- /dev/null +++ b/tools/filter.pl @@ -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 = < $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; +} diff --git a/tools/filters/filter-hub.pl b/tools/filters/filter-hub.pl new file mode 100644 index 0000000..8bfbfaf --- /dev/null +++ b/tools/filters/filter-hub.pl @@ -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 = < $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 = <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 = < 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); + $_ = ; + 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 () + { + 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 = <