# syntax.pl
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997, 1998, 1999 by RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: syntax.pl,v 2.29 1999/11/16 13:41:28 engin Exp $
#
#	$RCSfile: syntax.pl,v $
#	$Revision: 2.29 $
#	$Author: engin $
#	$Date: 1999/11/16 13:41:28 $
#
#       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 "defines.pl";
require "adderror.pl";
require "net2net.pl";    
require "misc.pl";	 
require "handle.pl";
require "dpr.pl";

sub requiredsyntaxcheck {
    local(*object, $type)=@_;

    local($rtcode)=$O_OK;

    &dpr("\n");

    if (!$type) {	
       
       &adderror(*object, "unknown object type");
       
       $rtcode=$O_ERROR;
       
    }
    
    #
    # so - source
    
    # print STDERR $object{"so"}, $CANUPD{$object{"so"}}, "\n";
    
    if ($object{"so"}) {
	if (!$DBFILE{$object{"so"}}) {
	    &adderror(*object, "unknown source \"".$object{"so"}."\"");
	    $rtcode=$O_ERROR;
	}
	if (!$CANUPD{$object{"so"}}) {
	    &adderror(*object,"cannot update entry with source \"" .
		      $object{"so"} . "\"");
	    $rtcode=$O_ERROR;
	}
    }
    else {
	&adderror(*object, "mandatory field \"source\" missing");
	$rtcode = $O_ERROR;
    }
    
    #
    # uo - override

    if ($object{"uo"}) {
    
       if ($object{"uo"}=~ /^\S+.*\s+(\S+)$/) {

#	  &dpr(" checking $1 with $OVERRIDECRYPTEDPW\n");           
          if (crypt($1,$OVERRIDECRYPTEDPW) eq $OVERRIDECRYPTEDPW) {
              
             $object{"uo"}=~ s/\s+(\S+)$/ \*\*\*/;
#	     &dpr("valid override\n");
          }  
          else {
              
             $object{"uo"}=~ /^(\S+)\s/;
              
#	      &dpr(" checking $1 with $OVERRIDECRYPTEDPW\n");
             if (crypt($1,$OVERRIDECRYPTEDPW) eq $OVERRIDECRYPTEDPW) {
                
                $object{"uo"}=~ s/^(\S+)\s+/\*\*\* /;
#		&dpr("valid override\n");
             }  
             else {
                 
                &syslog("AUDITLOG", "Override failure, wrong password in line: ".$object{"uo"});
                 
                &adderror(*object, "wrong override password specified, fact has been logged");
                 
                $rtcode=$O_ERROR;
                 
             }
              
          }
           
       }
       else {
            
           &adderror(*object, "illegal override value, syntax should be: Reason Passwd");
        
           $rtcode=$O_ERROR;
        
       }
        
    }
    
    #
    # ud - delete attribute
    
    if ((defined($object{"ud"})) && ($object{"ud"}=~ /^\s*$/)) {
       &adderror(*object, "delete attribute must contain a reason for delete");
       
       $rtcode=$O_ERROR;
    
    }
    
    
    return $rtcode;
 
}

sub checksyntax {
    local(*object)=@_;

    local($rtcode) =$O_OK;
    local($itmp, $val, $msg);

    foreach $itmp (keys %object) {
	if ($object{$itmp} eq "") {
	    ($val, $msg) = &dosyntax($itmp, "", *object);
	    if (defined($val)) {
	       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);
			}
#
# 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;
			}
#
# 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";
			}
#
# 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";
			    }
			}
		    }
#
# 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;
		}
		
		
		if($FLAG eq "ai") {
		  $object{$itmp} =~ s/from\s+|accept\s+//g;
		}
		if ($FLAG eq "ao") {
		  $object{$itmp} =~ s/to\s+|announce\s+//g;
		}
		if ($FLAG eq "it") {
		  $object{$itmp} =~ s/from\s+|accept\s+//g;
		}
		if ($FLAG eq "io") {
		  $object{$itmp} =~ s/to\s+|announce\s+//g;
		}
#
# 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 (defined($val)) {
			   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 {
	        if ($itmp=~ /^ac|ah|ch|tc|zc|cy|mb|ml$/) {
		    local($val, $msg) = &dosyntax($itmp, $object{$itmp}, *object);
		    # print STDERR "checksyntax - before attr: $itmp rtcode: $rtcode val: $val msg: $msg\n" if ($opt_V);
		    if (defined($val)) {
		       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 - after attr: $itmp rtcode: $rtcode val: $val msg: $msg\n" if ($opt_V);
		}
		else {
		   foreach $j (split(/\n/, $object{$itmp})) {
		    local($val, $msg) = &dosyntax($itmp, $j, *object);
		    # print STDERR "checksyntax - before attr: $itmp rtcode: $rtcode val: $val msg: $msg\n" if ($opt_V);
		    if (defined($val)) {
		       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 - after attr: $itmp rtcode: $rtcode val: $val msg: $msg\n" if ($opt_V);
		   }
		}
	    }
	}
    }
    
    return $rtcode;
    
}

sub dosyntax {

    local($key, $value, *object) = @_;
    
    local($type)=&entype(%object);
    

#
# 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.

    
#
# 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\" - neighbour 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 $O_OK;
    }
