syntax.pl fixes

#
#	$RCSfile: syntax.pl,v $
#	$Revision: 0.46 $
#	$Author: marten $
#	$Date: 1994/11/17 13:38:27 $
#
#       ARGUMENTS:      *ASSOC object
#       RETURNS:        INTEGER object_status
#
#       Object status = $O_OK, $O_WARNING, $O_ERROR
#       Object will be changed to have warnings and errors
#
# This is the really ugly bit, where the syntax of all the fields is checked
# This is completely independent of the config file and needs additions if
# you add your own fields. It does not check whether fields are allowed in
# this object, whether they are supposed to be multiple or any of that
# That part is basic configuration driven and can be found in enparse.pl
#
# The syntax stuff needs to be re-written at a later date to allow for
# configurable syntax. This is in the dreams of someones mind.....
#

require "adderror.pl";
require "net2net.pl";    # various routines to make classless life easier
require "misc.pl";	 # this one has quite a few used sub routines
require "maintainer.pl";	# For mnt-by verification

sub checksyntax {

    local(*object) = @_;
    local($rtcode) =$O_OK;
    local($itmp, $val, $msg);

    print STDERR "checksyntax - called\n" if $opt_V;

    foreach $itmp (keys %object) {
	if ($object{$itmp} eq "") {
	    ($val, $msg) = &dosyntax($itmp, "", *object);
	    if ($val == $O_WARNING) {
		&addwarning(*object, $msg);
		$rtcode = $O_WARNING if $rtcode == $O_OK;
	    }
	    elsif ($val == $O_ERROR) {
		&adderror(*object, $msg);
		$rtcode = $O_ERROR;
	    }
	} else {
#
# Got to preprocess the multi-line semantic attributes. sigh.. Did I really
# think this was a good idea ??
# The way this works is $peer and $wt (this is a combination depending on the
# attribute) are used as a key to check wrapped lines. 
# This is probably not the best way of doing this as you to do a lot of 
# splitting to get the correct unique keys.
# You also have to split differently depending on whether syntax sugar exists.
#
	    if($itmp eq "ai" || $itmp eq "ao" || $itmp eq "it" || $itmp eq "io") {
		local($FLAG) = $itmp;
		local(@array) = split(/\n/, $object{$itmp});
		local($j,$k) = 0;
		local(%linewrap) = ();
		local(%newval) = ();
		foreach $j (0..$#array) {
#
# as-in lines
#
		    if($FLAG eq "ai") {
			if($array[$j] =~ /^from/) {
			    ($sugar1, $peer, $wt, $sugar2, $pol) =
				split(/\s+/, $array[$j], 5);
			    if($sugar2 ne "accept") {
				&adderror(*object, "keyword problem in as-in line for peer $peer cost $wt");
				$rtcode = $O_ERROR;
                                next;
			    }
			} else {
			    ($peer, $wt, $pol) = split(/\s+/, $array[$j], 3);
			}
			$object{$itmp} =~ s/from\s+|accept\s+//g;
#
# as-out lines
#
		    } elsif ($FLAG eq "ao") {
			if($array[$j] =~ /^to/) {
			    ($sugar1, $peer, $sugar2, $pol) = 
				split(/\s+/, $array[$j], 4);
			    $wt = 1;
			    if($sugar2 ne "announce") {
				&adderror(*object, "keyword problem in as-out line for peer $peer");
				$rtcode = $O_ERROR;
				next;
			    }
			} else {
			    ($peer, $pol) = split(/\s+/, $array[$j], 2);
			    $wt = 1;
			}
			$object{$itmp} =~ s/to\s+|announce\s+//g;
#
# interas-in lines
#
		    } elsif ($FLAG eq "it") {
#
# Get rid of spaces in (<pref-type>=<value>)
#
			$array[$j] =~ 
			    s/\(\s*pref\s*\=\s*(\S+)\s*\)/\(pref=\1\)/;
			if($array[$j] =~ /^from/) {
			    ($sugar1, $peer, $lid, $rid, $cost, $sugar2, $pol) 
				= split(/\s+/, $array[$j], 7);
			    if($sugar2 ne "accept") {
				&adderror(*object, "keyword problem in interas-in line for peer $peer cost $cost");
				$rtcode = $O_ERROR;
				next;
			    }
			    $wt = "$lid-$rid-$cost";
			} else {
			    ($peer, $lid, $rid, $cost, $pol)  = 
				split(/\s+/, $array[$j], 5);
			    $wt = "$lid-$rid-$cost";
			}
			$object{$itmp} =~ s/from\s+|accept\s+//g;
#
# interas-out lines
#
		    } elsif ($FLAG eq "io") {
			local($gotmet) = 0;
#
# This is where you have insert new ``mertic-type'' values and get rid of 
# spaces
#
			if ($array[$j] =~ /metric-out/) {
			    $array[$j] =~ s/\(\s*metric\-out\s*\=\s*(\S+)\s*\)/\(metric-out=\1\)/;
			    $gotmet = 1;
			}	
			if($array[$j] =~ /^to/) {
			    if($gotmet) {
				($sugar1, $peer, 
				 $lid, $rid, $metric, $sugar2, $pol) = 
				     split(/\s+/, $array[$j], 7);
				$wt = "$lid-$rid-$metric";
			    } else {
				($sugar1, $peer, $lid, $rid, $sugar2, $pol) =
				    split(/\s+/, $array[$j], 6);
				$wt = "$lid-$rid";
			    }
			    if($sugar2 ne "announce") {
				&adderror(*object, "keyword problem in interas-out line for peer $peer");
				$rtcode = $O_ERROR;
				next;
			    }
			} else {
			    if($gotmet) {
				($peer, $lid, $rid, $metric, $pol) =
				    split(/\s+/, $array[$j], 5);
				$wt = "$lid-$rid-$metric";
			    } else {
				($peer, $lid, $rid, $pol) = 
				   split(/\s+/, $array[$j], 4);
				$wt = "$lid-$rid";
			    }
			}
			$object{$itmp} =~ s/to\s+|announce\s+//g;
		    }
#
# Now finally check if the lines are the same.
#
		    if($newval{"$peer:$wt"}) {
			if($linewrap{"$peer:$wt"}) {
			    $newval{"$peer:$wt"} = $newval{"$peer:$wt"}." ".$pol;
			} else {
			    $newval{"$peer:$wt"} = $newval{"$peer:$wt"}."\n".$array[$j];
			}
		    } else {
			$newval{"$peer:$wt"} = $array[$j];
		    }
		    $linewrap{"$peer:$wt"} = 1;
		}
#
# Now loop through the value and syntax check the re-built line
#	   
		foreach $k (keys %newval) {
		    foreach $l (split(/\n/, $newval{$k})) {
			local($val, $msg) = &dosyntax("$FLAG", $l, *object);
			if ($val == $O_WARNING) {
			    &addwarning(*object, $msg);
			    $rtcode = $O_WARNING if $rtcode == $O_OK;
			}
			elsif ($val == $O_ERROR) {
			    &adderror(*object, $msg);
			    $rtcode = $O_ERROR;
			}
		    }
		}
#
# Otherwise just split on newlines and pass line by line to syntax checker
#
	    } else {
		foreach $j (split(/\n/, $object{$itmp})) {
		    local($val, $msg) = &dosyntax($itmp, $j, *object);
		    if ($val == $O_WARNING) {
			&addwarning(*object, $msg);
			$rtcode = $O_WARNING if $rtcode == $O_OK;
		    }
		    elsif ($val == $O_ERROR) {
			&adderror(*object, $msg);
			$rtcode = $O_ERROR;
		    }
		}
	    }
	}
    }
    print STDERR "checksyntax - returned\n" if $opt_V;
    return $rtcode;
}

