🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: news.admin
Article #3986

Sanity-checking UUCP maps

#3986
From: Brendan Kehoe
Date: Wed, 15 Jul 1992 16:25
438 lines
15308 bytes
Archive-name: comb
Submitter: Brendan Kehoe <brendan@cs.widener.edu>

Brian Reid <reid@pa.dec.com> wrote:
>Quite a number of sites have published "map entries" with erroneous,
>fictitious, scrambled, or illegal #L fields. The purpose of the #L field is
>to give the location, as latitude and longitude, of the node.
>
>Here is the list of nodes that I have removed from the geographic maps
>because their data is so wrong that it messes up the maps if I include them:

Here's a perl script I wrote last year to sanity-check my map entries
before I send them in.  It'll tell you if, among other things, you've
hosed your #L entry.  (Please, no comments on style, it was my first
perl program larger than 5 lines.  I haven't looked at it since last
spring.)  Bug fixes, etc, welcome.

To run it, you have to put acode.pl in your perl library directory.  I
do something like:

	comb pa widener

to check the file `widener' that contains my map entry.  You can also,
for example, do

	comb pa u.usa.pa.1 u.usa.pa.2 u.usa.pa.3

to run it on all of the maps for a state.

I was thinking, it'd be cool to have an email address on an Internet
site which, given a zip code in the body of the message (`zip xxxxx'),
would return the full info given by the geographic server at
martini.eecs.umich.edu on port 3000.  That would help people get the
longitude & latitude right.  It'd probably be really easy to do with a
simple mail parser [I have a decent small one if you want it] and a
back-end that uses chat2.  (This has been on my ToDo list for a long
time.)

