#       dbmatch - looks up the offsets in the dbm file
#
# 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: dbmatch.pl,v 2.7 1999/10/06 16:41:04 marek Exp $
#
#	$RCSfile: dbmatch.pl,v $
#	$Revision: 2.7 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:04 $
#
#	looks up the offsets in the dbm file for all keys
#       and will return an array with the intersection of all
#       offsets of all keys

#
# NOTE: the intersection option doesn't work correctly
#       for non-split databases and classless keys

require "defines.pl";
require "enukey.pl";
require "dpr.pl";

sub dbmatch {
    local(*db, *allkeys, $types, $options) = @_;

    &dpr("\@allkeys = (", join(" ", @allkeys), ") \$types = $types\n");

    local(%tmp)=();
    local(%nonsplitkeys)=();
    local(@classlesstypes)=();
    local($inetlength)=-1;
        
    local(@result,$key,@offsets,@classlesskeys,@newkeys,@inetnums,@notinetnums,$length,%alldbs,$type,%entry);
    local($range,$code,$ip1,$ip2,@newtypes);
    
    local($classless)=0;
    
    local(@keys)=grep(++$tmp{$_}==1, @allkeys);
    %tmp=();
    
    if ((!$SPLIT{$db[1]}) &&
        (!($options & ($ALLMORESPECIFICOPTION | $ALLLESSSPECIFICOPTION)))) {
       
       if ($types) {
          @classlesstypes=grep($CLASSLESSDBS{$_}, split(/ /, $types));
       }
       else {
          @classlesstypes=grep($OBJATSQ{$_}, keys %CLASSLESSDBS);
       }
          
    }
#    &dpr("\@classlesstype = (", join(" ", @classlesstypes), ")\n");

    foreach $key (@keys) {

#	&dpr("\$key = $key, \$db{\$key} = $db{$key}, \$options = $options\n");
        
       if ($key=~ /^$VALIDPREFIXKEY$/o) {
          
          $classless=1;
          
          if (@classlesstypes) {
             %alldbs=();
             @alldbs{@classlesstypes}=(1) x scalar(@classlesstypes);
#             &dpr("\%alldbs keys: (", join(" ", keys %alldbs), ")",
#		  "\%alldbs vals: (", join(" ", values %alldbs), ")\n");
          }
          
          #
          # perl doesn't have real do ... until statements
          
          CHECKMORE: {
             
             %entry=();
             
             if ($options & ($MORESPECIFICOPTION | $ALLMORESPECIFICOPTION)) {
          
                @classlesskeys=&findmsps(*mspnxl, $key, ($options & $ALLMORESPECIFICOPTION));
                
           
             }
             else {
             
                @classlesskeys=&findlsps(*mspnxl, $key, ($options & $ALLLESSSPECIFICOPTION));
                
             }
#             &dpr("\@classlesskeys = (", join(" ", @classlesskeys), ")\n");
             @newkeys=grep(++$entry{$_}==1, &cla2unikey(*mspnxl, @classlesskeys));
#             &dpr("\@newkeys = (", join(" ", @newkeys), ")\n");

             # this is to get non-split databases have the same behavior
             # as split databases
          
             if (@classlesstypes) {
          
                # print STDERR keys %alldbs, "\n";
          
                if (@newkeys) {
                   
                   @newtypes=();
                   
                   foreach $key (@newkeys) {
                
                      # print STDERR "alldbs before: ", keys %alldbs, "\n";
                      # print STDERR "key: $key\n";
                
                      ($type, %entry)=&uniquekey2entry($key);
                      
                      #print STDERR "alldbs after: ", values %alldbs, "\n";
                      #print STDERR "type: $type alldbs: ",$alldbs{$type},"\n";
                      
                      if ($alldbs{$type}) {
                         
                         #print STDERR "type: $type\n";
                
                         if ($nonsplitkeys{$type}) {
                            $nonsplitkeys{$type}=join("\,", $nonsplitkeys{$type}, $key);
                         }
                         else {
                            $nonsplitkeys{$type}=$key;
                         }
                   
                         push(@newtypes, $type);
                         
                      }
                      
                   }
                   
                   foreach (@newtypes) {
                      delete($alldbs{$_});
                   }
                
                }
                else {
                
                   %alldbs=();
                
                }
             
                if (%alldbs) {
             
                   if ($options & $MORESPECIFICOPTION) {
                      $key=$classlesskeys[0];
                   }
                   else {
                      $classlesskeys[0]=~ s/\/(\d+)$//;
                      $length=$1;
                      $key=&iprightzeromask($classlesskeys[0],$length-1)."\/".($length-1);
                   }
                   
                   # print STDERR "newkey=$key\n";
                
                   redo CHECKMORE;
             
                }
                
                # print STDERR "alldbs=NULL\n";
                
                @newkeys=();
                @newtypes=();
                foreach $type (keys %nonsplitkeys) {
                   foreach (split(/\,/, $nonsplitkeys{$type})) {
                      push(@newkeys, $_);
                      push(@newtypes, $type);
                      #print STDERR "type: $type\n";
                   }
                }
                
             }
             
          }
          
          #
          # do the inetnum check
             
          if ((scalar(@newkeys)>1) &&
              (!($options & ($MORESPECIFICOPTION | $ALLMORESPECIFICOPTION | $ALLLESSSPECIFICOPTION)))) {
                
             @inetnums=();
             @notinetnums=();
                
             while ($key=shift(@newkeys)) {
                
                if (@classlesstypes) {
                   $type=shift(@newtypes);
                   # print STDERR "type: $type\n";
                }
                else {
                   ($type, %entry)=&uniquekey2entry($key);
                }
                
                if ($type eq "in") {
                   
                   ($type, %entry)=&uniquekey2entry($key) if (@classlesstypes);
                   
                   ($range, $code)=&normalizerange($entry{$type}, $type);
                      
                   ($ip1,$ip2)=split(/ *\- */, $range);
                   
                   #print STDERR "key: $key ip: $ip1 - $ip2\n";
                   
                   $length=&quad2int($ip2,1)-&quad2int($ip1,1);
                   
                   #
                   # first option is never true and is disabled by above 
                   # if statement, we might want to make this working once...
                   #
                   # this means that '-m' and inetnum queries
                   # can cause erratic results in very,very rare
                   # circumstances
                   
                   if ($options & $MORESPECIFICOPTION) {
                         
                      if (($inetlength<0) || ($length>$inetlength)) {
                         @inetnums=($key);
                         $inetlength=$length;
                      }
                      else {
                         push(@inetnums, $key) if ($length==$inetlength);
                      }     
                         
                   }
                   else {
                         
                      if (($inetlength<0) || ($length<$inetlength)) {
                         @inetnums=($key);
                         $inetlength=$length;
                      }
                      else {
                         push(@inetnums, $key) if ($length==$inetlength);
                      }
                         
                   }
                   
                   #print STDERR "inetlength: $inetlength",@inetnums," ",&quad2int($ip2,1)-&quad2int($ip1,1),"\n";
                   
                }
                else {
                   push(@notinetnums, $key);
                }
                   
             }
                
             @newkeys=@notinetnums;
             push(@newkeys, @inetnums) if (@inetnums);
                
          }
          
       }
       else {
          @newkeys=($key);
       }

#	&dpr("\@newkeys = (", join(" ", @newkeys), ")\n"); 
       	
       foreach (@newkeys) {
	
	  @offsets=split("\,", &getvalues(*db, $_));

#	  &dpr("\@offsets = (", join(" ", @offsets), ")\n"); 
	  
	  return () if ((!$classless) && ($options & $EXACTMATCHOPTION) && (!@offsets));
          
          next if (!@offsets);
	   
	  if ((!$classless) &&
	      ($options & $INTERSECTIONOPTION) &&
	      (!((scalar(@newkeys)>1) && (@classlesstypes))) &&
	      (!($options & ($ALLMORESPECIFICOPTION | $ALLLESSSPECIFICOPTION)))) {
#	      &dpr("doing intersection\n");
	     if (@result) {
#		 &dpr("before intersection, \@result = (", join(" ", @result), ")\n");
	     	%tmp=();
		grep($tmp{$_}++, @offsets);
		@result=grep($tmp{$_}, @result);
#		 &dpr("after intersection, \@result = (", join(" ", @result), ")\n");
	     }
	     else {
		@result=@offsets;
#		&dpr("intersection, \@result = (", join(" ", @result), ")\n");
	     }
	     
	     return () if (!@result);
	  
	  }
	  else {
#	      &dpr("doing union\n");
	     push(@result, grep(!$tmp{$_}++, @offsets));
	      
	  }
	  
       }
       
    }
    &dpr("\@result = (", join(" ", @result), ")\n");
    return @result;
    
}

1;
