#!/usr/bin/perl
#
#   Program to parse the raw FidoNet nodelist and spit out a BinkD-compatible
#   list of nodes. Addresses are discovered according to these rules:
#
#   1.  the address(es) attached to the IBN flag(s),
#       which might have ports attached
#   2.  the system name field, if it has a period in the middle of it
#   3.  the address(es) attached to the INA flag(s)
#   4.  the address(es) attached to the IP flag(s)
#   5.  the "phone number", if it looks like 000 followed by an IP address
#
#==>If no address is found, an "*" is used which causes BinkD to generate
#   a host name based upon the FTN address.
#
#   @(#) binkd_nodelister.pl version 1.0 - 26 November 2002
#   @(#) Copyright (c) 2002 by Jerry Schwartz and Write by Night
$version = "binkd_nodelister.pl version 1.0 - 26 November 2002";
$copyright_notice = "Copyright (c) 2002 by Jerry Schwartz and Write by Night";
#
# Change History
#
#   26 Nov 2002
#
#     Version changed to 1.0, no other changes
#
#   15 Nov 2002
#
#     If no address is specified, but one or more ports are specified,
#     combine the "*" with each port
#
#     If there were multiple IBN flags, and some specified a port number and
#     others did not, redundant address*port combinations were generated
#
#     A couple of minor revisions of the comments
#
#   13 Nov 2002
#
#     Renamed program to binkd_nodelister rather than the generic parse_nodelist
#
#     Found and fixed a bug in pulling the IP address out of the phone number
#
#     Made cosmetic changes to comments so they more exactly describe the
#     program's logic
#
#   12 Nov 2002
#
#     Added support for the experimental (as/of 12 Nov 2002) INA flag
#
#     Revised the order of preference for IP addresses
#
#   1.  the address(es) attached to the IBN flag(s),
#       which might have ports attached
#   2.  the system name field, if it has a period in the middle of it
#   3.  the address(es) attached to the INA flag(s)
#   4.  the address(es) attached to the IP flag(s)
#   5.  the "phone number", if it looks like 000 followed by an IP address
#
#   02 Nov 2002
#
#     Added a check to make sure the IBN flag has additional information before
#     trying to parse it. This did no real harm, but it generated pages of
#     error messages if you ran with the -w option.
#
#     Found a typo that kept the program from recognizing an address attached
#     to an IP flag
#
#   01 Nov 2002
#
#     Now announces the version and copyright notice in the output file
#
#   31 Oct 2002
#     Major reworking of the whole scheme:
#
#     - The order of precedence for finding addresses was changed to
#
#       1.  the system name field, if it has a period in the middle of it
#       2.  the addresses attached to the IBN flag(s),
#           which might have ports attached
#       3.  the addresses attached to the IP flag(s)
#       4.  the "phone number", if it looks like 000 followed by an IP address
#
#     - If more than one port number was specified by an IBN flag, then every
#       address is combined with every port to create a * p combinations
#
#     - All of the resulting combinations are then combined into a list of
#       addresses for BinkD to try
#
#     - Internally, the possible address candidates are stored in a hash so
#       that the entire algorithm can be extended or changed more easily
#
#     - &parsewords doesn't handle single-quotes used as apostrophes in
#       nodelist entries, so it was replaced by a call to the split function.
#       This had the interesting side effect of vastly speeding up the program.
#
#   30 Oct 2002
#     If no IP address is found for a node, an * will be used but the listing
#     will be written to the error file as well

if (( $ARGV[0] eq "") || ($ARGV[0] eq "/?") || ($ARGV[0] eq "-?"))
{
  print "$version\n$copyright_notice\n\n";
  print "Usage:\n";
  print "\tbinkd_nodelister.pl <input nodelist> " .
         " [<output nodelist> [<error list>]]\n\n";
  die;
}

$inputfile = $ARGV[0];
$outputfile = (defined $ARGV[1]) ? ">" . $ARGV[1] : ">&STDOUT";
$errorfile = (defined $ARGV[2]) ? ">" . $ARGV[2] : ">&STDERR";

#   Open the input and output files
#
#   The "three-argument" format doesn't work when re-opening STDOUT as/of
#   v5.6.1 built for MSWin32-x86-multi-thread

open (INSTUFF, "<", $inputfile) || die ("Can't open $inputfile: $!");
open (OUTSTUFF, $outputfile)    || die ("Can't open $outputfile: $!");
open (ERRFILE, $errorfile)      || die ("Can't open $errorfile: $!");

print (OUTSTUFF "#\tBinkD-compatible nodelist extraction - " . localtime() .
      "\n#\n#\tCreated by $version\n#\t$copyright_notice\n#\n")
        || die ("Can't write to $outputfile: $!");

#   Loop through the raw nodelist, passing through comment (;A and ;S) lines