#
# 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\"\nneighbour 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 braces and parentheses
#
	if(!&isbrace($pol)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\"" .
		"\n\tunequal braces \"\{\}\"\n";
	}
	if(!&isparen($pol)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\"" .
		"\n\tunequal parentheses \"\(\)\"\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}: $value\"".
		    "\n\tnetlist error $1";
	    }
	}
#
# Now check the actual keywords
#
# Joao. Including Curtis Villamizar's performance patch.
#	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";
        local($tmpword);
        foreach $tmpword ( split(/\s+/, $tmppol) ) {
 	   if (!&isaskeyword($tmpword)) {
 	       return $O_ERROR, 
 	       "syntax error in \"$ATTL{$key}: $value\"\n".
 		   "\t$tmpword is not a routing policy KEYWORD";

	    }
	}
	return $O_OK;
    }
#
# 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 $O_OK;
    }

#
# an - aut-num
# la - localas
# or - origin

    if ($key=~ /^an|la|or$/) {
    
	$value =~ tr/a-z/A-Z/;
	
	if (!&isasnum($value)) {
	    return $O_ERROR,
	    "syntax error in \"$ATTL{$key}\" - $value is not a valid AS";
	}
	
	$object{$key}=$value;
	
	return $O_OK;
    }
    
#
# am - as-macro
#
    if ($key eq "am") {
    
	if(!&isasmacro($value)) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return $O_OK;
    }
#
# 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\" - ".
		"neighbour 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 braces and parentheses
#
	if(!&isbrace($pol)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value \"" .
		"\n\tunequal braces \"\{\}\"\n";
	}
	if(!&isparen($pol)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value \"" .
		"\n\tunequal parentheses \"\(\)\"\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}: $value \"".
		    "\n\tnetlist error $1";
	    }
	}
	while($tmppol =~ s/(\S+)//) {
	    if (!&isaskeyword($1)) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}: $value \"".
		    "\n\t$1 is not a routing policy KEYWORD";
	    }
	}

       return $O_OK;

    }

#
# 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 $O_OK;
	    }
	}
	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 $O_OK;
	    }
	}	
	elsif ($authstr[0] eq "MAIL-FROM") {
	    local($regex) = $value;
	    $regex =~ s/^\s*MAIL\-FROM\s*//;	# del all up to regex
	    $regex =~ s/\s+$//;			# del whitespaces at the end
	    $regex =~ s/\\?\@/\Q\@\E/g;         # quote '@'s for perl5
	
	    if ($regex =~ /^$/) {
		return $O_ERROR, "regular expression missing from MAIL-FROM attribute";
	    }

	    if ($regex =~ /\s/) {
		return $O_WARNING, "whitespace found " . 
			"inside regular expression in MAIL-FROM attribute";
	    }

	    # Check the given regexp is valid.
	    eval { m/$regex/ };

	    if ($@) {
	      return $O_ERROR, "\"$regex\" is not a legal regular expression";
	    }
	    else {
	      return $O_OK;
	    }
	}
        elsif ($authstr[0] =~ /^PGPKEY/) {
            if ($authstr[0] !~ /^\s*PGPKEY-[0-9a-fA-F]{8}\s*$/) {
               return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
            } else {
                return $O_OK;
            }
        }
	    
	else {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\" $value";
	}
	return $O_OK;
    }
#
# au - authority
#
    if ($key eq "au") {
    
	if ($value !~ /^[a-zA-Z0-9\-\.\ \,\(\)\/]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return $O_OK;
    }
#
# 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 $O_OK;
    }
#
# 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 $O_OK;
    }
#
# 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 $O_OK;
    }
