#       dbadd - add, delete objects
#
# 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: dbadd.pl,v 2.14 1999/10/06 16:41:03 marek Exp $
#
#	$RCSfile: dbadd.pl,v $
#	$Revision: 2.14 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:03 $

require "dbopen.pl";
require "dbclose.pl";
require "cldb.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 "serial.pl";
require "cross-notify.pl";
require "dpr.pl";
require "pgp.pl";

sub finalchecksandupdate {
    local(*entry, $type, *autonichandles, *options) = @_;
    
    my($returncode) = $O_OK;
    my($source) = $entry{"so"};
    my($split)  = $SPLIT{$source};

    local($db)  = 'db';
    local(%db, @db);
    local($nicdb)      = 'nicdb';
    local($othernicdb) = 'othernicdb';
    local($mtdb)       = 'mtdb';
    local($andb)       = 'andb';
    local(@nicbd, %nicdb);
    local(@othernicdb, %othernicdb);
    local(@mtdb, %mtdb);
    local(@andb, %andb);
    
    &dpr("autonichandles: " . join("*", @autonichandles) . "\n") 
	if (@autonichandles);
    
    if ($options & $DELETEOPTION) {
	
	if ($type !~ /^pn|ro|mt|an$/) {
	    &dbopen(*db, *entry, 1) or return ($O_COULDNOTOPEN, $type);
	    &dbclopen(*entry, 1) if ($CLASSLESSDBS{$type});
	}
	else {

	    # don't delete persons/roles/maintainers
	    # that are referenced by other objects
	    
	    # to avoid possible race conditions one should actually
	    # delete pn|ro|mt object first then do all integrity checks
	    # and then eventually recreate when one of the checks fails
	    # this is pretty clumsy so we don't bother and just open all 
	    # databases one by one, do the check and close database

	    my($attr, $pointsto);
	    local(@keys, @longkeys, @nonsplitkeys);
	    local(%pointstoentry);
	    my(@dbs) = ($type eq 'an') ? ('an', 'rt') : @ALLOBJORDERED;
	    my(%number_of_referencing) = ();
	    my(@entrymatch);
	    
	    if (!$split) {
		# non-split database open
		&dbopen(*db, *entry, 1) or return ($O_COULDNOTOPEN, $type);
		&dbclopen(*entry, 1) if ($CLASSLESSDBS{$type});

		# create inverse keys to search for objects pointing
		# to the one being deleted
		if ($type eq 'an') {
		    $attr = 'or';
		}
		else {
		    $attr = join(" ", grep($POINTSTO{$_} =~ /\b($type)\b/, 
				       split(/ /,$ALLPOINTSTONICMTATTR)));
		}
		@nonsplitkeys = &makekeys($entry{$type}, $attr, *longkeys);
		@nonsplitkeys = @longkeys if (@longkeys);
		push(@nonsplitkeys, &makekeys($entry{"nh"}, $attr, *longkeys)) 
		    if (($entry{"nh"}) && ($type =~ /^pn|ro$/));
	    }

	    foreach $pointsto (@dbs) {

		local(*pointstodb);
		local($pointstodb) = 'pointstodb';
		local(%pointstodb, @pointstodb);
		my(%uniqueoffsets) = ();   # unique offsets for given pointsto

		# loop through all object types and check if there are object 
		# of that type pointing to the object being deleted

		&dpr("=========pointsto: $pointsto==========\n");

#		my(%referencefound);

		@keys = ();

		if ($split) {
		    # first create inverse search keys
		    next if ($OBJPOINTSTO{$pointsto} !~ /\b$type\b/);
		    if ($type eq 'an') {
			$attr = 'or';
		    }
		    else {
			$attr = 
			    join(" ", grep($POINTSTO{$_} =~ /\b($type)\b/,
					   split(/ /, 
					    $OBJPOINTSTONICMTATTR{$pointsto})));
		    }
		    if ($attr !~ /^\s*$/) {
		        &dpr("\$attr = $attr\n");
			@keys = &makekeys($entry{$type}, $attr, *longkeys);
			@keys = @longkeys if (@longkeys);
			push(@keys, &makekeys($entry{"nh"}, $attr, *longkeys)) 
			    if (($entry{"nh"}) && ($type =~ /^pn|ro$/));
		    }
		    # now open database
		    if ($type eq $pointsto) {
			&dbopen(*db, *entry, 1) or 
			    return ($O_COULDNOTOPEN, $type);
#			*pointstodb = *db;
			my($uniquekey) = &enukey(*entry, $type);
			local(@uniquekey) = ($uniquekey);
			@entrymatch = &dbmatch(*db, *uniquekey, "", 0);
			if (scalar(@entrymatch) > 1) {
			    $returncode = $E_MULT_MATCH;
			    next;
			}
		    }
		    elsif (@keys) {
			%pointstoentry = ($pointsto, "1", "so", $source);
			&dbopen(*pointstodb, *pointstoentry, 0) or
			    return ($O_COULDNOTOPEN, $pointsto);
		    }
		    else {
			next;
		    }
		}
		else {
		    @keys = @nonsplitkeys;
#		    *pointstodb = *db;
		}
		
		foreach (@keys) {
		    @longkeys = ($_);
		    my(@offsets) = (!$split || ($type eq $pointsto)) ?
			           &dbmatch(*db, *longkeys, "", 0) :
				   &dbmatch(*pointstodb, *longkeys, "", 0);
		    @uniqueoffsets{@offsets} = (1) x @offsets;
		    delete(@uniqueoffsets{@entrymatch});
		    @offsets = keys %uniqueoffsets;
		    $returncode = $E_STILLREFERENCED if (@offsets);

# the following code which actually finds objects referenced 
# and lists them in error message is commented out for performance reasons
# the summary of objects referenced is printed instead
#		    foreach (@offsets) {
#			my(%tmpentry);
#			if (!$split || ($type eq $pointsto)) {
#			    &enread($db, *pointstoentry, $_);
#			}
#			else {
#			    &enread($pointstodb, *pointstoentry, $_);
#			}
#			if (!defined($referencefound{$pointsto . $_})) {
#			    %tmpentry = %pointstoentry;
#			    push @referencing, \%tmpentry;
#			    $referencefound{$pointsto . $_} = 1;
#      			}
#		    }
		}
		&dbclose(*pointstodb) if ($split && ($type ne $pointsto));
		$number_of_referencing{$pointsto} = 
		    scalar(keys %uniqueoffsets);
		%uniqueoffsets = ();
	    }

# See prevoius comment
#	    if ($returncode == $E_STILLREFERENCED) {
#		my($messg, $ref, $type, $value, $nichdl);
#		$messg = "Object still referenced by the following object(s)\n";
#		while ($ref = shift @referencing) {
#		    $type   = &entype(%$ref);
#		    $value  = $ref->{$type};
#		    $nichdl = $ref->{'nh'} if ($ref->{'nh'});
#		    $nichdl = ($nichdl) ? "[$nichdl]" : "";
#		    $messg .= "$type: $value $nichdl\n";
#		}
#		&adderror(*entry, $messg);
#	    }
	    
	    if ($returncode == $E_STILLREFERENCED) {
		my($messg);
		$messg = "Object still referenced by:\n";
		foreach (keys %number_of_referencing) {
		    my($nor) = $number_of_referencing{$_};
		    if ($nor > 0) {
			$messg .= "\t$nor $ATTL{$_} object";
			$messg .= (($nor > 1) ? "s\n" : "\n");
		    }
		}
	        if ($options & $OVERRIDEINTEGRITY){   
		    &addwarning(*entry, $messg);
		}
	 	else {   
		    &adderror(*entry, $messg);    
		}
	    }
	} 
	# the actual delete
	$returncode = &dbdel(*db, *entry, $type, $options, @entrymatch) 
	    if ($returncode == $O_OK
		|| ($returncode == $E_STILLREFERENCED 
		    && $options & $OVERRIDEINTEGRITY));

	#closing databases
	&dbclclose() if ($CLASSLESSDBS{$type});
	&dbclose(*db);

	# send notification
	if ($returncode == $O_OK) {
	    my(%nothing) = ();
	    &AddNotify(*entry, *nothing);
	    delete($ASSIGNEDNIC{$source, $entry{"nh"}}) if 
		(grep($entry{"nh"} eq $_, values %ASSIGNEDNIC));
	}
    } # end of delete

    else {        
	
	#creation or modification


	my($rtcode, $rttype) = &opendatabases(*entry, $type, *db, *nicdb, 
					      *othernicdb, *mtdb, *andb);
	return ($rtcode, $rttype) if ($rtcode != $O_OK);

	local(@uniquekey) = (&enukey(*entry, $type));
	my(@result)       = &dbmatch(*db, *uniquekey, "", 0);
	local(%oldobject) = ();

	# this one is for the updating of old classless inetnum objects
	if (($type eq "in") && (!@result)) {
	    
	    local(@longkeys);
	    local(@keys) = &makekeys($entry{$type}, "", *longkeys);
	    my(@newresult) = 
		&dbmatch(*db, *keys, $type, $INTERSECTIONOPTION);
	    
	    if (@newresult) {
                my($offset,$code,$newvalue);
                foreach $offset (@newresult) {
		    &enread($db, *oldobject, $offset);
		    ($newvalue, $code) = 
			&normalizerange($oldobject{$type}, $type);
		    next if (($newvalue ne $entry{$type}) || 
			     ($entry{"so"} ne $oldobject{"so"}) || 
			     ($entry{"na"} ne $oldobject{"na"}));
		    $done = $offset;
		    @result=($done);
		    $options|=$BACKWARDCOMPATIBILITYOPTION;
		    last;
                }
                %oldobject=() if (!@result);
	    }
	}
	
	# this one is for person objects without a NIC handle
	if (($type eq "pn") && (!@result) && ($entry{"nh"})) {
	    &dpr("doing check for persons without nic handles\n");
	    my($oldvalue)          = delete($entry{"nh"});
	    local(@otheruniquekey) = (&enukey(*entry, $type));
	    my(@newresult)         = &dbmatch(*db, *otheruniquekey, "", 
					      $INTERSECTIONOPTION);
	    if (@newresult) {
		&dpr("\@newresult = (", join(", ", @newresult), ")\n");
                my($offset);
                foreach $offset (@newresult) {
		    &dpr("For \$offset=$offset:\n");
		    &enread($db, *oldobject, $offset);
		    &dpr("\%oldobject = ", join("*", %oldobject), "\n");
		    next if (!&encmp(*entry, *oldobject, "ch", 1));
		    &dpr("Compared equal\n");
		    $done = $offset;
		    @result = ($done);
		    last;
                }
                %oldobject = () if (!@result);
		&dpr("\%oldobject = ", join("*", %oldobject), "\n");
	    }
	    $entry{"nh"} = $oldvalue;
	}
	
	# this one is for changing person's name only
#	if (($type eq "pn") && (!@result) && ($entry{"nh"})) {
#	    &dpr("doing check for changing person's names\n");
#	    local(@longkeys) = ();
#	    local(@keys)   = &makekeys($entry{"nh"}, "", *longkeys);
#	    &dpr("\@keys = ", join("*", @keys), "\n");
#	    my(@newresult) = &dbmatch(*db, *keys, "", 0);
#	    if (@newresult) {
#		&dpr("\@newresult = (", join(", ", @newresult), ")\n");
#                my($offset);
#		my(@exclude) = ('pn');
#                foreach $offset (@newresult) {
#		    &enread($db, *oldobject, $offset);
#		    next if (!&encmp(*entry, *oldobject, @exclude));
#		    $done = $offset;
#		    @result = ($done);
#		    last;
#                }
#                %oldobject = () if (!@result);
#		&dpr("\%oldobject = ", join("*", %oldobject), "\n");
#		&dpr("\%entry = ", join("*", %entry), "\n");
#	    }
#	}
	
	# check if we are doing a modification
	if (@result) {
	    if (scalar(@result)>1) {
		&dpr("multiple match - $entry{$type}\n");
	        $returncode = $E_MULT_MATCH;
	    }
	    else {
	        &enread($db, *oldobject, $result[0]) if (!%oldobject);
	        &dpr("modification match - $oldobject{$type}\n");
                $options |= $MODIFYOPTION;
                $returncode = $E_NOOP if (&encmp(*entry, *oldobject));
                $returncode = $E_NOTNEW 
		    if ($returncode == $O_OK && 
			(($type eq "in"  &&  $opt_A) || $NEWMODE));
	    }
	    if ($returncode == $O_OK) {
                my($date)    = 0;
                my($newdate) = 0;
                my($curdate) = 0;
                my($email);

                # Check update date
                foreach (split(/\n/, $entry{"ch"})) {
		    ($email, $date) = split(/\s+/, $_);
		    $date = YYMMDDtoYYYYMMDD($date);
		    $newdate = $date if ($date > $newdate);
                }
                foreach (split(/\n/, $oldobject{"ch"})) {
		    ($email, $date) = split(/\s+/, $_);
		    $date = YYMMDDtoYYYYMMDD($date);
		    $curdate = $date if ($date > $curdate);
                }
                $returncode = $E_OLDER if ($newdate < $curdate);
	    }
	}          
	
	$options |= $NEWOPTION if (!($options & $MODIFYOPTION));

	if ($returncode == $O_OK) {
	    
	    # assign NIC handle
	    if (($type =~ /^pn|ro$/) &&
		($entry{"nh"} =~ /^$AUTONICPREFIXREGULAR(\d+)([A-Z]+)$/o)) {
                my($idnumber) = $1;
                my($idinitials) = $2;
                $entry{"nh"} = 
		    &findfirstfreehandle(*db, *othernicdb, *entry);
                $ASSIGNEDNIC{$source, $idnumber} = $entry{"nh"};
                $ASSIGNEDNIC{$source, $idnumber, $idinitials} = $entry{"nh"};
                $options |= $ASSIGNEDNICOPTION;
	    }

	    # substitute NIC handles if necessary
#	    &dpr("autonichandles: " . join(" ", @autonichandles) . "\n");
	    my($attribute);
	    foreach $attribute (@autonichandles) {
                my(@attributes) = ();
                foreach (split(/\n/, $entry{$attribute})) {
		    if (/^$AUTONICPREFIXREGULAR(\d+)([A-Z]*)$/) {
			if ($ASSIGNEDNIC{$source, $1, $2}){
			    push(@attributes, $ASSIGNEDNIC{$source, $1, $2});
			}
			elsif ($ASSIGNEDNIC{$source, $1}){
			    push(@attributes, $ASSIGNEDNIC{$source, $1});
			}
			else {
			    &adderror(*entry, "not assigned auto NIC " . 
				      "handle used as a reference ($_)");
			    $returncode = $E_GENERAL;
			    last;
			}
		    }
		    else {
			push(@attributes, $_);
		    }
                }
                last if ($returncode != $O_OK);
                $entry{$attribute} = join("\n", @attributes);
	    }
	}
	
	# check if NIC handle is not already assigned
	if ($returncode == $O_OK) {
	    if (($type =~ /^pn|ro$/) &&
		($options & $NEWOPTION) && 
		($entry{"nh"})) {

		&dpr("doing handle already in use check\n");
		local(@longkeys) = ();
		local(@keys) = &makekeys($entry{"nh"}, "", *longkeys);
		if ((&dbmatch(*db, *keys, "", 0)) ||
		    (&dbmatch(*othernicdb, *keys, "", 0))) {
		    $returncode = $E_GENERAL;
		    &adderror(*entry, "NIC handle (" . $entry{"nh"} . 
			      ") already in use for other object");
		}
	    }
	}
	# check if entry in the database exists with the same contact 
	# data and name as the one being added or modified.
	if ($returncode == $O_OK) {
	    if (($options & $NEWOPTION) && 
		($type eq 'pn')         && 
		$DUPLICATEPERSONCHECK) {
		&dpr("****************************\n");
		&dpr("doing duplicate person check\n");
		&dpr("****************************\n");
		local(@longkeys);
		local(@keys) = &makekeys($entry{$type}, "", *longkeys);
		@keys = @longkeys if (@longkeys);
		my(@results) = &dbmatch(*db, *keys, "", 0);

		&dpr("\%entry = " . join("*", %entry) . "\n");

		if (@results) {
		    my($messg) = "Other person object(s) with the " .
			"same name exists:";
		    foreach (@results) {
			local(%otherobj);
			&enread($db, *otherobj, $_);
			next if (&encmp(*entry, *otherobj));
			&dpr("\%other = " . join("*", %otherobj) . "\n");
			$messg .= ("\n" . $otherobj{'nh'}) if ($otherobj{'nh'});
			if (&cmpContactData(\%entry, \%otherobj)) {
			    if ($DUPLICATEPERSONCHECK =~ /^strict$/i) {
				&adderror(*entry, 
					  "Other person object exists with " . 
					  "the same name and contacts data" .
					  (($otherobj{'nh'}) ? 
					  ": $otherobj{'nh'}" : ""));
				$returncode = $E_GENERAL;
				last;
			    }
			    else {
				$messg .= "(same contact data too)";
			    }
			}
		    }
		    $messg .= "\n";
		    &addwarning(*entry, $messg) if ($returncode == $O_OK);
		}
	    }
	}

	# here we need the 'do referenced objects really exist code'

	if ($returncode == $O_OK) {
	    my(@notfoundmnt) = ();
	    my(%ExistMntner);
	    my(@notfoundnic) = ();
	    my(%ExistNic);
	    my(%ExistAS);
	    my($mnt, $nic, $as);
	    my(@mntners) = undef;
	    my(@nics) = undef;
	    my($AS);
	    my($attr);

	    foreach $attr (split(' ', $OBJPOINTSTOMTATTR{$type})) {
		push @mntners, split(' ', $entry{$attr});
	    }
	    foreach $attr (split(' ', $OBJPOINTSTONICATTR{$type})) {
		push @nics, split(' ', $entry{$attr});
	    }
	    $AS = $entry{'or'} if ($type eq 'rt');

	    foreach $mntner (@mntners) { 
		next if !$mntner;
		next if ($mntner eq $entry{'mt'});
		next if ($ExistMntner{$mntner});
		local(@longkeys);
		local(@keys) = &makekeys($mntner, " ", *longkeys);
		my(@result) = (!$split || ($type eq 'mt')) ?
		                  &dbmatch(*db, *keys, " ", 0) :
				  &dbmatch(*mtdb, *keys, " ", 0);
		if (!@result) {
		    push @notfoundmnt, $mntner;
		}
		else {
		    local(%CurMnt);
		    my($fh) = (!$split || ($type eq 'mt')) ? $db : $mtdb;
		    &enread($fh, *CurMnt, $result[0]);
		    $ExistMntner{$CurMnt{'mt'}} = 1;
		}
	    }

            &dbclose(*mtdb) if ($type ne 'mt');

	    if (@notfoundmnt) {
		my($messg) = "Unknown maintainer(s) @notfoundmnt referenced";
		if ($options & $OVERRIDEINTEGRITY) {
		    &addwarning(*entry, $messg);
		}
		else {
		    &adderror(*entry, $messg);
		    $returncode = $E_GENERAL;
		}
	    }

	    foreach $nic (@nics) {
		next if !$nic;
		next if ($nic eq $entry{'nh'});
		next if ($ExistNic{$nic});
		local(@longkeys);
		local(@keys) = &makekeys($nic, " ", *longkeys);
		my(@result) = (!$split || ($type =~ /^pn|ro$/)) ?
		                  &dbmatch(*db, *keys, " ", 0) :
				  &dbmatch(*nicdb, *keys, " ", 0);
		local(%CurNic);
		if (!@result) {
		    @result = &dbmatch(*othernicdb, *keys, " ", 0);
		    if (!@result) {
			push @notfoundnic, $nic;
		    }
		    else {
			&enread($othernicdb, *CurNic, $result[0]);
			$ExistNic{$CurNic{'nh'}} = 1;
		    }
		}
		else {
		    my($fh) = (!$split || ($type =~ /^pn|ro$/)) ? $db : $nicdb;
		    &enread($fh, *CurNic, $result[0]);
		    $ExistNic{$CurNic{'nh'}} = 1;
		}
	    }
	    if (@notfoundnic) {
		my($messg) = 
		    "Unknown nic handle(s) @notfoundnic referenced";
		if ($options & $OVERRIDEINTEGRITY) {
		    &addwarning(*entry, $messg);
		}
		else {
		    &adderror(*entry, $messg);
		    $returncode = $E_GENERAL;
		}
	    }
	    if ($type eq 'rt') {
		local(@longkeys);
		local(@keys)   = &makekeys($AS, " ", *longkeys);
		my(@result) = &dbmatch(*andb, *keys, " ", 0);
		if (!@result) {
		    my($messg) = "Unknown AS $AS referenced";
		    if ($options & $OVERRIDEINTEGRITY) {
			&addwarning(*entry, $messg);
		    }
		    else {
			&adderror(*entry, "Unknown AS $AS referenced");
			$returncode = $E_GENERAL;
		    }
		}
	    }
	}
								    
	if ($returncode == $O_OK) {
	    $returncode = &updatecheck(*db, *oldobject, *entry, 
				       $type, $options);
	}
	if ($returncode==$O_OK) { 
	    if ($options & $MODIFYOPTION) {
		$returncode=&dbdel(*db, *oldobject, $type,
				   $options | $NOCHECKSOPTION);
	    }
	    if ($returncode==$O_OK) {
		$returncode=&dbadd(*db, *entry, $type, $options) ;
	    }
	    if ($returncode==$O_OK) {
		&AddNotify(*oldobject, *entry);
	    }
	}
	&closedatabases($type, $split, *db, *nicdb, *othernicdb, *mtdb, *andb);

    } # end of creation/modification

    # If object has been successfully updated ($O_OK ?)  do the
    # cross notification checks and generate messages if
    # needed.  Messages will be in a form suitable to feed to
    # to sendmail (or other MTA) and are put in temporary
    # files. add_cross_notify returns (possibly empty) list of
    # file names.  They will be sent at the same time as the
    # Update Notification.

    # Do the cross notification checks here
    #   1. after the dbases have been closed (we need to open them again)
    #   2. while the new and old objects are still in scope

    # use $::REPLYTO as the originator of the update message
    # it gets set somewhere (?)

    undef @::cross_notification_mailfiles;

    if ($returncode == $O_OK) {
	if ($options & $DELETEOPTION) {
	    push @::cross_notification_mailfiles,
	    add_cross_notify(\%entry, undef, $::REPLYTO);
	}

	if ($options & $NEWOPTION) {
	    push @::cross_notification_mailfiles,
	    add_cross_notify(undef, \%entry, $::REPLYTO);
	}
    }
    return ($returncode, "");
}


