BUG fixes

[RIPE Database Manager <]

Dear all,

These are my first two fixes in the database software !
If there are any problems, please contact me. 

Kind regards,

David Kessens
RIPE NCC
# =================================

This are two related fixes. The bug was discovered by somebody
trying to delete an object with more changed attributes. One of these
attributes missed the date part.


Fix 1:

If a changed attribute missed the date part a date was added however if 
there where more changed attributes the date could be added to
the wrong changed attribute. In the case of objects with more
changed attributes and one missing date, it is most likely the oldest
object didn't contain a date and it would be inappropriate to add
the date of today. Missing dates in the changed attribute generate now
always an error to prevent these problems. 


Fix 2:

The database contains old objects which would not be allowed to get
in with the current syntax checking. Sometimes syntax checking helps
a user by adding info/changing some info and generates a warning
instead of an error.

However, the syntax checking was also done with the to be deleted objects.
This means that the sent in object could be changed before deletion
and would generate an error message that objects don't match.

# ===========================================
Fix 1:

Make the following changes in 'syntax.pl':

if ($date eq "") {
	    $object{$key} .= " $curdate";
	    return $O_WARNING, 
	    "todays date ($curdate) added to \"$ATTL{$key}\" attribute";
        }

if ($date eq "") {
	    return $O_ERROR, 
	    "No date specified in \"$ATTL{$key}\" attribute";
        }


Fix 2:

And substitute 'dbupdate.pl' and 'enparse.pl' with the following files
and do a make.

# ===========================================

#!PERL

#	$RCSfile: dbupdate.pl,v $
#	$Revision: 0.32 $
#	$Author: david $
#	$Date: 1995/02/10 11:38:56 $

# This is a client that will update objects read from a file directly
# in the database, without interference of updated.
# It will update the object in the database that is linked to the
# source field of the object, so better make sure you have a source field
# and that it has a database associated to it ...

@INC = ("LIBDIR", @INC);

require "adderror.pl";
require "cldb.pl";
require "dbadd.pl";
require "dbclose.pl";
require "dbopen.pl";
require "defines.pl";
require "enparse.pl";
require "entype.pl";
require "enwrite.pl";
require "getopts.pl";
require "handle.pl";
require "misc.pl";
require "rconf.pl";
require "rfc822.pl";
require "syslog.pl";

# Parse options:
#
# -l logfile		- log output to file in stead of STDOUT
# -v			- verbose output (LONGACK)
# -M			- treat input file (or STDIN) as mail and compose
#				and send ack mail back
# -A                    - assume "assign" mode, only add will be allowed
#                         usually set by parsing mail headers
# -H                    - handle assignment mode. Will only accept persons
#                         with nic-handle "assign" and return person entry
#                         with the handle assigned and filled in.
#                         (very RIPE database dependent)

&Getopts('l:vMAHV');

# Need this below for running perl in tainted mode.

$ENV{"PATH"} = "";
$ENV{"SHELL"} = "/bin/sh";
$ENV{"IFS"} = "";

# Read config file from RIPEDBCNF, or set to default.

$conffile=$ENV{"RIPEDBCNF"};
$conffile= "DEFCONFIG" unless $conffile;
print STDERR "dbupdate - reading config\n" if $opt_V;
&rconf($conffile);

# Save STDOUT

open(SAVEOUT, ">&STDOUT");

# Open one ack file. Proper handling (stdout, logfile or mail) is handled
# all the way at the end .... But, we open the logfile if needed already
# because we need to exit if we cannot even create that file ...
# If -M option is specified, -l is overruled.

if ($opt_l) {
    open(LOGFILE, ">$opt_l") || die "Cannot create $opt_l: $!";
}

open(STDOUT, ">$TMPDIR/dbupdack.$$") ||
    &syslog("ERRLOG", "cannot create tmp ack file: $!");

# Make STDOUT unbuffered