sub dosyntax {

    local($key, $value, *object) = @_;

#
# THE FIRST SET OF ATTRIBUTES MAY NOT HAVE AN EMPTY VALUE IF THEY EXIST
#

#
# ua - authorise
#
    if ($key eq "ua") {
        if ($value !~ /\S/) {
            return $O_ERROR, "illegal authorisation value";
        }
        return;
    }

#
# uo - override
#

    if ($key eq "uo") {
        if ($value !~ /\S/) {
            return $O_ERROR, "illegal override value";
        }
    }

#
# ud - delete
#
# The delete is a bit of a pain. Since we want to be able to delete
# objects that actually contain syntax errors, they are NOT syntax
# checked. Therefore, all the syntax checking for deletes is actually
# done in misc.pl sub &hasdelete. This is not very nice, but the only
# thing that actually works. Below is commented out.

#    if ($key eq "ud") {
#        if ($value !~ /\S/) {
#            return $O_ERROR, "delete attribute must contact email address and reason for delete";
#        }
#        return;
#    }

#
#
# AFTER THIS, ATTRIBUTES THAT ARE DEFINES BUT EMPTY ARE OK
#

    return if $value eq "";
#
# aa - see na
#

#
# ac - admin-c
#
    if ($key eq "ac") {
	if (!&isname($value)) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# ad - address
#   
    if ($key eq "ad") {
	if ($value !~ /^.*$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# ae - as-exclude
#
    if ($key eq "ae") {
	local($sugar1, $as, $sugar2, $rest) = "";
	if($value =~ /^exclude/) {
	    ($sugar1, $as, $sugar2, $rest) = split(/\s+/, $value, 4);
	    if($sugar2 ne "to") {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	    }
	} else {
	    ($as, $rest) = split(/\s+/, $value,2);
	}
	if(!&isasnum($as)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\" - neigbor peer".
		" $as doesn't look like an AS";
	}
	if(&isasnum($rest) || 
	   &iscommunity($rest) || 
	   &isasmacro($rest) ||
	   ($rest eq "ANY")) {
	    $object{$key} =~ s/exclude\s+|to\s+//g;
	} else {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\" - exclude-route-keyword".
		" $rest unknown";
	}
	return;
    }
#
# ai - as-in
#   
    if ($key eq "ai") {
# 
# This line has been pre-processed above.
# remove syntax fluff, flip to unpper case for ases and remove leading WS
#
	$value =~ s/from\s*//;
	$value =~ s/accept\s*//;
	$value =~ s/[aA][sS]/AS/g;
	$value =~ s/^\s+//;
#
# split the line up into AS, cost and the policy
#
	local($as,$pref,$pol) = split(/\s+/,$value,3);
	if (!&isasnum($as)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\"\nneigbour peer".
		" $as doesn't look like an AS";
	}
	if (!$pref) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\"\nyou must give a cost";
	}
	if (!&isaspref($pref)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\"\ncost $pref ".
		"must be a positive integer";
	}
	if (!$pol) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\"\n\tno ".
		"routing policy expression given";
	}
#
# now check equal brackets and braces
#
	if(!&isbracket($pol)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: peer $as cost $pref\"" .
		"\n\tunequal brackets \"\(\)\"\n";
	}
	if(!&isbrace($pol)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: peer $as cost $pref\"" .
		"\n\tunequal braces \"\{\}\"\n";
	}
#
# Now grab the netlist entries and check they are ok
#
	local($tmppol) = $pol;
	while($tmppol =~ s/(\{[^\}]*\})// ) {
	    if(!&isnetlist($1)) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}: peer $as cost $pref\"".
		    "\n\tnetlist error $1";
	    }
	}
