#       enparse - read RIPE database and check syntax errors
#
#	$RCSfile: enparse.pl,v $
#	$Revision: 1.8 $
#	$Author: ripe-dbm $
#	$Date: 1995/04/18 13:58:03 $
#
#	ARGUMENTS:	filehandle to read from
#	RETURNS:	INTEGER object_status
#			ASSOC   object
#
#	Object status = $O_OK, $O_WARNING, $O_ERROR, $EOF, or $NOK
#		$O_OK = object read and no errors/warnings generated
#		$O_WARNING = object read, but generated warnings
#		$O_ERROR = object read, but generated errors
#		$EOF = EndOfFile reached
#		$NOK = no object found, just garbage
#
#	Object has warnings and errors included.
#
#	This routine is a modified version of enread. It will read any
#	garbage, until it finds something of the form:
#	"xxxxxxx: " (no fixed length, spaces MUST be there)
#	or
#	"*xx: "
#	and then continues to read until it finds a line that does not
#	match these patterns. It then assumes it read an object, and will
#	start doing syntax checks.

require "entype.pl";
require "syntax.pl";
require "defines.pl";
require "adderror.pl";

sub readsomething {

    local($file) = @_;
    local($inentry) = $NOK;
    local($tag) = "";
    local(%entry) = ();

    while (<$file>) {

	s/^\s*//;
	s/\s*$//;
	s/\n*$//;

	next if /^#/;

        if (/^password:\s*(\S.*\S)/) {
            $PASSWORD = $1;
            next;
        }

	if (/^\*..:\s*(.*)/) {
	    $inentry = $OK;
	    $tag = substr($_, 1, 2);
	    if ($entry{$tag}) {
		$entry{$tag} .= "\n";
	    }
	    $entry{$tag} = $entry{$tag} . $1;
	    next;
	}
	if (/^([a-z\-A-Z_]+)\s*:\s*(.*)/) {
	    $inentry = $OK;
	    $tag = $1;
	    $tag =~ tr/A-Z/a-z/;
	    $tag = $ATTR{$tag} if $ATTR{$tag};
	    if ($entry{$tag}) {
		$entry{$tag} .= "\n";
	    }
	    $entry{$tag} = $entry{$tag} . "$2";
	    next;
	}

	if (/^.*$/) {
	    next if $inentry == $NOK;
	    $CUROBJTYPE = &entype(*entry);
	    return ($inentry,%entry);
	}

    }
    $CUROBJTYPE = &entype(*entry);
    return ($inentry, %entry) if ($inentry);
    return $EOF;
}


sub checkobject	{

    local(*object) = @_;
    local($type);
    local($rtcode) = $O_OK;
    local(%knownfield) = ();
    local(%mandfield) = ();
    local(%multfield) = ();
    local(%knownfield) = ();
    local(%guard) = ();
    local(%usefield) = ();
    local($i);

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

    $type = &entype(*object);
    if (!$type) {	
	&adderror(*object, "unknown object type");
	return $O_ERROR;
    }

    # Check guarded objects, should be authorised or maintained
    # The message will request the object be maintained

    foreach (keys %GRDOBJ) {
        if ($object{$_}) {
            if (!$object{"ua"} && !$object{"mb"}) {
		&adderror(*object,
			  "the \"$ATTL{$_}\" object cannot be updated ".
			  "automatically without a \"mnt-by\" attribute");

		# now if this object was supposed to be deleted, remove
		# the delete attribute, since deletes will remove
		# syntax errors later in the program and this is one
		# that may not be removed. There is also no point in
		# doing more checks if it was supposed to be deleted.
		
		if ($object{"ud"}) {
		    undef $object{"ud"};
		    return $O_ERROR;
		}

		# otherwise, continue extra checks for clarity to user
		
		$rtcode = $O_ERROR;
	    }
            last;
        }
    }

    foreach $i ((split(/\s+/, $OBJATSQ{$type}),"ud","ua","uo","uw","ue")) {
	$knownfield{"$i"} = 1;
    }

    foreach $i (split(/\s+/, $OBJMAND{$type})) {
	$mandfield{"$i"} = 1;
    }

    foreach $i (split(/\s+/, $OBJMULT{$type})) {
	$multfield{"$i"} = 1;
    }

    foreach $i (split(/\s+/, $GRD{$type})) {
	$guard{"$i"} = 1;
    }

    foreach $i (keys %object) {
	$usefield{"$i"} = 1;
    }

    foreach (split(/\s+/, $OBS{$type})) {
	if ($object{$_}) {
	    &addwarning(*object,
			"attribute \"$ATTL{$_}\" has been obsoleted,".
			" value removed from object");
	    delete $object{$_};
	    delete $usefield{$_};
	    $rtcode = $O_WARNING;
	}
    }

    foreach $i (keys %usefield) {
	if (!$knownfield{"$i"}) {
	    if ($ATTL{"$i"}) {
		&adderror(*object,
			  "attribute \"$ATTL{$i}\" unknown ".
			  "in $ATTL{$type} object");
	    } else {
		&adderror(*object,
			  "attribute \"$i\" unknown in $ATTL{$type} object");
	    }
	    $rtcode = $O_ERROR;
	}

	undef $mandfield{"$i"} unless $object{$i} eq "";
	if ($object{$i} =~ /\n/) {
	    if (!$multfield{"$i"}) {
		&adderror(*object,
			  "multiple lines not allowed for: \"$ATTL{$i}\"");
		$rtcode = $O_ERROR;;
	    }
	}
    }

    foreach $i (keys %mandfield) {
	if ($mandfield{$i}) {
	    if (defined($object{$i}) && ($object{$i} =~ /^\n*$/)) {
		&adderror(*object,
			  "mandatory field \"$ATTL{$i}\" must have a value");
	    } else {
		&adderror(*object,
			  "mandatory field \"$ATTL{$i}\" missing");
	    }
	    $rtcode = $O_ERROR;
	}
    }
    print STDERR "checkobject - returned\n" if $opt_V;
    return $rtcode;
}

sub enparse {

    local($file) = @_;
    local(%entry);
    local($rtcode) = $O_OK;
    local($stat);
    local($hasdelete);
	
    print STDERR "enparse - reading something\n" if $opt_V;

    ($stat, %entry) = &readsomething($file);

    return $EOF if $stat == $EOF;
    return $NOK if $stat == $NOK;

    # Now, let's check whether this is a delete request or not
    # If it is, we have to skip all syntax checks ...
    # since syntax checks may change the object AND
    # one wants to be able to delete objects with wrong syntax
    # A wrongly defined delete attribute will return a 0,
    # and add a error message.

    if (!($hasdelete = &hasdelete(*entry))) {
       print STDERR "enparse - checking object format\n" if $opt_V;
       $rtcode = &checkobject(*entry);
       if ($rtcode != $O_ERROR) {
          print STDERR "enparse - checking object syntax\n" if $opt_V;
	  $rtcode = &checksyntax(*entry);
       }
    }
    return $rtcode, $hasdelete, %entry;
}

1;
