#
# $Id: cross-misc.pl,v 2.9 2000/03/20 17:29:23 marek Exp $
#
# cross-misc.pl - support functions for cross-notify.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.

use lib qw/ dbmatch.pl /;

## cross-notify.pl encodes database objects as references to hashes
## rather than type globs of hashes.

## The 'Extra' entry in the hash is used to store non-attrib information that 
## the cross-notify code needs.

## First a couple of wrappers around the usual code.

# print_obj
#
# print text version of an object to given stream
# removeds the 'Extra' entry before giving a type glob to enwrite
# which does the actual work.

sub print_obj {
  my(
     $stream,			# type glob of file handle to print to
     $object			# reference to hash 
     ) = @_;

  # make a new clean object without the 'Extra' entry.

  # Eek! a 'local' object so we can pass a type glob to 'enwrite'
  undef local %clean_obj;
  my($key, $value);
  while (($key, $value) = each %{$object}) {
    unless ($key eq Extra) {
      $clean_obj{$key} = $value;
    }
  }

  enwrite($stream, *clean_obj, 1, 0, 1);
}

# source_lookup - lookup objects in a given source
#
# multiple lookup strings can be given with a ref to array of strings
# a lookup is done for each string independently (ie an OR)

sub source_lookup {

  # some variables are declared local for the type globbing.
  # so turn off strict vars
  no strict qw(vars);

  my(
     $source,		# name of source as given in source: attrib eg 'RIPE'
     $objtypes,		# ref to array of object types
     $string,		# the lookup string or ref to array of strings
     $args,		# ref to hash of extra args
     # Allless - all less specific matches
     # Allmore - all more specific matches
     # Exactmatch - non-classless exact match
     ) = @_;

  # return value - array of objects
  #
  my(@matches);

  my($options);
  $options |= $ALLMORESPECIFICOPTION if $args->{Allmore};
  $options |= $ALLLESSSPECIFICOPTION if $args->{Allless};
  $options |= $EXACTMATCHOPTION if $args->{Exactmatch};

  # default is to search all object types
  $objtypes = [ keys(%OBJATSQ) ] unless $objtypes;

  # if only a single type given wrap it in an array for consistency
  $objtypes = [ $objtypes ] unless (ref $objtypes);

  my($basename) = $DBFILE{$source};

  my ($objtype);
  foreach $objtype (@{$objtypes}) {

    my($datafilename) = $basename.'.'.$objtype;

    # skip non-existent data files
    # we are only reading so this isn't an error
    #
    next unless -f $datafilename;

    # need to be 'local' rather than 'my' as we are type globbing them.
    # the three variables define a (open) database instance
    #
    local($dbase)='dbase'; # name of database file handle
    local(@dbase)=();
    local(%dbase)=();

    local(%nullentry);     # placeholder to give to dbopen

    dbopen(*dbase, *nullentry, undef, $datafilename)
      || die "can't open [$datafilename]: $!";

    # whether this object type has a classless index
    #
    my($classlessp) = $CLASSLESSDBS{$objtype};

    # open classless index if needed
    #
    if ($classlessp) {
      &dbclopen(*nullentry, 0, $datafilename);
    }

    
    {
      my(@keys);
      if (ref $string) {
	@keys = @{$string};
      } else {
	@keys = $string;
      }

      # do the lookup - returns array of file offsets
      #
      foreach $key (@keys) {
	# a 'local' array of lookup strings
	# we need a type glob to give to dbmatch
	local(@allkeys) = $key;

	# although dbmatch looks like it will take multiple keys
	# and return the union of all the matches
	# it doesn't seem to work and I'm not going to try
	# and fix it ! - Chris
	#
	my(@offsets) = dbmatch(*dbase, *allkeys, $objtype, $options);

	foreach $offset (@offsets) {
	  local(%entry);

	  my($match) = &enread($dbase, *entry, $offset);
	  next unless %entry;	# quietly ignore not founds

	  # store the key we found and the filename we got the obj
	  # from in a 'meta' entry for Extra bits and pieces.
	  
	  $entry{Extra}->{Filename} = $datafilename;
	  $entry{Extra}->{Key} = $key;
	  push @matches, \%entry;
	}
      }
    }

    dbclclose() if $classlessp;
    dbclose(*dbase);
  }

  return @matches;
}

# find_overlaps - return list of overlapping routes
#
# routes have extra field {Extra} with Less, More or Exact set
# to indicate how specific the match was
#
# the given route object is removed from the return list
#
# returns ref to array of overlapping route objects 