# 
# bl - bdrygw-l
#
    if ($key eq "bl") {
    
	if ($value !~ /^[A-Z0-9\-\ ]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	
	return $O_OK;
    }

#
# ce - certif
#
    if ($key eq "ce") {
                
       print STDERR "dosyntax - checking ce\n" if $opt_V;
            
       unless ($value =~ /^[ -~]*$/) {
           return $O_ERROR, "syntax error in \"$ATTL{$key}\", only printable ascii characters (0x20-0x7e) expected.";
       }

        return $O_OK;
    }

#
# Try to do something clever with the changed field
#
# ch - changed
# wd - withdrawn
#
    if ($key=~ /^ch|wd$/) {
    
       local($returncode)=$O_OK;
       
       local($date);
       local(@newchanged)=();
       local(@changedvalues)=split(/\n+/, $value);
       
       #
       # add current date if needed to last specified attribute
       
       # match any string which looks like a date (we do the syntax
       # check a little bit later)

       if ($changedvalues[$#changedvalues]!~ / \d+$/) {
          
          $changedvalues[$#changedvalues].=" ".$DATE;
          
          &addwarning(*object, "added current date to ".$ATTL{$key}." field");
          
          $returncode=$O_WARNING;
          
       }

       #
       # sort values on date
       
       @changedvalues=sort sortchangedfield @changedvalues;

       #print STDERR join("\n", "values:", @changedvalues);
       
       foreach $value (@changedvalues) {
       
          $date="";
          
          if ($value=~ / /) {
             $value=~ s/ +(\d+)$//;
             $date=$1;
          }
       
          # print STDERR "*", $date, "*", $value, "\n";
       
          if (!(&isemail($value))) {
             return $O_ERROR, "syntax error in e-mail part of \"$ATTL{$key}\"";
          }

          if (!$date) {
	     return $O_ERROR, "No date specified in \"$ATTL{$key}\" attribute";
          }
           
	  if ($date=~ /^(\d\d\d\d\d\d)$/) {  # match YYMMDD dates
	     $date = YYMMDDtoYYYYMMDD($date);
	     &addwarning(*object, "date in \"$ATTL{$key}\" ($1) changed to $date");
	  }

          # at this point all dates should be YYYYMMDD

	  if ($date=~ /^(\d{4})(\d\d)(\d\d)$/) {
	    
	    local($year,$month,$day) = ($1,$2,$3);

	    if ($year<1988) {
	      return $O_ERROR,
	        "date ($year in $date) part of \"$ATTL{$key}\" is older than the database itself! (1988)";
	    }

	    if (($month<1) || ($month>12)) {
	      return $O_ERROR,
	        "Month part ($month) of \"$ATTL{$key}\" is not valid";
	    }
	  
	    if (($day>31) || ($day<1)) {
	      return $O_ERROR,
	        "Day part ($day) of \"$ATTL{$key}\" is not valid";
	    }

	  }
	  else {
	  
	     return $O_ERROR, "date part of \"$ATTL{$key}\" not in YYMMDD or YYYYMMDD format";
	
	  }
	  
	  if ($date > $DATE) {
	     
	     &addwarning(*object, "date in \"$ATTL{$key}\" ($date) is in the future - changed to $DATE");
	     $date=$DATE;
	     $returncode=$O_WARNING;
	     
	  }
	  
	  push(@newchanged, $value." ".$date);
	
       }
	  
       $object{$key}=join("\n", @newchanged);

       return $returncode;
	
    }
    
#
# This is the "community" stuff.
#
# cl - comm-list

    if ($key eq "cl") {
    
       foreach $j (split(/\s+/, $value)) {
     
          if (!&iscommunity($j)) {
		return $O_ERROR, 
		"syntax error in \"$ATTL{$key}\" - ".
		    "is an illegal keyword community name \"$j\"";
	  }
       
       }
       
       return $O_OK;
       
    }
    
#
# cm - community

    if ($key eq "cm") {
    
	if (!&iscommunity($value)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - ".
		"illegal community name \"$j\"";
	} 
	return $O_OK;
    }
    
# cn - cross-nfy
#
# value is a nic handle

    if ($key eq 'cn') {
      return $O_OK if isnichandle($value);

      return ($O_ERROR,
	      "syntax error in \"$ATTL{$key}\" - Not a nic handle ($value)");
    }


# ct - cross-mnt
#
# value is name of a mntner

    if ($key eq 'ct') {
      return $O_OK if ismaintainer($value);

      return ($O_ERROR,
	      "syntax error in \"$ATTL{$key}\" - Not a maintainer ($value)");
    }

#
# cy - country

    if ($key eq "cy") {
    
       local($errors)="";
       local(@errors)=();
       
       local($warnings)="";
       local(@aliases)=();
       local(@doubles)=();
       local(%doubles)=();
       
       local(@countries)=();
       
       # make sure it is upper case
       
       $value=~ tr/a-z/A-Z/;
       
       # check if country exists and convert aliases
       
       foreach $country (split(/\s+/, $value)) {
	  
	  if (!$COUNTRY{$country}) {
	      push(@errors, $country);
	  }
	  else {
	  
	    if ($COUNTRY{$country} ne $country) {
	       
	       push(@aliases, $country." -> ".$COUNTRY{$country});
	       
	       $country=$COUNTRY{$country};
	    
	    }
	  
	    if ($doubles{$country}) {
	       
	       push(@doubles, $country) if ($doubles{$country}==1); 
	       
	       $doubles{$country}++;
	       
	    }
	    else {
	       
	       # rearrange country attribute with no more then
	       # $MAXCOUNTRIES on one line
	    
	       push(@countries, $country);
	    
	       $doubles{$country}=1;
	       
	    }
	    
	  }
	
	}
	
	# constuct the country attribute value again, skip the leading \n
	
	local($i)=0;
	local(@newcountries)=();
	
	foreach (sort(@countries)) {
	   
	   $i++;
	      
	   if ($i % $MAXCOUNTRIES) {
	      push(@newcountries, " ", $_);
	   }
	   else {
	      push(@newcountries, "\n", $_);
	   }
	   
	}
	
	shift(@newcountries);
	
	$object{$key}=join("", @newcountries);
	
	
	# return with right warnings & error messages
	
	if (@errors) {
	   
	   if (@errors==1) {
	   
	      $errors='unknown country code: "'.$errors[0].'"';
	   
	   }
	   else {
	      
	      $errors='unknown country codes: ' . join(', ',@errors) . "\"";
	   
	   }
	   
	   # only ask for addition if the code looks like a real country code
	   
	   if (@errors=grep(/^[A-Z][A-Z]$/, @errors)) {
	      
	      $errors.="\ncontact \<$HUMAILBOX\> for addition to the valid country list\nif you believe that ";
	      
	      if (@errors==1) {
	         $errors.=$errors[0]." is a valid ISO 3166 country code";
	      }
	      else {
	         $errors.=join(", ", @errors)." are valid ISO 3166 country codes";
	      }

	   }
	   
	   return $O_ERROR, $errors;
	
	}
	
	if (@aliases) {
	
	   if (@aliases==1) {
	   
	      $warnings='changed country code: "'.$aliases[0].'"';
	   
	   }
	   else {
	      
	      $warnings='changed country codes: '.join(', ',@aliases);
	   
	   }
        
        }
        
        
        if (@doubles) {
	
	   $warnings.="\n" if ($warnings);
	   
	   if (@doubles==1) {
	   
	      $warnings.='removed more then once specified country code: '.$doubles[0];
	   
	   }
	   else {
	      
	      $warnings.='removed more then once specified country codes: '.join(', ',@doubles);
	   
	   }
        
        }

        return $O_WARNING, $warnings if ($warnings);
        
	return $O_OK;
	
    }

#
# de - descr
# rm - remarks
# tx - text
# ad - address
# tb - trouble

    if ($key=~ /^de|rm|tx|ad|tb$/) {
       
       if ($value!~ /^.*$/) {
          return $O_ERROR, "invalid characters found in \"$ATTL{$key}\"";
       }

       return $O_OK;

    }    

    
#
# 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 $O_OK;
    }
#
# 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 $O_OK;
    }
#
# 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 $O_OK;
    }

