bug fix for 2.00 release

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, at otherkeys, at pointsto, at otherpointsto, at classless);
    
    local($basename);
    
    local($newdb)='newdb';
    local(%newdb, at 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, at 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;


--------