#
# radbserver-index.pl
#
# routines to build and update the radbserver indexes.
#

##################################################################################
#
# BuildRouteIndices
#
# reads in each db file, building indexes for various items.
# also constructs a simple array of all routes, in simple flat format.
#
# because pre-perl5 we don't have direct link to gdbm (or db), first
# construct indicies in associative arrays.
# then we will use those to build db files, one for each source.
# there is one db file for all the indicies in each source, each key prefixed
# with code to indicate which index it is for.
#
# NB: this assumes @sources and @dbfiles are lined up correctly to associate source-dbfiles.
#
##################################################################################

sub BuildRouteIndices {
    local(*dbfiles,$DoIt) = @_;
	local($dbfile,$fcnt,@start,@end) = ('',0);
	local(@AllRoutesInDB);
	$#AllRoutesInDB = 50000;	# lets make it big once and for all!

	return if !$opt_N && !DoIt;			# don't do it unless user says to!
	&syslogRLR($QRYLOG,"[] BUILD INDEXES [@sources]");

	foreach $dbfile (@dbfiles) {	# scan all the db files, building assoc. arrays as we go...
		local($route,$sf,$inetrtrlist);
		local(%ROfOrigin,%OfComm,%ROfCountry,%ROfASMetric) = ('','','','');
		local($netCnt,$originCnt,$commAttrCnt,$commCnt,$netlistCnt) = (0,0,0,0,0);
		local($netancCnt,$countryCnt,$wdCnt,$tmplist) = (0,0,0,'');
		@AllRoutesInDB = ();

        if ( !open(DBFILE, $dbfile) ) {
	        print STDERR "\nERROR(BuildRouteIndices):  Can't open '$dbfile'!\n";
	        next;
        }
	    print STDERR "\nbegin reading and building fromfile $dbfile:" if ($opt_d || $opt_p );

        @start = (times);
        while ( <DBFILE> ) {
	        chop;
	        if ( /^\*(in|rt):\ *(.*)$/ ) { # handles old inet-num in AND new route rt
				$wd = 0;
		        $netCnt++;
		        $route = $2;
				local($origin,$comm,$netlist,$country) = ('','','','','');
		        while ( <DBFILE> ) {	# now look for items to index, wd, or end of object
			        chop;
			        last if ( /^\ *$/ ); # end-of-object
			        if ( /^\*(as|or):\ *(.*)$/ ) { # as(aut-sys) is for inet-num; or(origin) is for route
				        $originCnt++;
						$origin = $2;
			        }
			        elsif ( /^\*cl:\ *(.*)$/ ) {
				        $commAttrCnt++;
						$comm .= "$1 ";
			        }
                    elsif ( /^\*cy:\ *(.*)$/ ) {
                        $countryCnt++;
                        $country = $1;
                    }
			        elsif ( /^\*av:\ *AS690(\ *aslist)*\ *(.*)$/ ) { # AS690 advisory (was local-route)
				        $netlistCnt++;
						$netlist = "$2 ";
			        }
					elsif ( /^\*wd:\ *(.*)$/ ) {
						$wd = 1;                 # could speed this by skipping to end-of-object...
						$wdCnt++;
					}
		        }
				# now we have finnished with this net. if its not withdrawn, lets
				# put its parts in the assoc. arrays.
				if ( !$wd ) {
					push(@AllRoutesInDB,$route);
					$ROfOrigin{$origin} .= "$route " if $origin;
                    $ROfCountry{$country} .= "$route " if $country;
					if ( $comm ) {
						$_ = $comm;
				        while ( s/^([0-9A-Za-z\_]+)(\s*)// ) {
					        $commCnt++;
					        $ROfComm{$1} .= "$route ";
							$ROfComm{"$1:$origin"} .= $route if $origin;
				        }
					}
					if ( $netlist ) {
						$_ = $netlist; # should be m:a[(nss)] where m may be s for static
				        while ( s/^([s0-9\:\(\)]+)(\s*)// ) {
					        $netancCnt++;
							$tmplist = $1;
							$tmplist =~ tr/s/S/; # needs to be uppercase for search
				   			$ROfASMetric{$tmplist} .= "$route ";
# rlr turned off 95-04-12 at dsj request:
#				   			if ( $tmplist =~ /^(\d*:\d*)\(/ ) { # store without (nss), too.
#				   				$ROfASMetric{$1} .= "$route ";
#				   			}
				        }
					}
				}
	        } # end-of-net/route object
			elsif ( /^\*ir:\ *(.*)$/ ) { # save inet-rtr object list
				$inetrtrlist .= "$1 ";
			}
	        print STDERR "." if ( ($opt_p || $opt_d) && $netCnt % 500 == 499 );
        }
		close(DBFILE);

		if ( $opt_D || $opt_p || $opt_d ) {
	        @end = (times);
            print STDERR "\nDone reading $netCnt nets (skipped $wdCnt withdrawn):\n";
			print STDERR "   $originCnt as-origins, $commAttrCnt commAttrs ($commCnt comms), $netlistCnt netlists ($netancCnt netancs), $countryCnt countries.\n";
            printf STDERR "  (took %.2f CPU seconds)\n", $end[0] - $start[0];
			print STDERR "Now store in db index files..."
		}

		@start = (times);
		$sf = $sources[$fcnt];
		&TieNewSource( $sf );
		print STDERR " (tied to '$sf')..." if ( $opt_D || $opt_p || $opt_d );
		while ( ($k,$v) = each %ROfOrigin ) {
			$ek = "$RoutesOfOriginPrefix-$k";
			eval '$' . $sf . '{$ek} = $v';
    	}
    	while ( ($k,$v) = each %ROfComm ) {
            $ek = "$RoutesOfCommPrefix-$k";
            eval '$' . $sf . '{$ek} = $v';
		}
    	while ( ($k,$v) = each %ROfCountry ) {
            $ek = "$RoutesOfCountryPrefix-$k";
            eval '$' . $sf . '{$ek} = $v';
    	}
    	while ( ($k,$v) = each %ROfASMetric ) {
            $ek = "$RoutesOfASMetricPrefix-$k";
            eval '$' . $sf . '{$ek} = $v';
    	}
		&UnTieSource($sf);
		undef %ROfOrigin;
		undef %ROfComm;
		undef %ROfCountry;
		undef %ROfASMetric;

		if ( $inetrtrlist ) {
			$ek = "$SpecialSearchPrefix-" . "$LOOKinetrtrKey";    # store the special inet-rtr list by its key.
			eval '$' . $sf . '{$ek} = $inetrtrlist';
            # print STDERR "\nFor key $ek, store list '$inetrtrlist'.\n" if $opt_d;
        }


		# Now store the list of all routes for this DB there.
        # ==> we could maybe just write these out above, rather than store and write now! <====
		print STDERR "\nStore RouteCommunities in files named $sf-ROUTES...\n" if $opt_d;
        if ( !open(ALLROUTESFILE,">$DBIPath/$sf-ROUTES") ) {
            print STDERR "\nERROR: couldn't open $DBIPath/$sf-ROUTES for storing route list!\n";
        }
        else {
            local($r);
            foreach $r (@AllRoutesInDB) {
                print ALLROUTESFILE " $r\n";
            }
            close ALLROUTESFILE;
		    print STDERR "Done writing $cnt route to $DBIPath/$sf-ROUTES.\n" if $opt_d;
        }

    	@end = (times);
    	printf STDERR "done (took %.2f, %.2f)\n", $end[0] - $start[0], $end[1] - $start[1] if ($opt_D || $opt_p || $opt_d);
		$fcnt++;
    }

    undef @AllRoutesInDB;

	$BuiltRouteIndicies = 1;
}