#
# dn - domain
# da - dom-name
# ir - inet-rtr

    if ($key=~ /^d[an]|ir$/) {
    
       if (!&isdomname($value)) {
          return $O_ERROR, "illegal domain name in ".$ATTL{$key};
       }
	
       return $O_OK;
	
    }
    
#
# rf - refer
# referral attribute for domain objects

    if ($key eq "rf") {

	local($type,$host,$port) = split(/\s+/,$value);
        # Check syntax of TYPE field
	if ($type !~ /^ripe|internic|clientaddress|simple$/i) {
	    return $O_ERROR,
	    "syntax error in \"$ATTL{$key}: $value\" - ".
		"type must be one of RIPE, INTERNIC, CLIENTADDRESS or SIMPLE";
	}

        # Check syntax of host field
	if (!&isdomname($host)) {
	    return $O_ERROR, "illegal host name in ".$ATTL{$key};
	}

        # Check syntax of port field
	if (defined $port && ($port !~ /[0-9]{1,5}/ || $port > 65534) ) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}: $value\" - ".
		"port must be numeric value in the range 0-65534";
	}
	return $O_OK;
    }
    
#
# 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 $O_OK;
    }
#
# dp - dom-prefix
#
    if ($key eq "dp") {
    
	if (!&isclnsprefix($value)) {
	    return $O_ERROR, "illegal NSAP prefix format in \"$ATTL{$key}\"";
	}
	return $O_OK;
    }

#
# dt - upd-to
# em - e-mail
# gd - guardian
# mn - mnt-nfy
# ny - notify
# om - op-mail

    if ($key=~ /^dt|em|gd|mn|ny|op$/) {
    
	if (!&isemail($value)) {
	    return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" ".
		"- \"$value\" is not in \(RFC822\) format";
	}
	
        if( $value =~ /$AUTOBOX/ ) {
            return $O_ERROR,
            "invalid address in \"$ATTL{$key}\" ".
                "- \"$value\" ";
        }

	return $O_OK;
    }

#
# gw - gateway
#
    if ($key eq "gw") {
	if ($value !~ /^[a-zA-Z0-9\-\.\ ]+$/) {
	    return $O_WARNING, "syntax error in \"$ATTL{$key}\"";	
	}
	return $O_OK;
    }
#
# 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 $O_OK;
    }
#
# 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 $O_OK;
    }
#
# 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 $O_OK;
    }
#
# 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\tneighbour 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 braces and parentheses
#
        if(!&isbrace($pol)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\"" .
                "\n\tunequal braces \"\{\}\"\n";
        }
        if(!&isparen($pol)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value\"" .
                "\n\tunequal parentheses \"\(\)\"\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}: $value\"".
                    "\n\tnetlist error $1";
            }
        }
#
# Now check the actual keywords
#
        while($tmppol =~ s/(\S+)//) {
            if (!&isaskeyword($1)) {
                return $O_ERROR,
                "syntax error in \"$ATTL{$key}: $value\"\n\t$1 ".
                    "is not a routing policy KEYWORD";
            }
        }
	return $O_OK;
    }
#
# io - interas-out
#
    if ($key eq "io") {
    
	local($gotmet) = 0;
	local($as, $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\" - ".
                "neighbour 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 braces and parentheses
#
        if(!&isbrace($pol)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value \"" .
                "\n\tunequal braces \"\{\}\"\n";
        }
        if(!&isparen($pol)) {
            return $O_ERROR,
            "syntax error in \"$ATTL{$key}: $value \"" .
                "\n\tunequal parentheses \"\(\)\"\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}: $value \"".
                    "\n\tnetlist error $1";
            }
        }
        while($tmppol =~ s/(\S+)//) {
            if (!&isaskeyword($1)) {
                return $O_ERROR,
                "syntax error in \"$ATTL{$key}: $value \"".
                    "\n\t$1 is not a routing policy KEYWORD";
            }
        }
        $object{$key} =~ s/[aA][sS]/AS/g;
	return $O_OK;
    }