#
# Now check the actual keywords
#
	while($tmppol =~ s/(\S+)//) {
	    if (!&isaskeyword($1)) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}: peer $as cost $pref\"\n\t$1 ".

		    "is not a routing policy KEYWORD";
	    }
	}
	return;
    }
#
# al - as-list
#
    if ($key eq "al") {
	$value =~ tr/a-z/A-Z/;
	local(@aslist) = split(/\s+/, $value);
	local($i);
	foreach $i (@aslist) {
	    if(!&isasnum($i) && !&isasmacro($i)) {
		return $O_ERROR, "illegal value \"$i\" in \"$ATTL{$key}\"";
	    }
	}
	return;
    }
#
# an - aut-num
#    
    if ($key eq "an") {
	$value =~ tr/a-z/A-Z/;
	if (!&isasnum($value)) {
	    return $O_ERROR,
	    "syntax error in \"$ATTL{$key}\" - $value is not a valid AS";
	}
	if (($object{$key} =~ tr/a-z/A-Z/)) {
	    return $O_WARNING, "\"$ATTL{$key}\" value uppercased";
	}
	return;
    }
    
#
# am - as-macro
#
    if ($key eq "am") {
	if(!&isasmacro($value)) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# ao - as-out
#
    if ($key eq "ao") {
	$value =~ s/to//;
	$value =~ s/announce//;
	$value =~ s/[aA][sS]/AS/g;
	$value =~ s/^\s+//;
#
# split up into AS and policy
#
	local($as,$pol) = split(/\s+/,$value,2);
	if (!&isasnum($as)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\" - ".
		"neigbour peer $as doesn't look like an AS";
	}
	if (!$pol) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\" - ".
		"no routing policy expression given";
	}
#
# now check equal brackets and braces.
#
	if(!&isbracket($pol)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: peer $as \"" .
		"\n\tunequal brackets \"\(\)\"\n";
	}
	if(!&isbrace($pol)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: peer $as \"" .
		"\n\tunequal brackets \"\(\)\"\n";
	}
#
# Now grab loop through netlist entries and check they are ok
# Here a netlist entry is anything between braces.
#
	local($tmppol) = $pol;
	while($tmppol =~ s/(\{[^\}]*\})// ) {
	    if(!&isnetlist($1)) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}: peer $as \"".
		    "\n\tnetlist error $1";
	    }
	}
	while($tmppol =~ s/(\S+)//) {
	    if (!&isaskeyword($1)) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}: peer $as \"".
		    "\n\t$1 is not a routing policy KEYWORD";
	    }
	}

    }
#
# as - aut-sys
#   
    if ($key eq "as") {
	if ($value !~ /^\d+$/) {
	    if (!&isasnum($value)) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	    }
	}
	return;
    }
#
# at - auth
#
    if ($key eq "at") {
	local(@authstr) = split(/\s+/, $value, 2);
	if ($authstr[0] eq "NONE") {
	    if ($authstr[1] !~ /^$/) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\"".
		    "- $authstr[1] is extraneous for $authstr[0]";
	    } else {
	     	return;
	    }
	}
	if ($authstr[0] eq "CRYPT-PW") {
	    if(length($authstr[1]) != 13) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\"" .
		    " - password \"$authstr[1]\" is incorrect length";
	    } else {
		return;
	    }
	}	   
	elsif ($authstr[0] ne "MAIL-FROM") {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\" $value";
	}
	return;
    }
