# Local defines

sub msgdb    { return "c:\\fido\\hpt\\dupebase\\plduper.db"; }
sub pktdb    { return "c:\\fido\\hpt\\dupebase\\plduperpkt.db"; }
sub nldb     { return "c:\\fido\\nodelist\\nodelist.db"; }
sub faq      { return "c:\\fido\\itrack\\faq\\"; }

sub route94  { return "c:\\user\\gul\\work\\routing\\route.94"; }
sub sechubs  { return "c:\\fido\\nodelist\\2nd_hubs.463"; }
sub echol463 { return "c:\\user\\gul\\work\\echolist.463"; }
sub listdir  { return "c:\\fido\\hpt\\"; }
sub listname { return "5020_238.avl"  if $_[0] eq "2:5020/238";
               return "5020_1381.avl" if $_[0] eq "2:5020/1381";
               return "94.avl"        if $_[0] eq "2:463/94";
               return "58.avl"        if $_[0] eq "2:463/58";
               return "";
             }

sub maillists { return (
              "Staff",
              "Postmaster",
              "Admin",
              "Noc",
              "Hostmaster",
              "Cert",
              "Bugtraq",
              "Mutt-dev",
              "Registry"
              ); }

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, $pkttied, %msg, $msgtied, $newnet, $newecho, @crc_32_tab);
my($processpktname, $pktkey, $pktval, %msgpkt, $curnodelist, @areas);

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
  my(@hf, @mypoints, @lines, $firstpath, $lastpath, @path, $origin);
  my(@lastpath, $net, @origin, $msgid, $msgidfrom, $approved, $path);
  my($key, $oldval, $fromboss, $toboss, $knownpoint, $fname, $time, @myaddr);
  my($oldtime, $oldpath, $oldpktfrom, $curtime, $dupetext, @roechoes);
  local(*F);
  @hf = qw(
    2:5020/113
    2:5020/32
    2:5020/140
    2:5020/50.40
    2:5020/50.140
    2:5020/140.1
    2:5020/35
    2:5020/35.1
    2:5000/13
    2:5000/44
    2:5020/293
    2:5020/1040
    2:5020/443
    2:5020/517
  );
  @mypoints = qw(
    2:463/68
    2:463/68.1  # Yutta
    2:463/68.2  # son
    2:463/68.3  # Bor Mal
    2:463/68.4  # Voronov
    2:463/68.5  # Ksyu
    2:463/68.8  # Sergey Iovov (/8.2)
    2:463/68.9  # Kussul
    2:463/68.11 # Brun
    2:463/68.12
    2:463/68.13 # Maxim Obukhov
    2:463/68.17 # Kalina
    2:463/68.18 # Andrew Ilchenko
    2:463/68.26 # Dmitry Rachkovsky
    2:463/68.27 # Andrey Zinin
    2:463/68.28 # Jean Kantoroff <jean@acalto.dial.intercom.it>
    2:463/68.32 # dk
    2:463/68.36 # Valentin Klinduh
    2:463/68.41 # Motus
    2:463/68.45 # Artem Kulakov  Sergei Shevyryov <megamed@wantree.com.au>
    2:463/68.47 # Parkhom
    2:463/68.50 # Rozhko
    2:463/68.62 # Victor Cheburkin /62
    2:463/68.67 # Alexey Suhoy /67
    2:463/68.92 # Andrey Ichtchenko
    2:463/68.108 # Vitaliy Oleynik
    2:463/68.114 # Валерий Дмитриевич и Людмила Сергеевна Кузнецовы
    2:463/68.128 # gate
    2:463/68.141 # Sergey Skorodinsky <ssv@i.am>
    2:463/68.163 # Den Dovgopoly
    2:463/68.196 # Tverskaya flat
    2:463/68.200 # Michael Bochkaryov
    2:463/68.586 # eug@lucky.net
    2:463/68.690 # Al Poduryan
    2:463/68.702 # Miroslav Narosetsky
  );
  @roechoes = qw(
    1072.Compnews
    BOCHAROFF.MUST.DIE
    BOCHAROFF.UNPLUGGED
    DIG.LINUX
    JET.PHRASES
    HUMOR.FILTERED
    GUITAR.SONGS.FILTERED
    OBEC.FILTERED
    PVT.EXLER.FILTERED
    RU.ANEKDOT.FILTERED
    RU.ANEKDOT.THE.BEST
    RU.AUTOSTOP.INFO
    RU.SPACE.NEWS
    RU.UFO.THEORY
    RU.WINDOWS.NT.NEWS
    SPB.HUMOR
    SPB.SYSOP.FILTERED
    SU.CRISIS.SITUATION
    SU.FORMULA1.INFO
    SU.OS2.FAQ
    SU.WIN95.NEWS
  );

  @myaddr = &myaddr;
  if (defined($area))
  {
    unless ($pktfrom =~ /^(2:463\/94(\.0)?|2:5020\/238(\.0)?)$/)
    { # from downlink
      foreach(@roechoes)
      {
        if ($area eq $_)
        {
          putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr,
             $subject, $date, "pvt sent read",
             "hpt> Posting to r/o echo $area\r" . $text, 0);
          $kill = 1;
          return "Posting to r/o echo $area";
        }
      }
    }
    $text =~ s/\r\n/\r/gs;
    @lines = split('\r', $text);
    $firstpath = $lastpath = $origin = $msgidfrom = "";
    @path = grep(/^\x01PATH: /, @lines);
    $firstpath = "2:$1" if $path[0] =~ /^\x01PATH: (\S+)/;
    $lastpath = pop(@path);
    $lastpath =~ s/^\x01PATH: //;
    @lastpath = split(/\s+/, $lastpath);
    foreach(@lastpath)
    { $net = $1 if m#^(\d+)/\d+$#;
      $_ = "$net/$_" if /^\d+$/;
      $lastpath = $_;
    }
    $lastpath = "2:$lastpath" if $lastpath;
    @lastpath = ();
    @origin = grep(/^ \* Origin: .*\(.*\)\s*$/, @lines);
    if (@origin)
    { $origin = pop(@origin);
      @origin = ();
      if ($origin =~ /\(([0-9:\/\.]+)(\@[A-Za-z0-9.\-]+)?\)\s*$/)
      { $origin = $1;
      } else
      { undef($origin);
        @origin = ();
      }
    }
    ($msgid) = grep(/^\x01MSGID:/, @lines);
    $msgidfrom = $1 if $msgid =~ /^\x01MSGID: ([0-9:\/\.])+(\@\S+)? /;
    if ($area eq "HUMOR.FILTERED")
    {
      $approved = 0;
      foreach (@hf)
      { $approved = 1 if $firstpath eq $_ || $origin eq $_ || $msgidfrom eq $_;
      }
      unless ($approved)
      {
        putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr,
           $subject, $date, "pvt sent read",
           "hpt> Unapproved message in $area\r" . $text, 0);
        $kill = 1;
        return "Unapproved message in $area";
      }
    }
    elsif ($area =~ /^PVT\.EXCH\./)
    { unless ($lastpath =~ m/^2:50/)
      { if ($origin =~ /^2:46/)
        {
          putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr,
             $subject, $date, "pvt sent read",
             "hpt> R46 is r/o in PVT.EXCH.*\r" . $text, 0);
          $kill = 1;
          return "R46 is r/o in PVT.EXCH.*";
        }
      }
    }
    elsif ($area eq "NET463.COORD")
    { if ($fromname eq "Routing Poster" && $fromaddr eq "2:463/94.0")
      { if (open(F, ">".route94))
        { foreach(grep(!/^(\x01|SEEN-BY:)/, @lines))
          { print F "$_\n";
          }
          close(F);
        }
      }
    }
    elsif ($area eq "N463.SYSOP" && $fromname eq "N463EC" && $fromaddr eq "2:463/11.0")
    { $fname = "";
      if ($subject eq "secondaries")
      { $fname = sechubs;
      } elsif ($subject eq "echolist")
      { $fname =  echol463;
      }
      if ($fname && open(F, ">$fname"))
      { foreach(grep(!/^(\x01|SEEN-BY:)/, @lines))
        { print F "$_\n";
        }
        close(F);
      }
    }
    # Dupecheck
    unless ($msgtied)
    {
      if (tie(%msg, 'DB_File', msgdb, O_RDWR|O_CREAT, 0644))
      { $msgtied = 1;
      } else
      { $newecho = 1;
        return "";
      }
    }
    if ($msgid)
    { $msgid =~ s/^\x01MSGID:\s*//;
      $msgid =~ tr/A-Z/a-z/;
    }
    else
    { $msgid = sprintf("C%s %08x", $fromaddr, crc32($date . join(' ',grep(!/^(\x01PATH|SEEN-BY):/,@lines))));
    }
    $key = "$area|$msgid|" . crc32($fromname . $toname . $subject);
    $path = "";
    foreach(grep(/^\x01PATH: /, @lines))
    { s/^\x01PATH:\s*//;
      $path .= " " if $path;
      $path .= $_;
    }
    $curtime = time();
    if (defined($msg{$key}) || defined($msgpkt{$key}))
    { # Dupe
      if (defined($msg{$key}))
      { $oldval = $msg{$key};
      } else
      { $oldval = $msgpkt{$key};
      }
      ($oldtime, $oldpath, $oldpktfrom) = split(/\|/, $oldval);
       $dupetext = <<EOF;
Pkt from: $pktfrom
Original pkt from: $oldpktfrom
Original PATH: $oldpath
$text
EOF
      putMsgInArea("DUPES", $fromname, $toname, $fromaddr, "",
                   $subject, $date, "pvt sent read", $dupetext, 0);
      $kill = 1;
      return "Dupe";
    }
    $msgpkt{$key} = "$curtime|$path|$pktfrom";
    $newecho = 1;
    return "";
  }
  # NetMail
  $fromaddr =~ s/\.0$//;
  $toaddr   =~ s/\.0$//;
  $fromboss = $fromaddr;
  $fromboss =~ s/\.\d+$//;
  $toboss   = $toaddr;
  $toboss   =~ s/\.\d+$//;
  if ($secure)
  { compileNL() unless $nltied;
    if ($nltied && !defined($nodelist{$toboss}))
    { bounce($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text,
             "Node $toboss mising in $curnodelist");
      $kill = 1;
      return "Node $toboss mising in $curnodelist";
    }
  }
  else
  { if (isattr("att", $attr))
    {
      putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr,
         $subject, $date, "pvt sent read",
         "hpt> FileAttach from unsecure link\r" . $text, 0);
      $kill = 1;
      return "FileAttach from unsecure link";
    }
    if ($fromaddr =~ /^(2:463\/68|2:46\/128)(\.\d+)?$/)
    {
      putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr,
         $subject, $date, "pvt sent read",
         "hpt> Unprotected message from my system\r" . $text, 0);
      $kill = 1;
      return "Unprotected message from my system";
    }
    compileNL() unless $nltied;
    if ($nltied && !defined($nodelist{$fromboss}))
    {
      putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr,
         $subject, $date, "pvt sent read",
         "hpt> Unprotected message from inlisted system\r" . $text, 0);
      $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");
      putMsgInArea("UNSECURE", $fromname, $toname, $fromaddr, $toaddr,
         $subject, $date, "pvt sent read",
         "hpt> Unprotected outgoing message\r" . $text, 0);
      $kill = 1;
      return "Unprotected outgoing message";
    }
  }
  if ($toboss eq $myaddr[0])
  {
    $knownpoint = 0;
    foreach(@mypoints)
    { $knownpoint = 1 if $_ eq $toaddr;
    }
    unless ($knownpoint)
    { bounce($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text,
             "Unknown point");
      putMsgInArea("BADMAIL", $fromname, $toname, $fromaddr, $toaddr,
         $subject, $date, "pvt sent read",
         "hpt> Unknown point\r" . $text, 0);
      $kill = 1;
      return "Unknown point";
    }
  }
  if ($toaddr eq $myaddr[0])
  { # check maillists
    foreach (maillists)
    { if ($toname eq $_)
      { s/ //;
        tr/A-Z/a-z/;
        s/^(........).*$/$1/;
        putMsgInArea($_, $fromname, $toname, $fromaddr, $toaddr,
                  $subject, $date, "pvt sent read", $text, 0);
        $kill = 1;
        return "Maillist $toname";
      }
    }
    if ($toname =~ /^ping$/i)
    { 
      if (isattr("cpt", $attr))
      {
        putMsgInArea("BADMAIL", $fromname, $toname, $fromaddr, $toaddr,
           $subject, $date, "pvt sent read",
           "hpt> Ping request with RRC\r" . $text, 0);
        $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

Orignal message:

============================================================================
FROM:  $fromname	$fromaddr
TO  :  $toname		$toaddr
SUBJ:  $subject
DATE:  $date
============================================================================
$text
============================================================================
EOF
      putMsgInArea("", "Crazy Mail Robot", $fromname, "", $fromaddr,
                "Ping Reply", "", "pvt k/s loc cpt", $text, 1);
      $newnet = 1;
      $kill = 1;
      return "Ping from $fromaddr";
    }
    if ($toname =~ /^faqserver$/i)
    {
      if (isattr("cpt", $attr))
      {
        putMsgInArea("BADMAIL", $fromname, $toname, $fromaddr, $toaddr,
           $subject, $date, "pvt sent read",
           "hpt> FaqServer request with RRC\r" . $text, 0);
        $kill = 1;
        return "FaqServer request with RRC";
      }
      faqserv($fromaddr, $fromname, $subject, $text);
      $newnet = 1;
      $kill = 1;
      return "Message to FaqServer";
    }
    if (($fromname =~ /^(areafix|gecho|crashecho|areafix daemon|sqafix)$/i ||
         $fromname =~ /echo manager/) &&
        listname($fromaddr) ne "" &&
        ($subject =~ /^(List request|List of areas available|List of available areas|AreaFix list of areas|AreaFix response|[Aa]reafix reply: (list request|available areas))/ ||
         $subject =~ /^Your Areafix Request$/ && $text =~ /Areas available to|\001SPLITTED:/s && $text =~ /\r\n?      \S+\r/s ||
         $subject =~ /^Remote request operation report/ && $text =~ /areas available for|continued from the previous message/s ||
         $subject =~ /Reply from Parma Tosser Echo Manager, part/))
    {
      if ($subject eq "AreaFix response" && $text =~ /\r\n?%LIST.*\r\n?--- CrashEcho's AreaFix/s)
      { $kill = 1;
        return "CrashEcho's areafix response";
      }
      if (@areas)
      { if ($areas[0] ne $fromaddr)
        { putlist();
          @areas=($fromaddr);
        }
      }
      else
      { @areas=($fromaddr);
      }
      foreach (split(/\s*\r\n?/, $text))
      {
        next if /^(\x01|SEEN-BY:)/;
        if ($subject =~ /^AreaFix list of areas/) # CrashEcho
        { if (/^ {15,}(\S(?:.*\S)?)\s+(?:\?|\d+)\s*$/ && $areas[1])
          { $areas[@areas-1] .= " $1";
            next;
          }
        }
        elsif (/^ {15,}(\S.*)$/ && $areas[1] && $subject =~ /Parma Tosser/)
        { $areas[@areas-1] .= " $1"; # or "$1", without space?
          next;
        }
        elsif (/^ {15,}(\S.*)$/ && $areas[1])
        { $areas[@areas-1] .= " $1";
          next;
        }
        if ($subject =~ /^List request/)
        { # FastEcho
          next unless /^[\* ] (\S+)(?:(?: \.*)? (\S.*))?\s*$/;
          push (@areas, "$1 $2");
          next;
        }
        if ($subject =~ /^List of areas available/)
        { # FastEcho
          next unless /^([^() \*\'\-\[][^() *]*)(?: \.+ (\S.*))?\s*$/;
          push (@areas, "$1 $2");
          next;
        }
        if ($subject =~ /^List of available areas/)
        { # GEcho
          next unless /^[+ ](\S+)(?: +(\S.*))?\s*$/;
          next if /^ '[+-]'/;
          push (@areas, "$1 $2");
          next;
        }
        if ($subject =~ /^AreaFix list of areas/)
        { # CrashEcho
          next if /^ Group:/;
          next unless /^ (\S+)(?:\s+(\S(?:.*\S)?)?\s+(?:\?|\d+))?\s*$/;
          push (@areas, "$1 $2");
          next;
        }
        if ($subject =~ /^Your Areafix Request/)
        { # Fidogate
          next unless /^[ *] [ R]   (\S+)\s*$/;
          push (@areas, $1);
          next;
        }
        if ($subject =~ /^[Aa]reafix reply: list request/)
        { # hpt
          next unless /^[* ][R ]? (\S+)(?: \.* (\S.*))?\s*$/;
          push (@areas, "$1 $2");
          next;
        }
        if ($subject =~ /^[Aa]reafix reply: available areas/)
        { # hpt
          next unless /^ (\S+)(?: \.* (\S.*))?\s*$/;
          push (@areas, "$1 $2");
          next;
        }
        if ($subject =~ /^Remote request operation report/)
        { # SqaFix
          next unless /^(\S+) \.+ (?:Unlinked|Active  )   \[\S\](?: (\S.*\S))?\s*$/;
          push (@areas, "$1 $2");
        }
        if ($subject =~ /Parma Tosser/)
        { # Parma Tosser
          next if /^(Splitted by|--- |UpLink |Available areas|List of|Hello |Parma )/;
          if (/^([A-Za-z\.&\$0-9!'_\+\-]+)(?:(?: \.+)?\s+(\:Unlinked|Lined)\s+\[.\] (.*))?$/)
          { push(@areas, "$1 $2");
          }
        }
      }
      $kill=1;
      return "List reply";
    }
    if ($toname =~ /^(areafix|allfix|filefix)$/i)
    {
      if (isattr("cpt", $attr))
      {
        putMsgInArea("BADMAIL", $fromname, $toname, $fromaddr, $toaddr,
           $subject, $date, "pvt sent read",
           "hpt> $toname request with RRC\r" . $text, 0) ||
        ($kill = 1);
        return "$toname request with RRC";
      }
    }
    else
    {
      if (isattr("rrq", $attr) || isattr("arq", $attr))
      { receipt($fromaddr, $toaddr, $fromname, $toname, $subject, $date);
      }
      putMsgInArea("GUL", $fromname, $toname, $fromaddr, $toaddr,
                $subject, $date, "pvt sent read", $subject, $text, 0) ||
      ($kill = 1);
      return "Message to gul";
    }
  }
  else
  { # Transit message
    # Dupe- and loop- check
    opendupe();
    if ($msgtied)
    {
      ($msgid) = grep(/^\x01MSGID:/, @lines);
      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();
      if ($oldval=checkdupe($key))
      { # Dupe or Loop
        $dupetext = $text;
        $dupetext =~ s/\r\n?/\n/gs;
        ($oldtime, $oldpath, $oldpktfrom) = split(/\|/, $oldval);
        $oldtime = localtime($oldtime);
        if ($path eq $oldpath && $oldpktfrom eq $pktfrom)
        { # Dupe
           $dupetext = <<EOF;
Pkt from: $pktfrom
Original msg arrived: $oldtime
$dupetext
EOF
          putMsgInArea("NETMAILDUPES", $fromname, $toname, $fromaddr, "",
                       $subject, $date, "pvt sent read", $dupetext, 0);
          $kill = 1;
          return "Dupe";
        } else
        { # Loop
          putMsgInArea("LOOPS", $fromname, $toname, $fromaddr, $toaddr,
                       $subject, $date, "pvt sent read",
                       "hpt> loop\r" . $text, 0);
          $kill = 1;
          return "Loop";
        }
      }
      adddupe($key, "$curtime|$path|$pktfrom");
    }
    if (_route($toaddr, $attr, $text) eq $pktfrom)
    { # Route to pktfrom-addr -- ping-pong
      putMsgInArea("LOOPS", $fromname, $toname, $fromaddr, $toaddr,
                   $subject, $date, "pvt sent read",
                   "hpt> ping-pong with $pktfrom\r" . $text, 0);
      $kill = 1;
      return "Loop";
    }
    if (isattr("arq", $attr))
    { arqcpt($fromaddr, $toaddr, $fromname, $toname, $subject, $date, $attr, $text);
    }
  }
  $newnet = 1;
  return "";
}

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
  my ($toboss, $addr, $msgid, $key);
  my ($oldtime, $oldpath, $oldpktfrom, $dupetext);

  if ($toaddr eq "")
  { # echomail
    unless ($msgtied)
    {
      tie(%msg, 'DB_File', msgdb, O_RDWR|O_CREAT, 0644) || return "";
      $msgtied = 1;
    }
    ($msgid) = grep(/^\x01MSGID:/, split('\r', $text));
    if ($msgid)
    { $msgid =~ s/^\x01MSGID:\s*//;
      $msgid =~ tr/A-Z/a-z/;
    }
    else
    { $msgid = sprintf("C%s %08x", $fromaddr, crc32($date . join(' ',grep(!/^(\x01PATH|SEEN-BY):/,split('\r', $text)))));
    }
    $key = "$area|$msgid|" . crc32($fromname . $toname . $subject);
    if (defined($msg{$key}))
    { # Dupe
      ($oldtime, $oldpath, $oldpktfrom) = split(/\|/, $msg{$key});
      $dupetext = <<EOF;
Pkt from: local
Original pkt from: $oldpktfrom
Original PATH: $oldpath
$text
EOF
      putMsgInArea("DUPES", $fromname, $toname, $fromaddr, "",
                $subject, $date, "pvt sent read", $dupetext, 0);
      return "Dupe";
    }
    $msg{$key} = time() . "|local|local";
    return "";
  }
  $toboss   = $toaddr;
  $toboss   =~ s/\.\d+$//;
  # Remove my "hpt> " comments
  if ($text =~ /^((?:\x01[^\r]+\r)*)hpt> [^\r]+\r/)
  { $text = "$1$'";
    $change = 1;
  }
  compileNL() unless $nltied;
  if ($nltied && !defined($nodelist{$toboss}))
  {
    bounce($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text,
           "Node $toboss mising in $curnodelist");
    return "Node $toboss mising in $curnodelist";
  }
  if ($fromaddr eq $myaddr[0] &&
      !isattr("cpt", $attr) &&
      $area =~ /^netmail$/i &&
      $fromname !~ /areafix|crazy mail robot|allfix|ping|uucp/i)
  { putMsgInArea("I_SENT", $fromname, $toname, $fromaddr, $toaddr,
              $subject, $date, "pvt sent read", $text, 0);
  }
  if ($toaddr eq $myaddr[0])
  { if ($toname =~ /^faqserver$/i)
    {
      faqserv($fromaddr, $fromname, $subject, $text);
      $newnet = 1;
      return "Message to FaqServer";
    }
    unless ($toname =~ /^(areafix|allfix|filefix)$/i)
    { putMsgInArea("GUL", $fromname, $toname, $fromaddr, $toaddr,
                $subject, $date, "pvt sent read", $text, 0);
      return "Message to gul";
    }
  }
  $addr = $area;
  $addr =~ tr/A-Z/a-z/;
  foreach(maillists)
  { s/ //g;
    tr/A-Z/a-z/;
    if ($addr eq $_)
    { $toaddr = "2:46/128";
      $toname = "$_\@lucky.net";
      $text =~ s#^((?:.*\r)?)\x01INTL\s+\S+\s+(\S+)\s*\r#$1\x01INTL 2:46/128 $2\r#s;
      $text =~ s/^((?:.*\r)?)\x01TOPT[^\r]+\r//s;
      $change = 1;
      return "";
    }
  }
  return "";
}

sub route
{
# $addr = dest addr
# $from = orig addr
# $text = message text
# $attr = message attributes
# set $flavour to hold|normal|crash|direct|immediate
# return route addr or "" for default routing

  return _route($toaddr, $attr, $text);
}

sub _route
{
  my ($toaddr, $attr, $text) = @_;

  my @routemail = (
"crash  17:1800/94  17:.*",
"hold   2:46/128    (2:46/128|2:463/68.128)",
"hold   2:999/999   2:46/128\.",
"hold   noroute     2:463/68(\.\d+)?",
"hold   2:463/68.8  2:463/8\.2",
"hold   2:463/68.17 2:463/62\.17",
"crash  2:463/168   2:463/168(\.\d+)?",
"normal 2:463/666   2:(463/666|46/200)(\.\d+)?",
"crash  2:463/94    [123456]:.*",
"hold   2:999/999   .*"
);
  my @routefile = (
"crash  2:463/94    2:(463/83|463/940(\.\d+)?|462/95|4653/10|4643/5",
"crash  2:463/94    2:463/11(\.11)?",
"normal 2:463/666   2:(463/666(\.\d+)?|2:46/200)",
"crash  2:463/94    2:(46/0|465/50|465/70)",
"hold   noroute     .*"
);
  my (@route, $dest, $patt, $boss, $host, $flags);

  compileNL() unless $nltied;

  if (isattr("att", $attr))
  { @route = @routefile;
  } else
  { @route = @routemail;
  }
  $addr =~ s/\.0$//;

  $flags = $1 if $text =~ /^(.*\r\n?)?\x01FLAGS\s+(\S[^\r]*\S)\s*\r/;
  $flags =~ tr/A-Z/a-z/;
  foreach $flavour ("hld", "dir", "crash", "imm")
  { if (str2attr($flavour) != -1)
    { if ($attr & str2attr($flavour))
      {
        $flavour = "hold" if $flavour eq "hld";
        return $addr;
      }
    } else
    {
      if (index($flags, $flavour) >= 0)
      {
        $flavour = "immediate" if $flavour = "imm";
        return $addr;
      }
    }
  }

  foreach (@route)
  { ($flavour, $dest, $patt) = split(/\s+/, $_);
    $boss = $addr;
    $boss =~ s/\..*//;
    $host = $boss;
    $host =~ s#/.*#/0#;
    if ($patt =~ /^hub(.*)/i)
    { $_ = $1;
      if ($nodelist{$boss} =~ /,(.*)/)
      { $patt = ".*" if $_ eq $1;
      }
    } elsif ($patt =~ /^reg(.*)/i)
    { $_ = $1;
      if ($nodelist{$host} =~ /^(.*),/)
      { $patt = ".*" if $_ eq $1;
      }
    }
    if ($addr =~ /^$patt$/)
    { if ($dest eq "noroute")
      { $dest = $addr;
      } elsif ($dest eq "boss")
      { $dest = $boss;
      } elsif ($dest eq "host")
      { $dest = $host;
      } elsif ($dest eq "hub")
      { $dest = $boss;
        if ($nodelist{$boss} =~ /,(.*)/)
        { $dest = $1;
        } else
        { $dest = $host;
        }
      }
      return $dest;
    }
  }
  return "";
}

sub hpt_exit
{
  my($flags);
  local(*F);
  untie %nodelist if $nltied;
  untie %pkt if $pkttied;
  untie %msg if $msgtied;
  if (@areas)
  { putlist();
    @areas = ();
  }
  $nltied = $pkttied = $msgtied = 0;
  $flags = $ENV{"FLAGS"};
  close(F) if $newnet && open(F, ">$flags/wasnet.now");
  close(F) if $newecho && open(F, ">$flags/wasecho.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 *.dup)
  my($crc, $a, $mtime, $size, $pktstart);
  local(*F);
  $processpktname = "";
  %msgpkt = ();
  unless ($pkttied)
  {
    if (tie(%pkt, 'DB_File', pktdb, O_RDWR|O_CREAT, 0644))
    { $pkttied = 1;
    } else
    { return "";
    }
  }
  ($size,$mtime) = (stat($pktname))[7,9];
  open(F, "<$pktname") || return;
  read(F, $pktstart, 58+178); # sizeof(pkthdr) + sizeof(msghdr) (max msghdr)
  close(F);
  $crc = crc32($pktstart);
  $pktname =~ s/^.*[\/\\]//; # basename
  $pktname =~ tr/A-Z/a-z/;
  $pktkey = sprintf("%s|%u|%08x|%08x", $pktname, $size, $mtime, $crc);
  $pktval = time();
  $processpktname = $pktname;
  return "Duplicate $pktname" if defined($pkt{$pktkey});
  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
  my ($key, $val, $curtime, $sec, $min, $hour, $mday, $msgtime);
  return if defined($res) || !defined($pktkey) || !$pkttied;
  $pktname =~ s/^.*[\/\\]//; # basename
  $pktname =~ tr/A-Z/a-z/;
  return if $pktname ne $processpktname && $pktname ne "";
  $pkt{$pktkey} = $pktval;
  ($sec,$min,$hour,$mday) = localtime();
  if ($mday ne $pkt{"lastpurge"})
  { print "Purging pkt dupebase...";
    $curtime = time();
    while (($key, $val) = each %pkt)
    { delete($pkt{$key}) if $curtime-$val>14*24*3600;
    }
    $pkt{"lastpurge"} = $mday;
    print " Done\n";
  }
  $processpktname = "";
  return if !$msgtied;
  while (($key, $val) = each %msgpkt)
  { $msg{$key} = $val;
    delete $msgpkt{$key};
  }
  %msgpkt = ();
  if ($mday ne $msg{"lastpurge"})
  { print "Purging msg dupebase...";
    $curtime = time();
    while (($key, $val) = each %msg)
    { ($msgtime) = split(/\|/, $val);
      delete($msg{$key}) if $curtime-$msgtime>14*24*3600;
    }
    $msg{"lastpurge"} = $mday;
    print " Done\n";
  }
}

sub after_unpack
{
}

sub before_pack
{
}


# ========================================================================
#                        local functions
# ========================================================================

sub compileNL
{
  my(@nlfiles, $a, $mtime, $ctime, $curtime, $curmtime, $curctime);
  my($zone, $region, $net, $hub, $node, $flag);
  local(*F);
  opendir(F, nodelistDir()) || return;
  @nlfiles = grep(/^nodelist\.\d\d\d$/i, readdir(F));
  closedir(F);
  return unless @nlfiles;
  $curnodelist = pop(@nlfiles);
  ($curmtime,$curctime) = (stat(nodelistDir . "/$curnodelist"))[9,10];
  foreach(@nlfiles)
  { ($mtime,$ctime) = (stat(nodelistDir . "/$_"))[9,10];
    if ($mtime > $curmtime)
    { $curmtime = $mtime;
      $curctime = $ctime;
      $curnodelist = $_;
    }
  }
  ($mtime,$ctime) = (stat($nldb))[9,10];
  if (!defined($mtime) || $mtime < $curmtime)
  {
    unlink(nldb);
    tie(%nodelist, 'DB_File', nldb, O_RDWR|O_CREAT, 0644) || return;
    unless (open(F, "<".nodelistDir()."/$curnodelist"))
    { untie(%nodelist);
      return;
    }
    $zone = $region = $net = $hub = "";
    print "Compiling nodelist...";
    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);
    print "Done.\n";
  }
  tie(%nodelist, 'DB_File', nldb, O_RDONLY) && ($nltied=1);
  return;
}

sub bounce
{
  my($fromname, $fromaddr, $toname, $toaddr, $date, $subject, $text, $reason) = @_;
  my($bouncetext);
  local(*F);

  $text =~ tr/\r/\n/;
  $text =~ s/\n\x01/\n\@/gs;
  $text =~ s/^\x01/\@/s;
  $bouncetext = <<EOF;
   Hello $fromname.

$reason
Therefore I must return this message to you.

                 Lucky Carrier,
                                     Pavel Gulchouck
                                     gul\@gul.kiev.ua

Orignal message:

============================================================================
FROM:  $fromname	$fromaddr
TO  :  $toname		$toaddr
SUBJ:  $subject
DATE:  $date
============================================================================
$text
============================================================================
EOF
  putMsgInArea("", "Crazy Mail Robot", $fromname, "", $toaddr,
            "Unable to delivery", "", "pvt k/s loc cpt", $bouncetext, 1);
  $newnet = 1;
  return $reason;
}

sub isattr
{
  my($sattr, $attr) = @_;
  return $attr & str2attr($sattr);
}

sub faqserv
{
  my($fromaddr, $fromname, $subject, $text) = @_;
  my($size, $fsize, @lines, $reply, $correct, $skip, $topic, $a);
  local(*F);
  @lines = split('\r', $text);
  if ($subject =~ /\S/)
  { @lines = unshift(@lines, "Subject: $subject");
  } else
  { $subject = "";
  }
  $reply = "";
  $skip = "";
  $size = 0;
  foreach (@lines)
  {
    $reply .= "> $_\r";
    next if $skip;
    $_ = $subject if $subject;
    $subject = "";
    s/^\s*%?(\S+).*/$1/;
    s/^(........).*$/$1/;
    tr/A-Z/a-z/;
    if (/^(--.*|quit|exit)$/)
    { $reply .= "Rest skipped\r";
      $skip = 1;
      next;
    }
    $fsize = (stat(faq . "$_.faq"))[7];
    if (($size += $fsize) > 102400)
    { $reply .= "Size limit riched, rest skipped\r";
      $skip = 1;
      next;
    }
    if (open(F, "<" . faq . "$_.faq"))
    { read(F, $topic, $fsize);
      putMsgInArea("", "FaqServer", $fromname, "", $fromaddr,
                "Topic $_", "", "pvt loc k/s cpt", "Topic $_", $topic, 1);
      close(F);
      $correct = 1;
    }
    else
    {
      $reply .= "Topic $_ not found\r";
    }
  }
  unless($correct)
  {
    $reply .= "No valid commands found, help sent\r";
    if (open(F, "<" . faq . "help.faq"))
    { read(F, $topic, $fsize);
      putMsgInArea("", "FaqServer", $fromname, "", $fromaddr,
                "Help response", "", "pvt loc k/s cpt", $topic, 1);
      close(F);
    }
  }
  putMsgInArea("", "FaqServer", $fromname, "", $fromaddr,
            "FaqServer reply", "", "pvt loc k/s cpt", $reply, 1);
}

sub putlist
{
  my(%areas, $fromaddr, $areaname, $desc);
  local(*F);

  %areas = ();
  $fromaddr = shift(@areas);
  while(@areas)
  {
    $_ = shift(@areas);
    next unless /^(\S+)(?:\s+(\S.*)|\s*)$/;
    ($areaname, $desc) = ($1, $2);
    $desc = "" if $desc =~ /autocreated|new\/unsorted|description missing/i;
    $desc = "" if $desc =~ /^(Regional|Gated) [Ee]choe?s$/;
    if (defined($areas{$areaname}))
    { next if $desc eq "";
      $areas{$areaname} = $desc;
    }
    else
    { $areas{$areaname} = $desc;
    }
  }
  return if listname($fromaddr) eq "";
  open(F, ">".listdir().listname($fromaddr)) || return;
  foreach (sort keys %areas)
  { print F "$_ " . $areas{$_} . "\n";
  }
  close(F);
  return;
}

sub arqcpt
{
  my($fromaddr, $toaddr, $fromname, $toname, $subject, $date, $attr, $origtext) = @_;
  my($text, $route);
  $route = _route($toaddr, $attr, $origtext);
  $route = "internet gate" if $route eq "2:46/128";
  $text = <<EOF;
    Hello $fromname!

Your message with ARQ passed to $route through my station.

Original message header:
=============================================================
 From:    $fromname          $fromaddr
 To:      $toname            $toaddr
 Subject: $subject
 Date:    $date
=============================================================

                  Lucky carrier,
                         Pavel Gulchouck (and my mail robot;)
EOF
  putMsgInArea("", "Crazy Mail Robot", $fromname, "", $fromaddr,
            "Audit Receipt Response", "", "pvt k/s loc cpt", $text, 1);
  $newnet = 1;
}

sub 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
=============================================================

                  Lucky carrier,
                         Pavel Gulchouck (and my mail robot;)
EOF
  putMsgInArea("", "Crazy Mail Robot", $fromname, "", $fromaddr,
            "Return Receipt Response", "", "pvt k/s loc cpt", $text, 1);
  $newnet = 1;
}