sub dbadd {
    local(*db, *entry, $type, $options) = @_;

#    &dpr("dbadd - finding unique key $type (" . $entry{$type} . ")\n");
    my($uniquekey) = &enukey(*entry, $type);
#    &dpr("\$uniquekey = $uniquekey\n");

    # entry already exists
    return $E_EXIST if (defined($db{$uniquekey}));
    
    # add object to db
    seek($db, 0, 2);
    my($offset) = &enwrite($db, *entry, 0, 0);
#    &dpr("object written at offset: $offset\n");

    # find all keys and add to db
    
    local(@keys,@other,@pointsto,@otherpointsto,@classless);
    
    &enkeys(*entry, $OBJKEYS{$type}, *keys, 
	    *other, *pointsto, *otherpointsto, *classless, 1);
    
    foreach ($uniquekey, @keys) {
#	&dpr("adding normal & unique keys\n\t$_\n");
	&addkey(*db, $_, $offset);
#	&dpr("\$db{$_} = $db{$_}\n");
    }
    
    foreach (@other) {
#	&dpr("adding other keys\n\t$_\n");
	&addkey(*db, $_, $offset);
#	&dpr("\$db{$_} = $db{$_}\n");
    }
    
    foreach (@pointsto) {
#	&dpr("adding pointsto keys\n\t$_\n");
	&addkey(*db, $_, $offset);
#	&dpr("\$db{$_} = $db{$_}\n");
    }

    foreach (@otherpointsto) {
#	&dpr("adding otherpointsto keys\n\t$_\n");
	&addkey(*db, $_, $offset);
#	&dpr("\$db{$_} = $db{$_}\n");
    }
    
    # No need to modify the classless index if this is a
    # modification, rather than a addition of a new object
    
    if (($CLASSLESSDBS{$type}) &&
	((!($options & $MODIFYOPTION)) ||
	 ($type!~ /^i[n6]|rt$/) ||
	 ($options & $BACKWARDCOMPATIBILITYOPTION))) {
	
	foreach (@classless) {
#	    &dpr("adding classless keys\n\t$_\n");
	    &inscla(*mspnxl, $_, $uniquekey);
	}
	
    }

    # add PGP key to our keyring

    if ($type eq 'kc' && defined($entry{'kc'})) {
       addPGPkey(*entry, $type);
    }

#    &dpr("writing serial log\n");
    &writeseriallog($ADDACTION,*entry);

    return $O_OK;
}