#
# au - authority
#
    if ($key eq "au") {
	if ($value !~ /^[a-zA-Z0-9\-\.\ \,\(\)\/]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# av - advisory
#
    if ($key eq "av") {
	local(@list) = split(/\s+/, $value);
        if (!&isasnum($list[0])) {
            return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - $list[0] is no a valid peer";
        }
	return;
    }
#
# the RIPE-60 tags are just given a simple parse - not really needed
# as they are basically guarded.
#
# bg - bdry-gw
#
    if ($key eq "bg") {
	if ($value !~ /^[A-Z0-9\-]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# bi - bis
#      bis - Boundary intermediate system i.e. CLNS nonsense
#
    if ($key eq "bi") {
	local(@prefixes) = split(/\s+/, $value);
	local($i);
	if ($#prefixes > 1) {
	    return $O_ERROR, "too many prefixes in \"$ATTL{$key}\"";
	}
	foreach $i (@prefixes) {
	    if (!&isclnsprefix($i)) {
		return $O_ERROR, 
		"illegal NSAP prefix syntax in \"$ATTL{$key}\"";
	    }
	}
	return;
    }
# 
# bl - bdrygw-l
#
    if ($key eq "bl") {
	if ($value !~ /^[A-Z0-9\-\ ]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	
	return;
    }
#
# Try to do something clever with the changed field
#
# ch - changed
#
    if ($key eq "ch") {
	local($i);
	(@tmp) = split(/\s+/, $value);
	$email = "$tmp[0]";
	foreach $i (1..$#tmp-1) { # This is for emails with spaces ;-(
	    $email .= " $tmp[$i]";
	}
	$date = "$tmp[$#tmp]" if ($tmp[$#tmp] =~ /^\d+$/);
	if (!(&isemail($email))) {
	    return $O_ERROR, "syntax error in e-mail part of \"$ATTL{$key}\"";
	}
	local($s, $m, $h, $md, $mo, $y) = localtime(time);
	$mo += 1;
	$md = "0".$md unless $md > 9;
	$mo = "0".$mo unless $mo > 9;
	$y = "0".$y unless $y > 9;
	local($curdate) = "$y$mo$md";

	if ($date eq "") {
	    $object{$key} .= " $curdate";
	    return $O_WARNING, 
	    "todays date ($curdate) added to \"$ATTL{$key}\" attribute";
	}
	if ($date !~ /^(\d\d)(\d\d)(\d\d)$/) {
	    return $O_ERROR, "date part of \"$ATTL{$key}\"".
		"not in YYMMDD format";
	}
	# 1988 is the start of the world. This is where we test for proper
	# date values of YYMMDD

	if (($1 < 88) || ($2 > 12) || ($3 > 31)) {
	    return $O_ERROR, "date part of \"$ATTL{$key}\" is not a valid YYMMDD value";
	}
	
	if ($date gt $curdate) {
	    $object{$key} =~ s/$date/$curdate/;
	    return $O_WARNING,
	    "date in \"$ATTL{$key}\" ($date) is in the ".
		"future - changed to $curdate";
	}
	return;
    }
#
# This is the "community" stuff.
# It needs to make sure RIPE-81 keywords aren't there.
#
# cl - comm-list
#
    if ($key eq "cl") {
	local(@crap) = split(/\s+/,$value);
	foreach $j (@crap) {
	    if (!&iscommunity($j)) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}\" - ".
		    "appears to contain a routing policy KEYWORD \"$j\"";
	    }
	} 
	return;
    }
#
# cm - community
#
    if ($key eq "cm") {
	if (!&iscommunity($value)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - appears to ".
		"contain a routing policy KEYWORD \"$j\"";
	} 
	return;
    }
    
#
# co - connect
#
# check the list of connect values from the config.
#
    if ($key eq "co") {
	foreach $j (split(/\s+/, $value)) {
	    if (!$CONNECT{$j}) {
		return $O_ERROR, "unknown connect value \"$j\"";
	    }
	}
	return;
    }
#
# cy - country
#
    if ($key eq "cy") {
	if (!$COUNTRY{$value}) {
	    return $O_ERROR, "unknown country \"$value\"";
	} else {
	    if ($COUNTRY{$value} ne $value) {
		$object{$key} = $COUNTRY{$value};
		return $O_WARNING, 
		"country \"$value\" changed to \"$COUNTRY{$value}\"";
	    }
	}
	return;
    }
#
# de - descr
#
    if ($key eq "de") {
	if ($value !~ /^.*$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# df - default
#
    if ($key eq "df") {
	local($rest) = "";
	if ($object{"dp"}) {
	    $value =~ tr/A-Z/a-z/;
	    ($prefix, $pref,$rest) = split(/\s+/, $value, 3);
	    if (!&isclnsprefix($prefix)) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}: $value\" - incorrect ".
		    "NSAP prefix";
	    }
	}
	else {
	    $value =~ tr/a-z/A-Z/;
	    ($as,$pref,$rest) = split(/\s+/,$value, 3);
	    if (!&isasnum($as)) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}: $value\" ".
		    "- default peer $as doesn't look like an AS";
	    }
	}
	if (!$pref) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\" - you must give a cost";
	}
	if (!&isaspref($pref)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\" - ".
		"cost $pref must be a positive integer";
	}
	if($rest && !$object{"dp"}) {
	    $rest =~ s/STATIC/static/;
	    $rest =~ s/DEFAULT/default/;
	    if (&isnetlist($rest) ||
		($rest eq "static") || 
		($rest eq "default")) {}
	    else {
		return $O_ERROR,
		"syntax error in \"$ATTL{$key}\" - ".
		    "\"$rest\" is invalid";
	    }
	    $object{$key} =~ s/STATIC/static/;
	    $object{$key} =~ s/DEFAULT/default/;
	    $object{$key} =~ s/[aA][sS]/AS/g;
	}
	return;
    }
#
# Check to make sure the network list looks reasonable
#
#
# di - dom-net
#
    if ($key eq "di") {
	local(@list) = split(/\s+/,$value);
	local($j) = 0;
	foreach $j (0..$#list) {
	    if (!&isnetnum($list[$j])) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\" - ".
		    "illegal IP network number $list[$j]";
	    }
	}
	return;
    }
#
# dm - dom-in
#
    if($key eq "dm") {
	local($bis,$pref, at crap) = split(/\s+/,$value);
        if (!&isclnsprefix($bis)) {
            return $O_ERROR, 
            "syntax error in \"$ATTL{$key}: $value\" - dom-prefix".
                " $bis doesn't look like an NSAP";
        }
        if (!$pref) {
            return $O_ERROR, 
            "syntax error in \"$ATTL{$key}: $value\" - you must give a cost";
        }
        if (!&isaspref($pref)) {
            return $O_ERROR, 
            "syntax error in \"$ATTL{$key}: $value\" - cost $pref ".
                "must be a positive integer";
        }
        if ($#crap < 0 ) {
            return $O_ERROR, 
            "syntax error in \"$ATTL{$key}: $value\" - no ".
                "routing policy expression given";
        }
        foreach $k (@crap) {
            if (!&isclnskeyword($k)) {
                return $O_ERROR, 
                "syntax error in \"$ATTL{$key}: $value\" - $k ".
                    "is not a routing policy KEYWORD";
            }
        }
        return;
    }
#
# dn - domain
#
    if ($key eq "dn") {
	if (!&isdomname($value)) {
	    return $O_ERROR, "illegal domain name in $value";
	}
	return;
    }
#
# do - dom-out
#
    if ($key eq "do") {
	local($bis, at crap) = split(/\s+/,$value);
        if (!&isclnsprefix($bis)) {
            return $O_ERROR, 
            "syntax error in \"$ATTL{$key}: $value\" - ".
                "dom-prefix \"$bis\" doesn't look like an NSAP prefix";
        }
        if ($#crap < 0 ) {
            return $O_ERROR, 
            "syntax error in \"$ATTL{$key}: $value\" - ".
                "no routing policy expression given";
        }
        foreach $k (@crap) {
            if (!&isclnskeyword($k)) {
                return $O_ERROR, "syntax error in \"$ATTL{$key}: $value\" - ".
                    "$k is not a routing policy KEYWORD";
            }
        }
        return;
    }
#
# dp - dom-prefix
#
    if ($key eq "dp") {
	if (!&isclnsprefix($value)) {
	    return $O_ERROR, "illegal NSAP prefix format in \"$ATTL{$key}\"";
	}
	return;
    }
#
# da - dom-name
#
    if ($key eq "da") {
	if ($value !~ /^[a-zA-Z\-0-9\.]+$/) {
	    return $O_ERROR, "illegal $ATTL{$key} name";
	}
	return;
    }
#
# dt - upd-to
#
    if ($key eq "dt") {
	if (!&isemail($value)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" ".
		"- \"$value\" is not in \(RFC822\) format";
	}
	return;
    }
#
# em - e-mail
#
    if ($key eq "em") {
	if (!&isemail($value)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" ".
		"- \"$value\" is not in \(RFC822\) format";
	}
	return;
    }
#
# gd - guardian
#
    if ($key eq "gd") {
	if (!(&isemail($value))) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - ".
		"guardian must be a mailbox entry";
	}
	return;
    }

