Xref: feenix.metronet.com comp.mail.misc:2021
Path: feenix.metronet.com!news.utdallas.edu!wupost!waikato.ac.nz!comp.vuw.ac.nz!asjl
Newsgroups: comp.mail.misc
Subject: Re: R E P O S T :   I N T E R - N E T W O R K   M A I L   G U I D E
Message-ID: <1ts08h$cjv@st-james.comp.vuw.ac.nz>
From: Andy.Linton@comp.vuw.ac.nz (Andy Linton)
Date: 25 May 1993 02:28:33 GMT
References: <24MAY199314322842@cc.utah.edu>
Distribution: world
Organization: Victoria University, PO Box 600, Wellington, NEW ZEALAND
Keywords: gateways, networks, syntax
NNTP-Posting-Host: bats.comp.vuw.ac.nz
Lines: 343


The reposted guide mentions a perl script to query the document. I got this
from John Chew last year.

andy
--
#!/usr/bin/perl

# inmgq - Inter-Network Mail Guide Query utility
#
# Copyright (C) 1992 by John J. Chew, III <poslfit@utcs.utoronto.ca>
#
# COPYRIGHT NOTICE
#
# This document is Copyright (C) 1992 by John J. Chew.  All rights reserved.
# Permission for non-commercial distribution is hereby granted, provided
# that this file is distributed intact, including this copyright notice
# and the version information above.  Permission for commercial distribution
# can be obtained by contacting the author.

($rcs_revision = "\$Revision: 1.8 $") =~ s/\$//g;
($rcs_date = "\$Date: 92/07/28 23:39:27 $") =~ s/\$//g;
($rcs_file = "\$RCSfile: inmgq,v $") =~ s/\$//g;

# include libraries
($BASEDIR = $0) =~ s!/[^/]+$!! || ($BASEDIR='.');
require 'getopts.pl';

# log if appropriate
if ( -w "$BASEDIR/inmgq.callers" && ($_ = getpeername(STDIN)) )
  {
  local(@time) = localtime(time);
  local($proto, $port, @address) = unpack('SnC4', $_);
  $time[4]++;
  open(LOG, ">>$BASEDIR/inmgq.callers");
  printf LOG "%d-%02d-%02d %02d:%02d:%02d %d.%d.%d.%d %d\n", @time[5,4,3,2,1,0],
    @address, $port;
  close(LOG);
  }

# check command line
$help = "INMG Query Commands:\n\n".
  "dump                dump a stripped version of the INMG file (long)\n".
  "from [netid...]     list known connections from networks\n".
  "help                list available commands\n".
  "how net1 net2       explain how to send mail from net1 to net2\n".
  "network [netid...]  list information about networks\n".
  "networks            list known networks\n".
  "to [netid...]       list known connections to networks\n".
  "version             show version of INMG file and query utility\n".
  "quit                exit from the program\n".
  "";
$usage = "Usage: $0 [-v] [-f inmg-file] [command [arg...]]\n\n". $help;
die $usage unless &Getopts('f:v');

# look for inmg file in various places
(defined($inmg = $opt_f))
  || (-f ($inmg = "$ENV{'INMG'}"))
  || (-f ($inmg = "$BASEDIR/inmg"))
  || (-f ($inmg = "$ENV{'HOME'}/inmg/inmg"))
  || (-f ($inmg = "$ENV{'HOME'}/doc/inmg"))
  || (-f ($inmg = '/usr/local/doc/inmg'))
  || die "Cannot find inmg file\n";

# welcome user - loadinmg takes some time
$| = 1;
print "Welcome to the Inter-Network Mail Guide\n";
print "\n";
print "Please wait a few seconds while the database loads.\n";

# load the file
&loadinmg($inmg);
print "Thank you.  Type 'help' for a list of commands.\n";

# single command on command line?
if ($#ARGV >= 0) {
  $command = shift;
  die $usage unless eval "defined &do_$command";
  eval "&do_$command(\@ARGV)";
  print $@;
  }
else {
  while (print('inmgq> '),length($_=<>)) {
    split;
    next if $#_ == -1;
    $command = shift @_;
    eval "defined &do_$command"
      || (print ("Enter 'help' to list valid commands.\n"), next );
    eval "&do_$command(\@_)";
    print $@;
    }
  print "\n";
  }
exit 0;

## subroutines follow in alphabetical order

# &check_netid - check a network id
sub check_netid {
  for $netid (@_) {
    die "I do not know of a network called '$netid'.\n".
      "Use the 'networks' command to list known networks.\n"
      unless defined $netname{$netid};
    }
  }