#
# in - inetnum

    if ($key eq "in") {

       $value=~ s/\s+/ /g;
       
       local($newvalue, $code)=&normalizerange($value, $key);
       
#       &dpr("dosyntax - newrange: $newvalue code: $code (OK=$O_OK)\n");
       
       if ($code==$O_OK) {
          
          local($warnings)="";
          
          $object{$key}=$newvalue;
          
          # warn if we changed the value
          
          local($regularnewvalue)=&MakeRegular($newvalue);
          
          if ($value!~ /^\s*$regularnewvalue\s*$/) {
          
             $warnings="\"$ATTL{$key}\" value: \"$value\" changed to \"$newvalue\"";          
          
          }
          
          # warn if really huge ranges are specified
          
          local($ip1,$ip2)=split(/ *\- */, $newvalue);
          
          $ip1=&quad2int($ip1,0);
          $ip2=&quad2int($ip2,0);
          
          if (($ip2 - $ip1) > (2**24)) {
              return ($O_ERROR,
                      "\"$ATTL{$key}\" huge range specified ($newvalue)\n");
          } 

          if (($ip2-$ip1)>(2**13)) {
          
             $warnings.="\n" if $warnings;
             $warnings.="\"$ATTL{$key}\" huge range specified ($newvalue),\nplease check if that was the intention!\n";          
          
          }
          
          return ($O_WARNING, $warnings) if ($warnings);
          
          return $O_OK; 
          
       }
       else {
          
          if ($code==$O_INVALIDIP) {
             
             return ($O_ERROR, "error in \"$ATTL{$key}\" - invalid IP number specified in: $value\n"); 
          
          }
          elsif ($code==$O_INVALIDPREFIX) {
             
             return ($O_ERROR, "error in \"$ATTL{$key}\" - invalid prefix value specified\n");          
          
          }
          elsif ($code==$O_INVALIDRANGE) {
          
             return ($O_ERROR, "error in \"$ATTL{$key}\" - illegal range: end value of range is smaller then start value\n");
          
          }
          elsif ($code==$O_SYNTAXERROR) {
             
             return ($O_ERROR, "syntax error in \"$ATTL{$key}\" - illegal network $value,\nrange x.x.x.x - x.x.x.x expected\n");
          
          }
          
          return ($O_ERROR, "syntax error in \"$ATTL{$key}\" - illegal network $value,\nrange x.x.x.x - x.x.x.x expected\n");
       
       }
       
    }