select(STDOUT); $| = 1;

#
# printstat ( arg )
#
# int arg 	/* 0=failed, 1=ok, 2=noop	*/
#
# prints verbose version of the update result.
#

sub printstat {
    local($stat) = @_;
    local($type) = &entype(*entry);

    print STDERR "dbupdate - printstat($stat) called\n" if $opt_V;

    print STDERR "dbupdate - printstat 1\n" if $opt_V;

    if ($hasdelete) {
	print "Delete ";
    } else {
	print "Update ";
    }
    print STDERR "dbupdate - printstat 2\n" if $opt_V;
    if ($stat == 1) { print "OK: ";}
    elsif ($stat == 2) { print "NOOP: ";}
    else { print "FAILED: "; }
    print STDERR "dbupdate - printstat 3\n" if $opt_V;
    
    print "[$ATTL{$type}] $entry{$type}\n\n";
    print STDERR "dbupdate - printstat 4\n" if $opt_V;
}


#
# doaction ( )
#
# does all the work.
#

sub doaction {

    local($file) = @_;
    local($donestat) = 0;
    

    print STDERR "dbupdate - doaction($file) called\n" if $opt_V;
    
    while(1) {

	$donestat = 0;

	print STDERR "dbupdate - calling enparse\n" if $opt_V;

	($parsestat, $hasdelete, %entry) = &enparse($file);

				# next if nothing was read

	next if $parsestat == $NOK;

				# return if only thing read was EOF

	return if $parsestat == $EOF;

	$somethingfound = 1;

	print STDERR "dbupdate - read an object\n" if $opt_V;

	local($type) = &entype(*entry);

	# now if we are running in -H mode, just next when we have
	# not found a person.

	if ($opt_H) {
	    if ($type ne "pn") {
		print "No person object found\n";
		next;
	    } else {
		if ($entry{"nh"} !~ /^[aA][sS][sS][iI][gG][nN]$/) {
		    &adderror(*entry, "nichandle \"assign\" expected");
		    print "\n" if &enwrite(*entry,1,1);
		    next;
		}
	    }
	}

	if (($parsestat == $O_ERROR) && (!$hasdelete)) {
	    print STDERR "dbupdate - object has error and no delete\n" if $opt_V;
	    if ($opt_v) { &printstat(0); }
	    $haserror = 1;
	    print "\n" if &enwrite(*entry,1,1,1);
	    next;
	}

	# object parsed OK or has only warnings
	
	if ($parsestat == $O_OK || $parsestat == $O_WARNING) {

	    # open database file associated with "so" for writing

	    local(*db) = 'currentdb';
	    print STDERR "dbupdate - opening database\n" if $opt_V;
	    if (&dbopen(db, *entry, 1)) {

		# Open classless database

		print STDERR "dbupdate - opening classless db\n" if $opt_V;
		&dbclopen(*entry,1);

		# Looks like we have some locking problem, so let's
		# lock the thing before we do anything else ...

		print STDERR "dbupdate - locking databases\n" if $opt_V;
		&dblock(*db);
		
		# do we delete or not ?

		if ($hasdelete) {

		    print STDERR "dbupdate - deleting entry\n" if $opt_V;
		    $dbstat = &dbdel(*db, *entry);

		    # We do handle generation, so after a delete, we
		    # have to delete the handle from that database
		    # as well.

		    if ($DOHANDLE && $HANDLEATTR{$type}) {
			if ($dbstat == $OK) {
			    &DeleteHandle(*entry);
			}
		    }

		} else {

		    # We do handle generation, check whether we have
		    # to assign a nic handle (if nh value is "assign")
		    # Can be a request handle of form: assign handle
		    # Line has already been syntax checked, so no worries
		    # there. Errors are added by AssignHandle, so all we
		    # need is an extra check.

		    if ($DOHANDLE && $HANDLEATTR{$type}) {
			if ($entry{$HANDLEATTR{$type}} =~ /^[Aa][Ss][Ss][Ii][Gg][Nn]\s*(.*)$/) {
			    local($handle) = &AssignHandle(*entry, $1);
			} else {
				# new object, we may have to put the handle
				# in the database. AddHandle will return if
				# if the handle is already in handle database

			    &AddHandle(*entry);
			}
		    }

		    if (!&haserror(*entry)) {
   
			# NEW assignments && !person

			if ($opt_A && ($type ne "pn")) {
			    print STDERR "dbupdate - calling dbadd\n" if $opt_V;
			    $dbstat = &dbadd(*db, *entry);
			} else {
			    print STDERR "dbupdate - calling add_or_mod\n" if $opt_V;
			    $dbstat = &dbadd_or_modify(*db, *entry);
			}
		    } else {
				# Fake dbstat, has error due to handle
				# generation ...

			$dbstat = $OK;
		    }
		}

				# Totally yucky, but I do not know how to
				# do this better right now. The thing is that
				# every exit code but E_NOOP and OK are
				# errors, so catch NOOP first, and print
				# verbose warning if needed, then OK, and
				# then handle all the others as errors.

				# noop, just print stat if verbose

		print STDERR "dbupdate - doing acks\n" if $opt_V;

		if ($dbstat == $E_NOOP && $opt_v) {
		    &printstat(2);
		    $donestat = 1;
		}
		elsif (($dbstat != $OK) && ($dbstat != $E_NOOP)){
		    &adderror(*entry, "$MESSAGE[$dbstat]");
		}


		# Object has errors, so print, and next

		if (&haserror(*entry)) {

		    print STDERR "dbupdate - object has errors\n" if $opt_V;

		    $haserror = 1;
		    if ($opt_v) { &printstat(0); }
		    print "\n" if &enwrite(*entry,1,1);
		    &dbunlock(*db);
		    &dbclose(*db);
		    &dbclclose();
		    next;
		}

		# object has only warnings, so it must have
		# been processed. print and next.

		elsif (&haswarning(*entry)) {
		    print STDERR "dbupdate - object has warnings\n" if $opt_V;
		    $haserror = 1;
		    if (!$donestat && $opt_v) {
			&printstat(1);
		    }
		    print "\n" if &enwrite(*entry,1,1);
		    &dbunlock(*db);
		    &dbclose(*db);
		    &dbclclose();
		    next;
		}
						
		# all was OK, so only print stat if verbose

		if ($opt_v && !$donestat) { &printstat(1); }

		# all was OK, print object if nichandle assign mode

		if ($opt_H) {
		    &enwrite(*entry,1,1);
		}
		
		&dbunlock(*db);
		&dbclose(*db);
		&dbclclose();
	    }

	    else {

		# Not too good, probably permission problem
		# if this is given as output ...

		&adderror(*entry, "Failed to open DB file: $!");
		&adderror(*entry, "Please check the \"source:\" value");
		&adderror(*entry, "Contact <$HUMAILBOX> if source seems ok");
		&printstat(0);
		&enwrite(*entry,1,1);
	    }
	}
    }
    close(TMP);
}

