RIPE RR SW fix: dbadd.pl

[ Put this module in place of <dbhome>/src/dbadd.pl, go up to <dbhome>
and run a "make". "make install" is not needed -- MT]

#       dbadd - add, delete objects
#
#	$RCSfile: dbadd.pl,v $
#	$Revision: 0.23 $
#	$Author: marten $
#	$Date: 1994/12/06 01:10:29 $

require "dblock.pl";
require "enukey.pl";
require "enkeys.pl";
require "enwrite.pl";
require "addkey.pl";
require "dbmatch.pl";
require "defines.pl";
require "enread.pl";
require "encmp.pl";
require "updatecheck.pl";
require "cldb.pl";

sub dbadd {

    local(*db, *en, $modify) = @_;

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

    &dblock(*db);

    print STDERR "dbadd - finding unique key\n" if $opt_V;

    local($unikey) = &enukey(*en);

    print STDERR "dbadd - back from enukey\n" if $opt_V;

    if (defined($db{$unikey})) {
        &dbunlock(*db);
	return $E_EXIST;
    }

    print STDERR "dbadd - seeking\n" if $opt_V;

    seek(db, 0, 2);
    select(db);
    print "\n";
    local($offset) = tell(db);

    print STDERR "dbadd - writing object to db\n" if $opt_V;

    &enwrite(*en);
    select(STDOUT);

    print STDERR "dbadd - adding unikey\n" if $opt_V;

    &addkey(*db, $unikey, $offset);

    print STDERR "dbadd - done adding unique key\n" if $opt_V;

    # If $modify is set, this is not a new entry, but an update
    # to an existing entry. Then there is no need to update the
    # (expensive) classless index.

    foreach (&enkeys(*en)) {
	if (/^\d+\.\d+\.\d+\.\d+/ && !$modify) {
	    print STDERR "dbadd - inserting classless stuff\n" if $opt_V;
	    local($pref, $len) = split(/\//, $_);
	    local($netint) = &quad2int($pref);
	    &inscla("$netint/$len", $unikey, 1);
	} else {
	    print STDERR "dbadd - adding normal keys\n" if $opt_V;
	    &addkey(*db, $_, $offset) unless $_ eq $unikey;
	}
    }

    &dbunlock(*db);

    print STDERR "dbadd - returning\n" if $opt_V;

    return $OK;
}

#
# I don't think I am actually using this anywhere, so it is commented out
#
# sub dbmodify {
#    local(*db, *en) = @_;
#    local($i);
#
#    &dblock(*db);
#
#    local($unikey[0]) = &enukey(*en);
#
#    if (!defined($db{$unikey[0]})) {
#        &dbunlock(*db);
#	return $E_NOT_FOUND;
#    }
#
#    local(@result) = &dbmatch(*db, *unikey);
#    local(%curobject) = &enread(db, $result[0]);
#    if (&encmp(*en, *curobject)) {
#	&dbunlock(*db);
#	return $E_NOOP;
#    }
#
#    local($updatestat) = &updatecheck(*curobject, *en, *db);
#    if ($updatestat != $OK) {
#        &dbunlock(*db);
#	return $updatestat;
#    }
#
#    local($delstat) = &dbdel(*db, *curobject);
#    if ($delstat != $OK) {
#        &dbunlock(*db);
#	return $delstat;
#    }
#
#    seek(db, 0, 2);
#    select(db);
#    print "\n";
#    local($offset) = tell(db);
#    &enwrite(*en);
#    select(STDOUT);
#    seek(db,0,0);
#
#    &addkey(*db, $unikey[0], $offset);
#
#    foreach $i (&enkeys(*en)) {
#        if ($i =~ /^\d+\.\d+\.\d+\.\d+/) {
#            local($pref, $len) = split(/\//, $i);
#            local($netint) = &quad2int($pref);
#&inscla("$netint/$len", $unikey, 1);
#        } else {
#            &addkey(*db, $i, $offset) unless $i eq $unikey;
#        }
#    }
#
#    &dbunlock(*db);
#
#    return $OK;
#}


sub dbadd_or_modify {
    local(*db, *en) = @_;
    local($addstat);
    local($updatestat);
    local($modify) = 0;

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

    &dblock(*db);

    print STDERR "dbadd_or_modify - finding objects\n" if $opt_V;

    local($unikey[0]) = &enukey(*en);
    local(@result) = &dbmatch(*db, *unikey);

    if (defined $result[0]) {
	if ($#result > 1) {
	    &dbunlock(*db);
	    return E_MULT_MATCH;
	}

	local(%curobject) = &enread(db, $result[0]);

	# We know now that we are performing a real update, not
	# just a new entry or a delete. This means we can
	# mark this and not perform a classless index on this
	# because that will not change anything. Because the
	# classless index is expensive, it is better to not perform
	# it if unnecessary.

	$modify = 1;

	$updatestat = &updatecheck(*curobject, *en, *db);
        if ($updatestat != $OK) {
	    &dbunlock(*db);
	    return $updatestat;
	}

	if (&encmp(*en, *curobject)) {
	    &dbunlock(*db);
	    return $E_NOOP;
	}

	local($delstat) = &dbdel(*db, *curobject, $modify);
	if ($delstat != $OK) {
	    &dbunlock(*db);
	    return $delstat;
	}
	$addstat = &dbadd(*db, *en, $modify);
	&dbunlock(*db);
	return $addstat;
    }

    print STDERR "dbadd_or_modify - found one object\n" if $opt_V;

    $updatestat = &updatecheck(*curobject, *en, *db);
    if ($updatestat != $OK) {
	&dbunlock(*db);
	return $updatestat;
    }

    print STDERR "dbadd_or_modify - done checking, calling dbadd\n" if $opt_V;
    $addstat = &dbadd(*db, *en, $modify);
    &dbunlock(*db);
    return $addstat;
}

sub dbdel {
    local(*db, *en, $modify) = @_;
    local(@unikey);
    local(%curobject);
    local($mult) = 0;
    local($status) = $NOK;
    local(%dummy) = ();
    local($b);
    local($j);

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

    &dblock(*db);

    $unikey[0] = &enukey(*en);
    local(@result) = &dbmatch(*db, *unikey);

    if ($#result > 0) {
	print STDERR "dbdel - multiple entries found\n" if $opt_V;
	$mult = 1;
    }
    if ($#result < 0) {
	&dbunlock(*db);
	print STDERR "dbdel - entry not found\n" if $opt_V;
	return $E_NOT_FOUND;
    }

    foreach $b (@result) {
	%curobject = &enread(db, $b);
	if (!&encmp(*en, *curobject)) {
	    $status = $E_MISMATCH unless $status == $OK;
	    next;
	}

	# Dummy updatecheck to get notification.
	# New object is null, updatecheck will recognize and
	# skip checks not done for deletes. Only do if it is
	# a true delete, and not a replace
	
	if (&hasdelete(*en)) {
	    $status = &updatecheck(*en, *dummy, *db);
	    if ($status == $E_AUTHFAIL) {
		&dbunlock(*db);
		return $E_AUTHFAIL;
	    }
	}

	$status = $OK;

	seek(db, $b, 0);
	print db "*XX";

	@keys = &enkeys(*en);

	# No need to modify the classless index if this is a
	# modification, rather than a real delete.

	if (!$modify) {
	    foreach (@keys) {
		if (/^\d+\.\d+\.\d+\.\d+/) {
		    local($pref, $len) = split(/\//, $_);
		    local($netint) = &quad2int($pref);
		    &delfromcla("$netint/$len", $unikey[0]);
		}
	    }
	}

	@keys = ($unikey[0], @keys);
	foreach (@keys) {
	    &delkey(*db, $_, $b);
	}
    }
    &dbunlock(*db);
    return $status;
}

1;



-------- Logged at  Tue Dec 6 19:26:27 MET 1994  ---------