sub find_overlaps {
  my(
     $source,		# source to look for overlaps in
     $route,		# the route object to test
     ) = @_;

  # convert '193.0.0.0/16' to '3238002688/16' for lookup
  #
  my($address);
  {
    my($status, $error);
    ($status, $error, $address) = netpre_to_intnetpre($route->{rt});
    return undef if $status eq $NOK;
  }

  my(@more) = source_lookup($source, ['rt'], $address, {Allmore=>1});
  foreach (@more) {$_->{Extra}->{More}++};

  my(@less) = source_lookup($source, ['rt'], $address, {Allless=>1}) ;

  # Note: source_lookup returns exact matches together with the less
  # specific matches so we have to pick out the exact matches

  foreach (@less) {
    if ($_->{rt} eq $route->{rt}) {
      $_->{Extra}->{Exact}++;
    } else {
      $_->{Extra}->{Less}++;
    }
  };

  # If we are searching the same source as our original object
  # then remove our original route from the list of less-and-exact
  # matches.
  # 
  # Note: there might be other exact matches but with a different
  #       origin.
  #
  if ($route->{so} eq $source) {
    @less = grep { !(
		     $_->{rt} eq $route->{rt} &&
		     $_->{or} eq $route->{or} &&
		     $_->{so} eq $route->{so}
		     ) } @less;
  }    

  # ref to array of route objects
  return [@less, @more];
}

# add_autnum_notifies - add cross-notify attribute of autnum to 
#                       route objects that refer to it in their origin
#
# value of autnum's cross-notify attrib is added to
#  %{$route->{Extra}->{Cross_nfy}}
#
# value of autnum's cross-mnt attrib is added to
#  %{$route->{Extra}->{Cross_mnt}}

sub add_autnum_cross_notifies  {
  my(
     $origins,		# hash of origin -> routes
     $autnums,		# array of autnum objects
     ) = @_;

  my($autnum);
  foreach $autnum (@{$autnums}) {

    # Get the values of this autnum's cross-notify: attribs

    my(@cross_nfy) = split "\n", $autnum->{cn};
    my(@cross_mnt) = split "\n", $autnum->{ct};

    # add these values to each of the autnum's route objects
    #
    my($route);
    foreach $route (@{$origins->{$autnum->{an}}}) {
      my($entry);
      foreach $entry (@cross_nfy) {
	$route->{Extra}->{Cross_nfy}->{$entry}++;
      }
      foreach $entry (@cross_mnt) {
	$route->{Extra}->{Cross_mnt}->{$entry}++;
      }
    }
  }

  # be positive about it
  return 1;
}

# add_routes_cross_notifies - 
#
# split route's own cross-notify attrib and add to list of all
# cross-notify attribs that affect this route

sub add_routes_cross_notifies  {
  my(
     $routes,		# array of routes
     ) = @_;

  my($route);
  foreach $route (@{$routes}) {

    if (exists $route->{cn}) {
      my(@nfys) = split("\n", $route->{cn});
      foreach (@nfys) {$route->{Extra}->{Cross_nfy}->{$_}++;}
    }

    if (exists $route->{ct}) {
      my(@mnts) = split("\n", $route->{ct});
      foreach (@mnts) {$route->{Extra}->{Cross_mnt}->{$_}++;}

    }
  }

  return 1;
}

# build_hash_of_referenced_objs
#
# build list of all unique values from all cross-notify attributes.
# returns references to two hashs one for nic-hdls, one for mntners

sub build_hash_of_referenced_objs {
  my($routes) = @_;

  my(%cross_nfy);
  my(%cross_mnt);

  my($route);

  foreach $route (@{$routes}) {

    my ($value, $count);
    while (($value,$count) = each %{$route->{Extra}->{Cross_nfy}}) {
      push @{$cross_nfy{$value}}, $route;
    }

    while (($value,$count) = each %{$route->{Extra}->{Cross_mnt}}) {
      push @{$cross_mnt{$value}}, $route;
    }

  }

  return (\%cross_nfy, \%cross_mnt);
}


# find_origins
#
# build and return a hash
#  key is origin of route
#  value is array of routes with that origin

sub find_origins {
  my($routes) = @_;

  my(%origins);

  # populate %origins
  my($route);
  foreach $route (@{$routes}) {
    my($key) = $route->{or};
    push @{$origins{$key}}, $route;
  }

  return \%origins;
}


# send_nfy_message
#
# send a notice to given email address of added or removed overlap
# message is stored in a temporary file and actually sent after the
# update notifications.

