# cldb.pl
#
# 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: cldb.pl,v 2.5 1999/10/06 16:41:01 marek Exp $
#
#	$RCSfile: cldb.pl,v $
#	$Revision: 2.5 $
#	$Author: marek $
#	$Date: 1999/10/06 16:41:01 $

# This module contains all routines for classless indexing and lookups
#
# it is completely rewritten, much faster and you can now
# have more databases open at the same time (although the rest of the
# code doesn't support this yet

# %mspnxl :
#     keys   -> prefixes in form integer/len
#     values -> comma separated list of unique keys

require "defines.pl";
require "misc.pl";
require "net2net.pl";
require "addkey.pl";

# cla2unikey(*mspnxl, @clas)
#
# gives back an array of unique keys into the database that match these clas

sub cla2unikey {
    local(*mspnxl, @clas)=@_;

    local(@result)=();
    
    foreach (@clas) {
       push(@result, 
	    grep( /$UNIQUEKEYBINDING/o, split("\,", &getvalues(*mspnxl, $_))));
    }
    return @result;
}



################################################################
##  sub {@tbs@} 
################################################################
##
##  FUNCTIONAL DESCRIPTION:
##      Find the list of less specifics for prefix $cla. If the 
##      recursion flag is set, all less specifics (lsps) are 
##      returned, otherwise only the first less specific.
##  FORMAL PARAMETERS:
##      *mspnxl: in
##          classless index hash
##      $cla: in
##          prefix/len
##      $recurse: in
##          boolean flag
##          0 - only one level less specific (that is itself)
##          1 - all less specifics
##  RETURN VALUE:
##      just $cla if not recurse and $cla exists in %mspnxl
##      when $cla doesn't exist in %mspnxl then first existing
##      less specific prefix returned.
##      recurse -> list of less specific prefixes existing in %mslnxl
##      ordered according to descending prefix lengths 
##  SIDE EFFECTS:
##      {@description or none@}
##  DESIGN:
##      {@description or none@}
##   
################################################################