#
# Main program
#

# We want to make a local copy of the input, because we need to do mutliple
# things with it ...

open(COPY, ">$TMPDIR/dbupdcopy.$$") || die "Cannot open copy file: $!";
select(COPY); $| = 1; select(STDOUT);

while (<>) {
    print COPY;
}

close(COPY);

# Now we open the copy to actually process

open(COPY, "$TMPDIR/dbupdcopy.$$") || die "Cannot open copy: $!";

# We have a mail, so let's first parse the headers ...

if ($opt_M) {

    local($stat) = &parserfc822(COPY);

    # If we have at least a return address, compose the header of
    # the ack mail

    if ($stat) {

	if ($TESTMODE) {
	    print "To: $DEFMAIL\n";
	} else {
	    print "To: $FROM\n";
	}
	eval "print \"$MHEADER\";";
	eval "print \"$MAILTXT\";";

	# If not we are in trouble once more ...

    } else {
	print "Header could not be parsed ...\n";
    }
}

# Take all the stuff from file COPY in doaction. It will process the
# whole stuff.

&doaction(COPY);

if (!$somethingfound) {
    print "** No objects were found in your message **\n";
}
elsif ($haserror) {
    print "$ACKERR" unless $opt_H;
} else {
    print "$ACKOK" unless $opt_H;
}