sub dbdel {
    local(*db, *entry, $type, $options, @result) = @_;

#    &dpr("called for $type($entry{$type}) ($options)\n");

    local(@uniquekey) = (&enukey(*entry, $type));
    
#    &dpr("result: @result, unique: @uniquekey\n");

    my($uniquekey) = &enukey(*entry, $type);
#    &dpr("\$db{$uniquekey} = $db{$uniquekey}\n");

    # entry not found

    return $E_NOT_FOUND if (!defined($db{$uniquekey}));

    if (!@result) {
	local(@uniquekey) = ($uniquekey);
	@result = &dbmatch(*db, *uniquekey, "", 0);
    }

    # delete any exactly matching objects
    
    my($returncode) = $E_MISMATCH;
    my($offset);
    local(%oldobject) = ();
    foreach $offset (@result) {
	&enread($db, *oldobject, $offset);
	next if (!&encmp(*entry, *oldobject));
	$returncode = $O_OK;
	
	# 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 (!($options & $NOCHECKSOPTION)) {
	    local(%nothing) = ();
	    $returncode = &updatecheck(*db, *entry, *nothing, $type, $options);
	    return $returncode if ($returncode != $O_OK);
	}

	# delete object
	
	seek($db, $offset, 0);
	print $db "*", $DELETEDOBJECT, "\:";
        
	local(@keys,@other,@pointsto,@otherpointsto,@classless);
	
	&enkeys(*entry, $OBJKEYS{$type}, *keys, 
		*other, *pointsto, *otherpointsto, *classless, 1);
        
	foreach (@uniquekey, @keys) {
#	    &dpr("deleting normal keys\n");
	    &delkey(*db, $_, $offset);
	}
	
	foreach (@other) {
#	    &dpr("deleting other keys\n");
	    &delkey(*db, $_, $offset);
	}
	
	foreach (@pointsto) {
#	    &dpr("deleting pointsto keys\n");
	    &delkey(*db, $_, $offset);
	}
	
	foreach (@otherpointsto) {
#	    &dpr("deleting otherpointsto keys\n");
	    &delkey(*db, $_, $offset);
	}
	
	# No need to modify the classless index if this is a
	# modification, rather than a real delete.

	if (($CLASSLESSDBS{$type}) &&
	    ((!($options & $MODIFYOPTION)) ||
	     ($type !~ /^i[n6]|rt$/) ||
	     ($options & $BACKWARDCOMPATIBILITYOPTION))) {
	    foreach (@classless) {
#		&dpr("deleting classless keys\n");
		&delcla(*mspnxl, $_, $uniquekey[0]);
	    }
	}

	# delete PGP key from our keyring

	if ($type eq 'kc' && defined($entry{'kc'})) {
	    delPGPkey($entry{'kc'});
	}

#	&dpr("dbdel - writing serial log\n");
	&writeseriallog($DELETEACTION, *entry);
    }
    return $returncode;
}

sub cmpContactData {
    my($pnA, $pnB) = @_;
    my($attr);
    my($aa, $bb);
    my(@attrs) = qw( ad fx ph );

    foreach $attr (@attrs) {
#	&dpr("=== $attr ===\n");
	$aa = $pnA->{$attr};
	$bb = $pnB->{$attr};
#	&dpr("\$aa = $aa, \$bb = $bb\n");
	$aa =~ tr/a-z/A-Z/;
	$bb =~ tr/a-z/A-Z/;
	$aa =~ s/^\s*//;
	$bb =~ s/^\s*//;
	$aa =~ s/\s*$//;
	$bb =~ s/\s*$//;
	$aa =~ s/\s+/ /g;
	$bb =~ s/\s+/ /g;
#	&dpr("\$aa = $aa, \$bb = $bb\n");
	return 0 if ($aa ne $bb);
    }
    return 1;
}

1;