# &do_dump - process 'dump' command
sub do_dump { local($_, $from, $how, $key, $net, $to);
  die "Usage: $0 dump\n" if $#_ != -1;
  for $net (sort keys %netname) {
    &wrap("#N $net;$netname{$net};$netorg{$net};$nettype{$net};$netnote{$net}");
    }
  print "\n";
  for $key (sort keys %how) {
    ($from, $to) = ($key =~ /(.*) (.*)/);
    print "#F $from\n#T $to\n#R $recvr{$key}\n";
    print "#C $contact{$key}\n" if defined $contact{$key};
    for $how (split("\n",$how{$key})) { &wrap("#I $how"); }
    print "\n";
    }
  }

# &do_from - process 'from' command
sub do_from { local(@argv) = @_; local($from);
  for $from (($#argv == -1) ? sort keys %from: @argv)
    { &fmt($from{$from}, "$from: ", "  "); }
  }

# &do_help - process 'help' command
sub do_help { print $help; }

# &do_how - process 'how' command
sub do_how {
  local($from, $to) = @_;
  local($key) = "$from $to";
  local($how);

  die "Usage: how net1 net2\n" unless $#_ == 1;
  &check_netid($from, $to);
  defined $how{$key}
    || die "There is no known gateway from $netname{$from} to $netname{$to}.\n";
  &fmt("How to send mail from $netname{$from} to $netname{$to}:", '', '  ');
  &fmt("(For further information contact $contact{$key})", '  ', '    ')
    if defined $contact{$key};
  &fmt("To send mail to '$recvr{$key}'", '  ', '    ');
  for $how (split("\n", $how{$key})) { &fmt($how, '  - ', '    '); }
  }

# &do_network - process 'network' command
sub do_network { local(@argv) = @_; local($net);
  &check_netid(@argv);
  for $net (($#argv == -1) ? sort keys %netname : @argv) {
    print "$net:\n  Full Name:    $netname{$net}\n".
      "  Organization: $netorg{$net}\n  Type:         $nettype{$net}\n";
    print "  Notes:        $netnote{$net}\n" if length($netnote{$net});
    print "\n";
    }
  }

# &do_networks - process 'networks' command
sub do_networks { die "Usage: networks\n" if $#_ != -1;
  &fmt(join(' ', sort keys %netname, '', ''));
  }

# &do_quit - process 'quit' command
sub do_quit { exit 0; }

# &do_rerun - process secret 'rerun' command
sub do_rerun { exec $0; }

# &do_to - process 'to' command
sub do_to { local(@argv) = @_; local($to);
  for $to (($#argv == -1) ? sort keys %to: @argv)
    { &fmt($to{$to}, "$to: ", "  "); }
  }

# &do_version - process 'version' command
sub do_version { die "Usage: version\n" if $#_ != -1; 
  print "Inter-Network Mail Guide file:\n";
  print "  ", join("\n  ", @version), "\n";
  print "Inter-Network Mail Guide query utility:\n";
  print "  $rcs_revision\n  $rcs_date\n";
  }

# &fmt($string, $ind1, $ind2) - display a string, wrapping at word breaks to
#   80 columns max, indenting first line by ind1 and subsequent lines by ind2.
sub fmt {
  local($_, $ind1, $ind2) = @_;
  local($break, $hyphen, $measure, $space);

  $ind = $ind1; s/^ +//; s/ +$//;
  while (1) {
    print $ind;
    $measure = 80 - length($ind);
    if (length($_) < $measure) { print "$_\n"; last; }
    $hyphen = rindex($_, '-', $measure);
    $space = rindex($_, ' ', $measure);
    $break = ($hyphen > $space) ? $hyphen : $space;
    $break = $measure if $break == -1;
    print substr($_, 0, $break), "\n";
    substr($_, 0, $break) = '';
    s/^ +//;
    $ind = $ind2;
    last unless length;
    }
  }

# &getblock - read a block of records skipping comments, returns values in
#   @tags and @data.
sub getblock {
  local($tag, $data);
  @tags = @data = ();
  while (!$eof)
    {
    &getrecord;
    defined $tag || (($#tags >= 0) ? last : next);
    next if $tag eq '';
    push(@tags, $tag);
    push(@data, $data);
    }
  }

# &getline - read a line with one line of pushback, returns results in $linetag
#   and $linedata.  Also uses $eof, $pushback and $_.
$eof = 0;
$pushback = undef;
sub getline {
  $linetag = undef;
  $linedata = '';
  while (1) {
    defined($_ = $pushback) ? ($pushback = undef) : ($_ = <INMG>);
    if (! defined $_) { $eof = 1; return; }
    die "Line $. not terminated by newline\n" unless /\n$/;
    return if length == 1;
    die "Line $. too long\n" if length > 81;
    die sprintf("Illegal character \\%03d in line $..\n", ord($1))
      if /([^ -~\n])/;
    (($opt_v && &parsefailed("discarding garbage line")), next) if /^[^#]/;
    last;
    }
  ($linetag, $linedata) = /^#([^ \n]*) ?(.*)$/;
  }

# &getrecord - read a record, joining continuation lines, returns results in
#   $tag and $data.
sub getrecord {
  local($linetag, $linedata, $_);
  local($result);

  &getline;
  $tag = $linetag;
  ($data = $linedata) =~ s/^ +//;
  return unless defined $tag;
  die "Illegal continuation at line $..\n" if $tag eq '-';

  while (1) {
    &getline;
    if ($linetag eq '-') { $data .= $linedata; }
    else { $pushback = $_; last; }
    }
  }

# &loadinmg($filename) - load the inmg file into memory
sub loadinmg {
  local($data, $hascontact, $key, $lastfrom, $lastto, $tag, @_);

  # open file
  open(INMG, "<$inmg") || die "Cannot open $inmg ($!)\n";

  # load and check version block
  &getblock;
  for $tag (@tags)
    { &parsefailed("Unexpected tag in version block: '#$tag'") if $tag ne 'V'; }
  @version = @data;
  for $data (@version) { $data =~ s/\$//g; }

  # load and check network block
  &getblock;
  for $tag (@tags)
    { &parsefailed("Unexpected tag in network block: '#$tag'") if $tag ne 'N'; }
  for $data (@data) {
    split(/ *; */, $data, 10);
    ($#_ == 4) || &parsefailed("Bad field count in: $data");
    ($_[0] eq '') && &parsefailed("Missing network identifier in: $data");
    ($_[1] eq '') && &parsefailed("Missing network full name in: $data");
    ($_[2] eq '') && &parsefailed("Missing network organization in: $data");
    ($_[3] =~ 
      /^(academic|bbs|commercial|government|in-house|non-profit|none|\?)$/)
      || &parsefailed("Bad network type in: $data");
    $netname{$_[0]} = $_[1];
    $netorg{$_[0]} = $_[2];
    $nettype{$_[0]} = $_[3];
    $netnote{$_[0]} = $_[4];
    }

  # load and check the rest of the blocks
  $lastfrom = $lastto = '';
  while (&getblock, !$eof) {
    $hascontact = ($tags[3] eq 'C');
    if (defined($from{$data[0]}))
      { $from{$data[0]} .= " $data[1]" if $from{$data[0]} !~ / $data\[1]$/; }
    else { $from{$data[0]} = "$data[1]"; }
    if (defined($to{$data[1]}))
      { $to{$data[1]} .= " $data[0]" if $to{$data[1]} !~ / $data\[0]$/; }
    else { $to{$data[1]} = "$data[0]"; }
    $key = "$data[0] $data[1]";
    $recvr{$key} = $data[2];
    $contact{$key} = $data[3] if $hascontact;
    $how{$key} = join("\n", @data[($hascontact?4:3)..$#data]);
    ($#tags < 3) && &parsefailed("block too short");
    ($tags[0] eq 'F') || &parsefailed("bad first tag: '$tags[0]'");
    ($tags[1] eq 'T') || &parsefailed("bad second tag: '$tags[1]'");
    ($tags[2] eq 'R') || &parsefailed("bad third tag: '$tags[2]'");
    ($tags[3] =~ /^[CI]$/) || &parsefailed("bad fourth tag: '$tags[3]'");
    for $tag (@tags[4..$#tags])
      { ($tag eq 'I') || &parsefailed("bad tag: '$tag'"); }
    ($data[0] < $lastfrom) &&
      &parsefailed("source network out of order: $data[0]");
    (defined $netname{$data[0]}) ||
      &parsefailed("unknown source network: $data[0]");
    ($data[1] < $lastto) &&
      &parsefailed("destination network out of order: $data[1]");
    (defined $netname{$data[1]}) ||
      &parsefailed("unknown destination network: $data[1]");
    $lastto = ($lastfrom eq $tags[0]) ? $tags[1] : '';
    $lastfrom = $tags[0];
    }
  close(INMG);
  }

# &parsefailed($reason) - die because the inmg file couldn't be parsed
sub parsefailed {
  &fmt("$0: $inmg at or before line $.: $_[0]", '', '');
  exit 1;
  }

# &wrap($text) - print text wrapping to 80 columns with INMG continuations
sub wrap { local($_) = @_;
  print substr($_, 0, 80), "\n";
  substr($_, 0, 80) = '';
  while (length)
    { print "#- ", substr($_, 0, 77), "\n"; substr($_, 0, 77) = ''; }
  }