### Local Variables: ***
### mode:perl ***
### comment-column:0 ***
### comment-start: "### " ***
### comment-end: "***" ***
### End: ***
# 
# ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS*********************
#
# The first set of lines runs perl from any shell. The second set of lines 
# identifies the rest of the file as PERL for EMACS autoformatting. 
# See end of copyright for more information.
#
# 
# -------------------------------------------------------------------
#                                   X-BONE
#
#                          http://www.isi.edu/xbone
#                USC Information Sciences Institute (USC/ISI)
#                   Marina del Rey, California 90292, USA
#                          Copyright (c) 1998-2005
# 
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute.  The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
# 
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE.  THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
#  $RCSfile: XB_IPsec.pm,v $
#
# $Revision: 1.52 $
#   $Author: pingali $
#     $Date: 2005/03/31 07:03:55 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Lars Eggert

package XB_IPsec;
use Net::IP;
use XB_CiscoSSH;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(add delete init reset is_present key);

use strict;
use sigtrap;

use XB_Utils;
use XB_Log;
use XB_Params;


###############################################################################
# MODULE GLOBALS
###############################################################################

my %kame_aalgs = (  "md5"  => "hmac-md5",
		    "sha1" => "hmac-sha1",
		    "null" => "null" 
		 );

my %kame_ealgs = (  "des"      => "des-cbc",
		    "3des"     => "3des-cbc",
		    "simple"   => "simple",
		    "blowfish" => "blowfish-cbc",
		    "twofish"  => "twofish-cbc",
		    "cast128"  => "cast128-cbc",
 		    "aes"      => "rijndael-cbc" 
		 );

my %cisco_aalgs = ( "md5"  => "md5-hmac",
		    "sha1" => "sha-hmac",
		    "null" => "null");
		    
my %cisco_ealgs = (
		    "des" => "esp-des",
		    "3des" => "esp-3des");

my %key_lengths = ( # authentication algorithms
		    "md5"      =>  128,
		    "sha1"     =>  160,
		    "null"     => 2048, #      0-2048 bit key
		    # encryption algorithms
		    "des"      =>   64,
		    "3des"     =>  192,
		    "simple"   => 2048, #      0-2048 bit key
		    "blowfish" =>  448, #      40-448 bit key
		    "twofish"  =>  256, #       0-256 bit key
		    "cast128"  =>  128, #      40-128 bit key
		    "aes"      =>  256  # 128/192/256 bit key
		  );

# If replay protection is not disabled, older FreeBSD/KAME systems
# (like the UCL machines which run FreeBSD-3.4 + KAME-STABLE-20000425)
# fail to recover overlays after a restart of the RD.
#
# The problem manifests as tunnels being reported down; after a few
# repeated monitoring requests, they will suddenly be up again. This
# is caused by the replay protection dropping the RD ping packets.
#
# The actual bug is that while replay protection should default to "off",
# on these old KAME machines, it actually defaults to a 4-packet window,
# contrary to documentation. Setting this flag explicitly disables replay
# protection and restores funtionality.
my $enable_replay_protection = 1;

# Add random padding to IPsec overlay packets. Always a good idea.
my $enable_random_padding = 1;


###############################################################################
# UTILITY FUNCTIONS
###############################################################################

# Description: 
#	Check if argument is a hex number in 0x notation.
# Arguments:
#	$n	test string
# Returns:
#	1 on success
#	undef on failure
# Exceptions:
#	None.
#
sub check_hex ($) {
  my $n = lc shift;
  unless ($n =~ /^0x[\da-f]+$/) { 
    XB_Log::log "err", "$n is not a valid hex string";
    return undef;
  }
  return 1;
}


# Description: 
#	Check that spi is hex and in the correct range as specified in the RFC.
# Arguments:
#	$spi	spi in 0x notation
# Returns:
#	1 on success
#	undef on failure
# Exceptions:
#	None.
#
sub check_spi ($) {
  my $spi = shift;

  unless (check_hex $spi and hex $spi >= 0x100) {
    XB_Log::log "err", "SPI $spi must be between 0x100 and 0xffffffff";
    return undef;
  }
  return 1;
}