sub send_nfy_message {

  my(
     $recipient,		# Email address of recipient
     $object,			# updated route object
     $routes,			# array of route objects
     $isnew,			# 'true' if due to object being added
				# otherwise object was removed
     ) = @_;

  print "To: $recipient\n";

  # print subject line (configured in ripedb.config)
  if ($isnew) {
    print $::CROSSNFY_SUBJECT_OVERLAP_ADDED;
  } else {
    print $::CROSSNFY_SUBJECT_OVERLAP_REMOVED;
  }

  # separator between message headers and body
  print "\n";

  # print expanation
  if ($isnew) {
    print $::CROSSNFY_EXPLAIN_OVERLAP_ADDED;
  } else {
    print $::CROSSNFY_EXPLAIN_OVERLAP_REMOVED;
  }

  print "\n";
  print $object;
  print "\n";

  # Something like "It overlaps with your routes.."
  print $::

  print "\n";
  print "EXACT MATCHES\n";
  print "\n";

  my($route);

  foreach $route (@{$routes}) {
    if ($route->{Extra}->{Exact}) {
      print_obj (STDOUT, $route);
    }
  }
  print "\n";
  print "MORE SPECIFIC MATCHES\n";
  print "\n";

  foreach $route (@{$routes}) {
    if ($route->{Extra}->{More}) {
      print_obj (STDOUT, $route);
    }
  }
  print "\n";
  print "LESS SPECIFIC MATCHES\n";
  print "\n";

  foreach $route (@{$routes}) {
    if ($route->{Extra}->{Less}) {
      print_obj (STDOUT, $route);
    }
  }
}


# create_mail_to_updater
#
# send notice to the updater

sub create_mail_to_updater {
  my($originator, $object, $routes, $addition) = @_;

  ## send notice to originator of update of object
  return do_mail($originator, $object, $routes,
		 $addition ? \%::CN_ADD : \%::CN_DEL,
		 );
}


# create_mail_to_others
#
# send message to those addresses refered to by the cross-*: attribs
#
# Text for messages is taken from config file
#
# $addition indicates whether the update was adding a new object or deleting
# an old object. A 'true' value indicates it was an addition.

sub create_mail_to_others {
  my(
     $email_addresses,		# hash of addresses and associated routes
     $object,			# the updated object
     $addition,			# whether or not a new object
     ) = @_;

  my(@mailfiles);

  while (($email_address, $overlaps) = each %{$email_addresses}) {

    push @mailfiles, do_mail($email_address, $object, $overlaps,
			     $addition ? \%::CNO_ADD : \%::CNO_DEL,
			     );
  }
  
  return @mailfiles;
}

# do_mail
#
# actually generate the mail message

sub do_mail {
  my ( 
      $recipient,		# email address
      $object,			# updated object
      $overlaps,		# array of overlapping routes
      $texts,			# hash of texts for message
      ) = @_;

  my $filename = cross_notify_tmp_filename($recipient);

  unless (open(MAIL, ">$filename")) {
    &syslog("ERRLOG",
	    "Cannot create cross notification message file [$filename]");
    return 1;
  }

  ### DEBUG
  # if our special env variable exists use its value as recipient
  # and include an extra header with the intended recipient
  #
  if (exists $ENV{RIPEDB_CN_RECIP}) {
    print MAIL "X-RIPEDB-CN-REALLY-TO: $recipient\n";
    $recipient = $ENV{RIPEDB_CN_RECIP} 
  }

  print MAIL "From: $HUMAILBOX\n" if $HUMAILBOX;
  print MAIL "To: $recipient\n";
      
  # print subject line
  print MAIL $texts->{SUBJECT};

  # separator between message headers and body
  print MAIL "\n";

  # print explanation
  # Something like "Your update to the following object..."
  print MAIL $texts->{EXPLAIN};

  print MAIL "\n";
  print_obj (*MAIL, $object);
  print MAIL "\n";

  # Something like "It overlaps with your routes.."
  print MAIL $texts->{OVERLAP};

  print MAIL "\n";

  print_matches(*MAIL, $overlaps, 'Exact', 'EXACT MATCHES');
  print_matches(*MAIL, $overlaps, 'More',  'MORE SPECIFIC MATCHES');
  print_matches(*MAIL, $overlaps, 'Less',  'LESS SPECIFIC MATCHES');

  close MAIL || &syslog("ERRLOG",
			"Couldn't close [$filename]");

  return $filename;
}

# print_matches
#
# print the maching routes in three sections depending on 
# more or less specific match

sub print_matches {
  my($output, $overlaps, $type, $text) = @_;

  my (@matches) = grep {exists $_->{Extra}->{$type}} @{$overlaps};

  # don't print anything if there are no matches.
  return unless @matches;

  print $output $text; 
  print $output "\n";

  foreach $route (@matches) {
    print_obj ($output, $route);
    print $output "\n";
  }
}

# return a unique temporary filename based on the argument given
# usually the address of the recipient of the message.
#
# would be nice to use C's mkstemp - Sigh.

sub cross_notify_tmp_filename {
  my($recipient) = @_;

  my($filename);

  # strip out any 'funny' characters that might do something weird

  $recipient =~ s/[^\w\d]/_/g;

  my $random = int rand 32768;
  $filename = "${TMPDIR}/cn_${recipient}_${$}_${random}";

  # should check here that the file doesn't already exist

  return $filename;
}

1;