while ($inline = <INSTUFF>)
{
  chomp($inline);
  if ($inline !~ m/^\;/)
  {   #   For non-comment lines, parse out all of the fields in the listing
    @listing = split(",",$inline);
    GET_ADDRESS:
    {   #   Pick off the FTN address
      $listing[0] eq "Zone"   && do {   #   ZCs are a special case
                                      $zone = $listing[1];
                                      $net = $zone;
                                      $node = "0";
                                      last GET_ADDRESS;
                                    };
      $listing[0] eq "Region" && do {   #   RCs are also a special case
                                      $net = $listing[1];
                                      $node = "0";
                                      last GET_ADDRESS;
                                    };
      $listing[0] eq "Host"   && do {   #   and NCs are special, too
                                      $net = $listing[1];
                                      $node = "0";
                                      last GET_ADDRESS;
                                    };
      $node = $listing[1];    #   Otherwise, the second field is the node number
    }

#   Let's find the candidates for an IP address or host name

    %possible_addresses =   (
          system_name   =>  undef,
          ibn_flag      =>  undef,
          ina_flag      =>  undef,
          ip_flag       =>  undef,
          phone_number  =>  undef
                            );
    @port_list = ();
    undef ($address);

#   Now, look for an IBN flag signalling that this is a BinkP node

    $ibn_flag_count = grep (/^IBN/i, @listing);  #   Any IBN flags at all?
    if ($ibn_flag_count)
    {
      @ibn_flag = grep (/^IBN/i, @listing);  #   Get the flag(s)
      foreach $this_ibn_flag (@ibn_flag)
      {
        #   The address might be in the IBN flag itself
        
        $possible_address_port = ($this_ibn_flag =~ m/^IBN:(.+)/i) ? $1 : undef;

#   This might be an address, a port number, an address:port combo,
#   or undefined; let's find out. If there is more than one IBN flag with an
#   address, we string them together with semicolons as BinkD specifies.
#
#   We also have to build a list of the specified ports, for later use.
#
#=> There is an important ambiguity here. If there is a single IBN flag with a
#   port number, then we can assume it applies to every address; if there
#   is more than one IBN flag with both a port number and an address,
#   we can apply each port number to the associated address. The ambiguity
#   arises if there is more than one IBN flag with a port, but not every IBN
#   flag has both a port and an address. We also have to decide what to do with
#   any other addresses we might have found.
#
#   This program will assume that each port applies to each address (except when
#   explicitly paired), so it will produce multiple address entries: one for
#   each combination of port and address.
#
#   Thank goodness the only valid place to specify a port is in the IBN flag
#   (I hope).

        GET_PORT:
        {
          !defined($possible_address_port) && do   #   was the IBN flag bare?
              {
                last GET_PORT;
              };
          $possible_address_port =~ m/(.+):(\d+)$/ && do   #   address + port
              {
                $possible_addresses{ibn_flag} =
                    ((defined($possible_addresses{ibn_flag}))
                      ? ($possible_addresses{ibn_flag} . ";" . $1) : $1)
                      . ":" . $2;
                $port_list[$#port_list + 1] = $2;
                last GET_PORT;
              };
          $possible_address_port =~ m/^(\d+)$/ && do  #   port number only
              {
                $port_list[$#port_list + 1] = $1;
                last GET_PORT;
              };
          $possible_address_port =~ m/\D/ && do   #   not number, address only
              {
                $possible_addresses{ibn_flag} =
                    (defined($possible_addresses{ibn_flag}))
                      ? $possible_addresses{ibn_flag} . ";" .
                        $possible_address_port : $possible_address_port;
                last GET_PORT;
              };
        }
      }

#   The system name might be the address, if it has a . in the middle of it

      $possible_addresses{system_name} = ($listing[2] =~ m/.+\..+/)
        ? $listing[2] : undef;

#   The address might also be in the phone number; if it begins with 000 and
#   has four more numeric parts, assume that it is an IP address

      $possible_addresses{phone_number} =
        ($listing[5] =~ m/^000[-|\.](\d+)[-|\.](\d+)[-|\.](\d+)[-|\.](\d+)/x)
          ? ($1 . "." . $2 . "." . $3 . "." . $4) : undef;

#   The address might be in an INA flag

      $ina_flag_count = grep (/^INA/i, @listing);   #   Any INA flags?
      if ($ina_flag_count)
      {
        @ina_flag = grep (/^INA/i, @listing);    #   Get all of the flags
        foreach $this_ina_flag (@ina_flag)
        { #   Pick off and concatenate the addresses (and previously-found
          #   ports, if any)
          if ($#port_list >= 0)   #   Do we have some ports saved?
          {
            foreach $this_port (@port_list) #   Then we need the cross-product
            {
              if ($this_ina_flag =~ m/^INA:(.+)/)  # only if we have an address
              {
                $possible_addresses{ina_flag} =
                      ((defined($possible_addresses{ina_flag})) # Not the first?
                        ? $possible_addresses{ina_flag} . ";" . $1
                          : $1) . ":" . $this_port;
              }
            }
          }
          else  #   There aren't any ports, just list the addresses
          {
            if ($this_ina_flag =~ m/^INA:(.+)/)  # only if we have an address
            {
              $possible_addresses{ina_flag} =
                    (defined($possible_addresses{ina_flag}))  # Not the first?
                      ? $possible_addresses{ina_flag} . ";" . $1 . ":"
                        : $1;
            }
          }
        }
      }
      
#   The address might be in an IP flag

      $ip_flag_count = grep (/^IP/i, @listing);  #   Any IP flags?
      if ($ip_flag_count)
      {
        @ip_flag = grep (/^IP/i, @listing);   #   Get all of the flags
        foreach $this_ip_flag (@ip_flag)
        { #   Pick off and concatenate the addresses (and previously-found
          #   ports, if any)
          if ($#port_list >= 0)   #   Do we have some ports saved?
          {
            foreach $this_port (@port_list) #   Then we need the cross-product
            {
              if ($this_ip_flag =~ m/^IP:(.+)/)  # only if we have an address
              {
                $possible_addresses{ip_flag} =
                      ((defined($possible_addresses{ip_flag})) # Not the first?
                        ? $possible_addresses{ip_flag} . ";" . $1
                          : $1) . ":" . $this_port;
              }
            }
          }
          else  #   There aren't any ports, just list the addresses
          {
            if ($this_ip_flag =~ m/^IP:(.+)/)  # only if we have an address
            {
              $possible_addresses{ip_flag} =
                    (defined($possible_addresses{ip_flag}))  # Not the first?
                      ? $possible_addresses{ip_flag} . ";" . $1 . ":"
                        : $1;
            }
          }
        }
      }
      

#   By now, we should have an Internet address from at least one of four
#   places; now we concatenate the possibilities in this order:
#
#   1.  the address(es) attached to the IBN flag(s),
#       which might have ports attached
#   2.  the system name field, if it has a period in the middle of it
#   3.  the address(es) attached to the INA flag(s)
#   4.  the address(es) attached to the IP flag(s)
#   5.  the "phone number", if it looks like 000 followed by an IP address
#
#   Remember, we still have (maybe) a list of ports

#   Do the IBN flags, which would already have ports attached if found

      if (defined($possible_addresses{ibn_flag}))  #   Got any?
      {
        $address = (defined($address)) ?
              $address . ";" . $possible_addresses{ibn_flag}
                : $possible_addresses{ibn_flag};
      }
      
#   Do the system name * however many ports

      if (defined($possible_addresses{system_name})) # Looked like an address?
      {
        if ($#port_list >= 0)   #   Any ports?
        {
          foreach $this_port (@port_list)
          {
            $address = ((defined($address)) ?
                  $address . ";" . $possible_addresses{system_name}
                    : $possible_addresses{system_name}) . ":" . $this_port;
          }
        }
        else   #    No ports, just use the name
        {
          $address = (defined($address)) ?
                $address . ";" . $possible_addresses{system_name}
                  : $possible_addresses{system_name};
        }
      }

#   Now do the INA flag(s), which would already have ports attached if found

      if (defined($possible_addresses{ina_flag}))   #   Got any?
      {
        $address = (defined($address)) ?
              $address . ";" . $possible_addresses{ina_flag}
                : $possible_addresses{ina_flag};
      }


#   Now do the IP flags, which would already have ports attached if found

      if (defined($possible_addresses{ip_flag}))   #   Got any?
      {
        $address = (defined($address)) ?
              $address . ";" . $possible_addresses{ip_flag}
                : $possible_addresses{ip_flag};
      }
      
#   Now do the phone number * number of ports

      if (defined($possible_addresses{phone_number})) # Looked like an address?
      {
        if ($#port_list >= 0)   #   Any ports?
        {
          foreach $this_port (@port_list)
          {
            $address = ((defined($address)) ?
                  $address . ";" . $possible_addresses{phone_number}
                    : $possible_addresses{phone_number}) . ":" . $this_port;
          }
        }
        else   #    No ports, just use the IP address
        {
          $address = (defined($address)) ?
                $address . ";" . $possible_addresses{phone_number}
                  : $possible_addresses{phone_number};
        }
      }

#   Did we ever find any addresses at all?

      if (!defined($address))
      {
        print (ERRFILE "Addr? $zone:$net/$node\t$inline\n") ||
            die "Can't write to $errorfile: $!";

#       No addresses at all, so use "*"; but there might be ports

        if ($#port_list >= 0)   #   Any ports?
        {
          foreach $this_port (@port_list)
          {
            $address = ((defined($address)) ?
                  $address . ";*" : "*") . ":" . $this_port;
          }
        }
        else   #    No ports, just use the "*"
        {
          $address = "*";
        }
      }
      print (OUTSTUFF "Node $zone:$net/$node\t$address\t-\n")
          || die "Can't write to $outputfile: $!";
    }
  }
  elsif ($inline =~ m/^;[A|S](.*)/i)
  {
    print (OUTSTUFF "#$1\n") || die "Can't write to $outputfile: $!";
  }
}