# Description: 
#	Check that a $key is in the correct form and length for algorithm $alg.
# Arguments:
#	$alg	valid algorithm name (see XB_IPsec::add)
#	$key	key in 0x notation
# Returns:
#	1 on success
#	undef on failure
# Exceptions:
#	None.
#
sub check_key ($$) {
  my ($alg, $key) = @_;

  check_hex $key;
  unless (check_hex $key and ((length $key) - 2) * 4 == $key_lengths{$alg}) { 
    XB_Log::log "err", "expected key of length $key_lengths{$alg}" .
	" for $alg, got $key with length " . (((length $key) - 2) * 4);
    return undef;
  }
  return 1;
}


###############################################################################
# GENERIC EXPORTED API
###############################################################################


# Description: 
#	Delete IPsec SA with $spi between $src and $dst. This function is 
#	idempotent.
# Arguments:
#	$src	source for SA (dotted decimal address)
#	$dst	destination for SA (dotted decimal address)
#       $dir    direction of SA, either "in" or "out"
#	$spi	spi (in "0x" hex notation)
# Returns:
#	1 on success
# Exceptions:
#	"XB_IPsec::delete" on error, nothing to clean up by caller
#
sub delete ($$$$) {
  my ($src, $dst, $dir, $spi) = @_;
  my (@output, $config_line, $cmd1, $cmd2, $Tunnel, $Tunnel1);
  
  # print trace line
  XB_Log::log "info", "-> XB_IPsec::delete $src, $dst, $dir, $spi";

  eval { 
    # IP address verification
    foreach my $addr ($src, $dst) {
      # IPv6 peek: matching IP address format
      my $n = Net::IP->new($addr);
      if (not defined $n){
	XB_Log::log "err", "illegal IP address $addr" and die "addr";
      }
    }

    # check spi
    unless (check_spi $spi) {
      XB_Log::log "err", "illegal SPI $spi" and die "spi";
    }

    # check direction
    unless ($dir =~ /^(in|out)$/) { 
      XB_Log::log "err", "illegal direction $dir" and die "dir";
    }
     
    if ($XB_Params::node_opts{os} =~ /cisco/i) {
      my $cmd = ("show running-config | begin (Current)");
      my @result = XB_CiscoSSH::show_cmd $cmd;
      @output = split "\n", $result[0];
      foreach my $each (@output) {  
        if ($each =~ /\s*(access-list\s+\d+\s+permit\s+ip\s+host\s+((\d{1,3}\.){3}\d{1,3})\s+host\s+((\d{1,3}\.){3}\d{1,3}))/) {
          if($src eq $2 and $dst eq $4) {
	    $cmd1 .= ("no $1 \n");
	  }
        }   
        if ($each =~ /\s*interface\s+(Tunnel\s*\d+)/) { $Tunnel = $1;  next; }
	if (($each =~ /\s*crypto\s+map\s+((\d{1,3}\.){3}\d{1,3})-((\d{1,3}\.){3}\d{1,3})/) and ($src eq $1 and $dst eq $3)) {
	  if (defined $Tunnel) {
	    $cmd1 .= ("interface $Tunnel \n no crypto map $src-$dst \n exit \n");
	  }
	}
      }
      # This code snippet deletes the complete SA for a given $src-$dst pair. 
      # It does not take into account the $spi and $dir, since they are not 
      # rrequired if we are interested in deleting the complete SA. If we 
      # desire to delete only outbound or inbound policies in the crypto map 
      # or if we have entries with different $spi and want to delete ones 
      # which have a given $spi, then we will have to make use of them and 
      # not delete the complete crypto map.  
      # This is not required/or supported by present XBone code, so have 
      #ignored it.  
      
      $cmd1 .= (" no crypto map $src-$dst local-address $Tunnel \n no crypto map $src-$dst 1\n exit \n");
      @output = XB_CiscoSSH::cmd $cmd1; 
    }
    else {
      # FreeBSD or Linux
      # diddle IPsec depending on host implementation
      my $pipe = "| setkey -c 1> /dev/null";
      local $SIG{PIPE} = sub { XB_Log::log "err", "Pipe $pipe broke"; };
      open PIPE, $pipe 
        or XB_Log::log "err", "cannot open pipe $pipe: $!" and die "open";

      # delete SPD entry
      my $cmd = "spddelete $src $dst any -P $dir ipsec ;\n";
      print PIPE $cmd;
      XB_Log::log "debug", $cmd;

      # delete SAD entry
      foreach my $t ("ah", "esp") {
        $cmd = "delete $src $dst $t $spi -m transport;\n";
        print PIPE $cmd;
        XB_Log::log "debug", $cmd;
      }
      close PIPE
        or XB_Log::log "err", "cannot close pipe $pipe: $!" and die "close";
    }  
  };

  # print trace line
  XB_Log::log "info", "<- XB_IPsec::delete $src, $dst, $dir, $spi";

  return 1 unless $@; # success if no exception

  # exception handling
  unless ($@ =~ /^(addr|spi|dir|open|close)/x) {
    # unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "XB_IPsec::delete: caught unexpected exception $@";
  }
  # pass defined exceptions up to caller
  die "XB_IPsec::delete";
}


