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

# hiermnt.pl - implements the hierarchical authorization methods
# it works only for creation right now...

# Here's the scoop:
# 
# OldObject is empty: addition
# NewObject is empty: delete
# None empty:         normal update


require "notify.pl";
require "entype.pl";
require "dpr.pl";

sub HierarchicalAuthorization {
    local(*db,*OldObject,*NewObject,$type, $options)=@_;
    
    # And now the hierarchical authorization
    # only for creation right now...
    
    local($returncode)=$O_OK;
    
    if (!($options & $OVERRIDEOPTION)) {
    
       #    
       # We only deal with a creation actions so far...
    
       if ($options & $NEWOPTION) {
       
#          &dpr("hierarchial authorization (create: $type)\n");
       
          if ($type eq "in") {
       
             return &AuthorizeInetnum(*db, $options, $type, *OldObject, *NewObject, $NewObject{$type}, &enukey(*NewObject,$type));
          
          }
##\begin[1999 02 18]{engin}
          elsif ($type eq "i6") {
       
             return &AuthorizeInetv6num(*db, $options, $type, *OldObject, *NewObject, $NewObject{$type}, &enukey(*NewObject,$type));
          
          }
##\end{engin}
          elsif ($type eq "dn") {
          
             return &AuthorizeDomain(*db, $options, $type, *OldObject, *NewObject, $NewObject{$type});
       
          }
          elsif ($type eq "rt") {
       
             return &AuthorizeRoute(*db, $options, $type, *OldObject, *NewObject, $NewObject{$type}, $NewObject{"or"});
          
          }
    
       }
       
    }
    
    return $returncode;
    
}
       

sub DoHierarchicalAuthorization {
    local(*db, $options, $type, *OldObject, *NewObject, *keys)=@_;

    local($returncode)=$O_NOTFOUND;

    local(%directabove);
    local($key);

#    &dpr("keys: ".join(" ",@keys)."\n");
    
    foreach $key (&dbmatch(*db, *keys, "", 0)) {
       
       &enread($db, *directabove, $key);
        
#       &dpr("hierarchical offset=$key, object=", $directabove{$type}, "\n");
 
       # check the type, we might have a non-split database!
 
       if ($type eq &entype(%directabove)) {
       
          $returncode=$O_OK;
            
#          &dpr("hierarchical last step ml=", $directabove{"ml"}, "...\n");
          
          if ($directabove{"ml"}) {
          
	      if (&Maintainer(*OldObject, *NewObject, 
			      $options, $directabove{"ml"})) {
		  &NotifyMaintainers(*OldObject, *NewObject, $directabove{"ml"});
	      }
	      else{
		  $returncode = $E_HIER_AUTHFAIL;
	      }

          }
          
          last;
                
       }
   
    }
    
    return $returncode;
       
}    
    
     
    

sub AuthorizeInetnum {
    local(*db, $options, $type, *OldObject, *NewObject, $value, $uniquekey)=@_;
    
    local($returncode)=$O_OK;
    local($code);
    
    local(%directabove)=();
    local(@lessspecifics)=();
     
    local($key); 
     
    $directabove{$type}=$value;
    
#    &dpr("hierarchical inetnum direct above=",$directabove{$type},"\n");
    
    local(@keys,@other,@pointsto,@otherspointsto,@classless);
    
    &enkeys(*directabove, $KEYS{$type}, *keys, *other, *pointsto, *otherspointsto, *classless, 1);
    
#    &dpr("hierarchical inetnum keys=", join(" ", @classless) ,"\n");
    
    #
    # we don't have time for sophisticated routines now
    # and it looks like brute force might be more efficient anyway
    # so here we go ...
    #
    # first find all less specific objects
    
    foreach $key (@classless) {
    
       #
       # we try to find all less specifics to be sure that we find
       # the right objects in case of non-split databases
       # no time right now to handle this differently for split and
       # and non split databases...
       # note: a parent in a non-split database might be an object
       # with another type, yes we might call this a bug...
       
       push(@lessspecifics, &findlsps(*mspnxl, $key, 1));
    
    }
    
#    &dpr("hierarchical inetnum lessspecifics=", 
#	 join(" ", @lessspecifics) ,"\n");
    
    #
    # remove doubles (grep perl trick, see camel book)
    
    local(%tmp)=();
    grep($tmp{$_}++, @lessspecifics);
    @lessspecifics=keys(%tmp);
    
#    &dpr("hierarchical inetnum after removing doubles lessspecifics=", 
#	 join(" ", @lessspecifics) ,"\n");
    
    #
    # find the smallest objects that are bigger then the current object
    
    local(@directabove)=();
    
    local($uniquekey,$size,$newsize, $newtype, $ip1, $ip2, $newrange);
    local(%foundobject);
    
    $size=&quad2int("255.255.255.255",1);
    
#    &dpr("start size: $size\n");
    
    foreach $key (@lessspecifics) {
       
       #
       # we don't want to use the authorization of the old object...
       
       next if ($key eq $uniquekey);
       
       foreach $uniquekey (&cla2unikey(*mspnxl, ($key))) {
       
          ($newtype, %foundobject)=&uniquekey2entry($uniquekey);
          
#          &dpr("newtype: $newtype name: ",$foundobject{$newtype},"\n");
       
          #
          # don't use objects with another type, this is for non split databases
       
          if ($newtype eq $type) {
          
             ($newrange, $code)=&normalizerange($foundobject{$type}, $type);
          
#             &dpr("newrange: $newrange code: $code\n");
             
             ($ip1,$ip2)=split(/ *\- */, $newrange);
       
             $ip1=&quad2int($ip1,1);
             $ip2=&quad2int($ip2,1);
       
             $newsize=$ip2-$ip1;
       
             if ($newsize<=$size) {
             
                if ($newsize==$size) {
                
#                   &dpr("same size: $newsize\n");
                
                   push(@directabove,$key);   
                
                }
                else {   
                
#                   &dpr("newsize: $newsize\n");
                
                   $size=$newsize;
                   @directabove=($key);
             
                }
          
             }
          
          }
       
       }
       
    }
    
    $code=&DoHierarchicalAuthorization(*db, $options, $type, *OldObject, *NewObject, *directabove);
    
    # everything is fine if we didn't find any parent object
    
    return $O_OK if ($code==$O_NOTFOUND);
    
    return $code;
    
}
    