#
# i6 - inet6num

    if ($key eq "i6") {

       $value=&fullipv6formatprefix($value);
       
       # print STDERR $value, "\n";
       
       if (!&isipv6prefix($value)) {
          
          return ($O_ERROR, "error in \"$ATTL{$key}\" - invalid ipv6 prefix value specified\n");          
          
       }
             
 
       local($fullipv6prefix,$prefixlength);
       ($fullipv6prefix,$prefixlength) = split('/',$value);
       local(@words);
       @words = split(':',$fullipv6prefix);
  
       if($words[0] !~ /[23][0-9A-Fa-f]{3}/ ){ #only unicast addresses can be registered

           return ($O_ERROR, "error in \"$ATTL{$key}\" - only global unicast addresses can be registered\n");
 
       }
 
       if($words[0] eq '2001'){  # if this is TLA 0x0001
 
         if($prefixlength < 4 || $prefixlength > 64){
 
           return ($O_ERROR, "error in \"$ATTL{$key}\" - invalid ipv6 prefix value specified\n");  
 
         }
 
       }
       else{
          if($prefixlength < 4 || $prefixlength >64 || ( $prefixlength >= 16 && $prefixlength <= 24 )){
 
            return ($O_ERROR, "error in \"$ATTL{$key}\" - invalid ipv6 prefix value specified\n");  
 
          }
          if(hex($words[1]) > hex('FF')){ # reserved field is _not_ zeros
 
            return ($O_ERROR, "error in \"$ATTL{$key}\" - reserved field must be filled with zeros\n");  

          }
       }
       
       #
       # remove long ranges of zeroes
       
       local($length)=0;
       local($maxlength)=0;
       $value=~ s/\/(\d+)$//;
       local($prefixlength)=$1; 
       local(@fields)=split(/\:/, $value);
       local($counter)=0;
       
       local($start,$maxstart);
       
       foreach (@fields) {
          
          if ($_) {
             $length=0;
          }
          else {
             
             $start=$counter if (!$length);
             $length++;
             
             if ($length>$maxlength) {
                $maxlength=$length;
                $maxstart=$start;
             }
             
          }
          
          $counter++;
       
       }
       
       # print STDERR join("*", @fields), "\n";
       
       if ($maxlength>1) {
          
          splice(@fields, $maxstart, $maxlength, "");
       
          unshift(@fields, "") if ($fields[0]!~ /^[\da-f]+$/);
          push(@fields, "") if ($fields[$#fields]!~ /^[\da-f]+$/);
          
       }
       
       ($object{$key}=join("\:", @fields)."\/".$prefixlength) =~ tr/a-f/A-F/;
       
       # print STDERR "l: $length st: $maxstart end: $maxlength ", $object{$key}, "\n";
       
       return $O_OK;
       
    }


    
#
# kc - key-cert
#
    if ($key eq "kc") {

       print STDERR "dosyntax - checking kc\n" if $opt_V;

       if ($value =~ m/^\s*PGPKEY-[0-9a-fA-F]{8}\s*$/i) {
        return $O_OK;
       } else {
        return $O_ERROR, "syntax error in  \"$ATTL{$key}\", PGPKEY-hhhhhhhh expected (h = hexadecimal #)";
       }
    }


#
# li - limerick
#
    if ($key eq "li") {
    
       $value=~ tr/a-z/A-Z/;
       
       if (!&islimerick($value)) {
          return $O_ERROR, "syntax error in \"$ATTL{$key}\", LIM-LimerickName expected";
       }
       
       $object{$key}=$value;

       return $O_OK;

    }    
    
      

#
# lo - location
#

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

# 
# 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 $O_OK;
    }
	
#
# ma - maintainer
#
    if ($key eq "ma") {
    
	if ($value !~ /^[A-Z0-9\-]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}    
	return $O_OK;
    }

#
# mb - mnt-by
# ml - mnt-lower

    if ($key=~ /^m[bl]$/) {

       local($mntner);

       local(@syntaxerrors)=();
       # local(@optionerrors)=();
       
       local($errormsg)="";
       
       local(@mntners)=();
       # local(%options)=();
       
       # convert to uppercase

       $value=~ tr/[a-z]/[A-Z]/;

       foreach $mntner (split(/\n+/,$value)) {
	  
	  # check syntax first
	  
	  # check syntax of maintainer itself
	  
	  # print STDERR "*$mntner*\n";
	  
	  if (!&ismaintainer($mntner)) {
	     push(@syntaxerrors, $mntner);
             next;
          }
          
          # check syntax of options, not yet, it only works for creation
          
          #%options=();
          
          #if (grep((!(/^\s*$/)) &&             # we might have white space
          #         ((!$MNTOPTIONS{$_}) ||      # check for valid option
          #          ($options{$_})),           # check for double options
          #         split(/\s*(\(|\)|\&)\s*/, $1))) {
          #         
          #   push(@optionerrors, $mntner);
          #   next;
          #   
          #}
          
             
          #   next if ($option=~ /^\s*$/);
          #   
          #   if ($MNTOPTIONS{$option}) {
          #      push(@options,$option);
          #   }
          #   else {
          #      push(@syntaxerrors, $mntner);
          #      next;
          #   }
          #
          #}
	   
          push(@mntners,$mntner);
          
        }
        
        $errormsg.="syntax error in maintainer name(s) \'".join(" ",@syntaxerrors)."\',\nonly -, A-Z, 0-9 are allowed\n" if (@syntaxerrors);
        
        # $errormsg.="syntax error in option(s) of maintainer \'".join(" ",@optionerror)."\'\n,syntax is MNTNER [ ( [NEW|UPD|DEL] [ & NEW|UPD|DEL ] ... ) ]\n"if (@optionerrors);

	if ($errormsg) {
	   return $O_ERROR, $errormsg;
	}
	else {   
	   $object{$key}=join("\n", @mntners);
	}
	if ($key eq 'mb' && $type eq 'kc') {
	   my($warningmsg) = "";

           foreach $mntner (split(/\s+/,$value)) {
	      my(%mnt);

	      if (%mnt = GetMaintainer($mntner, $object{'so'}, 0)) {
	         foreach (split(/\n/, $mnt{"at"})) {
		    unless (/^PGPKEY/) {
		       $warningmsg .= "maintainer $mntner does not provide "
			   . "adequate protection for\nPGP key certificate "
			   . "object -- consider upgrading auth to PGPKEY\n";
		       last;
		    }
	         }
	      }
	   }
           return ($O_WARNING, $warningmsg) if $warningmsg;
	}
	return $O_OK;
    }
    
#
#  mt - mntner
#
    if ($key eq "mt") {
       
       # convert to uppercase

       $value=~ tr/[a-z]/[A-Z]/;
       $object{$key}=$value;

       if (!&ismaintainer($value)) {
          return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
       }
	    
       return $O_OK;
       
    }
    
#
# na - netname
# aa - as-name

    if ($key=~ /^[na]a$/) {
    
	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 (!&isnetname($object{$key})) {
	    $object{$key} = $cur;
	    return $O_ERROR, "illegal $ATTL{$key} \"$cur\"";
	}
	else {
	    if ($changed) {
		$value = $object{$key};
		return $O_WARNING, "\"$cur\" changed to \"$value\"";
	    }
	}
	return $O_OK;
    }
    
#
# nh - nic-hdl

    if ($key eq "nh") {
#       &dpr("dosyntax - checking nh ($key)\n");
       $object{$key} = $value if ($value =~ tr/a-z/A-Z/);

       if ($value =~ /^${AUTONICPREFIXREGULAR}0*([1-9]\d*)?(\d)([A-Z]*)$/) {
          local($prefix) = $AUTONICPREFIX.$1.$2;
          local($initials) = $3;
          local($autoinitials) = 0;

          # check if the ID is not already used
          return $O_ERROR, "error in \"$ATTL{$key}\", auto NIC handle " . 
	                   "assignment\nidentification code ($1.$2) " . 
			   "already used in other object" 
			       if ($NICID{$object{"so"}, $prefix});

          # find initials if not already specified
          if (!$initials) {
             $autoinitials = 1;
             $initials = &findinitials($object{$type});
          }
          
          if (&isnichandle($initials."1\-".$NICPOSTFIX{$object{"so"}})) {
             $object{$key} = $prefix.$initials;
             # check if the ID is not already used
             $prefix =~ /\-(\d+)$/;
             return $O_ERROR, "error in \"$ATTL{$key}\", auto NIC handle " .
		              "assignment identification code ($1) already " .
			      "used in other object\nplease use another " .
			      "number than $1" 
				  if ($NICID{$object{"so"}, $prefix});
             $NICID{$object{"so"}, $prefix}=1;
             return $O_OK;
          }
          else {
             if ((length($initials)>$MAXLENGTHINITIALS) ||
                 (length($initials)<2)) {
                if ($autoinitials) {
                   return $O_ERROR, "couldn\'t find a valid set of initials" .
		                    " for NIC handle, please specify " .
				    "yourself: AUTO-#[Initials]"; 
                }
                else {
                   return $O_ERROR, "syntax error in \"$ATTL{$key}\", " .
		                    " number of initials must be >=2 and " .
				    "<=$MAXLENGTHINITIALS"; 
                }
             }
             return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
          }
       }
       return $O_ERROR, "syntax error in \"$ATTL{$key}\"" 
	   if (!&isnichandle($value));
       return $O_ERROR, "reserved word $1 used as nic handle" 
	   if ($value =~ /^(auto\d*)/i);
       return $O_OK;
    }
    
#
# ni - nsf-in

    if ($key eq "ni") {
    
	if ($value !~ /^[(\d=\d+)\s*]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return $O_OK;
    }
#
# no - nsf-out
#
    if ($key eq "no") {
    
	if ($value !~ /^[(\d=\d+)\s*]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return $O_OK;
    }
#
# 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 $O_OK;
    }
    
#
# op - op-phone
# of - op-fa
# ph - phone
# fx - fax-no
#

    if ($key=~ /^o[pf]|ph|fx$/) {
       
	if (!(&isphone($value))) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\",\nphone number is not formatted as an international phone number";
	}
	
	return $O_OK;
	
    }

#
# uo - override
#
# checking is already done in requiredsyntaxcheck

    if ($key eq "uo") {

       return $O_OK;

    }


#
# 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 $O_OK;
    }
    
