#! /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:  prcheck.pl prcheck.8 Makefile README INSTALL CHANGES TODO
# Wrapped by tony@mature.ripe.net on Thu Aug 18 15:33:20 1994
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f prcheck.pl -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"prcheck.pl\"
else
echo shar: Extracting \"prcheck.pl\" \(31632 characters\)
sed "s/^X//" >prcheck.pl <<'END_OF_prcheck.pl'
X#!PERL
X#
X# 
X# Copyright (c) 1993, 1994 The RARE Association 
X# 
X# All Rights Reserved
X# 
X# Permission to use, copy, modify, and distribute this software and its 
X# documentation for any purpose and without fee is hereby granted, 
X# provided that the above copyright notice appear in all copies and that
X# both that copyright notice and this permission notice appear in 
X# supporting documentation, and that the name of the author not be
X# used in advertising or publicity pertaining to distribution of the
X# software without specific, written prior permission.  
X# 
X# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
X# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
X# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
X# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
X# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, ARISING OUT OF
X# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
X#
X#       $RCSfile: prcheck.pl,v $
X#       $Revision: 0.26 $
X#       $Author: tony $
X#       $Date: 1994/08/17 11:45:17 $
X#
X# ############################################################################
X# #                                                                          #
X# # prcheck - check the syntax, semantics and other things in a policy object#
X# #                                                                          #
X# # This is a first pass (very rough as well) at some sort of check  of      #
X# # a policy object. Will get better as the PRIDE tools become more developed#
X# #                                                                          #
X# # Here a policy object means a RIPE-81 object. The idea behind this is to  #
X# # give the operators something they can use to test their policy objects   #
X# # before they send it in. It will do various levels of checking depending  #
X# # on what you want.                                                        #
X# #                                                                          #
X# # Each test is split into various levels. See $tname array.                #
X# #                                                                          #
X# ############################################################################
X# #
Xrequire "getopts.pl";
X# #
X$whoishost      = "WHOISHOST";
X$keepopen       = TRUE;
X$fast 		= "FAST";
X$version 	= "VERSION";
X$port           = PORT;   
X$AF_INET        = 2;
X$SOCK_STREAM    = SOCKSTREAM;
X#
X# Change this and everything breaks.
X#
X$fd             = S;
X#
X# Some counters.
X$error          = 0;
X$warn           = 0;
X$whoisq         = 0;
X#
X# Current levels supported
X#
X$MAXLEVEL       = 7;		# This includes a unsupported check 7.
X#
X# Change this if you want >2 means a lot more work.
X#
X$DEFLEVEL       = 2;
X#
X# Return codes for check currently only $R_ERROR is actually used os far
X$R_OK           = 1;
X$R_ERROR        = 2;
X$R_WARNING      = 3;
X$R_OTHER        = 4;
X#
X# These are general policy lines we use to build the big associate array.
X# It sort of matches the short-forms but I don't bother with the star.
X# DO NOT CHANGE THIS ORDER
X@KEYWORDS = (
X        "ai",
X        "ao",
X        "df",
X        "an",
X);
X# Now the mappings
X$long{"ai"}     = "as-in";
X$long{"ao"}     = "as-out";
X$long{"df"}     = "default";
X$long{"an"}     = "aut-num";
X#
X# The Test names
X#
X$tname[1]       = "Syntax check of policy components";
X$tname[2]       = "Semantic check of policy expressions";
X$tname[3]       = "Peer comparison";
X$tname[4]       = "Syntax check of peer policy components";
X$tname[5]       = "Semantic check of peer policy expressions";
X$tname[6]       = "Policy expression comparison";
X$tname[7]       = "Generate cisco as-path lists per peers (experimental)";
X#
X# As L'oncle says "I'm flag crazy !!!"
X#
X&Getopts('vsdh:p:f:o:l:KVFS');	# KVF undocumented
X#
X# Told you !!
X#
X$usage="Usage: $0 [-v] [-d] policy-object\nOther: [-S] [-h whoishost] [-p port] [-f ASfilename | -s ] [-o filename] [ -l level ]";
X 
Xif ($#ARGV != 0 && !$opt_S) {
X        print STDERR "$usage\n";
X        exit 1;
X}
Xif ($ENV{"PRTRACEHOST"}) {
X	$whoishost = &getfqdn($ENV{"PRTRACEHOST"});
X} 
Xif ($opt_h) {
X        $whoishost = &getfqdn($opt_h);
X}
Xif ($ENV{"PRTRACEPORT"}) {
X    $port = $ENV{"PRTRACEPORT"};
X}
Xif ($opt_p) {
X    $port = $opt_p;
X}
X
X 
Xif ($opt_f) {
X        $filename = $opt_f;
X}
X 
Xif ($opt_l) {
X    if (($chklevel = &atoilevel($opt_l)) == -1) {
X	print STDERR "$0: bad level \"$opt_l\"\n";
X	exit 1;
X    }
X} else {
X    $chklevel = $DEFLEVEL;
X}
X# 
Xif ($keepopen =~ /^TRUE$/) {
X    $keepopen = 1;
X} else {
X    $keepopen = 0;
X}
Xif ($opt_K) {
X    $keepopen = 0;
X}
Xif ($fast =~ /^TRUE$/) {
X    $fast = 1;
X} else {
X    $fast = 0;
X}
Xif ($opt_F) {
X    $fast = 0;
X}
Xif ($version=~ /^TRUE$/ ) {	                # Tell whoisd version
X    $versionno = "\$Revision: 0.26 $";          # " extra quote to fool emacs
X    $versionno =~ s/\$Revision\: //;
X    $versionno =~ s/ \$$//;
X    $version = 1;
X} else {
X    $version = 0;
X}
Xif ($opt_V) {
X    $version = 0;
X}
X
X
Xif ($opt_f && $opt_s) {
X    printf STDERR "%s: Why do you want to read from a file and stdin ?\n", $0;
X    exit 1;
X}
X
Xif ($opt_S) {
X    printf "Summary of prcheck tests available\n";
X    for ($i = 1; $i < $MAXLEVEL+1; $i++) {
X	printf "Test %s - %s\n", $i, $tname[$i];
X    }
X    exit 0;
X}
X
Xif ($opt_o) {
X    $outfile = $opt_o;
X    open(OUT, "+>$outfile") || die "$0: cannot open outputfile $outfile $!\n";
X    if ($opt_v) {
X	printf STDERR "all output will be written to %s\n", $outfile;
X    }
X} else {
X    open(OUT, ">&STDOUT") ||  die "$0: cannot dup stdout $!\n";
X}
Xselect(OUT); $| = 1;
X
X$ouras = $ARGV[0];
X$ouras =~ tr/a-z/A-Z/;
X
Xif ($opt_f) {
X    open(F, "$filename") || die "$0: cannot open $filename $!\n";
X} elsif ($opt_s) {
X    $fd=STDIN;
X} else {
X    &whois("-a $ouras");
X}
X
X# First read in our own object. This can come from either built-in whois, 
X# standard input where the object is seperated by an etra carriage return
X# or from a file where the it will try to find it and then not look any further
X# in that file.
X
Xif($opt_f) {
X    $fd = F;
X}
X# Read our AS as required
X$SIG{'ALRM'} = 'alarmread';
Xif($opt_f || $opt_s) {
X    alarm(0);
X} else {
X    alarm(2);
X}
X&asread($ouras);
X#
X# This whole main needs a complete re-write I know ;-(
X# 
Xif(!$gotsomeinfo{$ouras}) {
X    printf STDERR "Exiting - cannot find any information for $ouras\n";
X    exit(1);
X}
Xif(!$gotsomepol{$ouras}) {
X    &pw("$ouras doesn't contain any policy information");
X}
Xalarm(0);
X# Remember to set the FD
X
X$fd = S;
X
X# Then do a basic syntax check on our own object as read in.
X&checksyn($ouras);
X
X
X
X
X$curlevel++;
Xprintf OUT "---\nlevel $curlevel $tname[$curlevel]\n";
X
Xif($chklevel == 1) {
X    printf OUT "level $curlevel complete\n";
X    &summary($chklevel);
X    exit 0;
X} else {
X    printf OUT "level $curlevel complete - continuing...\n\n";
X}
X#
X# Check the semantics of the policy object.
X#
X$curlevel++;
Xprintf OUT "---\nlevel $curlevel $tname[$curlevel]\n";
X
X&checksem($ouras);
X#        &printpolicy($ouras);
X# 
Xif($chklevel == 2) {
X    printf OUT "level $curlevel complete - exiting\n";
X    &summary($chklevel);
X    exit 0;
X} else {
X    printf OUT "level $curlevel complete - continuing...\n\n";
X}
X
X#
X# Next get all our information on the peers
X# and check peer to peer relationships exist or not.
X#
X
X$curlevel++;
Xlocal($i,$j) = 0;
X
Xprintf OUT "---\nlevel $curlevel $tname[$curlevel] - Getting peer info wait..\n";
Xforeach $i (@KEYWORDS[0..2]) {
X    foreach $j (split(/\n/, $polarray{"$ouras:$i"})) {
X	($peer, $tmp)  = split(/\s+/, $j);
X	if (!$done{$peer}) {
X	    &whois ("-a $peer");
X	    &asread($peer);
X	}
X    }
X}
Xlocal($x) = 0;
Xforeach $x (keys %done) {
X    next if ($x eq $ouras);
X    printf OUT "  checking against peer %6s\n", $x;
X    &checkp2p($ouras,$x);
X}
X
Xif($chklevel == 3) {
X    printf OUT "level $curlevel complete - exiting\n";
X    &summary($chklevel);
X    exit 0;
X} else {
X    printf OUT "level $curlevel complete - continuing...\n\n";
X}
X				 
X			       
X# Now check the syntax of any reference peer.
X#
X$curlevel++;
Xprintf OUT "---\nlevel $curlevel $tname[$curlevel]\n";
X
Xforeach $x (keys %done) {
X    next if ($x eq $ouras);
X    printf OUT "  checking peer %6s\n", $x;
X    &checksyn($x);
X}
X
Xif($chklevel == 4) {
X    printf OUT "level $curlevel complete - exiting\n";
X    &summary($chklevel);
X    exit 0;
X} else {
X    printf OUT "level $curlevel complete - continuing...\n\n";
X}
X
X#
X# Now check the semantics of any referenced peer as well.
X# Also build the policy info as well into three global associative arrays
X# %permitlist
X# %denylist
X# %exist
X# Where key is "ourAS:thereAS@weight" where weight "-1" means as-out
X#
X
X$curlevel++;
Xprintf OUT "---\nlevel $curlevel $tname[$curlevel]\n";
X
Xforeach $x (keys %done) {
X    next if ($x eq $ouras);
X    printf OUT "  checking peer %6s\n", $x;
X    &checksem($x);
X#               &printpolicy($x);
X}
X
Xif($chklevel == 5) {
X    printf OUT "level $curlevel complete - exiting\n";
X    &summary($chklevel);
X    exit 0;
X} else {
X    printf OUT "level $curlevel complete - continuing...\n\n";
X}
X        
X#
X# Now try to check each policy against each other - lovely stuff
X#
X$curlevel++;
Xprintf OUT "---\nlevel $curlevel $tname[$curlevel]\n";
X
Xforeach $x (keys %done) {
X    next if ($x eq $ouras);
X    printf OUT "  checking peer %6s\n", $x;
X    &checkpol2pol($ouras,$x);
X   }
X
Xif($chklevel == 6) {
X    printf OUT "level $curlevel complete - exiting\n";
X    &summary($chklevel);
X    exit 0;
X} else {
X    printf OUT "level $curlevel complete - continuing...\n\n";
X}
X#
X# cisco as-path list (NOT VERY GOOD BUT...)
X#
X$curlevel++;
Xprintf OUT "---\nlevel $curlevel $tname[$curlevel]\n";
X
Xforeach $x (keys %done) {
X    next if ($x eq $ouras);
X    &dopolists($ouras,$x);
X}
X
Xif($chklevel == $MAXLEVEL) {
X    printf OUT "level $curlevel complete - exiting\n";
X    &summary($chklevel);
X    exit 0;
X}
X#
X#
X# Return the fully qualified domain name.
X#
Xsub getfqdn {
X    local($host) = @_;
X#
X# resolve an address first
X#
X    if($host =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) { 
X        local($tmp) = pack('C4', $1, $2, $3, $4);
X        local($name, $alias, $addrtype, $length, @addr) = gethostbyaddr($tmp,2);
X        if (defined($name)) {
X            return($name);
X        } else {
X            return($host);
X        }
X    }   
X#
X# okay then try a name
X#           
X
X    local($name, $alias, $addrtype, $length, @addr) = gethostbyname($host);  
X    if (!defined($name)) {
X	print STDERR "$0: unknown host $host\n";
X	exit 1;
X    }
X    return($name);
X}
X
Xsub pw {
X    local ($str) = @_;
X    printf OUT "  *WARNING*: $str\n";
X}
Xsub pe {
X    local ($str) = @_;
X    printf OUT "  *ERROR*: $str\n";
X}
Xsub dopolists {
X    local($us, $them) = @_;
X    local($i) = "";
X    local($ind,$wght) = "";
X    foreach $i (keys %exist) {
X	if ($i !~ /^$us:$them/) {
X	    next;
X	}
X	($couple,$wght) = split(/@/, $i);
X	$number++;
X	&genciscofilter(*us, *them, *wght);
X    }
X}
Xsub genciscofilter {
X    local(*us, *them, *wght) = @_;
X    local(@permit, @deny) = ();
X    local($list, $flag);
X    $catchallflag = 0;
X    
X    printf OUT "!%s for %s\n",
X    ($wght eq "-1") ? "out-bound filter-list" : "in-bound filter-list ".
X	"at weight ".$wght, $them;
X    print OUT "no ip as-path access-list $number\n";
X    $list = $denylist{"$us:$them@$wght"};
X    $flag = "deny";
X    &genfilter(*list, *peer, *flag, *us);
X    $list = $permitlist{"$us:$them@$wght"};
X    $flag = "permit";
X    &genfilter(*list, *peer, *flag, *us);
X    if (!$catchallflag) {
X	print OUT "ip as-path access-list $number ";
X	if ($denylist{"$us:$them@$wght"} && $permitlist{"$us:$them@$wght"}) {
X	    print OUT "deny .*\n";
X	}
X	elsif ($denylist{"$us:$them@$wght"}) {
X	    print OUT "permit .*\n";
X	}
X	else {
X	    print OUT "deny .*\n";
X	}
X    }
X    print OUT "!\n";
X }
X
Xsub genfilter {
X
X    local(*list, *peer, *flag, *us) = @_;
X    local(@args) = ();
X    local($i);
X    local($tmp) = "";
X    local($foo) = "";
X    $foo = $us;
X    $foo  =~ s/AS//;		# Keep a local copy of our AS number
X    @args = split(/%/, $list);
X    for $i (0..$#args) {
X
X	# Can't do RIPE-DB
X
X	if ($args[$i] =~ /RIPE-DB/) {
X	    $warn++;
X	    $failw{$curlevel}  = 1;
X	    print OUT "!*WARNING* Cannot do RIPE-DB in cisco filterlists\n";
X	    return;
X	}
X
X	# Can't do LOCAL
X
X	elsif ($args[$i] =~ /LOCAL/) {
X	    $warn++;
X	    $failw{$curlevel}  = 1;
X	    print OUT "!*WARNING* Cannot do LOCAL in cisco filterlists\n";
X	    return;
X	}
X
X	# Catch ANY i.e. .*$ correctly
X
X	elsif ($args[$i] =~ /ANY/) {
X	    $tmp = substr($args[$i], 2);
X	    print OUT "ip as-path access-list $number ";
X	    print OUT "$flag .*\n";
X	    $catchallflag = 1;
X	}
X
X	#  Now do the actual ASes
X
X	elsif ($args[$i] =~ /AS\d+/) {
X	    $tmp = substr($args[$i], 2);
X	    print  OUT "ip as-path access-list $number "; 
X	    # 
X	    # This checks if it is the local AS as this has ^$ as it 
X	    # representation
X	    # 
X            if ($tmp eq $foo) {
X		print OUT "$flag \^\$\n";
X	    }
X	    else {
X		print OUT "$flag .* $tmp\$\n"; 
X	    }
X	}
X    }
X}
X
X# checkpol2pol
X#
X# This concatenates all the as-in (weight != -1) into a permit and deny array
X#
Xsub checkpol2pol {
X    local($us,$them) = @_;
X    local($i) = "";
X    local($ind,$tmp) = "";
X    local(%p,%d) = ();
X    #&printpolicy($us);
X    #&printpolicy($them);
X    foreach $i (keys %exist) {
X	if($i !~ /^$us:$them/ && $i !~ /^$them:$us/) {
X	    next;
X	}
X	($ind,$tmp) = split(/@/, $i);
X	next if $tmp eq "-1";	# Don't put in the as-out lines
X	$p{$ind} .= $permitlist{$i};
X	$d{$ind} .= $denylist{$i};
X    }
X    &dopol2pol($us,$them,$p{"$us:$them"},$d{"$us:$them"},
X	       $permitlist{"$them:$us@-1"},$denylist{"$them:$us@-1"});
X    &dopol2pol($them,$us,$p{"$them:$us"},$d{"$them:$us"},
X	       $permitlist{"$us:$them@-1"},$denylist{"$us:$them@-1"});
X}
X
Xsub dopol2pol {
X    local($myas,$youras,$myp, $myd, $yourp, $yourd) = @_;
X    
X    $myd =~ s/%$//;
X    $myp =~ s/%$//;
X    $yourp =~ s/%$//;
X    $yourd =~ s/%$//;
X    local(@myp) = split(/%/, $myp);
X    local(@myd) = split(/%/, $myd);
X    local(@yourp) = split(/%/, $yourp);
X    local(@yourd) = split(/%/, $yourd);
X
X    if ((($myp eq "") || ($myp eq "ANY")) && ($myd eq "")) {
X	return;
X    }
X    if ((($yourp eq "") || ($yourp eq "ANY")) && ($yourd eq "")) {
X	return;
X    }
X
X    foreach $i (@myp) {
X       	if ($yourp =~ s/^$i$|^$i%|%$i$//) {
X	    next;
X	}
X	if ($yourp =~ s/%$i%/%/) {
X	    next;
X	}
X	if ($yourd =~ /$i/) {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    &pw("\n\t$myas is announcing $i to".
X		" $youras\, but it is not permitted");
X	    next;
X	}
X	if ($yourd =~ /^ANY$/) {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    &pw("\n\t$youras not permitting anything from $myas");
X	    next;
X	}
X	if ($i =~ /^ANY$/) {
X	    next;
X	}
X	if ($yourp eq "ANY") {
X	    next;
X	}
X	$error++;
X	$faile{$curlevel} = 1;
X	&pe("\n\t$myas is permitting ".
X	    "$i from $youras\, but it is not announced");
X    }
X    foreach $i (@yourp) {
X	if ($myp =~ s/^$i$|^$i%|%$i$//) {
X	    next;
X	}
X	if ($myp =~ s/%$i%/%/) {
X	    next;
X	}
X	if ($myd =~ /$i/) {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    &pw("\n\t$youras is announcing $i but $myas is not permitting it");
X	    next;
X	}
X	if ($myd =~ /^ANY$/) {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    &pw("\n\t$myas is not permitting anything from $youras");
X	    next;
X	}
X	if ($i eq "ANY") {
X	    next;
X	}
X	if ($myp eq "ANY") {
X	    next;
X	}
X	$error++;
X	$faile{$curlevel} = 1;
X	&pe("\n\t$youras is announcing $i".
X	    " to $myas\, but it is not permitted");
X    }
X}
X
X# checkp2p - peer 2 peer checking.
X# 
X# Find all my as-in for peer
X#         check for as-out in peer
X#               else check for a default
X#                   else error
X# Find all my as-outs for them
X#         check for as-ins in peer
X#               else check for default
X#         else error
X#
X# Find all my defaults for them
X#         check for as-outs
X#               else check for a default (possible loop)
Xsub checkp2p {
X    local($us, $them) = @_;
X    local($i);
X    local($ok) = 0;
X    
X    if ($polpeers{"$us%i%$them"} == 1) {
X	if($polpeers{"$them%o%$us"} == 1) {
X	    $ok = 1;
X	} elsif ($polpeers{"$them%d%$us"} == 1) {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    print OUT "  *WARNING*:\n\tNo corresponding $long{ao} in $them but $long{df} exists\n";
X	} 
X	else {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    print OUT "  *WARNING*:\n\tNo corresponding $long{ao} in $them for $us $long{ai} line\n";
X	}
X    }
X        
X        
X    if ($polpeers{"$us%o%$them"} == 1) {
X	if($polpeers{"$them%i%$us"} == 1) {
X	    $ok = 1;
X	} elsif ($polpeers{"$them%d%$us"} == 1) {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    print OUT "  *WARNING*:\n\tNo corresponding $long{ai} in $them but $long{df} exists\n";
X	} 
X	else {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    print OUT "  *WARNING*:\n\tNo corresponding $long{ai} in $them for $us $long{ao} line\n";
X	}
X    }
X    
X    if ($polpeers{"$us%d%$them"} == 1) {
X	if($polpeers{"$them%o%$us"} == 1) {
X	    $ok = 1;
X	} else {
X	    $warn++;
X	    $failw{$curlevel} = 1;
X	    print OUT "  *WARNING*:\n\tNo corresponding $long{ao} in $them for $us $long{df} line\n";
X	}
X    }
X}
X
X
Xsub checksem {
X    local($as) = @_;
X    local($rtval) = 0;
X    local($i, $j, $k, $diagtxt, $tmp);
X    foreach $i (@KEYWORDS[0,1]) {
X	foreach $j (split(/\n/, $polarray{"$as:$i"})) {
X	    ($rtval, $diagtxt) = &dosemantic($as, $i, $j);
X	    if ($rtval == $R_ERROR) {
X		$error++;
X		$faile{$curlevel} = 1;
X		printf OUT "  *ERROR* in line:\n\t%-10s %s\n", $long{$i}.":", $j;
X	        printf OUT "  *REASON*:\n\t$diagtxt\n";
X	    }
X	}
X    }
X    foreach $k (keys %dbldef) {
X	if ($k =~ /^$as:/ ) {
X	    ($tmp,$dbpeer) = split(/:/, $k);
X	    $error++;
X	    $faile{$curlevel} = 1;
X	    printf OUT "  *ERROR*: in lines\n";
X	    foreach $l (split(/\n/, $polarray{"$as:df"})) {
X		if ($l =~ /$dbpeer/) {
X		    printf OUT "\t%-10s %s\n", $long{df}.":", $l;
X		}
X	    }
X	    printf OUT "  *REASON*:\n\tMore than one default to peer $dbpeer\n";
X	}
X    }
X}
X
X                        
Xsub dosemantic {
X    local($localas, $key, $value) = @_;
X    local($rtval) = 0;
X    local($diagtxt);
X    if ($key eq "ai") {
X	($peer, $pref, $policy) = split(/[\s\t]+/, $value, 3);
X	($rtval, $diagtxt) = &parsepolicy(*localas, *peer, *pref, *policy);
X	if ($rtval == $R_ERROR) {
X	    return $rtval, $diagtxt;
X	}
X	return;
X    }
X    if ($key eq "ao") {
X	($peer, $policy) = split(/[\s\t]+/, $value, 2);
X	$pref = "-1";
X	($rtval, $diagtxt) = &parsepolicy(*localas, *peer, *pref, *policy);
X	if ($rtval == $R_ERROR) {
X	    return $rtval, $diagtxt;
X	}
X	return;
X    }
X}
X        
X
Xsub checksyn {
X    local($as) = @_;
X    local($rtval) = 0;
X    local($i, $j, $diagtxt);
X    foreach $i (@KEYWORDS) {
X	foreach $j (split(/\n/, $polarray{"$as:$i"})) {
X	    ($rtval, $diagtxt) = &dosyntax($i, $j);
X	    if ($rtval == $R_ERROR) {
X		$error++;
X		$faile{$curlevel} = 1;
X		printf OUT "  *ERROR* in line:\n\t%-10s %s\n", $long{$i}.":", $j;
X		printf OUT "  *REASON*:\n\t$diagtxt\n";
X	    }
X	}
X    }       
X}
X
Xsub dosyntax {
X    local($key, $value) = @_;       
X    local($as) = "";
X    
X    if ($key eq "ai") {
X	$value =~ tr/a-z/A-Z/;
X	($as,$pref,@crap) = split(/\s+/,$value);
X	if (!&isasnum($as)) {
X	    return $R_ERROR, "neighbour peer $as doesn't look like an AS";
X	}
X	if (!$pref) {
X	    return $R_ERROR, "you must give a preference";
X	}
X	if (!&isaspref($pref)) {
X	    return $R_ERROR, "preference $pref must be a positive integer";
X	}
X	if ($#crap < 0 ) {
X	    return $R_ERROR, "no policy expression given";
X	}
X	return;
X    }
X    
X    if ($key eq "an") {
X	if (!&isasnum($value)) {
X	    return $R_ERROR, "$value is not a valid AS number";
X	}
X        return;
X    }
X    
X    if ($key eq "ao") {
X	$value =~ tr/a-z/A-Z/;
X	($as,@crap) = split(/\s+/,$value);
X	if (!&isasnum($as)) {
X	    return $R_ERROR, "neighbour peer $as is not an AS number ";
X	}
X	if ($#crap < 0 ) {
X	    return $R_ERROR, "no policy expression given";
X	}
X	return;
X    }
X    
X    if ($key eq "df") {
X	$value =~ tr/a-z/A-Z/;
X	($as,$pref) = split(/\s+/,$value);
X	if (!&isasnum($as)) {
X	    return $R_ERROR, "$long{$key} peer $as is not an AS number";
X	}
X	if (!$pref) {
X	    return $R_ERROR, "you must give a preference";
X	}
X	if (!&isaspref($pref)) {
X	    return $R_ERROR, "preference $pref must be a positive integer";
X	}
X	return;
X    }
X}
X# 
X# 
X# Deal with AS Macros 
X# 
X# They take the form of AS-<MACRO_NAME>
X# Need to deal with recursion as well
X#
Xsub expasmac {
X
X    local($asmac) = @_;
X    local(@data) = ();
X    local($i) = 0;
X    if(!$gotasmac{$asmac}) {
X	&whois($asmac);
X	while(<S>) {
X
X# this is needed for the -k delimeter which is \n\n
X
X	    if ($keepopen) {
X		if (/^\s*$/) {
X		    last if $newline == 1;
X		    $newline = 1;
X		    next;
X		}
X		$newline = 0;
X	    }
X
X	    $data[$i++] = $_;
X	}
X	foreach $i (0..$#data) {
X	    $_ = $data[$i];
X
X	    chop;
X	    if(/^as-macro: / || /^\*am: /) {
X		local($tmp, $rest) = split(/[\s\t]+/, $_, 2);
X		if ($asmac eq $rest) {
X		    $gotasmac{$asmac} = 1;
X		} else {
X		    return ("");
X		}
X	    }
X	    if ((/^as-list: / || /^\*al: /) && $gotasmac{$asmac}) {
X		local($tmp, @aslist) = split(/[\s\t]+/, $_);
X		foreach $i (@aslist) {
X		    if($i =~ /^AS\-[A-Z]+$/) {
X			$asmacros{$asmac} .= &expasmac($i)." ";
X		    } else {
X			$asmacros{$asmac} .= "$i ";
X		    }
X		}
X	    }
X	}
X    }
X    $asmacros{$asmac};
X}
X#
X#
X#
Xsub asread {
X    local($as) = @_;
X    local($rempeer, $rest, $tmp1, $tmp2) = "";
X    local(@data) = ();
X    local($i) = 0;
X    
X    if($done{$as}) {
X	return;
X    } else {
X	$done{$as} = 1;
X    }
X    while (<$fd>) {
X	if ($opt_s || $keepopen) {
X	    if (/^\s*$/) {
X		last if $newline == 1;
X		$newline = 1;
X		next;
X	    }
X	    $newline = 0;
X	}
X	
X	$data[$i++] = $_;
X    }
X    foreach $i (0..$#data) {
X	$_ = $data[$i];
X	chop;
X
X	if (/^aut-num:/ || /^\*an:/ ) {	# aut-num line. Check this is our AS
X	    if ($opt_f) {
X		if( $gotit == 1) {
X		    $opt_f = 0;
X		    $do = 0;
X		    last;
X		}
X	    }
X	    ($tmp1, $tmp2) = split(/[\s\t]+/, $_);
X	    $tmp2 =~ tr/a-z/A-Z/;
X	    if ($tmp2 eq $as) {
X		$do = 1;
X		$gotit = 1;
X		if ($opt_d) {
X		    print STDERR "** Found our AS object $as\n";
X		}
X		$polarray{"$as:an"} = $tmp2;
X		$gotsomeinfo{"$as"} = 1;
X	    }
X	    else {
X		$do = 0;
X	    }
X	    next;
X	}
X        
X# as-in lines, split into peer, weight and policy, and then parse a little 
X# and then stronger into the policy expression itself then make policy 
X# into an internal representation.
X
X	if ((/^as-in:/ || /^\*ai:/)) {
X	    if (!$opt_f || $do == 1) {
X		($tmp1, $tmp2) = split(/[\s\t]+/, $_, 2);
X		$tmp2 =~ tr/a-z/A-Z/;
X		if ($opt_d) {
X		    print STDERR "** Found as-in line for peer $as\n";
X		}
X		$gotsomepol{"$as"} = 1;
X		if($polarray{"$as:ai"}) {
X		    $polarray{"$as:ai"} = $polarray{"$as:ai"} . "\n" . $tmp2;
X		} else {
X		    $polarray{"$as:ai"} = $tmp2;
X		}
X		($rempeer, $rest) = split(/\s+/, $tmp2);
X		$polpeers{"$as%i%$rempeer"} = 1;
X	    }
X	    next;
X	}
X                
X# as-out lines, split into peer and policy, and then parse a little 
X# and then stronger into the policy expression  then make policy 
X# into an internal representation.
X
X	if ((/^as-out:/ || /^\*ao:/)) {
X	    if (!$opt_f || $do == 1) {
X		($tmp1, $tmp2) = split(/[\s\t]+/, $_, 2);
X		$tmp2 =~ tr/a-z/A-Z/;
X		if ($opt_d) {
X		    print STDERR "** Found as-out line for peer $as\n";
X		}
X		$gotsomepol{"$as"} = 1;
X		if($polarray{"$as:ao"}) {
X		    $polarray{"$as:ao"} = $polarray{"$as:ao"} . "\n" . $tmp2;
X		} else {
X		    $polarray{"$as:ao"} = $tmp2;
X		}
X		($rempeer, $rest) = split(/\s+/, $tmp2);
X		$polpeers{"$as%o%$rempeer"} = 1;
X	    }
X	    next;
X	}
X#
X# Now do the same for default
X#
X	if ((/^default:/ || /^\*df:/)) {
X	    if (!$opt_f || $do == 1) {
X		($tmp1, $tmp2) = split(/[\s\t]+/, $_, 2);
X		$tmp2 =~ tr/a-z/A-Z/;
X		if ($opt_d) {
X		    print STDERR "** Found default line $tmp2 for peer $as\n";
X		}
X		$gotsomepol{"$as"} = 1;
X		if($polarray{"$as:df"}) {
X		    $polarray{"$as:df"} = $polarray{"$as:df"} . "\n" . $tmp2;
X		} else {
X		    $polarray{"$as:df"} = $tmp2;
X		}
X		($rempeer, $rest) = split(/\s+/, $tmp2);
X		if ($polpeers{"$as%d%$rempeer"}) {
X
X# This is used as an added semantic check 
X# You should never see the same df for the same peer
X# It is not in a very nice place but so what ?
X		    $dbldef{"$as:$rempeer"} = 1;
X		} else {
X		    $polpeers{"$as%d%$rempeer"} = 1;
X		}
X	    }
X	    next;
X	}
X	if ((/^descr:/ || /^\*de:/) && !$descr{$as}) {
X	    if (!$opt_f || $do == 1) {
X		($tmp1, $tmp2) = split(/[\s\t]+/, $_, 2);
X		if ($opt_d) {
X		    print STDERR "** Found description for peer $as\n";
X		}
X		$descr{$as} = $tmp2;
X	    }
X	    next;
X	}
X    }
X}
X# 
Xsub isaspref {
X    local($str) = @_;
X    $str = $str + 0 ;
X    if ( $str < 1 ) {
X	return 0;
X    }
X    return 1;
X}
X#
X# isasnum() from RIPE-81 AS[1-65535]
X#
Xsub isasnum {
X    local($str) = @_;
X    if($str !~ /^AS[1-9]+\d*/ ) {
X	return 0;
X    }
X    $str =~ s/AS//;
X    if($str =~ /[A-z]+/ ) {
X	return 0;
X    }
X    $str = $str + 0 ;
X    if ( $str < 1 || $str > 65535 ) {
X	return 0; 
X    }
X    return 1;
X}
X#
X# So what I don't care ;-)
X#
Xsub atoilevel {
X    local($num) = @_;
X    if($num !~ /\d+/) {
X	return -1;
X    }
X    $num = $num + 0;
X    if($num < 1 || $num > $MAXLEVEL) {
X	return -1;
X    }
X    return $num;
X}
X#
X# Built-in whois server - will keep the connection open if it asked to
X# Also supports the fast mode and passes the version of prcheck to the
X# daemon.
X#
Xsub whois {
X    local($string) = @_;
X    local($key) = "";
X    local($type);
X
X    $whoisq++;
X    if (!$connected) {
X	$sockaddr = 'S n a4 x8';
X	($name, $aliases, $type, $len, $thataddr) = gethostbyname($whoishost);
X	$that = pack($sockaddr, $AF_INET, $port, $thataddr);
X	socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket failed\n";
X	if ( connect(S, $that) ) {
X	    if ( $opt_d ) {
X		printf STDERR "** connecting to whois host %s\n", $whoishost;
X	    }
X	    if ( $keepopen ) {
X		$connected = 1;
X	    }
X	} else { 
X	    die "Connect to whois host $whoishost failed\n";
X	}
X	if ( $opt_d ) {
X	    printf STDERR "** connected ok\n";
X	}
X    }
X    select(S); $| = 1; select(STDOUT);
X    
X    if ($string =~ /^-a/) {
X	($tmp, $key) = split(/[\t\s]+/,$string, 2);
X	print S "-a ";
X    }
X    else {
X	$key = $string;
X    }
X    if($keepopen) {
X	print S "-k ";
X    }
X    if($fast) {
X	print S "-F ";
X    }
X    if($version) {
X	printf S "-Vpk%s ", $versionno;	    # This is its identifier
X    }				            # Taken from RCS version
X    print S "-r $key\n";
X    return S;
X}
X
X
Xsub summary {
X    local($level) = @_;
X    local($i, $x);
X    
X    printf OUT "\n===\nSummary of prcheck for %s policy-object\n\n", $ouras;
X    printf OUT "  Testing completed to level: %3d\n", $level;
X    printf OUT "  Error(s) encountered:       %3d\n", $error;
X    printf OUT "  Warning(s) encountered:     %3d\n", $warn;
X    printf OUT "  No of whois queries:        %3d\n", $whoisq;
X    for ($i = 1 ; $i < $level+1; $i++) {
X	if($faile{$i} == 1) {
X	    printf OUT "  Test %s: FAILED\n", $i;
X	} elsif ($failw{$i} == 1) {
X	    printf OUT "  Test %s: passed with warnings\n", $i;
X	}
X	else {
X	    printf OUT "  Test %s: passed\n", $i;
X	}
X    }
X#
X# Print a summary of the peers found
X#
X        
X    if($opt_v && $level > 2) {
X	printf OUT "  Legend of peers associated with object:\n";
X	foreach $x (keys %done) {
X	    next if ($x eq $ouras);
X	    printf OUT "\t%6s : %s\n", $x, $descr{$x};
X	}
X    }
X}
X#
X#  This is the first stab parser
X#
Xsub parsepolicy {
X    local(*localas, *peer, *weight, *string) = @_;
X    local($lens,$left,$lenl) = 0;
X    $_ = $string;
X    if ($_ =~ /^\s+$/ || /^$/) {
X	
X	return $R_ERROR, "no policy expression given";
X    }
X    if ($peer eq $localas) {
X	return $R_ERROR, "Peering is Internal ? Remote Peer equals Local AS";
X    }
X
X# Ok how's this for dirty ... Since we do not need an OR in the policy
X# description, but the nice recursive descend parser below needs it
X# we substitute ASXXX ASYYY by ASXXX OR ASYYY.
X# The thing is we have do this twice for recursive sake ...
X    
X    s/(ANY|RIPE\-DB|LOCAL|AS[0-9]+|AS\-[A-Z]+)\s+(ANY|RIPE\-DB|LOCAL|AS[0-9]+|AS\-[A-Z]+)/\1 OR \2/g;
X    s/(ANY|RIPE\-DB|LOCAL|AS[0-9]+|AS\-[A-Z]+)\s+(ANY|RIPE\-DB|LOCAL|AS[0-9]+|AS\-[A-Z]+)/\1 OR \2/g;
X    $strtmp = $_;
X    $val = &expr;
X    if ($_) {
X	chop;
X	$left = $_;
X#
X# Yep not very nice is it...
X#
X	$lens = length($strtmp) - 1;
X	$lenl = length($left);
X	$ptr = " " x ($lens - $lenl);
X	return $R_ERROR, "$strtmp\n\t$ptr^\n\tUnexpected term detected at '^' marker.";
X    }
X    return;
X}
X
Xsub expr {
X    local($left, $op, $right);
X
X    $left = &term;
X    
X    while ($op = &oper) {
X	$right = &term;
X	if ($op eq "OR") {
X	    $op = "";
X	}
X	$left = $left.$op.$right;
X    }
X    $left;
X}
X
Xsub oper {
X    s/^[\s]+//;
X        ((s/^(AND)//) && $1) || ((s/^(OR)//) && $1);
X}
X
Xsub addtolist {
X    local(*array, $index, $value) = @_;
X    if($value =~ /^AS\d+/) {
X	if($array{$index} =~ /$value\%/) {
X	    if($index =~ /^(.*):(.*)@(.*)$/) {
X		$warn++;
X		$failw{$curlevel} = 1;
X		printf OUT "  *WARNING*:\n\tDuplicate announcement".
X		" of %s on %s line of %s for peer %s\n", 
X		$value, ($3 eq "-1") ? "as-out" : "as-in", $1, $2;
X	    }
X	    return;
X	}
X    }
X    return if $array{$index} =~ /$value\%/;
X    $array{$index} .= "$value"."%";
X}
X
Xsub term {
X    local($val);
X    
X    return if /^\s*$/;    
X    s/^[\s]+//;
X
X    if (s/^(AS[0-9]+)//) {
X	$val = $1;
X	if (!$not) {
X	    &addtolist(*permitlist, "$localas:$peer@$weight", $val);
X	    $exist{"$localas:$peer@$weight"} = 1;
X	}
X	else {
X	    &addtolist(*denylist, "$localas:$peer@$weight", $val);
X	    $exist{"$localas:$peer@$weight"} = 1;
X	}
X    }
X    elsif (s/^(AS\-[A-Z]+)//) {
X	local($save) = $_;
X	foreach $i (split(/\s+/, &expasmac($1))) {
X	    if (!$not) {
X		&addtolist(*permitlist, "$localas:$peer@$weight", $i);
X		$exist{"$localas:$peer@$weight"} = 1;
X	    }
X	    else {
X		&addtolist(*denylist, "$localas:$peer@$weight", $i);
X		$exist{"$localas:$peer@$weight"} = 1;
X	    }
X	}
X	$_ = $save;
X    }
X    elsif (s/^\(//) {
X	$val = &expr;
X	# s/^\)// || die "Missing closing paren $_\n";
X	s/^\)// || return;
X    }
X    elsif (s/^(NOT)//) {
X	$not = 1;
X	$val = &expr;
X	$not = 0;
X    }
X    elsif (s/^(ANY)//) {
X	$val = "ANY";
X	if (!$not) {
X	    &addtolist(*permitlist, "$localas:$peer@$weight", $val);
X	    $exist{"$localas:$peer@$weight"} = 1;
X	}
X	else {
X	    &addtolist(*denylist, "$localas:$peer@$weight", $val);
X	    $exist{"$localas:$peer@$weight"} = 1;
X	}
X    }
X    elsif (s/^(RIPE-DB)//) {
X	$val = "ANY";
X	if (!$not) {
X	    &addtolist(*permitlist, "$localas:$peer@$weight", $val);
X	    $exist{"$localas:$peer@$weight"} = 1;
X	}
X	else {
X	    &addtolist(*denylist, "$localas:$peer@$weight", $val);
X	    $exist{"$localas:$peer@$weight"} = 1;
X	}
X    }
X    elsif (s/^(LOCAL)//) {
X	$val = "LOCAL";
X	if (!$not) {
X	    &addtolist(*permitlist, "$localas:$peer@$weight", $val);
X	    $exist{"$localas:$peer@$weight"} = 1;
X	}
X	else {
X	    &addtolist(*denylist, "$localas:$peer@$weight", $val);
X	    $exist{"$localas:$peer@$weight"} = 1;
X	}
X    }
X    else {
X
X# Left in for now as we should do better messages in the parser itself
X#
X#               print "Cannot parse $_\n";
X#               print "In context $op\n";
X#               print "Syntax error\n";
X                return;
X                }
X    $op = $val;
X    $val;
X}
X
X# Debugging for policy Arrays printing...
X#
Xsub printpolicy {
X    local($localas) = @_;
X    local($i);
X
X    foreach $i (keys %exist) {
X	if ($i =~ /$localas:/) {
X	    print OUT "locals:remoteas@weight: $i\n";
X	    print OUT "           Permit: ".$permitlist{$i}."\n";
X	    print OUT "           Deny:   ".$denylist{$i}."\n";
X	}
X    }
X}
Xsub alarmread {
X    $alarm = 0;
X    if($a <= 6) {
X	print STDERR "still getting information for $ouras...\n";
X        $a++;
X    } else {
X	print STDERR "taking too long - giving up...\n";
X	exit(1);
X    }
X    alarm 3;
X}
X1;
END_OF_prcheck.pl
if test 31632 -ne `wc -c <prcheck.pl`; then
    echo shar: \"prcheck.pl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f prcheck.8 -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"prcheck.8\"
else
echo shar: Extracting \"prcheck.8\" \(7429 characters\)
sed "s/^X//" >prcheck.8 <<'END_OF_prcheck.8'
X.\"
X.\"
X.\" Copyright (c) 1993 The RARE Association
X.\"
X.\" All Rights Reserved
X.\"
X.\" Permission to use, copy, modify, and distribute this software and its
X.\" documentation for any purpose and without fee is hereby granted,
X.\" provided that the above copyright notice appear in all copies and that
X.\" both that copyright notice and this permission notice appear in
X.\" supporting documentation, and that the name of the author not be
X.\" used in advertising or publicity pertaining to distribution of the
X.\" software without specific, written prior permission.
X.\"
X.\" THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
X.\" ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
X.\" AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
X.\" DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
X.\" AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
X.\" OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
X.\"
X.\"
X.\"	$RCSfile: prcheck.8,v $
X.\"	$Revision: 0.13 $
X.\"	$Author: tony $
X.\"	$Date: 1994/05/19 13:47:04 $
X.\"
X.\"
X.TH prcheck 8 "November 25, 1993"
X.UC 6
X.SH NAME
Xprcheck \- check the syntax, semantics and validity of a RIPE-81 policy object
X.SH SYNOPSIS
X.B prcheck
X[
X.B \-d
X] [
X.B \-v
X] [
X.B \-l
Xlevel
X] [
X.B \-o
Xfilename
X] [
X.B \-f
XASfilename |
X.B \-s
X] [
X.B \-h
Xwhoishost
X] [
X.B \-p
Xport
X] [
X.B \-S
X]
X.I policy-object
X.SH DESCRIPTION
XA standard method for storing IP routing policies within Routing
XRegistries (RR)
Xhas been defined. This is known as RIPE-81 and defines the use, syntax
Xand semantics of a policy object stored in the RIPE database. 
X.I Prcheck 
Xis a checking tool to make it easy for operators to check their RIPE-81 policy
Xobject before it is submitted to an RR.
XPrcheck can do various levels of 
Xtesting ranging from basic syntax checking of the
Xpolicy attributes up to full checking of policy expressions against 
Xother referenced policy objects.
X.PP
XOptions are:
X.SH OPTIONS
X.TP 6
X.B \-d
XDebug output. Gives additional internal information and should not be
Xused for general use. This can generate a lot of information.
X.TP
X.B \-v
XVerbose output. This gives additional information including a 
Xa summary of the names of any peers referenced by the object
Xand tested in some way. It should be noted that the output
Xis already quite verbose.
X.TP
X.BI \-l " level"
XSet the level of prcheck test you require. See TEST LEVELS below for more
Xdetails. If no \-l option is specified the default level is set to 2.
X.TP
X.BI \-o " filename"
XSpecify an output filename for results of prcheck to be written to instead of
Xstandard output.
X.TP
X.BI \-f " filename"
XSet a filename to search for your object (as specified by the policy-object
Xargument). This is useful for trying things out. This cannot be used in
Xconjunction with the \-s option.
X.TP
X.B \-s
XRead in the policy-object from standard input. Prcheck will read in the object
Xuntil it receives
Xtwo newlines. This cannot be used in conjunction with the \-f
Xoption.
X.TP
X.BI \-h " whoishost"
XSpecify an alternate whois server to the configured one for routing registry
X(RR) data.
X.TP
X.BI \-p " port"
XSpecify an alternate port for the RR whois server.
X.TP
X.B \-S
XPrint a summary of the prcheck tests available and then exit.
X.SH BASICS
XPrcheck will walk through each test in turn and 
Xreport either errors or warnings
Xdepending on the nature of the problem. It will 
Xhighlight the offending line and
Xgive a reason as to why there is a problem with it.
XAs each test starts and finishes it will inform you.
XAt the end of testing a summary will be given. If the \-v mode is used you
Xwill also see a legend of the names of other peers/objects referenced in the 
Xpolicy-object.
XPrcheck uses the
X.I whois
Xprotocol (which is built in) to derive the RR policy information
Xfor any associated peers referenced within the object.
X.SH TEST LEVELS
XThe number of tests can be displayed by using the \-S option. It is quite
Xpossible the number of tests will increase in future releases. The basic
Xpremise behind prcheck is check your own object first and
Xthen move on to associated peers. As part of this it does 
Xmean you run similar checks on your associated peers policy objects but
Xthis is seen as worthwhile.
X.SH EXAMPLE USAGE
XThe easiest way to invoke prcheck is to do everything via the RIPE RR.
Xfor example:
X.DS L
X.nf
X.if t .ft C
X
X% prcheck AS1104
X.fi
X.DE
X.PP
Xwill produce two (the default) prcheck tests on the 
XAS1104 object. It will do this by obtaining AS1104 policy information
Xfrom RIPE RR and perform syntax and semantic checking of the policy
Xcomponent parts of the object. A sample prcheck session would look
Xlike this:
X.DS L
X.nf
X.if t .ft C
X
X% prcheck AS1274
Xstarting level 1 - Syntax check of policy components
Xlevel 1 complete - continuing...
X
Xstarting level 2 - Semantic check of policy expressions
Xlevel 2 complete - exiting
X
XSummary of prcheck for AS1274 policy-object
XTesting completed to level 2
XEncountered 0 errors
XEncountered 0 warnings
XTook 1 whois query
XCheck test 1 passed
XCheck test 2 passed
X.fi
X.DE
X.PP
XAs you can see the output is quite verbose (even more so with the \-v option).
XFor tests higher than level 2 then you must use the \-l flag. 
XHowever, if you wish to test an object (say for example before you
Xsubmit it to the RR) you can either enter the policy object by hand
Xwith the \-s option or have it read from a file with \-f option.
XHere is an example of inputing an object in by hand:
X.DS L
X.nf
X
X.if t .ft C
X% prcheck -s AS1104
Xaut-num: AS1104
Xas-in: AS1 10 TYPO
Xas-out: AS1 AS1
X
X
Xstarting level 1 - Syntax check of policy components
Xlevel 1 complete - continuing...
X
Xstarting level 2 - Semantic check of policy expressions
X*ERROR* in line:
X        as-in:     AS1 10 TYPO
X*REASON*:
X        TYPO
X        ^
X        Unexpected term detected at '^' marker.
Xlevel 2 complete - exiting
X
XSummary of prcheck for AS1104 policy-object
XTesting completed to level 2
XEncountered 1 error
XEncountered 0 warnings
XTook 0 whois queries
XCheck test 1 passed
XCheck test 2 FAILED
X.fi
X.DE
X
XHere we can test indivdual policy lines. For the \-s option you need
Xtwo carriage returns for prcheck to start checking.
XThe rest of the tests are left for your enjoyment or otherwise.
X.SH ENVIRONMENT
X.IP "PRTRACEHOST" 8
XThis will change the RR whoishost to use. The \-h option will override this.
XThe default is WHOISHOST.
X.IP "PRTRACEPORT" 8
XThe will change the port number to use to connect to the RR. The \-p port
Xwill override this. The default is port XPORT.
X.SH AUTHORS
XTony Bates wrote the bulk of it with some help from Marten Terpstra in code
X(the policy parser) and design. Daniel Karrneberg helped in the 
Xco-development of the idea.
X.SH EXPERIMENTAL
XAn experimental test (currently test number 7) is available for
Xgenerating cisco as-path filter lists. Not really a test but can be
Xdone after the per peer tests. Use this at your own risk. 
X.SH BUGS
XThe semantic checker may not be able to handle complex boolean
Xexpressions. You cannot call the tests individually (more a
Xlimitation than a bug). All objects
Xexcept your own policy-object require connectivity to the RR.
X.SH SEE ALSO
Xwhois(8).
X.PP 
X"Representation of IP Routing Policies in the RIPE Database - ripe-81",
XTony Bates, Jean-Michel Jouanigot, Daniel Karrenberg, Peter Lothberg, Marten
XTerpstra.
X.PP
XCisco Systems Inc. Router Software Configuration Manual.
END_OF_prcheck.8
if test 7429 -ne `wc -c <prcheck.8`; then
    echo shar: \"prcheck.8\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f Makefile -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"Makefile\"
else
echo shar: Extracting \"Makefile\" \(2374 characters\)
sed "s/^X//" >Makefile <<'END_OF_Makefile'
X#
X# 
X# Copyright (c) 1993 The RARE Association 
X# 
X# All Rights Reserved
X# 
X# Permission to use, copy, modify, and distribute this software and its 
X# documentation for any purpose and without fee is hereby granted, 
X# provided that the above copyright notice appear in all copies and that
X# both that copyright notice and this permission notice appear in 
X# supporting documentation, and that the name of the author not be
X# used in advertising or publicity pertaining to distribution of the
X# software without specific, written prior permission.  
X# 
X# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
X# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
X# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
X# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
X# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, ARISING OUT OF
X# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
X#
X#
X#	$RCSfile: Makefile,v $
X#	$Revision: 0.21 $
X#	$Author: tony $
X#	$Date: 1994/06/16 09:34:26 $
X#
X#
XSRC=		prcheck.pl 
XMAN=		prcheck.8
X
XBINDIR=		/usr/local/bin
XPERL=		/usr/local/bin/perl
XMANDIR=		/usr/local/man
XMANEXT=		8
XWHOISHOST=	whois.ripe.net
XPORT=		43 
X# 
X# If you are running Solaris 2.* set SOCKSTREAM to 2
X# otherwise leave it as it is
X#
XSOCKSTREAM=	1
X#
XKEEPOPEN=	TRUE
XFAST=		TRUE
XVERSION=	TRUE
XSHAR=		shar -odist.shar
X
XOBJ=		prcheck
XDIST=		$(SRC) $(MAN) Makefile README INSTALL CHANGES TODO
X
Xprcheck: prcheck.pl Makefile $(DEP)
X	sed     -e 's:WHOISHOST:$(WHOISHOST):'  \
X		-e 's: PORT: $(PORT):' \
X		-e 's:PERL:$(PERL):'            \
X		-e 's:KEEPOPEN:$(KEEPOPEN):'\
X		-e 's:SOCKSTREAM:$(SOCKSTREAM):' \
X		-e 's:FAST:$(FAST):'\
X                -e 's:VERSION:$(VERSION):'\
X		< prcheck.pl | \
X	$(PERL) -e 'while(<>) { chop; s/\s*$$//; next if (/^# #/); if(/(^.*)(# #.*$$)/) { printf "$$1\n"; next; } print "$$_\n"; }' > $@
X	chmod 755 $@
X
Xinstall: $(OBJ) Makefile $(MAN) $(DEP)
X	sed -e 's:WHOISHOST:$(WHOISHOST):' \
X	    -e 's:XPORT:$(PORT):' $(MAN) > $(MAN).tmp
X	-install -m 755 $(OBJ) $(BINDIR)
X	-install -m 644 ${MAN}.tmp ${MANDIR}/man${MANEXT}/${MAN}
X	-rm $(MAN).tmp
X
Xdist.shar: $(DIST) 
X	$(SHAR) $(DIST)
X
Xdist: dist.shar
X
Xall: prcheck dist
X
Xman: $(MAN)
X	-install -m 644 ${MAN} ${MANDIR}/man${MANEXT}/${MAN}
X
Xclean:
X	-rm -f core a.out dist.shar *.o ,* $(OBJ)
X
X
END_OF_Makefile
if test 2374 -ne `wc -c <Makefile`; then
    echo shar: \"Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f README -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"README\"
else
echo shar: Extracting \"README\" \(913 characters\)
sed "s/^X//" >README <<'END_OF_README'
X#
X#	$RCSfile: README,v $
X#	$Revision: 0.12 $
X#	$Author: tony $
X#	$Date: 1993/11/26 16:55:38 $
X#
X                THIS IS THE README FOR PRCHECK
X
X
XINTRODUCTION
X
X	Prcheck is part of the PRIDE Tools release. It comes with a 
X	simple installation procedure. It relies on having the following:-
X
X		o perl
X
X	built on your system.
X
X	"perl" can be obtained from any of the well known
X	ftp archive sites (preferably somewhere near to you). 
X
X	For more details look at the manual page. (sorry but this is only
X        a beta release at the moment ;-))
X
XINSTALLATION
X
X        See the file "INSTALL" for more details on installing prcheck.
X
X
XPORTING ISSUES
X
X        prcheck has been tested on both SUNOS and BSDI with various 
X        versions of perl without any problems.
X
XBUG REPORTS, FIXES, COMMENTS AND HELP
X
X	Please report bugs, enhancements and comments to the mailing
X	list below:
X
X		pride-tools@ripe.net
X
X	Enjoy !!!!
END_OF_README
if test 913 -ne `wc -c <README`; then
    echo shar: \"README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f INSTALL -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"INSTALL\"
else
echo shar: Extracting \"INSTALL\" \(1654 characters\)
sed "s/^X//" >INSTALL <<'END_OF_INSTALL'
X#
X#	$RCSfile: INSTALL,v $
X#	$Revision: 0.13 $
X#	$Author: tony $
X#	$Date: 1993/12/17 11:43:20 $
X#
X#
XINSTALL - prcheck 
X
XInstallation:
X
X- Edit the Makefile for
X
X	BINDIR		- Installation directory (default: /usr/local/bin)
X
X        KEEPOPEN        - Enables or disables keeping the tcp connection
X                          for the built-in whois client. This will only work
X                          with RIPE whoisd. Possible values are TRUE or FALSE.
X                          (default: TRUE as using whois.ripe.net by default).
X
X	MANDIR		- Man directory (default: /usr/local/man)
X        
X        
X	PERL		- the full path of Perl on your system
X				(default: /usr/local/bin/perl)
X
X
X	WHOISHOST	- Alternative RIPE whois server
X				(default: whois.ripe.net)
X
X	FAST		- Used for getting whois data out of the daemon faster
X			  This will only work the *latest* RIPE whoisd. 
X			  Possible values are TRUE or FALSE.
X			  (default: TRUE as using whois.ripe.net by default).
X
X	VERSION		- Used for telling the daemon the version number of the
X			  client. This will only work
X                          with RIPE whoisd. Possible values are TRUE or FALSE.
X                          (default: TRUE as using whois.ripe.net by default).
X
X	
XType the following:
X
X"make" - This will install a executable version in the current directory
X
X"make install" - This will install executable version in BINDIR
X
X"make clean"  -  This will clean up, including executable versions in 
X                 current directory.
X
XOptionally:
X
X"make dist"  - This will make a distribution in shar format (requires shar, or
X               you need to change the SHAR variable in the Makefile)
END_OF_INSTALL
if test 1654 -ne `wc -c <INSTALL`; then
    echo shar: \"INSTALL\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f CHANGES -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"CHANGES\"
else
echo shar: Extracting \"CHANGES\" \(520 characters\)
sed "s/^X//" >CHANGES <<'END_OF_CHANGES'
X#
X#
X#	$RCSfile: CHANGES,v $
X#	$Revision: 0.14 $
X#	$Author: tony $
X#	$Date: 1993/12/17 11:42:25 $
X
XChanges from the BETA-1 Release
X-------------------------------
X
X1. Check 6 (policy 2 policy) completed
X
X2. Check 7 (generates cisco as-path lists) added in as experimental
X
X3. Output Format changed quite a lot.
X
X4. Added in FAST support.
X        This is needed due to the size of some of the RIPE-81 policy objects.
X        See AS1755.
X
X5. Added in VERSION support.
X        This is used to track the use of PRIDE tools.
X
END_OF_CHANGES
if test 520 -ne `wc -c <CHANGES`; then
    echo shar: \"CHANGES\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f TODO -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"TODO\"
else
echo shar: Extracting \"TODO\" \(270 characters\)
sed "s/^X//" >TODO <<'END_OF_TODO'
X#
X#
X#	$RCSfile: TODO,v $
X#	$Revision: 0.12 $
X#	$Author: tony $
X#	$Date: 1993/12/17 10:58:54 $
X#       PRCHECK TODO LIST
X#
X#
X1. Need to be able to read all the entries from a local file if needed.
X
X2. Need to tidy the code a lot and modulise a lot of it (esp. the main).
END_OF_TODO
if test 270 -ne `wc -c <TODO`; then
    echo shar: \"TODO\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0