##\begin[1999 02 18]{engin}
sub AuthorizeInetv6num{

    local(*db, $options, $type, *OldObject, *NewObject, $value, $uniquekey)=@_;
    
    local($returncode)=$O_OK;
    local($code);
    
    local(%directabove)=();
    local(@lessspecifics)=();
     
    local($key); 
     
    $directabove{$type}=$value;
    
#    &dpr("hierarchical inetnum direct above=",$directabove{$type},"\n");
    
    local(@keys,@other,@pointsto,@otherspointsto,@classless);
    
    &enkeys(*directabove, $KEYS{$type}, *keys, *other, *pointsto, *otherspointsto, *classless, 1);
    
#    &dpr("hierarchical inetnum keys=", join(" ", @classless) ,"\n");
    
    #
    # we don't have time for sophisticated routines now
    # and it looks like brute force might be more efficient anyway
    # so here we go ...
    #
    # first find all less specific objects
    
    foreach $key (@classless) {
    
       #
       # we try to find all less specifics to be sure that we find
       # the right objects in case of non-split databases
       # no time right now to handle this differently for split and
       # and non split databases...
       # note: a parent in a non-split database might be an object
       # with another type, yes we might call this a bug...
       
       push(@lessspecifics, &findlsps(*mspnxl, $key, 1));

    
    }
    
#    &dpr("hierarchical inetnum lessspecifics=", 
#	 join(" ", @lessspecifics) ,"\n");
    
    #
    # remove doubles (grep perl trick, see camel book)
    
    local(%tmp)=();
    grep($tmp{$_}++, @lessspecifics);
    @lessspecifics=keys(%tmp);
    
#    &dpr("hierarchical inetnum after removing doubles lessspecifics=", 
#	 join(" ", @lessspecifics) ,"\n");
    
    #
    # find the smallest objects that are bigger then the current object
    
    local(@directabove)=();

# now, try to find the smallest one in @lessspecifics:
    local($size);
    $size = 0;
    foreach $key  (@lessspecifics){
       ($prefixv6,$lengthv6) = split(/\//,$key);
       if ($lengthv6 > $size){
          $size = $lengthv6;
          @directabove = ($key); 
       }
    }

    
    
    $code=&DoHierarchicalAuthorization(*db, $options, $type, *OldObject, *NewObject, *directabove);
    
    # everything is fine if we didn't find any parent object
    
    return $O_OK if ($code==$O_NOTFOUND);
    
    return $code;

}
##\end{engin}

sub AuthorizeDomain {
    local(*db, $options, $type, $OldObject, $NewObject, $domain)=@_;
    
    local($returncode)=$O_OK;
    
    local($code);
    local(@keys,@other,@pointsto,@otherspointsto,@classless);
    
    # top level domains may not be automatically created
    
    if (($domain!~ /\./) && ($options & $NEWOPTION)) {
       
       return $E_HIER_AUTHFAIL;

    }
    
    # find the parent domain
        
    while ($domain=~ s/^\s*[^\s\.]+\.(\S+)\s*$/$1/) {
       
       local(%directabove)=();
             
       $directabove{$type}=$1;
       
#       &dpr("hiermnt - hierarchical domain direct above=",
#	    $directabove{$type},"\n");
       
       &enkeys(*directabove, $KEYS{$type}, *keys, *other, *pointsto, *otherspointsto, *classless, 0);
       
#       &dpr("hiermnt - hierarchical domain keys=", join(" ", @keys) ,"\n");
       
       $code=&DoHierarchicalAuthorization(*db, $options, $type, *OldObject, *NewObject, *keys);
       
       return $code if ($code!=$O_NOTFOUND);
       
    }
    
    # we didn't find a parent object
    
    return $O_OK;
          
}    

sub AuthorizeRoute {
    local(*db, $options, $type, *OldObject, *NewObject, $value)=@_;
    
    local($returncode)=$O_OK;
    
    
    return $returncode;
    
}

1;
