syntax.pl fixes
- Date: Thu, 17 Nov 1994 14:45:04 +0100
#
# $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,@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,@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;