print $ACKSIG unless $opt_H;

close(COPY);
close(STDOUT);
open(STDOUT, ">&SAVEOUT");

# Output the ack, if -M specified then no logfile or stdout will be given.

if ($opt_M) {
    system("$MAILCMD < $TMPDIR/dbupdack.$$");
} else {
    open(TMP, "$TMPDIR/dbupdack.$$");
    while (<TMP>) {
	if ($opt_l) {
	    print LOGFILE;
	} else {
	    print;
	}
    }
    close(TMP);
}

# We sent out the ack, now send out the notifications if needed

if (%notify) {
    &SendNotifications();
}
if (%forward) {
    &SendForwardMails();
}

# log all stuff to the right places

# todays YYMMDD

local($s,$m,$h,$md,$mo,$y,$wd,$yd,$is) = localtime(time);

$mo+=1;

$mo = "0".$mo unless $mo > 9;
$md = "0".$md unless $md > 9;
$y = "0".$y unless $y > 9;

$YYMMDD = "$y$mo$md";

# This may seem yucky, but is needed to untaint the filename ...

$filename = $LOGFILE{"UPDLOG"}."/".$YYMMDD;
$filename =~ /(.*)/;
$realfile = $1;

# first let's log the updates send in or via stdin

if (open(LOG, ">>$realfile")) {
    &lock(LOG);
    if ($opt_M) {
	print LOG "\n>>> MAIL UPDATE <<<\n\n";
    } else {
	print LOG "\n>>> STDIN UPDATE <<<\n\n";
    }

    open(TMP, "$TMPDIR/dbupdcopy.$$");

    while (<TMP>) {
	print LOG;
    }
    close(TMP);
    close(LOG);
    &unlock(LOG);
} else {
    &syslog("ERRLOG", "dbupdate cannot open $LOGFILE{\"UPDLOG\"}/$YYMMDD"); 
}


# then we log the acknowledgement

$filename = $LOGFILE{"ACKLOG"}."/".$YYMMDD;
$filename =~ /(.*)/;
$realfile = $1;

if (open(LOG, ">>$realfile")) {
    &lock(LOG);
    if ($opt_M) {
	print LOG "\n>>> MAIL ACK <<<\n\n";
    } else {
	print LOG "\n>>> STDIN ACK <<<\n\n";
    }
    open(TMP, "$TMPDIR/dbupdack.$$");
    while (<TMP>) {
	print LOG;
    }
    close(TMP);
    close(LOG);
    &unlock(LOG);
} else {
    &syslog("ERRLOG", "dbupdate cannot open $LOGFILE{\"ACKLOG\"}/$YYMMDD"); 
}


# remove the temp stuff we made

unlink("$TMPDIR/dbtmp.$$");
unlink("$TMPDIR/dbupdcopy.$$");
unlink("$TMPDIR/dbupdack.$$");

# ===========================================

#       enparse - read RIPE database and check syntax errors
#
#	$RCSfile: enparse.pl,v $
#	$Revision: 1.7 $
#	$Author: david $
#	$Date: 1995/02/10 11:39:22 $
#
#	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_OK) {
          print STDERR "enparse - checking object syntax\n" if $opt_V;
	  $rtcode = &checksyntax(*entry);
       }
    }
    return $rtcode, $hasdelete, %entry;
}

1;


# ===========================================