fidohub/tools/filters/filter-route.pl

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