### 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_Utils.pm,v $
#
# $Revision: 1.7 $
#   $Author: pingali $
#     $Date: 2005/03/31 07:04:00 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary  Authors: Yu-Shun Wang
# Original Authors: Anindo Banerjea, Gregory Finn
#
# Utility functions for XBone:
#
#   - SSL socket functions
#


#############################################
#
# Common utilities used by XBONE Perl modules.
#
#############################################

package XB_Utils;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(XB_mcast_recv_socket XB_udp_socket
             XB_obsolete XB_banner_msg);
@EXPORT_OK = qw(ssl_grep_cert ssl_accept);

use strict;
use sigtrap;

use Socket;
use Time::Local;

use XB_Params;
use XB_Log;


##############################
#
# XB_mcast_recv_socket ( \fh, ip_iface, mcast_addr, mcast_port )
#
# Obtains a multicast receive socket that is associated with the IP
# interface passed in ip_iface.  The multicast address is passed by
# mcast_addr and the port by mcast_port.
#
# ip_iface is a string and may be either a recognized host name or a
# dotted decimal address.  If it is NULL, the INADDR_ANY address is
# substituted.
#
# The filehandle used to attach to the socket is passed by reference
# in \fh.
##############################

sub XB_mcast_recv_socket ($$$$)
{
    my ($fh, $ip_iface, $mcast_addr, $mcast_port) = @_;
    my $subrname = "XB_mcast_recv_socket";
    my ($mcastaddr, $ipaddr, $mcastport, $conn_protonumber);

    XB_Log::log ("info", "->$subrname (@_)");

    if ($ip_iface)
    {
        # IPv6 arg: inet_aton
	unless ($ipaddr = inet_aton ($ip_iface))
	{ die "Cannot resolve IP address.\n"; };
    }
    else  { $ipaddr = INADDR_ANY; };

    unless ($mcastaddr = inet_aton ($mcast_addr))
    { die "Cannot resolve mcast_addr.\n"; };

    $mcast_port = pack_sockaddr_in ($mcast_port, $mcastaddr);

    unless ($conn_protonumber = getprotobyname ('udp'))
    {die "Cannot resolve UDP protocol.\n"; };

    unless (socket ($fh, PF_INET, SOCK_DGRAM, $conn_protonumber))
    {die "Cannot obtain socket: $!.\n"; };

    unless (setsockopt ($fh, SOL_SOCKET, SO_REUSEADDR, pack ("l", 1)))
    {die "Cannot reuse socket address: $!.\n"; };

    # Set the socket receive buffer large, to prevent drops when the
    # process can't receive the data fast enough. UDP has this problem
    # with perl, it seems.
    setsockopt $fh, SOL_SOCKET, SO_RCVBUF, pack ("l", $XB_Params::SO_RCVBUF)
      or die "setsockopt SO_RCVBUF $XB_Params::SO_RCVBUF: $!";
    
    unless (setsockopt ($fh, $XB_Params::SOL_IP,
			$XB_Params::IP_ADD_MEMBERSHIP,
			pack ("a4a4", $mcastaddr, $ipaddr)))
    {die "Cannot set multicast membership: $!.\n"; };

    unless (bind ($fh, $mcast_port))
    {die "Cannot bind to multicast group: $!.\n"; };

    XB_Log::log ("info", "<-$subrname");
}





##############################
#
# XB_udp_socket ( \fh, dest_addr, udp_port )
#
# Obtains a UDP socket.  The destination address is passed by dest_addr
# and the port by udp_port.  If dest_addr is false, INADDR_ANY is assumed.
#
# The filehandle used to attach to the socket is passed by reference
# in \fh.
##############################

sub XB_udp_socket ($$$)
{
    my ($fh, $dest_addr, $udp_port) = @_;
    my $subrname = "XB_udp_socket";
    my ($destaddr, $ipaddr, $mcastport, $conn_protonumber);

    XB_Log::log ("info", "->$subrname (@_)");

    if ($dest_addr)
	{
	    # IPv6 arg: inet_aton
	    unless ($destaddr = inet_aton ($dest_addr))
	    { die "Cannot resolve dest_addr.\n"; };
	}
    else { $destaddr = INADDR_ANY; };

    $udp_port = pack_sockaddr_in ($udp_port, $destaddr);

    unless ($conn_protonumber = getprotobyname ('udp'))
    {die "Cannot resolve UDP protocol.\n"; };

    unless (socket ($fh, PF_INET, SOCK_DGRAM, $conn_protonumber))
    {die "Cannot obtain socket: $!.\n"; };

    unless (setsockopt ($fh, SOL_SOCKET, SO_REUSEADDR, pack ("l", 1)))
    {die "Cannot reuse socket address: $!.\n"; };

    XB_Log::log ("info", "<-$subrname");
}


# Description: 
#	Detects and returns a value for XB_Params::NODEOS based on the
#	current system.
# Arguments:
#	-
# Returns:
#	One of: freebsd, linux, solaris, kame, nist
# Exceptions:
#	"node_os" on failure.
sub XB_IPsec::is_present ();
sub node_os () {
  XB_Log::log "info", "-> XB_Utils::node_os";
  my ($osname, $osvers, $arch);

  eval {
    # taint-safe backticks equivalent
    my $pid = open KID, "-|";
    unless(defined $pid) { die "open: $!"; }
    unless($pid) { 
      foreach my $uname ("/usr/bin/uname", "/bin/uname") {
	if(-x $uname) { exec $uname, "-msr" or die "exec: $!"; }
      }
      die "cannot find uname"; 
    }
    ($osname, $osvers, $arch) = split ' ', lc <KID>;
    close KID or die "close: $!";

    # XB_IPsec::is_present requires $XB_Params::NODEOS to be set correctly.
    my $old_osname = $XB_Params::NODEOS;
    $XB_Params::NODEOS = $osname;
    if (XB_IPsec::is_present) {
      if ($osname eq "freebsd")  { $osname = "kame"; }
      elsif ($osname eq "linux") { $osname = "nist"; }
    }
    $XB_Params::NODEOS = $old_osname;
  };
  
  XB_Log::log "info", "<- XB_Utils::node_os";
  return $osname unless $@; # success if no exception
  # exception handling
  if($@ !~ /^(open|close)/) {
    # unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "XB_Utils::node_os caught unexpected exception $@";
  }
  # pass defined exceptions up to caller
  die "node_os";
  
}