#
# gw - gateway
#
    if ($key eq "gw") {
	if ($value !~ /^[a-zA-Z0-9\-\.\ ]+$/) {
	    return $O_WARNING, "syntax error in \"$ATTL{$key}\"";	
	}
	return;
    }
#
# ho - hole
#
# still need to check against route entry
#
    if ($key eq "ho") {
	local($stat, $msg, @str) = &netpre_verify($value);
	if($stat == $NOK) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"\n$msg\n";
	}		
	return;
    }
#
# if - ifaddr
#
    if ($key eq "if") {
	local($if, $mask) = split(/\s+/, $value, 2);
	if(!&isipaddr($if)) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\""
		. " $if is incorrect";
	}
	if(!&ismask($mask)) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\""
		. " $mask is incorrect";
	}
	return;
    }
#
# ii - ias-int
#

    if ($key eq "ii") {
	local(@iistr) = split(/\s+/,$value);	
	if ($#iistr != 1 ) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - wrong number of components";
	}
	if (!&isipaddr($iistr[0])) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - \"$iistr[0]\" ".
		"is not a valid IP address";
	}
	if (!&isasnum($iistr[1])) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - ".
		"\"$iistr[1]\" is not a valid AS";
	}
	return;
    }
#
# it - interas-in
#
    if ($key eq "it") {
#
# This line has been pre-processed above.
# remove syntax fluff, flip to unpper case for ases and remove leading WS
#
        $value =~ s/from\s*//;
        $value =~ s/accept\s*//;
        $value =~ s/[aA][sS]/AS/g;
        $value =~ s/^\s+//;
#
# split the line up into AS, lid, rid, cost and the policy
#
	local($as, $lid, $rid, $pref, $pol) = split(/\s+/,$value, 5);
	if (!&isasnum($as)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\"\n\tneigbour peer".
                " $as doesn't look like an AS";
        }
	if (!&isipaddr($lid) || !&isipaddr($rid)) {
	    return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\"\n\tip address error";
	}
	if (!$pref) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\"\nyou must give a cost";
        }
        if ($pref !~ /^\(pref=(\S+)\)$/) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\" preferece is invalid";
	}
	if ($1 ne "MED" && $1 !~ /^\d+$/) {
	    return $O_ERROR,
                "syntax error in \"$ATTL{$key}: $value\"".
		    "\n\t<pref-type> value \"$1\" is invalid";
	}
        if (!$pol) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\"\n\tno ".
                "routing policy expression given";
        }
#
# now check equal brackets and braces
#
        if(!&isbracket($pol)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: peer $as cost $pref\"" .
                "\n\tunequal brackets \"\(\)\"\n";
        }
        if(!&isbrace($pol)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: peer $as cost $pref\"" .
                "\n\tunequal braces \"\{\}\"\n";
        }
