507 lines
13 KiB
Perl
507 lines
13 KiB
Perl
# 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;
|