# Description: 
#	Return value of sysctl variable $var.
# Arguments:
#	$var	sysctl variable to check
# Returns:
#	value of $var if found
#	undef if $var not found
# Exceptions:
#	"sysctl_read" on failure
sub sysctl_read ($)
{
  my $var = shift; # variable to read
  my $val;
  # print trace line
  XB_Log::log "info", "-> XB_Utils::sysctl_read $var";
  eval {
  # get the value by reading from a pipe to sysctl
    my $pipe = "/sbin/sysctl -n $var 2> /dev/null |";
    open PIPE, $pipe or XB_Log::log "err", "cannot open pipe $pipe: $!" 
      and die "open";
    # read the output
    $val = <PIPE>;
    # done with pipe
    close PIPE or not $! or XB_Log::log "err", "cannot close pipe $pipe: $!" 
      and die "close";
    # post-process
    if(defined $val) { chomp $val; }
  };
  # print trace line
  XB_Log::log "info", "<- XB_Utils::sysctl_read $var";
  return $val unless $@; # success if no exception
  # exception handling
  if($@ =~ /^(open|close)/) {
    # known exception, nothing to handle, pass up
  } else {
    # unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "XB_Utils::sysctl_read: caught unexpected " .
      "exception $@";
  }
  # pass defined exceptions up to caller
  die "sysctl_read";
}

# Description: 
#	set value of sysctl variable $var.
# Arguments:
#	$var	sysctl variable to set 
#       $val    value
# Returns:
#       1 if succeed	
#	undef if fail
# Exceptions:
#	"sysctl_write" on failure
sub sysctl_write ($;$)
{
  my ($var, $val) = @_; # variable to write
  # print trace line
  XB_Log::log "info", "-> XB_Utils::sysctl_write $var $val";
  eval {
  if (not defined $val or $val eq "") { $val = 1; }
  my @cmd = ("sysctl", "-w", "$var=$val");
  XB_Log::log "debug3", "Command: @cmd";
  my $rc = 0xff & system (@cmd);
  ($rc == 0 ) or
    XB_Log::log "err",
      "Unable to set variable $var. @cmd failed : $!" and die "system";
  };
  #print trace line
  XB_Log::log "info", "<- XB_Utils::sysctl_write $var";
  return 1 unless $@; # success if no exception
  # exception handling
  if ($@ =~ /^(system)/) {
    # known exception, nothing to handle, pass up
  } else {
    # unknown exception caught, log and pass up a defined one
    XB_Log::log "warning", "XB_Utils::sysctl_write: caught unexpected " .
      "exception $@";
  }
  # pass defined exceptions up to caller
  die "sysctl_write";
}

sub rand_seed ()
{
  # init random number generator in a portable and relatively secure fashion
  my ($rand_seed, $rand_src) = (undef, undef);
  # try to find a "good" random source"
  foreach my $s ("/dev/urandom", "/dev/random") { 
    if(-e $s) { $rand_src = $s; last; } 
  }
  if(defined ($rand_src) and -e $rand_src) {
    # found good random source, now get a seed
    open RAND, $rand_src 
      or XB_Log::log "warning", "cannot open $rand_src: $!, continuing";
    if(read(RAND, $rand_seed, 4) == 4) { 
      # transmogrify into a string
      $rand_seed = unpack "L", $rand_seed;
    } else {
      # warn and discard value
      XB_Log::log "warning", 
        "cannot read 4 random bytes from $rand_src: $!, continuing";
      $rand_seed = undef;
    }
    close RAND #or not $! 
      or XB_Log::log "warning", "cannot close $rand_src: $!, continuing";
  }
  else
  {
    # we have to use a somewhat compromised seed value
    XB_Log::log "warning",
      "cannot find good random source, generated keys will be weak";
    $rand_seed = time ^ ($$ + ($$ << 15));
  }
  return $rand_seed;
}




sub XB_obsolete ()
{
    my $seconds;
    my ($day, $month, $year) =
	split /\//, $XB_Params::XBONE_VERSION_DATE;

    $seconds = timelocal (0, 0, 0, $day, $month-1, $year-1900);

    if ((time() - $seconds) >= (2 * $XB_Params::XBONE_OBSOLETE_LIMIT))
    {
	return -1;
    }
    elsif ((time() - $seconds) >= $XB_Params::XBONE_OBSOLETE_LIMIT)
    {
	return 0;
    }

    return 1;
}




sub XB_banner_msg () {
  my $msg = "\n";
  
  $msg  = "################################################################\n";
  $msg .= "Startup:  ". $FindBin::Bin ."/". $FindBin::Script . "@ARGV\n";
  $msg .= "Release:  $XB_Params::XBONE_RELEASE\n";
  $msg .= "Protocol: $XB_Params::XBONE_PROTOCOL\n";
  $msg .= "Time:     ". (scalar localtime) ."\n";
  $msg .= "################################################################\n";

  XB_Log::log "warning", $msg;
}




1;				# Make sure this file evaluates to TRUE.