#
# pn - person
# ro - role
#
    if ($key =~ /^pn|ro$/) {

#	&dpr("checking pn,ro ($key)\n");
	
	my($nichdl) = $value;
	my($nrofcomponents);
	my($name) = $value;

	# person and role attibutes are single so no need to split on \n

	$nichdl=~ tr/a-z/A-Z/;

	if ($nichdl=~ /^$AUTONICPREFIXREGULAR\d+[A-Z]*$/o) {

	    return $O_ERROR, 
	        "error in \"$ATTL{$key}\", " .
		"$nichdl looks like auto NIC handle assignment reference\n" .
		"instead of a $ATTL{$key} name";              
        }
	elsif ( !(($NROFNAMES < 2) &&
		  ($nichdl =~/^[A-Z]+$/)) &&
	       (&isnichandle($nichdl)) ) {
	    
	    return $O_ERROR,
	        "error in \"$ATTL{$key}\", " .
		"$nichdl looks like a NIC handle\n" .
		    "instead of a $ATTL{$key} name" if ($nichandle =~ /\d/);
	}
	$name =~ s/ +/ /g;
	return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" ($name) \n" .
	    "use non-abbreviated first and last names"
		if (($name =~ /^$TITLES/i) || 
		    ($name =~ /^\S+\. /) || 
		    ($name =~ /\S\.$/));

        $nrofcomponents=0;
       
        foreach (split(/ /, $name)) {
            return $O_ERROR, "syntax error in \"$ATTL{$key}\"" 
		if (!&isname($_));
            $nrofcomponents++ if ($name =~ /\S\S/);
        }

        return $O_ERROR, 
	    "syntax error in \"$ATTL{$key}\" - " . 
	    "name must contain at least $NROFNAMES components of at " .
	    "least two characters" 
		if ($nrofcomponents<$NROFNAMES);

        $object{$key} = $name;

	return $O_OK;
    }

# ac - admin-c
# ah - author
# tc - tech-c
# zc - zone-c