##################################################################################
#
# UpdateIndicies
#
# ActionCode						parameter
# -----------------------------		------------
# $Add/Delete-RouteASMetricCode		source,m=a,route
# $Add/Delete-RouteOriginCode		source,a,route
# $Add/Delete-RouteCommunCode		source,commname,route
# $Add/Delete-RouteCountryCode		source,countrycode,route
# $Add/Delete-SpecialCode           source,$LOOKinetrtr=ir,value (&others,if any)
# $ReIndexCode                      sources,...
#
# For adds, basic idea is:
# 1. fetch value (a blank delimited string of routes) associated with
#    the key (m,a,commname,countrycode).
# 2. if route is not in the string of routes, append it.
# 3. store (key,value) back in db file.
#
# For deletes, basic idea is:
# 1. fetch the value (a blank delimited string of routes) associated with the key.
# 2. if route is in string, delete it.
# 3. store (key,value) back in db file.
#
# For ReIndex, save sources, set sources, build indices, reset sources to orignals.
#
# Return (code,msg) to be returned to client.
#
# ===> Needs locking control???
#
##################################################################################

sub UpdateIndicies {
	local( $code, $cmdpar, $rhostname, *sources, *dbfiles ) = @_;
	local($routelist,$key,$value,$prefix,$source) = ('','','','','');
	local($rc,$rm) = ($EODReturnCode,'');

	print STDERR "\nUpdateIndicies( $code, $cmdpar, $rhostname )...\n" if $opt_d; 

	if ( !grep(/$rhostname/,@TrustedHosts) ) {
		return ($ErrorReturnCode,"Host '$rhostname' not allowed to do index updates.");
	}

	if ( $code == $ReIndexCode ) {
		local(@saveSources) = @sources;
		local(@ldbfiles) = ();
		#print STDERR "ReIndex, curSources @sources\n" if $opt_d;
		if ( ($rm = &SetSources($cmdpar,*sources,*ldbfiles,1)) ) {
			return( $ErrorReturnCode, $rm );
		}
		#print STDERR "ReIndex for sources @sources, dbfiles @ldbfiles\n" if $opt_d;
		&BuildRouteIndices( *ldbfiles, 1 );
		if ( ($rm = &SetSources(join(',',@saveSources),*sources,*dbfiles,1)) ) {
			return( $ErrorReturnCode, $rm );
		}
		#print STDERR "ReIndex done. curSources @sources\n   dbfiles @dbfiles)\n" if $opt_d;
		return( $rc, '' );
	}

	if ( ($prefix = &GetIndexPrefix($code)) eq $ErrorPrefix ) {
		return ($ErrorReturnCode, 'Illegal code for updating!');
	}

	$cmdpar =~ /^(.*)\,(.*)\,(.*)$/;
	$source = $1;
	$source =~ tr/a-z/A-Z/;
	$key = "$prefix-$2";
	$value = $3;
	($routelist,$rc,$rm) = &GetValueFromIndex( $key, $source );
	$i = index( $routelist, $value );                   # see if route is in the string
	print STDERR "$key => routelist '$routelist'\n" if $opt_d;

	if (  grep(/$code/,@AddCmdCodes) ) {
        print STDERR "Add ($code: key $key, value $value, index $i)...\n" if $opt_d;
        if ( $i >= 0 ) {
            $rc = $ErrorReturnCode;
            $rm = 'Add failed---item there already!';
        }
        else {
            $routelist .= " $value";
        }
	}
	else { # better be a delete! 
		print STDERR "Delete ( $code: key $key, value $value, index $i )...\n" if $opt_d;
		if ( $i < 0 ) {
            $rc = $ErrorReturnCode;
            $rm = 'Delete failed---item not there!';
        }
        else {
            substr($routelist,$i,length($value)+1) = '';
        }
	}

    $rc = $ErrorReturnCode;
	print STDERR "   routelist now '$routelist'.\n" if $opt_d;

	if ( 1 ) { # $rc != $ErrorReturnCode ) {
		print STDERR "     About to store changed value '$routelist'..." if $opt_d;
		if ( ($rm = &TieSource( $source, "RW" )) ) {
			$rc = $ErrorReturnCode;
		}
		else {
			eval '$' . $source . '{$key} = $routelist';
            &UnTieSource( $source );
        }
    }

    print STDERR "($$) UpdateIndices done: rc $rc, rm '$rm'.\n" if $opt_d;
    return( $rc, $rm );
}