--
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  comb.pl acode.pl
# Wrapped by brendan@betty on Wed Jul 15 11:31:52 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'comb.pl' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'comb.pl'\"
else
echo shar: Extracting \"'comb.pl'\" \(7694 characters\)
sed "s/^X//" >'comb.pl' <<'END_OF_FILE'
X#!/bin/perl
X#
X# comb v1.0 - 04/11/91 - by Brendan Kehoe (brendan@cs.widener.edu)
X#
X# Go thru a pathalias map (or set of maps) checking out how proper
X#  it is. Derived from maps.pl, a more versatile pathalias tool (still
X#  in development).
X#
X#       comb [-n] state map1 [map2 .. mapn]
X#
X#		-n = produce non-vital NOTEs in addition to ERRORs
X#		state = the two-letter abbrev for the state
X#		map1..mapn = one or more files containing one or
X#	        	     more maps
X#
X# BUGS:
X#    1 -  doesn't deal with multiple #E lines
X#    2 -  doesn't deal with multiple #T lines
X#
X($program = $0) =~ s%.*/%%;
X
Xwhile ($ARGV[0] =~ /^-/) {
X    $ARGV[0] =~ s/^-//; 
X    foreach $flag ( split (//,$ARGV[0]) ) {
X	if ( 'n' !~ /$flag/ ) {
X	    printf stderr "unknown flag: %s\n", $flag;
X	    die "usage: $program [-n] state [map ...]\n";
X	} 
X	die "$0: '$flag' flag already set\n" if ($flags{$flag}++);
X    } 
X    shift;
X}
X
Xdie "usage: $program [-n] state [map ...]\n" if (($state = $ARGV[0]) eq "");
X
X# get the area codes
Xrequire "acode.pl";
X
Xshift;
X$state =~ tr/a-z/A-Z/;
X
X# get the areacode for the state
X$state_ac = $ind{$state};
Xdie "usage: $program [-n] state [map ...]\n" if
X    (($acs = join(' ', @ac[$state_ac..$state_ac+$number{$state}-1])) eq "");
X
X#$date = `date`;
X#print "$date\n";
X$| = 1; print STDERR "One moment, parsing in $state...";
X@types = ( 'N', 'F', 'S', 'O', 'C', 'E', 'T', 'P', 'L', 'R', 'U', 'W' );
X($n, $f, $s, $o, $c, $e, $t, $p, $l, $r, $u, $w) = 
X    (1,2,4,8,16,32,64,128,256,512,1024, 2048);
X
X$mandatory = $n | $s | $o | $c | $e | $t | $p | $l | $w;
X
X# this should never even be seen
X$site = "NoSuchSite";
X
Xwhile (<>) {
X    chop;
X
X    # check out the name
X    /^\#N\s+(.*)/ && do {
X	if (! $1) { &error("\#N line has no HOST!!\n"); } else {
X	    $site = &getsite($1); }
X
X	$flag{$site} = 0;
X    };
X
X    # check out the Internet forwarder, if any
X    /^\#F\s*(.*)/ && do {
X	$flag{$site} |= $f;
X	if (! $1) { &note("empty \#F line unnecessary\n"); }
X    };
X
X    # check out the machine & os
X    /^\#S\s*(.*)/ && do {
X	$flag{$site} |= $s;
X	if (! $1) { &note("\#S line is empty\n"); } else {
X	    $1 !~ /;/ && do { &error("\#S line is missing its ';'\n"); };
X	}
X    };
X
X    # check out the organization
X    /^\#O\s*(.*)/ && do {
X	$flag{$site} |= $o;
X	if (! $1) { &note("\#O line is empty\n"); } else {
X	    if (length($1) > 80) {
X		&error("\#O line is too long (80 max)\n");
X	    }
X	}
X    };
X
X    # check out the contact
X    /^\#C\s*(.*)/ && do {
X	$flag{$site} |= $c;
X	if (! $1) { &note("\#C has no contact!\n"); }
X    };
X
X    # check out the contact's email addr
X    /^\#E\s*(.*)/ && do {
X	$flag{$site} |= $e;
X	if (! $1) { &note("\#E has no email address for the contact\n"); }
X	else {
X	    $1 !~ /!/ && do {
X		$1 =~ /@/ ? &note("\#E line has @ addr instead of !.\n")
X		    : &error("\#E line has a possibly bad address\n");
X	    };
X	}
X    };
X
X    # check out the contact's tele
X    # The only legal format is '+1 aaa ppp xxxx'; but there are things
X    #  throughout all the maps that're like:
X    #      (aaa) ppp xxxx            (aaa)-ppp-xxxx
X    #      1+ aaa ppp xxxx           aaa-ppp-xxxx
X    #      aaa.xxx.pppp              1 aaa ppp xxxx
X    #      +1 aaa ppp {xxxx,xxxx}
X    # We'll stick with the strictly legal one, in the hopes that map
X    #  administrators will clean up the tel no's that don't conform.
X    # Also some sites list the extension with 'ex' instead of 'x'.
X    /^\#T\s*(.*)/ && do {
X	$flag{$site} |= $t;
X	if (! $1) { &note("\#T line is empty\n"); } else {
X	    $foo = $1;
X	    # izzit legal?
X	    if ($foo !~ /^\+1 ([0-9]{3}) [0-9]{3} [0-9]{4}[ ]*x*[0-9]*/o) {
X		&error("\#T line has a bad format ('$foo')\n");
X	    } else {
X		if (index($acs, $1) eq -1) {
X		    &error("\#T AreaCode is bad ('$foo')\n");
X		}
X	    }
X	    # if there are words (like 'evening', etc), suggest that
X	    #  they move the stuff down into the remarks
X	    # allow the letter 'x' for the extension
X	    $foo =~ /[a-wyzA-WYZ]+/ && do {
X		&note("Perhaps describe the \#T in \#R(emarks)?\n");
X	    };
X	}
X    };
X     
X    # check out the organization's addr
X    /^\#P\s+(.*)/ && do {
X	$flag{$site} |= $p;
X	if (! $1) { &note("\#P line is empty\n"); }
X    };
X
X    # check out the longitude & latitude
X    # should be 'DD MM [SS] N|S / DDD MM [SS] E|W ["city"]'
X    /^\#L\s+(.*)/ && do {
X	$flag{$site} |= $l;
X	if (! $1) { &note("\#L has no coordinates\n"); } else {
X	    $foo = $1;
X	    if ($foo =~ /.*[EW].*[NS]/) {
X		&error("\#L line has a reversed order ('$foo')\n");
X	    } elsif (!($foo =~ /[0-9]{2}[ ]+[0-9]{2}[ ]*[0-9]*[ ]+[N|S][ ]+\/[ ]+[0-9]{2}[0-9]*[ ]+[0-9]{2}[ ]*[0-9]*[ ]+[E|W][ ]*[Cc]*[Ii]*[Tt]*[Yy]*/o)) {
X		&error("\#L line has a bad format ('$foo')\n");
X	    }
X	}
X    };
X
X    # check out any remarks
X    /^\#R\s+(.*)/ && do {
X	$flag{$site} |= $r;
X	if (! $1) { &note("empty \#R line is unnecessary\n"); }
X    };
X
X    # check out any netnews neighbors
X    /^\#U\s+(.*)/ && do { 
X	$flag{$site} |= $u;
X	if (! $1) { &note("empty \#U line is unnecessary\n"); }
X    };
X
X    # check out when this was done and by whom
X    /^\#W\s+(.*)/ && do {
X	$flag{$site} |= $w;
X	if (! $1) { &error("\#W has no name or date\n"); } else {
X	    $real = $1;
X	    ($real !~ /\(.*\)/) && do {
X		&error("\#W line should have (Contact's Real Name)\n");
X	    };
X	    if ($real !~ /;/) {
X		&error("\#W line has no ';' on it\n");
X	    } else {
X		# Make sure the date's good. This one will reject
X		#  dates of (e.g.) 'Tue,  5 Jan..' (the day is where the
X		#  month should be); rather than deal with this case
X		#  (the few I've found are from uunet), it'll bitch;
X		#  if you want it to work on it, add a 2nd regexp
X		!/^\#W\s+.*;[ \t]*[^ ].[^,][,]*[ \t]+[^ ].[^ ][ \t]+[ 0-3]*[0-9][ \t]+[ 0-9]*[0-9]:[ 0-9]*[0-9]:*[ 0-9]*[0-9]*[ \t]+[A-Z]{2}T[ \t]+[0-9]{4}/o
X		    && do {
X			&error("\#W line has a bad date on it\n");
X		    };
X	    }
X	}
X    };
X
X    # check out any equivalencies, like 'foo = foo.internet.name'
X    # XXX: This needs to accept grouping, and addlinks() has to
X    #      deal with it too, e.g.:
X    #                      blah = { site1, site2, site3 }
X    #                      foo blah(LOCAL)
X    #      the cost of LOCAL gets distributed across every site in blah
X    /^$site\s*=\s*(.+)/ && do {
X	if (! $1) { &error("host equivalency line is empty\n"); }
X    };
X
X    # maybe create parsing rules for connectivity; not now.
X}
X
Xprint STDERR "Done.\n"; $| = 0;
X#$date = `date`;
X#print "$date\n";
Xforeach $site (sort (keys flag)) {
X    $cleansite = $site . substr("        ", 0, 9 - length($site));
X
X    for ($i = 1; $i < $numerrs{$site}; $i++) {
X	print "ERROR ($cleansite): $error{$site . $i}";
X    }
X
X    if ($flags{'n'}) {
X	for ($i = 1; $i < $numnotes{$site}; $i++) {
X	    print "NOTE  ($cleansite): $note{$site . $i}";
X	}
X    }
X
X    $bit = $cur = 1;
X    while (($bit <<= 1) < 4096) {
X	if ($mandatory & $bit) {
X	    if (!($flag{$site} & $bit)) {
X		print "ERROR ($cleansite): \#$types[$cur] line is MISSING\n";
X	    }
X	}
X	$cur++;
X    }
X}
X
X# say it's an error 
Xsub error { $error{$site . $numerrs{$site}++} = @_[0]; };
X
X# say a note
Xsub note  { if ($flags{'n'}) { $note{$site . $numnotes{$site}++} = @_[0]; } };
X
X# parse down the site name so we can get their UUCP name
X# deal with:
X#     .bar.com, foo               foo
X#     foo.bar.com, foo            foo, foo.bar.com
X#     .bar.com, foo.bar.com, foo  foo, foo.bar.com, foo.bat.com
Xsub getsite {
X    local($pos) = @_[0];
X    # host, foo.bar, test.that, .one.too
X    if ($pos =~ /^([^\.,]+),.*/) { return $1; }
X    # foo.bar, .test.this, host
X    elsif ($pos =~ /((\.*[\w\-]+)+,)+\s*([\w\-]*)/) { return $3; }
X    # host (added . and , to deal with things like cs.utexas.edu)
X    else { $pos =~ /\s*([\w\-\.\,]+)/; return $1; }
X}
END_OF_FILE
if test 7694 -ne `wc -c <'comb.pl'`; then
    echo shar: \"'comb.pl'\" unpacked with wrong size!