# new syntax checks - value of the above attributes is now enforced to 
# contain a nic handle (RK - 19980917)

    if ($key=~ /^[atz]c|ah$/) {
       
       my(@names)=();
       my($name);
       
       foreach $name (split(/\n+/, $value)) {
       
          my($nichdl) = $name;
          $nichdl =~ tr/a-z/A-Z/;
          
          if ($nichdl =~ /^$AUTONICPREFIXREGULAR\d+[A-Z]*$/o) {
#	      &dpr("Auto nic handle $nichdl referenced in \"$ATTL{$key}\"\n");
              push(@names, $nichdl);
              next;
          }
          elsif ( &isnichandle($nichdl) ) {
              push(@names, $nichdl);
              next;
          }
	  else {
	      return $O_ERROR,
	          "syntax error in \"$ATTL{$key}\":\n" .
		  "\"$name\" is neither nic handle nor auto nic handle";
	  }
       }
       $object{$key}=join("\n", @names);
       return $O_OK;
    }


    
#
# rl - routpr-l

    if ($key eq "rl") {
    
	if ($value !~ /^[A-Z0-9\-\ ]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return $O_OK;
    }
    
#
#  rp - rout-pr
#
    if ($key eq "rp") {
    
	if ($value !~ /^[A-Z0-9\-]+$/) {
	    return $O_ERROR, "syntax error in \"$ATTL{$key}\"";
	}
	return $O_OK;
    }
#
# rt - route
#
# A little messy - all the work is done in net2net.pl
#
    if ($key eq "rt") {
    
       if (($value=~ /^[\d\.]+$/) || ($value=~ /\-/)) {
          
          local($newvalue, $code)=&normalizerange($value, "in");
       
#          &dpr("dosyntax - newrange: $newvalue code: $code (OK=$O_OK)\n");
       
          if ($code==$O_OK) {
             
             local(@classless)=grep(s/^(\d+)\//&int2quad($1)."\/"/e, &range2prefixes($newvalue));
             
             if (scalar(@classless)==1) {
                $object{$key}=$classless[0];
                return $O_WARNING, "$ATTL{$key} rewritten to ".$classless[0]." from $value";
             }
             else {
                return $O_ERROR, "$value is not CIDR aligned\nresubmit the following separate objects: ".join(" ", @classless);
             }
             
          }
          else {
             
             if ($value=~ /\-/) {
                return $O_ERROR, "error in $ATTL{$key}, $value is not a valid IP range";
             }
             else {
                return $O_ERROR, "error in $ATTL{$key}, $value is not a valid classfull A,B or C net";
             }
             
          }
          
       }
       
        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\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 $O_OK;
    }
#
# 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 $O_OK;
    }
#
# sd - sub-dom
#
    if ($key eq "sd") {
    
	foreach (split(/\s+/, $value)) {
	    if (!&issubdomname($_)) {
		return $O_ERROR, "syntax error in \"$ATTL{$key}\": $_";
	    }
	}
	return $O_OK;
    }

#
# so - source
#
# checking is already done in requiredsyntaxcheck

    if ($key eq "so") {

       return $O_OK;

    }

#
# st - status
#
    if ($key eq "st") {
    
       $value=~ tr/a-z/A-Z/;
       $value=~ s/\s+/ /g;
       $object{$key}=$value;  
       
       # for backwards compatibility, must be BEFORE other checks
       
       if ($type eq "in") {
	  if ($value =~ /^D(ELEGATED)?$/) {
          
              $value="ALLOCATED UNSPECIFIED";
              $object{$key}=$value;
          
              return $O_WARNING, "\"$ATTL{$key}\" changed to \"$object{$key}\"";
          }

          if ( $value =~ /^ASSIGNED (PI|PA)$/ ) {
              return $O_OK;
          }

	  if ( $value =~ /^ALLOCATED (PI|PA|UNSPECIFIED)$/) {
		# the requiredsyntaxcheck would have removed override ("uo")
		# if the password wer incorrect. So we can check for it here,
		# or for the mntner being one of those allowed to insert ALLOCATED
	      if( defined %ALLOCMNT && ! $ALLOCMNT{$object{"mb"}} 
		&& ! $object{"uo"}) {
		return $O_ERROR, 
			"Status ALLOCATED can be set only by the following mntner(s):\n\t" .
			join("\n\t",sort keys %ALLOCMNT);
	      }
              return $O_OK;
          }
       }

       if ($type eq "i6") {

                return $O_ERROR, "\"$ATTL{$key}\" is a generated attribute in inet6num objects";
      
       }

       return $O_ERROR, "\"$ATTL{$key}\" has an illegal value";
    
    }

#
# tr - as-transit
#
    if ($key eq "tr") {
       
	return $O_OK;
    }
    
#
# These are not checked and not used, just in here for clarity
#
#
# ue - *ERROR*
#   
    if ($key eq "ue") {
       
	return $O_OK;
    }
#
# uf - u-from (NOT USED)
#    
    if ($key eq "uf") {
       
	return $O_OK;
    }
#
# ui - msg-id (NOT USED)
#
    
    if ($key eq "ui") {
       
	return $O_OK;
    }
#
# uw - WARNING
#
    if ($key eq "uw") {
    
	return $O_OK;
    }
    
    if ($ATTR{$key}) {
        return $O_ERROR, "Internal error: $key is not syntax checked" 
	    unless grep(/\b$key\b/, $GEN{$type});
    } else {
      return $O_ERROR, 
	  "Internal error: unknown attribute found during syntax check ($key)";
    }
}

1;