# Description: 
#	Add IPsec SA between $src and $dst. If $aalg and $akey are given, an AH
#	SA will be created, if $ealg and $ekey are given, an ESP SA will be
#	created, if both are given, both AH and ESP (and not ESP with ESP-auth)
#	will be created. This function is idempotent.
# Arguments:
#	$src	source for SA (dotted decimal address)
#	$dst	destination for SA (dotted decimal address)
#       $dir    direction of SA, either "in" or "out"
#	$spi	spi (in "0x" hex notation)
#	$aalg	undef or one of: md5, sha1, null
#	$akey	undef or valid key for the chosen $aalg (in "0x" hex notation)
#	$ealg	undef or one of: des, 3des, simple, blowfish, cast128, rc5
#	$ekey	undef or valid key for the chosen $ealg (in "0x" hex notation)
# Returns:
#	1 on success
# Exceptions:
#	"XB_IPsec::add" on error (XXX: an existing SA between $src and $dst 
#	may be deleted when an exception is thrown!)
#
sub add ($$$$$$$$) {
  my ($src, $dst, $dir, $spi, $aalg, $akey, $ealg, $ekey) = @_;

  # print trace line
  my $trace_str = sprintf "XB_IPsec::add $src, $dst, $dir, $spi, %s, %s",
    (defined $aalg ? "$aalg, <akey>" : "undef, undef"),
    (defined $ealg ? "$ealg, <ekey>" : "undef, undef");
  XB_Log::log "info", "-> $trace_str";
  if($aalg =~ /undef/){ undef $aalg; }
  if($ealg =~ /undef/){ undef $ealg; }

  eval {
    if ($XB_Params::node_opts{os} =~ /cisco/i) {
      # map algorithm names to Cisco IOS 
      if(defined $aalg) { 
        if(not $cisco_aalgs{$aalg}) { 
 	  XB_Log::log "err", "unsupported authentication algorithm $aalg" 
              and die "aalg"; 
	} 
  	$aalg = $cisco_aalgs{$aalg}; 
      } 
      if(defined $ealg) { 
        if(not $cisco_ealgs{$ealg}) { 
          XB_Log::log "err", "unsupported encryption algorithm $ealg" 
              and die "ealg"; 
        } 
        $ealg = $cisco_ealgs{$ealg}; 
      }
      my ($cmd, $cmd1, $Tunnel, $Tunnel1, $access_list_number, @list_numbers,
          $interface_crypto);
      # this begin thing is a hack for my ssh module... :(
      my @cmd = ("show running-config | begin (Current)");
      my @result = XB_CiscoSSH::show_cmd @cmd;
      my @output = split "\n", $result[0];
      foreach my $each (@output) {
	if ($each =~ /\s*access-list\s+(\d+)/) {
	  if (($1 ge 100) and ($1 le 199)){
	    push @list_numbers, $1;
	  }
	  else {
	    push @list_numbers, "99";
	  }
	}
	else {
	  push @list_numbers, "99";
	}
	$access_list_number = $list_numbers[$#list_numbers] + 1; 
        if ($each =~ /\s*interface\s+(Tunnel\s*\d+)/) { $Tunnel = $1;  next; }
        if (($each =~ /\s*ip\s+address\s+((\d{1,3}\.){3}\d{1,3})\s+((\d{1,3}\.){3}\d{1,3})\s*\w*/)) { 
	  if ($1 eq $src and $dir eq "out") {
	    $cmd = ("crypto map $src-$dst local-address $Tunnel \n  crypto map $src-$dst 1 ipsec-manual \n set peer $dst \n");
	    if ($aalg and $ealg) {
	      # want both AH and ESP
	      if ($ekey =~ /^0x([\da-f]+)$/) { $ekey = $1; }
	      if ($akey =~ /^0x([\da-f]+)$/) { $akey = $1; }
	      $cmd .= ("set session-key outbound esp $spi cipher $ekey \n set session-key outbound ah $spi $akey \n set transform-set $aalg-$ealg \n"); 
	    } elsif ($aalg) {
	      # only want AH 
	      if ($akey =~ /^0x([\da-f]+)$/)  { $akey = $1; }
	      $cmd .= ("set session-key outbound ah $spi $akey \n set transform-set $aalg \n");
	    } elsif ($ealg) {
	      # only want ESP
	      if ($ekey =~ /^0x([\da-f]+)$/) {$ekey = $1; }
	      $cmd .= ("set session-key outbound esp $spi cipher $ekey \n set transform-set $ealg \n");
	    }  	  
	    $interface_crypto = ("interface $Tunnel \n crypto map $src-$dst \n exit \n");
	  }      
	  elsif ($1 eq $dst and $dir eq "in") {
	    $cmd = ("crypto map $dst-$src 1 ipsec-manual \n");
	    if ($aalg and $ealg) {
	      # want both AH and ESP
	      if ($ekey =~ /^0x([\da-f]+)$/) { $ekey = $1; }
	      if ($akey =~ /^0x([\da-f]+)$/) { $akey = $1; }
	      $cmd .= ("set session-key inbound esp $spi cipher $ekey \n set session-key inbound ah $spi $akey \n exit \n exit \n");
	    } elsif ($aalg) {
	      # only want AH
	      if ($akey =~ /^0x([\da-f]+)$/) { $akey = $1; }
	      $cmd .= ("set session-key inbound ah $spi $akey \n exit \n exit \n");
	    } elsif ($ealg) {
	      # only want ESP
	      if ($ekey =~ /^0x([\da-f]+)$/) { $ekey = $1; }
	      $cmd .= ("set session-key inbound esp $spi cipher $ekey \n exit \n exit \n"); 
	    }
	  }
	}
      }	
      if ($dir eq "out") {
	$cmd .= ("match address $access_list_number \n exit \n");
	# create the access-list
	# create the access-list before adding the match address to the crypto
	# map! else error: % Invalid access list name.
        $access_list_number = $list_numbers[$#list_numbers] + 1;
	$cmd = "access-list $access_list_number permit ip host $src host $dst \n" . $cmd;
	# apply the crypto map to the Tunnel interface
	$cmd .= $interface_crypto if defined ($interface_crypto);
      }
      foreach my $each (@output) {
        if ($each =~ /\s*interface\s+(Tunnel\s*\d+)/) { $Tunnel1 = $1;  next; }
	if ($each =~ /\s*tunnel\s+source\s+((\d{1,3}\.){3}\d{1,3})/) {
	  if ($1 eq $src) { next; }
	}
	if ($each =~ /\s*tunnel\s+destination\s+((\d{1,3}\.){3}\d{1,3})/) {
	  if ($1 eq $dst) {
	    $cmd1 = ("interface $Tunnel1 \n crypto map $src-$dst \n exit \n exit \n");
	  }
	}
      }
      $cmd .= $cmd1 if defined ($cmd1);
      # clear the existing SAs and reintialize all the configured SAs. This 
      # is required for Manual Keying only,
      # not required for IKE.
      $cmd .= ("clear crypto sa \n exit \n");
      @output = XB_CiscoSSH::cmd $cmd;
    }
    else {
    # FreeBSD or Linux
    # check dir
      unless ($dir =~ /^(in|out)$/) { 
        XB_Log::log "err", "illegal direction $dir" and die "dir";
      }

      # check authentication key and algorithm
      if (defined $aalg) {
        # check algorithm
        unless (exists $kame_aalgs{$aalg}) {
	  XB_Log::log "err", "unsupported auth algorithm $aalg" and die "aalg";
        }

        # check key
        unless (check_key $aalg, $akey) {
	  XB_Log::log "err", "invalid auth key $akey" and die "akey";
        }
        $aalg = $kame_aalgs{$aalg};
      }

      # check encryption key and algorithm
      if (defined $ealg) {
      # check algorithm
        unless (exists $kame_ealgs{$ealg}) {
	  XB_Log::log "err", "unsupported enc algorithm $ealg" and die "ealg";
        }

        # check key
        unless (check_key $ealg, $ekey) {
	  XB_Log::log "err", "invalid enc key $ekey" and die "ekey";
        }
        $ealg = $kame_ealgs{$ealg};
      }

      # IP address verification
      foreach my $addr ($src, $dst) {
      # IPv6 peek: matching IP address format
        my $n = Net::IP->new($addr);
        if (not defined $n){
	  XB_Log::log "err", "illegal IP address $addr" and die "addr";
        }
      }

      # check spi
      unless (check_spi $spi) {
        XB_Log::log "err", "illegal SPI $spi" and die "spi";
      }

      # remove previous state, if any
      XB_IPsec::delete $src, $dst, $dir, $spi;

      # add keys and selectors to database
      my $pipe = "| setkey -c 1> /dev/null";
      local $SIG{PIPE} = sub { XB_Log::log "err", "pipe $pipe broke: $!"; };
      open PIPE, $pipe 
        or XB_Log::log "err", "cannot open pipe $pipe: $!" and die "open";

      # add SAD/SPD entries
      my $cmd = "add $src $dst ";

      # specify transport mode instead of any
      my $ext = "-m transport";

      # disable replay protection if configured
      $ext .= " -r 0" unless $enable_replay_protection;

      # enable random padding if configured
      $ext .= " -f random-pad" if $enable_random_padding;

      if ($aalg and $ealg) {
        # want both AH and ESP
        $cmd .= "ah $spi $ext -A $aalg $akey;\n" . $cmd . 
	  "esp $spi $ext -E $ealg $ekey;\nspdadd $src $dst any -P $dir ipsec ".
	      "esp/transport/$src-$dst/require ".
	    "ah/transport/$src-$dst/require;\n"; 
      } elsif ($aalg) { 
        # only want AH
        $cmd .= "ah $spi $ext -A $aalg $akey;\nspdadd $src $dst any " .
	  "-P $dir ipsec ah/transport/$src-$dst/require ;\n"; 
      } elsif ($ealg) { 
        # only want ESP
        $cmd .= "esp $spi $ext -E $ealg $ekey;\nspdadd $src $dst any " .
	  "-P $dir ipsec esp/transport/$src-$dst/require ;\n";  
      }
      print PIPE $cmd;
      XB_Log::log "debug", $cmd;
      close PIPE
        or XB_Log::log "err", "cannot close pipe $pipe: $!" and die "close";
    }
  };

  # print trace line
  XB_Log::log "info", "<- $trace_str";

  return 1 unless $@; # success if no exception

  # exception handling
  unless ($@ =~ /^(dir|(a|e)key|addr|spi|open|close|XB_IPsec::delete)/x) {
    # unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "XB_IPsec::add: caught unexpected exception $@";
  }
  # pass defined exceptions up to caller
  die "XB_IPsec::add";
}


# Description: 
#	Init IPsec. Must be called once before any other IPsec function.
# Arguments:
#       none
# Returns:
#	1 on success
# Exceptions:
#	"XB_IPsec::init" on error, nothing to clean up by caller
#
sub init () {
  # print trace line
  XB_Log::log "info", "-> XB_IPsec::init";

  if ($XB_Params::node_opts{os} =~ /linux/i) {
    # Linux OS
    # Linux has no such utility, will check later
  } elsif ( $XB_Params::node_opts{os} =~ /cisco/i) {
    # Disabling the IKE
    my $cmd = ("no crypto isakmp enable \n");
    # initialize the transform sets
    # Cisco IOS 11.2 supported the command: "show crypto algorithms", which
    # is not supported anymore.
    # this creates a problem in identifying if 3DES is supported by the image 
    # installed on the router.
    # A crude way is to check from the image name.
    # eg: c2600-ik8o3s-mz.122-8.T.bin & c2600-ik9o3s-mz.122-8.T.bin
    # k8 = DES and k9 = 3DES. But this is not consistent across all images. 
    # There are more combinations.
    # Alternatively, this can be asked at the time of configuration, by placing
    # this in the xb-config.pl
    # For the moment, I have simply supported only DES, irrespective of the
    # presence of 3DES. 
									       
    my $crypto = "crypto ipsec transform-set";
    my $mode = "mode transport";
    # Use this command if 3DES is present
    # $cmd .= ("$crypto sha-hmac-esp-des ah-sha-hmac esp-des \n $mode \n exit \n  $crypto sha-hmac-esp-3des ah-sha-hmac esp-3des \n $mode \n exit \n $crypto md5-hmac-esp-des ah-md5-hmac esp-des \n $mode \n exit \n $crypto md5-hmac-esp-3des ah-md5-hmac esp-3des \n $mode \n exit \n $crypto sha-hmac ah-sha-hmac \n $mode \n exit \n $crypto md5-hmac ah-md5-hmac \n $mode \n exit \n $crypto esp-des esp-des \n $mode \n exit \n $crypto esp-3des esp-3des \n $mode\n exit \n");   
    # This command ignores 3DES!
    $cmd .= ("$crypto sha-hmac-esp-des ah-sha-hmac esp-des \n $mode \n exit \n $crypto md5-hmac-esp-des ah-md5-hmac esp-des \n $mode \n exit \n $crypto sha-hmac ah-sha-hmac \n $mode \n exit \n $crypto md5-hmac ah-md5-hmac \n $mode \n exit \n $crypto esp-des esp-des \n $mode \n exit \n exit \n");   
    
    my @output = XB_CiscoSSH::cmd $cmd;
  } else { 																			
    # Default OS (FreeBSD)	
    # init random number generator
    srand XB_Utils::rand_seed;
  
    # check if we're on a recent KAME (FreeBSD-4.5 or later)
    my @fields = split /\//, XB_Utils::sysctl_read "net.inet6.ip6.kame_version";
  
    unless ($fields[0] >= 20010528) {
      XB_Log::log "err", "Probe for KAME version failed. Aborting." 
	and die "XB_IPsec::init";
    }
  } 
  
  # print trace line
  XB_Log::log "info", "<- XB_IPsec::init";

  return 1;
}


# Description: 
#	Reset IPsec, will delete all xbone SAs.
# Arguments:
#       none
# Returns:
#	1 on success
# Exceptions:
#	"XB_IPsec::reset" on error, nothing to clean up by caller
#
sub reset () {
  # print trace line
  XB_Log::log "info", "-> XB_IPsec::reset";

  eval {
    # XXX: At this time it simply removes ALL SAs!
    XB_Log::log "warning", "Removing ALL IPsec SAs, not only X-Bone ones.";
    if ($XB_Params::node_opts{os} =~ /cisco/i) {
      my ($Tunnel, $cmd1);
      my $cmd = ("show running-config | begin (Current)");
      my @result = XB_CiscoSSH::show_cmd $cmd;
      @result = split "\n", $result[0];
      foreach my $each (@result) {
        if ($each =~ /\s*(access-list\s+\d+\s+permit\s+ip\s+host\s+((\d{1,3}\.) {3}\d{1,3})\s+host\s+((\d{1,3}\.){3}\d{1,3}))/) { 
	# if(XB_Utils::XB_is_xbone_address $2 and XB_Utils::
	  # XB_is_xbone_address $4)
          $cmd1 .= ("no $1 \n");
        }
        if ($each =~ /\s*interface\s+(Tunnel\s*\d+)/) { $Tunnel = $1;  next; }
        if (($each =~ /\s*crypto\s+map\s+((\d{1,3}\.){3}\d{1,3})-((\d{1,3}\.){3} \d{1,3})/) 
	  # and (XB_Utils::XB_is_xbone_address $1 and XB_Utils::
	  # XB_is_xbone_address $3)
	  and defined $Tunnel) {
	  $cmd1 .= ("interface $Tunnel \n no crypto map $1-$3 \n exit \n  no crypto map $1-$3 local-address $Tunnel \n no crypto map $1-$3 \n");
        }
      }      
      $cmd1 .= ("exit \n");
      my @output = XB_CiscoSSH::cmd $cmd1;
    } else {  
      # FreeBSD 	
      foreach my $opt ("-F", "-FP") {
        my @cmd = ("setkey", $opt);
        my $rc = 0xff & system(@cmd);
        ($rc == 0) 
	  or XB_Log::log "err", "@cmd failed: $!" and die "system";
      }
    }  
  };

  # print trace line
  XB_Log::log "info", "<- XB_IPsec::reset";

  return 1 unless $@; # success if no exception

  # exception handling
  unless ($@ =~ /^(system)/) {
    # unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "XB_IPsec::reset: caught unexpected exception $@";
  }
  # pass defined exceptions up to caller
  die "XB_IPsec::reset";
}


# Description: 
#	Returns a valid (spec-conforming) key for algorithm $alg in hex form.
# Arguments:
#	$alg	algorithm for which to generate key
# Returns:
#	key as hex string ("0x..." format)
# Exceptions:
#	"XB_IPsec::key" on error, nothing to clean up by caller
#
sub key ($) {
  my $alg = shift;
  my $key = "0x";

  # print trace line
  XB_Log::log "debug6", "-> XB_IPsec::key $alg";

  eval {
    unless (exists $key_lengths{$alg}) { 
      XB_Log::log "err", "unknown algorithm $alg" and die "badalg";
    }

    # this of course only works if the key length is a multiple of 4 bits
    my $len = $key_lengths{$alg} / 4;

    # patch the key together
    while (--$len >= 0) { $key .= sprintf "%1x", int rand 0xf; }
  };
  
  # print trace line
  XB_Log::log "debug6", "<- XB_IPsec::key $alg";

  return $key unless $@; # success if no exception

  # exception handling
  unless ($@ =~ /^badalg/) {
    # unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "XB_IPsec::key: caught unexpected exception $@";
  }
  # pass defined exceptions up to caller
  die "XB_IPsec::key";
}



# Description: 
#	Check if IPsec is available on a host.
# Arguments:
#	-
# Returns:
#	1 if IPsec is available, 0 otherwise.
# Exceptions:
#	-
sub is_present () {
  XB_Log::log "info", "-> XB_IPsec::is_present";
  my $result = 0;  
  
  if ($XB_Params::node_opts{os} =~ /linux/i) {
    # Linux OS
    # XXX look for setkey. Is there a better way of detecting 
    # ipsec on linux other than this?
    my $pipe = "which setkey |";
    open PATH, $pipe or 
      XB_Log::log "err", "Unable to obtain setkey information.".
	  " cannot open $pipe:$!" and die "open";
    my $path = <PATH>;     
    if (defined $path){
      close PATH or XB_Log::log "err", "cannot close pipe $pipe: $!"
         and die "close";
      if ($path ne ""){
        $result = 1; 
      }
    }      
  } elsif($XB_Params::node_opts{os} =~ /cisco/i) {
    # On Cisco IOS, check if the crypto engine is installed.
    eval { 
      my @cmd = ("show crypto engine configuration | include (crypto engine state)");
      my @output = XB_CiscoSSH::show_cmd @cmd;
      XB_Log::log "debug","IPSEC:  @output ";
      $output[0] =~ /\s*crypto\s+engine\s+state\s*:\s*(\w*)/;
      if($1 eq "installed") { $result = 1; }
      if ($result) {
	eval { init() };
	if ($@) {
	  XB_Log::log "err", "XB_IPsec::init failed with $@";
	  die "";
        }
      }    
    }; 
  } else {
  # Default OS (FreeBSD)	
    if ($XB_Params::node_opts{ipproto} =~ /(ipv4|both)/i){ 
      $result = XB_Utils::sysctl_read ('net.inet.ipsec.debug'); 
      $result = defined $result;
    }
    if (! $result and 
	($XB_Params::node_opts{ipproto} =~ /(ipv6|both)/i)){
      $result = XB_Utils::sysctl_read('net.inet6.ipsec6.debug');
      $result = defined $result;
    }
  } #else
  XB_Log::log "info", "<- XB_IPsec::is_present";
  return $result;
}

1;


syntax highlighted by Code2HTML, v. 0.9.1