##################################################################################
#
# GetIndexPrefix
#
# The indexed items are stored in the same db (gdbm) file.
# To distinguish them, they are stored with a prefix indicated the index type.
# Thus format is  <prefix>-<key>:<value> for the key-value pairs.
# (NB: for GetAllRoutes, the key is <prefix>-, no <key>.)
#
##################################################################################

sub GetIndexPrefix {
    local($code) = @_;

    if ( grep(/$code/,($GetRoutesByOriginCode,$AddRouteOriginCode,$DeleteRouteOriginCode)) ) {
        return( $RoutesOfOriginPrefix );
    }
    elsif ( grep(/$code/,($GetRoutesByASMetricCode,$AddRouteASMetricCode,$DeleteRouteASMetricCode)) ) {
        return( $RoutesOfASMetricPrefix );
    }
    elsif ( grep(/$code/,($GetRoutesByCountryCode,$AddRouteCountryCode,$DeleteRouteCountryCode)) ) {
        return( $RoutesOfCountryPrefix );
    }
    elsif ( grep(/$code/,($GetRoutesByCommunCode,$AddRouteCommunCode,$DeleteRouteCommunCode)) ) {
        return( $RoutesOfCommPrefix );
    }
	elsif ( grep(/$code/,($SpecialSearchCode,$AddSpecialCode,$DeleteSpecialCode)) ) {
		return( $SpecialSearchPrefix );
	}
    print STDERR "\n\n===> ERROR (GetIndexPrefix): illegal code '$code'.\n\n" ;
    return( $ErrorPrefix );
}

1;