fi
chmod +x 'comb.pl'
# end of 'comb.pl'
fi
if test -f 'acode.pl' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'acode.pl'\"
else
echo shar: Extracting \"'acode.pl'\" \(3210 characters\)
sed "s/^X//" >'acode.pl' <<'END_OF_FILE'
X%number = ('AK',  1, 'AL', 1, 'AR', 1, 'AZ', 1, 'BH', 1, 'CA', 12,
X	   'CN', 15, 'CO', 2, 'CT', 1, 'DC', 1, 'DE', 1,
X	   'FL',  4, 'GA', 2, 'HI', 1, 'IA', 3, 'ID', 1,
X	   'IL',  6, 'IN', 3, 'KS', 2, 'KY', 2, 'LA', 2,
X	   'MA',  3, 'MD', 2, 'ME', 1, 'MI', 4, 'MN', 3,
X	   'MO',  3, 'MS', 1, 'MT', 1, 'MX', 2, 'NC', 2,
X	   'ND',  1, 'NE', 2, 'NH', 1, 'NJ', 3, 'NM', 1,
X	   'NV',  1, 'NY', 8, 'OH', 4, 'OK', 2, 'OR', 1, 'PA', 4,
X	   'RI',  1, 'SC', 1, 'SD', 1, 'TN', 2, 'TX', 8,
X	   'UT',  1, 'VA', 2, 'VT', 1, 'WA', 2, 'WI', 3,
X	   'WV',  1, 'WY', 1,
X	   );
X
X%ind = ( 'AK', 0  ,  'AL', 1  ,  'AR', 2  ,  'AZ', 3  , 
X         'BH', 4  ,  'CA', 5  ,  'CN', 17 ,  'CO', 32 , 
X         'CT', 34 ,  'DC', 35 ,  'DE', 36 ,  'FL', 37 , 
X         'GA', 41 ,  'HI', 43 ,  'IA', 44 ,  'ID', 47 , 
X         'IL', 48 ,  'IN', 54 ,  'KS', 57 ,  'KY', 59 , 
X         'LA', 61 ,  'MA', 63 ,  'MD', 66 ,  'ME', 68 , 
X         'MI', 69 ,  'MN', 73 ,  'MO', 76 ,  'MS', 79 , 
X         'MT', 80 ,  'MX', 81 ,  'NC', 83 ,  'ND', 85 , 
X         'NE', 86 ,  'NH', 88 ,  'NJ', 89 ,  'NM', 92 , 
X         'NV', 93 ,  'NY', 94 ,  'OH', 102,  'OK', 106, 
X         'OR', 108,  'PA', 109,  'RI', 113,  'SC', 114, 
X         'SD', 115,  'TN', 116,  'TX', 118,  'UT', 126, 
X         'VA', 127,  'VT', 129,  'WA', 130,  'WI', 132, 
X         'WV', 135,  'WY', 136, );
X
X@ac = (907,			# AK
X       205,			# AL
X       501,			# AR
X       602,			# AZ
X       809,			# bahamas, bermuda, pr, vi
X       209, 213, 310, 408, 415,	# CA
X       510, 619, 707, 714, 805,	# CA cont'd
X       818, 916,		# CA cont'd
X       204, 306, 403, 416, 418, # Canada
X       506, 514, 519, 604, 613,	# Canada cont'd
X       705, 709, 807, 819, 902,	# Canada cont'd
X       303, 719,		# CO
X       203,			# CT
X       202,			# DC
X       302,			# DE
X       305, 407, 813, 904,	# FL
X       404, 912,		# GA
X       808,			# HI
X       319, 515, 712,		# IA
X       208,			# ID
X       217, 309, 312, 618, 708,	# IL
X       815,			# IL cont'd
X       219, 317, 812,		# IN
X       316, 913,		# KS
X       502, 606,		# KY
X       318, 504,		# LA
X       413, 508, 617,		# MA
X       301, 410,		# MD
X       207,			# ME
X       313, 517, 616, 906,	# MI
X       218, 507, 612,		# MN
X       314, 417, 816,		# MO
X       601,			# MS
X       406,			# MI
X       706, 905,		# Mexico (MX)
X       704, 919,		# NC
X       701,			# ND
X       308, 402,		# NE
X       603,			# NH
X       201, 609, 908,		# NJ
X       505,			# NM
X       702,			# NV
X       212, 315, 516, 518, 607,	# NY
X       716, 718, 914,		# NY cont'd
X       216, 419, 513, 614,	# OH
X       405, 918,		# OK
X       503,			# OR
X       215, 412, 717, 814,	# PA
X       401,			# RI
X       803,			# SC
X       605,			# SD
X       615, 901,		# TN
X       214, 409, 512, 713, 806,	# TX
X       817, 903, 915,		# TX cont'd
X       801,			# UT
X       703, 804,		# VA
X       802,			# VT
X       206, 509,		# WA
X       414, 608, 715,		# WI
X       304,			# WV
X       307,			# WY
X       );
X
X# code to generate the ind:
X#
X#$total = $num = 0;
X#print "%ind = (";
X#foreach $state (sort (keys number)) {
X#    printf " \'%s\', %-3d, ", $state, $total;
X#    $total += $number{$state};
X#    $num++;
X#    if ((++$num % 8) eq 0) { print "\n        "; $num = 0; };
X#}
X#print ");\n";
END_OF_FILE
if test 3210 -ne `wc -c <'acode.pl'`; then
    echo shar: \"'acode.pl'\" unpacked with wrong size!
fi
# end of 'acode.pl'
fi
echo shar: End of shell archive.
exit 0
-- 
Brendan Kehoe, Sun Network Manager                      brendan@cs.widener.edu
Widener University                                                 Chester, PA
                                              At Bennigan's, EVERYONE gets it!
Technical Details
Message-ID: <141jh9INNdlm@betty.cs.widener.edu>
Path: arc1-ca.pugleaf.net!wupost!tulane!ukma!widener!nobody
References: <1992Jul14.165918.24010@PA.dec.com>

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!wupost!tulane!ukma!widener!nobody
From: brendan@cs.widener.edu (Brendan Kehoe)
Newsgroups: news.admin,news.sysadmin,comp.lang.perl,alt.sources,comp.mail.uucp
Subject: Sanity-checking UUCP maps
Followup-To: comp.mail.uucp
Date: 15 Jul 1992 12:25:13 -0400
Organization: Widener University Computer Science Dept, Chester PA
Lines: 438
Sender: brendan@cs.widener.edu (Brendan Kehoe)
Distribution: world
Message-ID: <141jh9INNdlm@betty.cs.widener.edu>
References: <1992Jul14.165918.24010@PA.dec.com>
NNTP-Posting-Host: betty.cs.widener.edu