bug fix for 2.00 release

10 Aug 1996

      Dear all,

I found this morning a bug that could case the software not to remove the
lockfile when doing a database cleanup when indexing files with a full
path name. Please substitute your 'donetdbm.pl' file by the included one
or pick up a new distribution from:

ftp://ftp.ripe.net/ripe/dbase/software/ripe-dbase-2.0.1.tar.gz

Kind regards,

David K.

--------

#	$RCSfile: donetdbm.pl,v $
#	$Revision: 2.1 $
#	$Author: david $
#	$Date: 1996/08/10 15:53:32 $

require "defines.pl";
require "dbopen.pl";
require "dbclose.pl";

require "enread.pl";
require "enwrite.pl";

require "addkey.pl";
require "enkeys.pl";
require "enukey.pl";

#
# exit cleanly when asked to ...

sub quitdonetdbm {

    unlink(@DONETDBMFILES);

    print "\n$PROGRAMNAME terminated by signal.\n";

    exit;

}    

sub flushkeys {
   local(*database, *normalkeys)=@_;

   # print STDERR "do flush to disk for normal keys (happens every $MAXLISTLENGTH keys) ...";

   local($oldoffsets,$key,$value,$length);

   #
   # old overflow files

   local(@toobig)=();

   #
   # new overflow files

   local(@toobignewkeys)=();
   local(@toobignewvalues)=();

   #
   # normal keys

   local(@addkeys)=();
   local(@addvalues)=();

   while (($key,$value)=each(%normalkeys)) {

      $length=length($key);

      $key=~ s/^.{$OVERFLOWSIZE-1,$OVERFLOWSIZE-1}.*$/$1/ if ($length>=$OVERFLOWSIZE);

      #
      # check if the key already existed, that makes life
      # more complicated

      if (($oldoffsets=$database{$key})) {

         #
         # add to overflow file

         if ($oldoffsets=~ s/^$OVERFLOWPREFIXREGULAR//o) {

            push(@toobig, $oldoffsets, $value);

            next;

         }

         $value=join("\,", $oldoffsets, $value);

      }   

      #
      # do a value addition

      $length+=length($value);

      if ($length>=$OVERFLOWSIZE) {

         push(@toobignewkeys, $key);
         push(@toobignewvalues, $value);

      }
      else {

         push(@addkeys, $key);
         push(@addvalues, $value);

      }

   }

   #
   # clean up the memory

   %normalkeys=();

   #
   # add data to old overflow files

   local($dbfile)=$database[1].$OVERFLOWEXTENSION;

   if (@toobig) {

      while (@toobig) {

         if (open(OVERFLOWADD, ">>".$dbfile.shift(@toobig))) {

            print OVERFLOWADD "\,", shift(@toobig);
            close(OVERFLOWADD);

         }
         else {
            &fatalerror("in donetdbm flushkeys: cannot open for addition $dbfile.$_ value: ".shift(@toobig)." code: $!");
         }

      }

   }

   #
   # create new overflow files

   if (@toobignewkeys) {

      local($filenumber)=$database{$OVERFLOWKEY};
      local(@overflowvalues)=(++$filenumber .. ($filenumber+scalar(@toobignewkeys)-1));
      push(@addkeys, $OVERFLOWKEY);
      push(@addvalues, $overflowvalues[$#overflowvalues]);

      #print STDERR join(" ", @toobignewkeys), "\n";
      #print STDERR join(" ", @toobignewvalues), "\n";
      #print STDERR join(" ", @overflowvalues), "\n";

      foreach (@overflowvalues) {

         if (open(OVERFLOWNEW, ">".$dbfile.$_)) {

            print OVERFLOWNEW shift(@toobignewvalues);
            close(OVERFLOWNEW);

         }
         else {
            &fatalerror("in donetdbm flushkeys: cannot open for creation $dbfile.$_ value: ".shift(@toobignewvalues)." code: $!");
         }

      }

      push(@addkeys, @toobignewkeys);
      push(@addvalues, (@overflowvalues=grep($_=$OVERFLOWPREFIX.$_, @overflowvalues)));

   }

   #
   # add all keys to the physical database in one single command !!!

   @database{@addkeys}=@addvalues;

   # print STDERR " done\n";

   return 0;

}

sub flushclkeys {
   local($basename, $i, *list, *notexistingprefixes)=@_;

   #print STDERR "do flush to disk prefix \/$i (happens every $MAXSTRINGCOMPONENTS prefixes) ...";

   local($file)=$basename.$i;

   push(@DONETDBMFILES, $file) if (grep($_ ne $file, @DONETDBMFILES)==scalar(@DONETDBMFILES));

   open(FLUSHCLKEYS, ">>".$file);

   print FLUSHCLKEYS $list[$i];

   close(FLUSHCLKEYS);

   #print STDERR " done\n";

   $list[$i]="";

   $notexistingprefixes[$i]=0;

   return 0;

}

sub donetdbm {
    local($filename, $todir, $options)=@_;

    local($type,$uniquekey,$offset,$prefix);
    local($NEWDIR, $newfilename);

    local($classless)=$options & $CLASSLESSOPTION;
    local($cleaning)=$options & $CLEANOPTION;

    local(%entry);

    local($objseen) = 0;
    local($processed)=0;
    local(@clalist)=();
    local(@classlesslist)=();
    local(@nrofentries)=();
    local(%normalkeys)=();

    local(@notexistingprefixes)=(1) x 129;

    local(@keys,@otherkeys,@pointsto,@otherpointsto,@classless);

    local($basename);

    local($newdb)='newdb';
    local(%newdb,@newdb);

    local(%nothing)=();
    local($lockfile);

    # print STDERR "donetdbm - file: $filename classless: $classless cleaning: $cleaning\n";

    if ($cleaning) {

       ($NEWDIR, $newfilename)= $filename=~ /$SPLITFILENAME/o;

       $lockfile=$CLEANLOCK.$newfilename;

       # We will create a temporary directory to build the new database and
       # indexes.

       $NEWDIR.=$newfilename."-newindex.".$$;
       $newfilename=$NEWDIR."\/".$newfilename;

       &fatalerror("Temporary directory \"$NEWDIR\" already exists!") if (-d $NEWDIR);

       if (!mkdir($NEWDIR, 0750)) {
          &fatalerror("Failed to create temporary directory ($!): $NEWDIR");
       }

       &dbopen(*newdb, *nothing, 1, $newfilename ) || &fatalerror("Cannot open $newfilename");
       seek($newdb,0,2);

    }
    else {

       &delormoveindices($filename, "", $classless);

    }

    local(%dummyobject)=();

    local($db)='db';
    local(%db,@db);
    &dbopen(*db,*dummyobject,1,$filename) || &fatalerror("$0: error opening database: $filename");
    seek($db,0,0);

    if ($cleaning) {

       &fatalerror("lockfile: $lockfile already exists") if (-e $lockfile);

       push(@DONETDBMFILES, $lockfile);

       open(LOCKFILE, ">".$lockfile) || &fatalerror("cannot create $lockfile"); 
       print LOCKFILE "$$\n";
       close(LOCKFILE);

    }

    if ($classless) {

       local($prefixfilename);

       if ($filename=~ /^.*\/([^\s\/]+)\s*$/) {

          $prefixfilename=$2;

       }
       else {

          $prefixfilename=$filename;

       }

       $basename=$TMPDIR."/prefixdata.".$$.".".$prefixfilename;

       #
       # remove any possible left over files...

       local(@files)=();

       for $i (0..128) {
           push(@files, $basename.$i) if (-f $basename.$i);
       }

       unlink(@files) if (@files);

    }

    #
    # exit clean on a signal (except for the cleaning files, I am sorry
    #                         no time for the real fancy stuff)

    $SIG{'INT'}='quitdonetdbm';
    $SIG{'KILL'}='quitdonetdbm';
    $SIG{'TERM'}='quitdonetdbm'; 

    @OPENNETDBMFILES=();

    #
    # start gathering the keys...

    while ($type=&enread($db, *entry, -1)) {

        next if (!$OBJATSQ{$type});

        # print STDERR "type: $type\n";

	# $objseen++;
	# if ($objseen % 400 == 0) {
	#    print STDERR "donetdbm - indexed $objseen\n";
	# }
	# print STDERR "entry ($type): ", $entry{$type}, "\n";
	# print STDERR "\noffset: ", $entry{"offset"};
	# print STDERR "\nuniquekey: $uniquekey\n";

	if ($cleaning) {

	   $offset=&enwrite($newdb,*entry);

	}
	else {

	   $offset=$entry{"offset"};

	}   

	&enkeys(*entry, $OBJKEYS{$type}, *keys, *otherkeys, *pointsto, *otherpointsto, *classless, $classless);

	$processed+=grep((($normalkeys{$_}) && 
	                  ($normalkeys{$_}=join("\,", $normalkeys{$_}, $offset))) ||
	                 ($normalkeys{$_}=$offset), ($uniquekey=&enukey(*entry, $type)), 
	                                            @keys,
	                                            @otherkeys,
	                                            @pointsto,
	                                            @otherpointsto);

	if ($cleaning) {

	   $processed=&flushkeys(*newdb, *normalkeys) if ($processed>$MAXLISTLENGTH);

  	}
  	else {

  	   $processed=&flushkeys(*db, *normalkeys) if ($processed>$MAXLISTLENGTH);

  	}

  	if ($classless) {

  	   foreach (@classless) {

  	      /^(.+)\/(\d+)$/;
  	      $classlesslist[$2]=join("", $classlesslist[$2], $1, "\%", $uniquekey, "\%");

	      $nrofentries[$2]=&flushclkeys($basename,$2,*classlesslist,*notexistingprefixes) if (++$nrofentries[$2]>$MAXSTRINGCOMPONENTS);

  	   }

        }

    }

    #
    # note: we do the wait for a child flush *after* the classless indexing
    #       it might save us some extra time!

    if ($cleaning) {
       &flushkeys(*newdb, *normalkeys);
    }
    else {
       &flushkeys(*db, *normalkeys);
    }

    #
    # now we start with the classless indices

    if ($classless) {

       undef %normalkeys;

       print STDERR "docldbm - start inserting prefixes\n" if $opt_V;

       if ($cleaning) {
          &dbclopen(*dummyobject,1,$newfilename);
       }
       else {
          &delormoveindices($filename.$CLASSLESSEXT, "", $classless);
          &dbclopen(*dummyobject,1,$filename);
       }

       $objseen = 0;

       local($entry);
       local($p,$i,$cla,$newcla);

       #
       # we need to read entries separated by '%' characters
       # 
       # trickey: we don't need to reset it for:
       #
       # flushclkeys, getvalues, addkey since
       # they are not affected.

       local($/)="\%";

       for $i (1..128) {

	   print STDERR "try $basename$i\n" if ($opt_V);

	   #
	   # flush first the remaining prefixes...

	   &flushclkeys($basename, $i, *classlesslist, *notexistingprefixes) if ($nrofentries[$i]);

	   next if ($notexistingprefixes[$i]);

	   undef $nrofentries[$i];

	   if (open(FLUSHCLKEYS, "<".$basename.$i)) {

	      print STDERR "opened $basename$i\n" if ($opt_V);

	      $entry=1;

	      while ($entry) {

	         print STDERR "read from $basename$i\n" if ($opt_V);

	         $processed=0;

	         undef @clalist;

	         while (($processed<$MAXLISTLENGTH) && ($entry=<FLUSHCLKEYS>)) {

	             $key=<FLUSHCLKEYS>;

	             chop($entry);
	             chop($key);

                     push(@clalist,$entry,$key);	   

	             $processed++;

	         }

	         while ($prefix=shift(@clalist)) {

	            # print STDERR $prefix, "\n";

	            if (&addkey(*mspnxl, ($cla=join("\/", $prefix, $i)), shift(@clalist))) {

                       for ($p=$i-1;
                            ($p>0) &&
                            (($notexistingprefixes[$p]) ||
                            (!defined($mspnxl{($newcla=join("\/", &iprightzeromask($prefix,$p), $p))})));
                            $p--) {};

                       # print STDERR $p, " ",$i, " ", $newcla, "\n";

                       &addkey(*mspnxl, $p>0?$newcla:"0\/0", $cla);

                    }

	         }

	      }

	      close(FLUSHCLKEYS);

	      push(@DONETDBMFILES, $basename.$i);

	   }
	   else {

	      &fatalerror("Couldn\'t open prefix file: $basename$i ($!)");

	   }

       }
       unlink(@DONETDBMFILES) if (@DONETDBMFILES);           

       #
       # make the not existing prefixes array

       $mspnxl{$NOTEXISTINGPREFIXESKEY}=join(" ", @notexistingprefixes);

       &dbclclose();

    }

    #
    # we might still have a child process for the normal keys...

    # wait;

    # print STDERR "closing\n";

    if ($todir) {

       ($NEWDIR, $newfilename)= $filename=~ /$SPLITFILENAME/o;

       $lockfile=$CLEANLOCK.$newfilename; 

       &fatalerror("lockfile: $lockfile already exists") if (-e $lockfile);

       #
       # we don't accept termination of the program from here

       @DONETDBMFILES=();
       $SIG{'INT'}='IGNORE';
       $SIG{'KILL'}='IGNORE';
       $SIG{'TERM'}='IGNORE'; 

       open(LOCKFILE, ">".$lockfile) || &fatalerror("cannot create $lockfile"); 
       print LOCKFILE "$$\n";
       close(LOCKFILE);

       $todir.="\/" if ($todir!~ /\/\s*$/);

       &dbclose(*db);
       &delormoveindices($filename.$CLASSLESSEXT, $todir.$newfilename.$CLASSLESSEXT, $classless) if ($classless);
       &delormoveindices($filename, $todir.$newfilename, 0);

       unlink($lockfile);

    }
    elsif ($cleaning) {

       &dbclose(*newdb);
       &dbclose(*db);

       #
       # we don't accept termination of the program from here

       @DONETDBMFILES=();
       $SIG{'INT'}='IGNORE';
       $SIG{'KILL'}='IGNORE';
       $SIG{'TERM'}='IGNORE'; 

       &delormoveindices($newfilename.$CLASSLESSEXT, $filename.$CLASSLESSEXT, $classless) if ($classless);
       &delormoveindices($newfilename, $filename, 0);

       unlink($lockfile);

       warn "could\'t remove directory ($NEWDIR) errorcode: $!\n" if (!rmdir($NEWDIR));

    }
    else {
       # print STDERR "close db\n";
       &dbclose(*db);
       # print STDERR "done db\n";
    }

    # print STDERR "done -$/- db\n";

    return;

    #print STDERR "done db\n";

}

1;

--------

bug fix for 2.00 release

RIPE Database Manager