sub findlsps {
    local(*mspnxl, $cla, $recurse)=@_;
    
    local($prefix, $i)=split(/\//, $cla);
    
    local(@returnlist)=();
    local($newcla);

    # print STDERR "findlsps($cla*$recurse) called\n";
    
    #
    # check the first level, and skip the rest if possible
    
    if (defined($mspnxl{$cla})) {
    
       return ($cla) if (!$recurse);
       
       @returnlist=($cla);
       
    }
    
    $i++;
    
    local(@notexistinglevels)=split(/ /, $mspnxl{$NOTEXISTINGPREFIXESKEY}, $i);
    
    return () if (scalar(@notexistinglevels)!=$i);
    
    for ($i-=2;$i>0;$i--) {
        
        next if ($notexistinglevels[$i]);
        
        if (defined($mspnxl{($newcla=&iprightzeromask($prefix,$i)."\/".$i)})) {
        
           # print STDERR "findlsps - i: $i newcla: $newcla\n";
           
           return ($newcla) if (!$recurse);
           
           push(@returnlist, $newcla);
           
           next;
           
        }
        
        # print STDERR "findlsps - skipped i: $i newcla: $newcla\n";
        
    }
    
    # print STDERR "findlsps: ", join(" ", @returnlist), "\n";
    
    return @returnlist;
    
}


#
# findmsps(*mspnxl, $cla, $recurse)
#
# routine to find all more specifics of a certain classless address cla.

sub findmsps {
    local(*mspnxl, $cla, $recurse) = @_;

    # print STDERR "findmsps($cla * $orig * $first * $nonrecurse) called\n";

    #
    # Look up first less specific when the requested $cla does not
    # exist itself, and use that to find all more specifics.

    local($p2, $l2)=split(/\//, $cla);
    local($p1, $l1, $msps);

    local($dontcheckifmorespecific)=0;

    if (!defined($mspnxl{$cla})) {
    
       $cla=(&findlsps(*mspnxl,$cla,0))[0];
       $cla="0\/0" if (!$cla);
    
    }
    else {
       
       $dontcheckifmorespecific=1;
       
    }
    
    local(@msps)=();
    local(@todo)=($cla);
    
    while (@todo) {
    
       foreach $msps (split("\,", &getvalues(*mspnxl, shift(@todo)))) {
       
          # print STDERR "cla: $cla new: $new\n";
       
          next if ($msps!~ /^$VALIDPREFIX$/o);

          ($p1, $l1)=split(/\//, $msps);
          
          #
          # we do a string comparison since the ipv6 classless
          # values are strings!!
          
          if (($dontcheckifmorespecific) || (&iprightzeromask($p1,$l2)) eq &iprightzeromask($p2,$l2)) {
             
             push(@msps, $msps);
             push(@todo, $msps) if ($recurse);
             
          }
          
       }
       
       $dontcheckifmorespecific=1;   
       
    }
    
    return @msps;
    
}


#
# inscla(*mspnxl, $cla, $uniquekey)
#
# Insert classless address $cla with $uniquekey in the database
# into the tree structure
#
# NOTE: donetdbm has it's own version built in that skips
#       certain tests that are costly and not necessary when we
#       have the prefixes presorted.

sub inscla {
    local(*mspnxl, $cla, $uniquekey)=@_;
    
    local($lsps);
    
    # print STDERR "here: ",@mspnxl[1], " ", $mspnxl{'536870912/8'}, "\n";
    
    if ($cla eq ($lsps=(&findlsps(*mspnxl, $cla, 0))[0])) {
    
       # print STDERR "inscla - double addition lsps: $lsps\n";
       
       &addkey(*mspnxl, $cla, $uniquekey);
       
    }
    else {
       
       #
       # store the undefined/defined levels index value
       
       local(@notexistinglevels)=split(/ /, $mspnxl{$NOTEXISTINGPREFIXESKEY});
       
       @notexistinglevels=((1) x 129) if (scalar(@notexistinglevels)!=129);
       
       $cla=~ /\/(\d+)$/;
       
       if ($notexistinglevels[$1]) {
       
          $notexistinglevels[$1]=0;
       
          $mspnxl{$NOTEXISTINGPREFIXESKEY}=join(" ", @notexistinglevels);
       
       }
    
       $lsps="0\/0" if (!$lsps);
       
       # print STDERR "inslca - inserting lsps: $lsps\n";
       
       local($changes)=join("\,", &findmsps(*mspnxl, $cla, 0));
       
       if ($changes) {
          
          &delkey(*mspnxl, $lsps, $changes);
          &addkey(*mspnxl, $lsps, $cla);
          
          &addkey(*mspnxl, $cla, join("\,", $uniquekey, $changes));
       
       }
       else {
          
          # print STDERR "inscla - no changes lsps: $lsps cla: $cla unique: $uniquekey\n";
          
          &addkey(*mspnxl, $cla, $uniquekey);
          &addkey(*mspnxl, $lsps, $cla);
       
       }
       
    }
    
    return;
    
}



# 
# delcla(*mspnxl, $cla, $uniquekey) 
#
# delete a specific string from a $cla value. Delete the complete $cla
# if the result is an empty reference.

sub delcla {
    local(*mspnxl, $cla, $uniquekey) = @_;
    
    # print STDERR "delcla($cla*$uniquekey) called\n";

    local($values)=&getvalues(*mspnxl, $cla);
    
    return if (!$values);
    
    local(@msps)=();
    local(@uniquekeys)=();
    
    foreach (split("\,", $values)) {
    
      if (/^$VALIDPREFIX$/o) {
         push(@msps, $_);
      }
      else {
         push(@uniquekeys, $_);
      }
    
    }
    
    # print STDERR "uniquekeys: ", join(" ", @uniquekeys), "\n";
    # print STDERR "msps: ", join(" ", @msps), "\n";
    
    if (scalar(@uniquekeys)==1) {
    
       &delkey(*mspnxl, $cla, $values);
       
       local($lsps)=(&findlsps(*mspnxl, $cla, 0))[0];
       $lsps="0\/0" if (!$lsps);
    
       &addkey(*mspnxl, $lsps, join("\,", @msps)) if (@msps);
       &delkey(*mspnxl, $lsps, $cla);
       
    }
    else {
    
       &delkey(*mspnxl, $cla, $uniquekey);
    
    }
    
    return;
        
}

1;
