nic handle feature
- Date: Tue, 17 Jan 1995 17:46:52 +0100
On request from the other NCC staff, I have tightened the checking on
nic handles. The version of syntax.pl below will no longer accept nic
handles for persons with different names that the person currently in
the database holding the same handle. This addition is only useful if
your database contains persons with nic handles. However, the routine
ExistsObject() inside syntax.pl can be used for various other purposes.
Drop in src/syntax.pl and run a "make" in the database top level dir.
-Marten
PS For those who have line-wrap problems with email, the ftpable copy
on ftp://ncc.ripe.net/dbase-beta/dbase-beta.tar.gz is kept up-to-date
with any changes made.
#
# $RCSfile: syntax.pl,v $
# $Revision: 0.53 $
# $Author: ripe-dbm $
# $Date: 1995/01/17 15:58:00 $
#
# 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
# This routine checks whether a specific object with a certain source
# and type exists. It will return the number of hits. Does NOT work for
# IP address just yet and has to be moved away from here .... If $lookup
# is set, then it will also return the first object in the list.
require "dbopen.pl";
require "dbmatch.pl";
require "dbclose.pl";
require "enread.pl";
sub ExistsObject {
local($key, $type, $source, $lookup) = @_;
local(*i) ='curdb';
local($dbfile) = "";
local(%nothing) = ();
local(@keys) =($key);
local(@matches);
local(%en) = ();
if ($TYPE{$source} eq "SPLIT") {
$dbfile = "$DBFILE{$source}.$type";
} else {
$dbfile = $DBFILE{$source};
}
if (&dbopen(i, *nothing, 0, $dbfile)) {
@matches = &dbmatch(*i, *keys, 1);
} else {
&dbclose(*i);
return -1;
}
if ($lookup) {
%en = &enread(i, $matches[0]);
}
&dbclose(*i);
if ($lookup) {
return $#matches+1, %en;
} else {
return $#matches+1;
}
}
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] eq "MAIL-FROM") {
local($regex) = $value;
$regex =~ s/^\s*MAIL\-FROM\s*//;
eval "/$regex/;";
if ($@) {
return $O_ERROR, "\"$regex\" is not a legal regular expression";
} else {
return;
}
}
else {
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}\" - ".
"is an illegal keyword community name \"$j\"";
}
local($copy) = $j;
$copy =~ tr/A-Z/a-z/;
local($stat) = &ExistsObject($copy, "cm", $object{"so"});
if ($stat < 1 ) {
return $O_ERROR, "community \"$j\" does not exist in ".
"the $object{\"so\"} database";
}
}
return;
}
#
# cm - community
#
if ($key eq "cm") {
if (!&iscommunity($value)) {
return $O_ERROR,
"syntax error in \"$ATTL{$key}\" - ".
"illegal community name \"$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(%preventry) = ();
local($matches) = 0;
local($newname) = "";
local($curname) = "";
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";
}
local($goandfind) = $value;
$goandfind =~ tr/A-Z/a-z/;
($matches, %preventry) =
&ExistsObject($goandfind, "pn", $object{"so"} , 1);
if ($matches) {
$curname = $preventry{"pn"};
$curname =~ tr/A-Z/a-z/;
$curname =~ s/\s+/ /g;
$newname = $object{"pn"};
$newname =~ tr/A-Z/a-z/;
$newname =~ s/\s+/ /g;
if ($curname ne $newname) {
return $O_ERROR,
"nic-hdl \"$value\" already assigned to $preventry{\"pn\"}";
}
}
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") {
foreach (split(/\s+/, $value)) {
if (!&issubdomname($_)) {
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;
}
#
# st - status
#
if ($key eq "st") {
if ($value =~ /^d$|^[Dd][Ee][Ll][Ee][Gg][Aa][Tt][Ee][Dd]$/) {
$object{$key} = "D";
return $O_WARNING, "\"$ATTL{$key}\" changed to \"D\"";
}
if ($value =~ /^r$|^[Rr][Ee][Ss][Ee][Rr][Vv][Ee][Dd]$/) {
$object{$key} = "R";
return $O_WARNING, "\"$ATTL{$key}\" changed to \"R\"";
}
if ($value =~ /^[Aa]$|^[Aa][Ss][Ss][Ii][Gg][Nn][Ee][Dd]$/) {
$object{$key} = "";
return $O_WARNING, "\"$ATTL{$key}\" has default value; removed";
}
if ($value =~ /^D$|^R$/) {
return 1;
}
return $O_WARNING, "\"$ATTL{$key}\" has an illegal value";
}
#
# 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;
