YAF (Yet Another Fix)

[Marten Terpstra <]

Mntner passwords that contain spaces were not correctly handled.
Please replace your version of enparse.pl with the one below. Please
note that passwords with leading or trailing spaces can NOT be used
(simply because of parsing limitations, one can never know where a
password starts or ends ...). Spaces somewhere in the middle of
passwords are fine with the below version of enparse.pl.

-Marten

#       enparse - read RIPE database and check syntax errors
#
#	$RCSfile: enparse.pl,v $
#	$Revision: 1.6 $
#	$Author: marten $
#	$Date: 1994/12/08 01:47:21 $
#
#	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);
	
    print STDERR "enparse - reading something\n" if $opt_V;

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

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

    print STDERR "enparse - checking object format\n" if $opt_V;

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

1;