#
# Now grab the netlist entries and check they are ok
#
        local($tmppol) = $pol;
        while($tmppol =~ s/(\{[^\}]*\})// ) {
            if(!&isnetlist($1)) {
                return $O_ERROR,
                "syntax error in \"$ATTL{$key}: peer $as cost $pref\"".
                    "\n\tnetlist error $1";
            }
        }
#
# Now check the actual keywords
#
        while($tmppol =~ s/(\S+)//) {
            if (!&isaskeyword($1)) {
                return $O_ERROR,
                "syntax error in \"$ATTL{$key}: peer $as cost $pref\"\n\t$1 ".
                    "is not a routing policy KEYWORD";
            }
        }
	return;
    }
#
# io - interas-out
#
    if ($key eq "io") {
	local($gotmet) = 0;
	local($as, $lib, $rid, $metric, $pol);
        $value =~ s/to//;
        $value =~ s/announce//;
        $value =~ s/[aA][sS]/AS/g;
        $value =~ s/^\s+//;
#
# split up into parts
#
	if ($value =~ /metric-out/) {
	    $gotmet = 1;
	    ($as, $lid, $rid, $metric, $pol) = split(/\s+/, $value, 5);
	} else {
	    ($as, $lid, $rid, $pol) = split(/\s+/, $value, 4);
	}
        if (!&isasnum($as)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\" - ".
                "neigbour peer $as doesn't look like an AS";
        }
        if (!&isipaddr($lid) || !&isipaddr($rid)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\"\n\tip address error";
        }
	if ($gotmet) {
	    if ($metric !~ /^\(metric-out=(\S+)\)$/) {
		return $O_ERROR,
		"syntax error in \"$ATTL{$key}: $value\"".
		    "\n\t<metric-type> is invalid";
	    }
	    if ($1 ne "IGP" && $1 !~ /^\d+$/) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}: $value\"".
		    "\n\t<metric-type> value \"$1\" is invalid";
	    }
	}
        if (!$pol) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\" - ".
                "no routing policy expression given";
        }
#
# now check equal brackets and braces
#
        if(!&isbracket($pol)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: peer $as \"" .
                "\n\tunequal brackets \"\(\)\"\n";
        }
        if(!&isbrace($pol)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: peer $as \"" .
                "\n\tunequal brackets \"\(\)\"\n";
        }
#
# Now grab the netlist entries and check they are ok
#
        local($tmppol) = $pol;
        while($tmppol =~ s/(\{[^\}]*\})// ) {
            if(!&isnetlist($1)) {
                return $O_ERROR,
                "syntax error in \"$ATTL{$key}: peer $as \"".
                    "\n\tnetlist error $1";
            }
        }
        while($tmppol =~ s/(\S+)//) {
            if (!&isaskeyword($1)) {
                return $O_ERROR,
                "syntax error in \"$ATTL{$key}: peer $as \"".
                    "\n\t$1 is not a routing policy KEYWORD";
            }
        }
        $object{$key} =~ s/[aA][sS]/AS/g;
	return;
    }
#
# This is simple for now. TB
# Will change the isnetnum routine to return various codes and modified
# netnum.
# in - inetnum
#
    if ($key eq "in") {
	$j = 0;
	local($onenet) = 0;
	@nets = split(/\s+/, $value);
	if ($#nets == 0) {
	    # check the single network
	    $onenet = 1;
	    $add[0] = $nets[0];
	} elsif ($#nets == 2 && $nets[1] == "-") {
	    $add[0] = $nets[0];
	    $add[1] = $nets[2];
	} elsif ($#nets == 1 ) {
	    $add[0] = $nets[0];
	    $add[1] = $nets[1]; 
	    $mod = 1;
	} else {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - illegal network $value\n";
	}
	foreach $j (0..$#add) {
	    if (!&isnetnum($add[$j])) {	
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}\" - ".
		    "illegal network \"$add[$j]\"\n";
	    }
	}
	if(!$onenet && (&quad2int($add[1])) < (&quad2int($add[0]))) {
	    return $O_ERROR, 
	    "error in \"$ATTL{$key}\" - range is illegal ".
		"- end of block is too low\n";
	}
	
	if($mod) {
	    $new = $add[0]." - ".$add[1];
	    $object{$key} = $new;
	    return $O_WARNING, "\"$ATTL{$key}\" value ".
		"\"$value\" changed to \"$new\"\n";
	}
	if(!$onenet) {
	    $new = $add[0]." - ".$add[1];
	    if($new ne $value) {
		$object{$key} = $new;
		return $O_WARNING, "\"$ATTL{$key}\" value ".
		    "\"$value\" changed to \"$new\"\n";
	    }
	} 
	return;
    }
#
# la - localas
#
    if ($key eq "la") {
	if(!&isasnum($value)) {
	  return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }  

#
# lo - location
#

    if ($key eq "lo") {
	if ($value !~ /^[a-zA-Z0-9\-\.\ \,\(\)\&\'\"\/]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }

# 
# Added this in for now - maybe removed at a later date.
# This is MERIT/RA special.
# lr - local-route
#
    if ($key eq "lr") {
	local(@list) = split(/\s+/, $value);
	if (!&isasnum($list[0])) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\" - $list[0] is not a valid peer";
	} 
	foreach (1..$#list) {
	    if($list[$_] !~ /^\d+:\d+(\(\d+\))*$/) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\" - $list[$_] is invalid";
	    }
	}
	return;
    }
	
#
# ma - maintainer
#
    if ($key eq "ma") {
	if ($value !~ /^[A-Z0-9\-]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}    
	return;
    }
#
# mb - mnt-by
#
    if ($key eq "mb") {

	if ($value !~ /^[A-Z0-9\-\s+]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}    
	# Check whether all mentioned maintainer values are actually
	# present in the database. This is yucky, but %ExistMaintainer
	# is sneakily built in GetMaintainer to speed things up....
	# As everything, these are only kept per ONE update message (which
	# can of course have multiple objects ....)

	local($status) = 0;
	local($notfound) = "";
	
	foreach (split(/\s+/, $value)) {
            next if
                ($ExistMaintainer{$_} ||
		 ($value eq $object{"mt"}) ||
		 &GetMaintainer($_, $object{"so"}));
            $notfound .= "$_ ";
            $status = 1;
        }
	return $O_ERROR,
	"unknown maintainer(s) \"$notfound\" referenced" if $status;
	return;
    }
#
#  mt - mntner
#
    if ($key eq "mt") {
	if ($value !~ /^[A-Z0-9\-]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}    
	return;
    }
#
# mn - mnt-nfy
#
    if ($key eq "mn") {
	if (!&isemail($value)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" ".
		"- \"$value\" is not in \(RFC822\) format";
	}
	return;
    }
#
# na - netname OR aa - as-name
#
    if ($key eq "na" || $key eq "aa") {
	local($cur) = $value;
	local($changed) = 1 if $object{$key} =~ tr/a-z/A-Z/;
	local($changed) = 1 if $object{$key} =~ tr/\./\-/;
	local($changed) = 1 if $object{$key} =~ tr/\_/\-/;
	if ($object{$key} !~ /^[A-Z0-9][A-Z0-9\-]+$/) {
	    $object{$key} = $cur;
	    return $O_ERROR, "illegal $ATTL{$key} \"$cur\"";
	}
	else {
	    if ($changed) {
		$value = $object{$key};
		return $O_WARNING, "\"$cur\" changed to \"$value\"";
	    }
	}
	return;
    }
#
# Will need to change when the NIC-handle syntax is fixed.
#
# nh - nic-hdl
#
    if ($key eq "nh") {
	local($uppercased) = 0;
	if ($DOHANDLE) {
	    if ($value =~ /^[Aa][Ss][Ss][Ii][Gg][Nn]\s*(.*)$/) {
		if ($1) {
		    if (!&ishandle($1)) {
			return $O_ERROR, "syntax error in requested nichandle";
		    }
		} 
		return;
	    } 
	}
	if ($object{$key} =~ tr/a-z/A-Z/) {
	    $value = $object{$key};
	    $uppercased = 1;
	}

	if (!&ishandle($value)) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	if ($uppercased) {
	    return $O_WARNING, "\"$ATTL{$key}\" value uppercased";
	}
	return;
    }
#
# ni - nsf-in
#
    if ($key eq "ni") {
	if ($value !~ /^[(\d=\d+)\s*]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# no - nsf-out
#
    if ($key eq "no") {
	if ($value !~ /^[(\d=\d+)\s*]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# ns - nserver
# 
    if ($key eq "ns") {
	@list = ();
	@list = split(/\s+/,$value);
	$j = 0;
	foreach $j (0..$#list) {
	    if (!&isdomname($list[$j])) {
		if ($list[$j] !~ 
		    /^[0-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*\.[0-9][0-9]*$/) {
		    return $O_ERROR, 
		    "illegal nameserver in \"$ATTL{$key}\" ".
			"component \"$list[$j]\"";
		}
	    }
	}
	return;
    }
#
# ny - notify
#
    if ($key eq "ny") {
	if (!&isemail($value)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - ".
		"\"$value\" is not in \(RFC822\) format";
	}
	return;
    }
#
# op - op-phone
# of - op-fa
# ph - phone
# fx - fax-no
#

    if (($key eq "op") || ($key eq "of") || ($key eq "ph") || ($key eq "fx")) {
	if (!(&isphone($value))) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# om - op-mail
#


    if ($key eq "om") {
	if (!(&isemail($value))) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# or - origin
#
    if ($key eq "or") {
	$value =~ tr/a-z/A-Z/;
	if (!&isasnum($value)) {
	    return $O_ERROR,
	    "syntax error in \"$ATTL{$key}\" - $value is not a valid AS";
	}
	if (($object{$key} =~ tr/a-z/A-Z/)) {
	    return $O_WARNING, "\"$ATTL{$key}\" value uppercased";
	}	
	return;
    }
#
# pe - peer
#
    if ($key eq "pe") {
	local(@peer) = split(/\s+/, $value);
	if($value =~ /localas/) {
	    if($peer[3] ne "localas" || !&isasnum($peer[4])) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\"".
		    " - localas error for $value";
	    }
	}
	elsif (!&isipaddr($peer[0]) || 
	       !&isasnum($peer[1]) ||
	       !&ispeerkeyword($peer[2]) ) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\" - $value";
	}
	return;
    }
#
# pn - person
#
    if ($key eq "pn") {
	local(@names) = split(/\s+/, $value);
	if ($#names == 0) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - ".
		"must contain at least two components";
	}
	foreach $j (0..$#names) {
	    if (!&isname($j)) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	    }
	}
	return;
    }
#
# rl - routpr-l
#
    if ($key eq "rl") {
	if ($value !~ /^[A-Z0-9\-\ ]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# rm - remarks
#
    if ($key eq "rm") {
	if ($value !~ /^.*$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
#  rp - rout-pr
#
    if ($key eq "rp") {
	if ($value !~ /^[A-Z0-9\-]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# rt - route
#
# A little messy - all the work is done in net2net.pl
#
    if ($key eq "rt") {
        local($i) = 0;
	local($NETMASK) = "[nN]*[eE]*[tT]*[mM][aA][sS][kK]";
	local($HEX) = "[0-9a-fA-F]";
	local($HEXMASK) = "0x$HEX$HEX$HEX$HEX$HEX$HEX$HEX$HEX";
	local($IPADDR) = "\\d+\\.\\d+\\.\\d+\\.\\d+";

	if ($value =~ /^$IPADDR$/) {
	    local($stat, $msg, @str) = &clasfn_to_netpre($value);
	    if($stat == $NOK) {
		return $O_ERROR, "$msg\n";
	    } else {
		$object{$key} = $str[0];
		return $O_WARNING, "$ATTL{$key} re-written to $str[0] from $value\n";
	    }
	} elsif ($value =~ /^$IPADDR\s+\-\s+$IPADDR$/) {
	    local($stat, $msg, @str) = &clasfr_to_netpre($value);
	    if($stat == $NOK) {
		return $O_ERROR, "$msg\n";
	    } else {
		if($#str >= 1) {
		    $msg = "$value is not CIDR aligned\n".
			"resubmit the following seperate objects\n";
		    foreach $i (0..$#str) {
			$msg .= "$str[$i]\n";
		    }
		    return $O_ERROR, "$msg\n";
		} else {
		    $object{$key} = $str[0];
		    return $O_WARNING, "$ATTL{$key} re-written to $str[0] from $value\n";
		}
	    }
	} elsif ($value =~ /^$IPADDR\s+($NETMASK)*\s*$IPADDR$/ 
		 || $value =~/^$IPADDR\s+($NETMASK)*\s*$HEXMASK$/) {
	    local($stat, $msg, @str) = &netmask_to_netpre($value);
	    if($stat == $NOK) {
		return $O_ERROR, "$msg\n";
	    } else {
		$object{$key} = $str[0];
		return $O_WARNING,
		"$ATTL{$key} \"$value\" re-written to $str[0] from $value\n";
	    }
	} else {
	    local($stat, $msg, @str) = &netpre_verify($value);
	    if($stat == $NOK) {
		return $O_ERROR, "$msg\n";
	    }
	}
	return;
    }
#
# Need to really check against the DNS eventually
#
# rz - rev-srv
#
    if ($key eq "rz") {
	@list = ();
	@list = split(/\s+/,$value);
	$j = 0;
	foreach $j (0..$#list) {
	    if (!&isdomname($list[$j])) {
		return $O_ERROR, "illegal nameserver in $value";
	    }
	}
	return;
    }
#
# sd - sub-dom
#
    if ($key eq "sd") {
	if ($value !~ /^[a-zA-Z0-9\-\ ]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# so - source
#
    if ($key eq "so") {
	if (!$DBFILE{$value}) {
	    return $O_ERROR, "unknown source \"$value\"";
	}
	if (!$CANUPD{$value}) {
	    return $O_ERROR, "cannot update entry with source \"$value\"";
	}
	return;
    }
#
# tc - tech-c
#
    if ($key eq "tc") {
	if (!&isname($value)) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }
#
# tr - as-transit
#
    if ($key eq "tr") {
	return;
    }
#
# wd - withdrawn
#
    if ($key eq "wd") {
	if($value !~ /^(\d\d)(\d\d)(\d\d)$/) {
	    return $O_ERROR, 
	    "date part of \"$ATTL{$key}\" not in YYMMDD format";
	}
	# 1988 is the start of the world. This is where we test for proper
	# date values of YYMMDD

	if (($1 < 88) || ($2 > 12) || ($3 > 31)) {
	    return $O_ERROR, 
	    "date part of \"$ATTL{$key}\" is not a valid YYMMDD value";
	}
	local($s, $m, $h, $md, $mo, $y) = localtime(time);
	$mo += 1;
	$md = "0".$md unless $md > 9;
	$mo = "0".$mo unless $mo > 9;
	$y = "0".$y unless $y > 9;
	local($curdate) = "$y$mo$md";

	if ($value gt $curdate) {
	    return $O_ERORR, 
	    "date in \"$ATTL{$key}\" ($date) is in the future";
	}
	return;
    }
#
# zc - zone-c
#
    if ($key eq "zc") {
	if (!&isname($value)) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return;
    }

#
# These are not checked and not used, just in here for clarity
#
#
# ue - *ERROR*
#   
    if ($key eq "ue") {
	return;
    }
#
# uf - u-from (NOT USED)
#    
    if ($key eq "uf") {
	return;
    }
#
# ui - msg-id (NOT USED)
#
    
    if ($key eq "ui") {
	return;
    }
#
# uw - WARNING
#
    if ($key eq "uw") {
	return;
    }
}
1;



-------- Logged at  Thu Nov 17 16:02:18 MET 1994  ---------