eval '(exit $?0)' && eval 'PERL=`which perl5`; exec $PERL -wS $0 ${1+"$@"}'
& eval 'setenv PERL `which perl5`; exec $PERL -wS $0 $argv:q'
if 0;
### 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-node-daemon.pl,v $
#
# $Revision: 1.146 $
# $Author: pingali $
# $Date: 2005/04/21 00:25:13 $
# $State: Exp $
# ----------------------------------------------------------------------------
# The first lines start PERL on any system where perl is in the path.
# This is a modified version of the "start perl" script provided in
# the PERL man pages, which starts perl on the remainder of the file
# regardless of whether it is run under sh, csh, or perl.
#
# This version is modified to dynamically locate the perl path, rather
# than requiring it be hard-coded.
# set library search path
BEGIN {
use strict;
use sigtrap;
use FindBin;
use Config;
delete $ENV{PATH};
my $version = $Config{'version'};
my $arch = $Config{'archname'};
my $ldir = $FindBin::RealBin;
foreach my $p ($ldir,
"$ldir/modules",
"$ldir/modules/cpan",
"$ldir/modules/cpan/lib/perl5/$version",
"$ldir/modules/cpan/lib/perl5/$version/$arch",
"$ldir/modules/cpan/lib/perl5/site_perl/mach",
"$ldir/modules/cpan/lib/perl5/site_perl/mach/$arch",
"$ldir/modules/cpan/lib/perl5/site_perl/$version",
"$ldir/modules/cpan/lib/perl5/site_perl/$version/$arch",
"$ldir/modules/cpan/lib/perl5/site_perl/$version/mach",
"$ldir/modules/cpan/lib/perl5/site_perl/$version/mach/$arch",
) {
if(-d $p) { unshift @INC, $p; }
}
# untaint the resulting include path so "use" works
foreach my $i (@INC) { if($i =~ /(.*)/) { $i = $1;} }
};
##############################################################################
# END OF PREFIX - PUT YOUR PERL CODE BELOW #
##############################################################################
# Primary Author: Yu-Shun Wang
# Description: This is the new XBone daemon main program file.
# Notes:
# - TODO: Grep for "TODO"s, those are unfinished tasks & too many of them.
use strict;
use warnings;
use diagnostics;
use Getopt::Long;
use Data::Dumper;
use FindBin;
use IO::Socket;
use IO::Select;
use Net::hostent;
use AppConfig;
use AppConfig::Getopt;
use File::Temp qw(tempfile tempdir);
use LWP::UserAgent;
use IO::Socket::SSL 0.92;
use IO::Socket::Multicast;
use IO::Socket::SSLv6;
use IO::Socket::Multicast6;
use Socket6;
use vars qw(@ISA);
use XB_Params;
use XB_Log;
use XB_API;
use XB_Common;
use XB_CTL;
use XB_CTL_parser;
use XB_IPsec;
use XB_SMIME;
use XB_VN_funcs;
use XB_VN_IPalloc;
use XB_VN_DNS;
use XB_XML_GUI;
use XB_XML_scan;
use XB_LDAP;
#use sigtrap;
#use POSIX "sys_wait_h";
#use Config;
# flags for Data::Dumper
$Data::Dumper::Indent = 1;
$Data::Dumper::Purity = 1;
my $modname = "Main::";
# configuration options:
%XB_Params::node_opts = (
"auto" => $XB_Params::auto,
# basic configuration options
"conf" => $XB_Params::conf,
"workdir" => $XB_Params::workdir,
"state_file" => $XB_Params::state_file,
"pidfile" => $XB_Params::pidfile,
"daemon_type" => $XB_Params::daemon_type,
"background" => 0 ,
# node IP config options
"hostname" => `hostname`,
"ctl_addr" => $XB_Params::ctl_addr,
"ctl_addr6" => $XB_Params::ctl_addr6,
"app_addr" => $XB_Params::app_addr,
"app_addr6" => $XB_Params::app_addr6,
# XBone network parameters
"ipproto" => $XB_Params::ipproto,
"xbone_mcast_addr" => $XB_Params::xbone_mcast_addr,
"xbone_mcast_addrv6" => $XB_Params::xbone_mcast_addrv6,
"xbone_api_port" => $XB_Params::xbone_api_port,
"xbone_ctl_port" => $XB_Params::xbone_ctl_port,
# logging options
"log_dest" => $XB_Params::log_dest,
"log_mask" => $XB_Params::log_mask,
"log_file" => $XB_Params::log_file,
# X.509 certificate & key info
"node_cert" => $XB_Params::node_cert,
"node_key" => $XB_Params::node_key,
"ca_cert" => $XB_Params::ca_cert,
"ca_path" => $XB_Params::ca_path,
# ACLs: for overlay manager & users
"ovl_manager" => \@XB_Params::ovl_manager,
"user_acl" => \%XB_Params::user_acl,
"shared_user_acl" => [{}], #empty shared acl list
# features & capabilities
# - os [should only set these for buddy host; i.e., Cisco]
"os" => $XB_Params::os,
"os_version" => $XB_Params::os_version,
"kern_version" => $XB_Params::kern_version,
"node_arch" => $XB_Params::node_arch,
# - routing (static vs. dynamic)
"routing" => $XB_Params::routing,
# - ipsec
"IPsec" => $XB_Params::IPsec,
# - qos
"qos" => $XB_Params::qos,
# - [optional] address server options
"addrserv" => $XB_Params::addrserv,
"netv4" => $XB_Params::netv4,
"netv6" => $XB_Params::netv6,
"addr_server" => $XB_Params::addr_server,
# legacy options
"address_type" => $XB_Params::address_type,
"control_protocol" => $XB_Params::control_protocol,
"linkv4" => $XB_Params::linkv4,
"linkv6" => $XB_Params::linkv6,
# - [optional] DDNS (Dynamic DNS update) server/zone/key info
"xbone_net" => $XB_Params::XBONE_NET,
"dns" => $XB_Params::dns,
"name_server" => $XB_Params::name_server,
"forward_zone" => $XB_Params::forward_zone,
"reverse_zone" => $XB_Params::reverse_zone,
"reverse_zone6" => $XB_Params::reverse_zone6,
"dns_key_file" => $XB_Params::dns_key_file,
# - [optional] Dynamic routing options
"zebra_dir" => $XB_Params::zebra_dir,
# - [optional] Force router options
"force-router" => 0,
# - [optional] Cisco platform options
"cisco_buddy_username" => $XB_Params::CISCO_BUDDY_USERNAME,
"cisco_buddy_password" => $XB_Params::CISCO_BUDDY_PASSWORD,
"cisco_buddy_enable_password"=> $XB_Params::CISCO_BUDDY_ENABLE_PASSWORD,
# - [optional] register attributes
"register" => \%XB_Params::register,
# - [optional] Ldap options
"ldap" => \%XB_Params::ldap,
);
# array of option descriptions for Getopt::Long & AppConfig
my @opts_spec = (
"auto|a=s", # disable automatic mode
# basic configuration options
"conf|c=s", # config file
"workdir|w=s", # working dir
"state_file|s=s", # state file
"pidfile|pid=s", # state file
"daemon_type|t=s", # daemon type
"background|bg", # run in the background
# node IP config options
"hostname|h=s", # hostname
"ctl_addr|caddr=s", # addr for control connection IPv4
"ctl_addr6|caddr6=s", # addr for control connection IPv6
"app_addr|aaddr=s", # addr for app/data connection IPv4
"app_addr6|aaddr6=s", # addr for app/data connection IPv6
# XBone network parameters
"ipproto|ip=s",
"xbone_mcast_addr|mcast=s",
"xbone_mcast_addrv6|mcastv6=s",
"xbone_ctl_port|ctl=i",
"xbone_api_port|api=i",
# logging options
"log_dest|d=i",
"log_mask|m=s",
"log_file|l=s",
# X.509 certificate & key info
"node_cert|cert=s",
"node_key|key=s",
"ca_cert|ca=s",
"ca_path|cp=s",
# ACLs: for overlay manager & users
"ovl_manager|om=s@",
"user_acl|acl=s%",
# node features & capabilities
# - os [should only set these for buddy host; i.e., Cisco]
"os=s",
"os_version|over=s",
"kern_version|kver=s",
"node_arch|arch=s",
# - routing/IPsec/QoS
"routing|rt=s",
"IPsec|sec=s",
"qos|q=s",
# address server options [optional]
"addrserv|as", # enable address server / IP allocator
"netv4|n4=s", # - Overlay net v4 block
"netv6|n6=s", # - Overlay net v6 block
"addr_server|asname=s", # remote address server
# legacy options
"address_type|atype=s",
"control_protocol|cc=s",
"linkv4|l4=s", # - Overlay link v4 block
"linkv6|l6=s", # - Overlay link v6 block
# DNS related options
"xbone_net|xb=s",
"dns=s",
"name_server|ns=s",
"forward_zone|fzone=s",
"reverse_zone|rzone=s",
"reverse_zone6|rzone6=s",
"dns_key_file|dnskey=s",
# Dynamic routing related options
"zebra_dir|zd=s",
# Force router option
"force-router|fr",
# Cisco platform option
"cisco_buddy_username|ciscouname=s",
"cisco_buddy_password|ciscopw=s",
"cisco_buddy_enable_password|ciscoenpw=s",
# variables to be registered with the main xbone daemon
"register|reg=s%",
# variables to be registered with the main xbone daemon
"ldap=s%",
);
#=> command line option & config file option hashes
my %cmdl_opts; # hash of args from command line
my $file_opts; # obj of args from config file
my $ldap_opts; # obj of args from ldap server
#=> socket handles
my ($api_sock, $ctl_sock, $mcast_send_sock, $mcast_recv_sock);
my ($api_sock6, $ctl_sock6, $mcast_send_sock6, $mcast_recv_sock6);
my ($sel, @ready);
#=> timer
my ($now, $next_refresh, $next_data_refresh, $next_check);
#=> state variable:
%XB_Params::node_state = (
"state" => "idle",
"node" => "",
"creator" => "",
"application" => "",
"name" => "",
"start" => 0,
"level" => 0
);
# ============================================================================
# Program structure of X-Bone node daemon:
# ============================================================================
# X-Bone node main blocks:
# o Initialization
# - configuration variables:
# - command line, configuration file, default values
# - paths & files:
# - log file, state file, cert/key, temp file system
# - initialization & verification of system capabilities
# - logging, ACL, OS, IP, IPsec, QoS, IP address server, etc.
# - read & restore state file
# - bind sockets
# o Main loop
# - periodic tasks: refresh/heartbeat, expiration checks
# - listen on socket
# - switch based on incoming messages & events
# - exception handling
# - termination
# - clean up - files, states, systems
# - exit
# ============================================================================
# ========================================================================
# Process Command Line & Configuration File Options
# ========================================================================
# Description:
# Get options from command line and config file. Option precedence:
# Command Line > Configuration File > LDAP configuration > Default in XB_Params.pm
# Arguments:
# -
# Returns:
# -
# Exceptions:
# -
sub get_opts {
#=> get command line options
if (GetOptions(\%cmdl_opts, @opts_spec)==0) {
print "Usage: ./xb-node-daemon.pl [<option>]\n";
print "The following options are supported\n";
foreach my $opt (@opts_spec){
$opt =~ s/=s/ = <value>/;
print "\t$opt\n";
}
exit;
}
#=> get conf file options
my $have_conf = 1;
$XB_Params::node_opts{conf} = defined $cmdl_opts{conf} ?
$cmdl_opts{conf} : $XB_Params::node_opts{conf};
unless (-f $XB_Params::node_opts{conf}){
warn "! Could not find XBone config file: $XB_Params::node_opts{conf}";
$have_conf = 0;
}else{
$file_opts = AppConfig->new(@opts_spec);
$file_opts->file($XB_Params::node_opts{conf}) or
warn "! Error parsing XBone conf file: $XB_Params::node_opts{conf}"
and die "parse";
}
#=> Check the auto mode. more to follow?
if (defined $cmdl_opts{auto} ) {
if ($cmdl_opts{auto} =~ /(yes|no)/i){
$XB_Params::node_opts{auto} = $cmdl_opts{auto};
} else {
warn "Incorrect command line. Automode option syntax is ".
"[[--auto|-a] [yes|no]";
die "parse";
};
};
#=> compute and get the ldap information.
get_ldap_opts($file_opts, \%cmdl_opts);
#=> Compute node options by merging command line options, conf file
#and ldap options
for my $n (keys %XB_Params::node_opts){
# The following are sets and they have to be treated
# slightly differently.
next if ($n =~ /(ldap|user_acl|ovl_manager|register)/);
if (defined $cmdl_opts{$n}){ # command line
$XB_Params::node_opts{$n} = $cmdl_opts{$n};
} elsif ((defined $file_opts) and (defined $file_opts->get($n))){ # conf file
$XB_Params::node_opts{$n} = $file_opts->get($n);
} elsif ((defined $ldap_opts) and (defined $ldap_opts->get($n))){ # ldap
$XB_Params::node_opts{$n} = $ldap_opts->get($n);
};
};
# cleanup the result from `hostname`
chomp($XB_Params::node_opts{hostname});
#=> Handle Overlay Manager List. Let command line override
# conf file, and conf file transitively override ldap.
my (@mgrarr) = ();
@mgrarr = @{$cmdl_opts{'ovl_manager'}}
if (defined $cmdl_opts{'ovl_manager'});
if ($#mgrarr == -1){
@mgrarr = @{$file_opts->get('ovl_manager')}
if ((defined $file_opts) and (defined $file_opts->get('ovl_manager')));
}
if ($#mgrarr == -1){
@mgrarr = @{$ldap_opts->get('ovl_manager')}
if ((defined $ldap_opts) and (defined $ldap_opts->get('ovl_manager')));
}
$XB_Params::node_opts{'ovl_manager'} = \@mgrarr;
#=> Handle ACL Rules compute the acl union. conflicts between acl
#rules of the different sites is handled through offline control.
my (@aclarr) = ();
push @aclarr, $ldap_opts->get('user_acl')
if ((defined $ldap_opts) and (defined $ldap_opts->get('user_acl')));
push @aclarr, $file_opts->get('user_acl')
if ((defined $file_opts) and (defined $file_opts->get('user_acl')));
push @aclarr, $cmdl_opts{'user_acl'}
if (defined $cmdl_opts{'user_acl'});
# process ACLs. the order is important
foreach my $map (@aclarr){
# process each map separately
foreach my $key (keys %{$map}){
$XB_Params::node_opts{user_acl}->{$key} = $map->{$key};
}
};
#=> Handle the register commands
if ((keys %{$cmdl_opts{'register'}}) > 0){
$XB_Params::node_opts{register} = $cmdl_opts{'register'};
} elsif ((defined $file_opts) and ((keys %{$file_opts->get('register')}) > 0)){
$XB_Params::node_opts{register} = $file_opts->get('register');
} elsif ((defined $ldap_opts) and ((keys %{$ldap_opts->get('register')}) > 0)){
$XB_Params::node_opts{register} = $ldap_opts->get('register');
};
# debugging outputs
#print ">>> ", Dumper(\%cmdl_opts), "\n";
#print ">>> ", Dumper(\%XB_Params::node_opts), "\n";
#print ">>> ", Dumper($ldap_opts), "\n";
#print ">>> ", Dumper($file_opts), "\n";
#print ">>> ACL: ", Dumper($XB_Params::node_opts{user_acl});
};
# Description:
# Obtain the certificates from the LDAP server and stores it
# in ca_path. c_rehash is run to generate the appropriate hashes
# later use by OpenSSL.
# Arguments:
# force the running of c_rehash (during initialization)
# Returns:
# -
# Exceptions:
# -
sub refresh_shared_data (;$) {
my ($force) = @_;
my $capath = $XB_Params::node_opts{ca_path};
my $procname = "refresh_shared_data";
my $results = "";
$force = 0 if (not defined $force);
XB_Log::log "info", "-> $modname$procname $force";
# Search where?
my $scope = $XB_Params::node_opts{ldap}->{scope};
eval {
#=> If LDAP is enabled, grab the certificates
if ($XB_Params::node_opts{"ldap"}->{enable} =~ /(yes)/){
# Process the shared ACLs first...
eval {
#=> get shared ACLs
my %shared_user_acl = ();
#=> Read from the LDAP server and ignore incorrect entries
#=> Rules might get overwritten and we cannot do anything
#=> about that
$results = XB_LDAP::LDAP_search("acl", $scope);
foreach my $h (keys %{$results}){
next if ($h eq ""); # safety check
#=> Extract all the collected acls
my $attrlist = $results->{$h}{'xbacl'};
foreach my $attrval (@{$attrlist}){
$attrval =~ s/\'//g; # remove the quotes
my ($no, $rule) = split(/\s*=\s*/, $attrval);
if ((not defined $no) or ($no le 0) or
(not defined $rule) or ($rule eq "")) {
XB_Log::log "err",
"Ignoring Rule: \"$no = $rule\" from ".
"$h because the number or rule itself are".
" undefined or incorrect";
next;
};
$shared_user_acl{$no} = $rule;
}; # cover shared ACLs introduced by one host
}; # cover all hosts
#=> Overwrite the previous copy of the ACLs
my $ignore = 1;
$XB_Params::node_opts{"shared_user_acl"} =
XB_Common::parse_user_acl(\%shared_user_acl, $ignore);
};
# Ignore the errors but reset this variable so that
# code elsewhere does not bomb
$XB_Params::node_opts{shared_user_acl} = [{}] if ($@);
undef $@;
}; # if ldap is enabled
#=> clean up the hashes and CAs that have been downloaded
if ($force) {
my $cmd = "/bin/ls -1 $capath |";
open(DIR, $cmd) or
XB_Log::log "err",
" [$procname] Cannot list the directory entries $!"
and die ("dir");
while(<DIR>){
my $f = $_;
chomp($f);
unlink "$capath/$f" if ($f =~ /^(.*\.0|TMPCA.*)$/);
}
close(DIR);
};
#=> If LDAP is enabled, grab the certificates
if ($XB_Params::node_opts{"ldap"}->{enable} =~ /(yes)/){
$results = XB_LDAP::LDAP_search("ca", $scope);
foreach my $h (keys %{$results}){
next if ($h eq ""); # safety check
my $count = 0;
my $calist = $results->{$h}{'cACertificate;binary'};
my $crllist =
$results->{$h}{'certificateRevocationList;binary'};
foreach my $der (@{$calist}, @{$crllist}){
#=> store the certificate
my $derout = "$capath/TMPCA.$h.$count.der";
my $pemout = "$capath/TMPCA.$h.$count.pem";
open(DER, ">$derout") or
XB_Log::log "err",
" [$procname] Couldnt store the certificates"
and die ("file");
print DER $der;
close(DER);
#=> convert it into pem
my @cmd = ("openssl", "x509",
"-inform", "DER", "-outform", "PEM",
"-in", $derout, "-out", $pemout);
my $rc = 0xff & system(@cmd);
($rc == 0) or
XB_Log::log "err", "@cmd failed : $!"
and die("syscall");
#=> unlink the
unlink $derout;
#=> counter...
$count++;
};
};
$force = 1;
};
# All the stuff to be grabbed has been. So generate the hashes.
if ($force) {
my @cmd = ("c_rehash", $capath);
my ($rc, $msg) = XB_Common::execcmd(\@cmd);
XB_Log::log "debug5", "Executed c_rehash after downloading".
" the certificates. Output=\"$msg\"\n";
($rc == 0) or XB_Log::log "err", "@cmd failed : $!" ;
# Dont exit
};
}; # eval
XB_Log::log "info", "<- $modname$procname $@";
return 1 unless $@;
unless($@ =~ /\b(dir|file|syscall)\b/) {
XB_Log::log "warning", " ! $procname caught unknown exception: $@";
}
return 0;
};
# Description:
# Get options from LDAP Server
# Called from main getopts
# Notes: By the time control comes here the node_opts has not been
# completely updated because of the precedence - LDAP information
# has to be obtained first before applying the configuration file
# options or the command line options. We have to however use any
# certificate or hostname information from the conf file and
# command line.
# Arguments:
# -
# Returns:
# -
# Exceptions:
# -
sub get_ldap_opts ($$){
my ($file_opts, $cmdl_opts) = @_;
eval {
#=> compute the information required to lookup the LDAP server.
my $have_ldap = 0;
my %ldapconf = ();
################################################
# Get the LDAP connectivity information in place
################################################
#=>initialize from XB_Params settings
foreach my $attr (keys %XB_Params::ldap){
$ldapconf{$attr} = $XB_Params::node_opts{ldap}->{$attr};
}
$ldapconf{'hostname'} = $XB_Params::node_opts{hostname};
chomp($ldapconf{'hostname'});
$ldapconf{'ca_cert'} = $XB_Params::node_opts{ca_cert};
$ldapconf{'ca_path'} = $XB_Params::node_opts{ca_path};
$ldapconf{'node_cert'} = $XB_Params::node_opts{node_cert};
$ldapconf{'node_key'} = $XB_Params::node_opts{node_key};
#=> override default values with those specified in the conf file.
if (defined $file_opts){
my $ldaphash = $file_opts->get('ldap');
if (defined $ldaphash) {
foreach my $attr (keys %{$ldaphash}){
$ldapconf{$attr} = $ldaphash->{$attr};
};
}
foreach my $attr ('ca_cert', 'ca_path',
'node_key', 'node_cert', 'hostname'){
if (defined $file_opts->get($attr)){
$ldapconf{$attr} = $file_opts->get($attr);
};
};
};
#=> finally override with specification from the command line.
my $ldapcmdl = $cmdl_opts->{'ldap'};
if (defined $ldapcmdl) {
#copy the parameters over
foreach my $attr (keys %{$ldapcmdl}){
$ldapconf{$attr} = $ldapcmdl->{$attr};
};
};
foreach my $attr ('ca_cert','ca_path',
'node_key','node_cert','hostname'){
if (defined $cmdl_opts->{$attr}){
$ldapconf{$attr} = $cmdl_opts->{$attr};
};
};
if ($ldapconf{'enable'} =~ /(yes)/i){
if ((not defined $ldapconf{"instance"}) or
($ldapconf{"instance"} eq "")){
XB_Log::log "err",
"LDAP host configuration instance not ".
"defined. Typically each host is associated ".
"with multiple configuration instances ".
"corresponding to different installations/OSes. ".
"Edit xbone configuration file to correctly ".
"identify the instance name. Add:\n\n\t\tldap ".
"instance = <instance-name>\n\n";
die("instance");
}
# udpate the node_opts
$XB_Params::node_opts{'ldap'} = \%ldapconf;
################################################
# Now read the LDAP information
################################################
my @args = ();
my ($results, $attrlist, $attrval);
# receive the settings from the ldap server and process them
# as if they have come from the command line.
#my (@arr) = split(/\$/, $attrval);
#push @args, $arr[0] . " = " . $arr[1];
#=> Obtain the configuration information
push @args, "\n#\n# Configuration Entries --- \n#\n";
eval {
$results = XB_LDAP::LDAP_search("config", "local");
};
if ($@) {
#basic ldap connection has failed. so disable ldap
if ($XB_Params::node_opts{auto} =~ /yes/i ){
$@ = ""; # eliminate the exception message
XB_Log::log "notice", "Automode warning: Disabled LDAP ".
"because connection to server failed.";
$ldapconf{enable} = "no";
} else {
XB_Log::log "info", "Cannot obtain configuration.".
" Connection to server failed.";
die("ldap");
}
} else {
$attrlist = $results->{$ldapconf{'hostname'}}{'xbattr'};
foreach my $attrval (@{$attrlist}){
#XB_Log::log("debug1", "xbattr: $attrval");
$attrval =~ s/\'//g; # remove the quotes
push @args, $attrval;
} # foreach attribute
#=> get host registry settings
$attrlist =
$results->{$ldapconf{'hostname'}}{'xbregister'};
foreach $attrval (@{$attrlist}){
#XB_Log::log("debug1", "xbregister: $attrval");
$attrval =~ s/\'//g; # remove the quotes
push @args, "register " . $attrval;
}
#=> get host-specific ACLs
push @args, "\n#\n# Host-specific ACLs from " .
$ldapconf{'hostname'} . "\n#\n";
$attrlist = $results->{$ldapconf{'hostname'}}{'xbacl'};
foreach $attrval (@{$attrlist}){
#XB_Log::log("debug1", "xbacl: $attrval");
$attrval =~ s/\'//g; # remove the quotes
push @args, "acl " . $attrval;
}
};
#=> Dump and process the replies
# create a temporary because the AppConfig;:getopt does not
# seem to function like AppConfig->file(). Also automatically
# destroy the file when we return from this function.
my ($fh, $filename) = tempfile( "/tmp/xbone.XXXXXXXXXX",
SUFFIX => '.conf');
print $fh join ("\n", @args);
print $fh "\n";
close $fh;
$ldap_opts = AppConfig->new(@opts_spec);
$ldap_opts->file($filename) or
warn "! Error parsing XBone conf file: $filename"
and die "parse";
unlink $filename;
};
}; # eval
return 1 unless ($@);
unless($@ =~ /(ldap|instance)/){
XB_Log::log "err",
"$modname: Node Daemon initialization failed. ".
"Function \"init\" caught unknown exception: $@";
};
die ("ldap");
};
# ========================================================================
# Initialization & Checks
# ========================================================================
# Description:
# Initialize and check all the paths, necessary files, settings.
# Arguments:
# -
# Returns:
# -
# Exceptions:
# -
sub init {
# file which would be updated
my $conf = $XB_Params::node_opts{"conf"};
eval{
#-----------------------------------------------------------------------
# 1. process config file & cmd-line options to $XB_Params::node_opts
#-----------------------------------------------------------------------
get_opts;
#-----------------------------------------------------------------------
# 2. sanity check of the configuration
#-----------------------------------------------------------------------
my @types = ("host", "router", "node", "meta");
my @match = grep { $_ eq $XB_Params::node_opts{'daemon_type'} } @types;
unless ($#match > -1){
XB_Log::log "err", "! Node Daemon initialization failed. ".
"Unknown daemon_type ". $XB_Params::node_opts{'daemon_type'}.
"\n";
die("config");
}
unless ($XB_Params::node_opts{'auto'} =~ /(yes|no)/i){
XB_Log::log "err", "Node Daemon initialization failed. ".
"auto mode setting incorrect. Automode setting should ".
" yes or no e.g., xb-node-daemon --auto yes ";
die("config");
}
unless ($XB_Params::node_opts{'xbone_ctl_port'} !~
$XB_Params::node_opts{'xbone_api_port'}) {
XB_Log::log "err", "Node Daemon initialization failed. ".
"The control and api ports specified should not be identical";
die("config");
}
#-----------------------------------------------------------------------
# 3. paths & files
#-----------------------------------------------------------------------
XB_Common::check_create_dir $XB_Params::node_opts{workdir};
my $ldir = $FindBin::RealBin;
for my $key ("node_cert", "node_key", "ca_cert"){
my $f = $XB_Params::node_opts{$key};
unless(-e $f and -f $f and -r $f ){
XB_Log::log "err", "! Node Daemon initialization error. ".
"SSL key or certificate file $f does not exist.";
# Hmm. The file specified is not correct. We can ask
# if we need to update the variable.
if ($XB_Params::node_opts{'auto'} =~ /yes/i){
$f = XB_Common::get_string("Enter onfiguration variable: $key",
$f);
XB_Common::update_conf_file($conf, $key, $f);
};
unless(-e $f and -f $f and -r $f ){ die "file"; }
$XB_Params::node_opts{$key} = $f;
};
};
for my $f ($XB_Params::node_opts{ca_path}){
unless(-e $f){
XB_Log::log "err", "! Node Daemon initialization failed. ".
"Directory $f does not exist. Modify setting in ".
"configuration file.";
die "file";
};
};
#-----------------------------------------------------------------------
# 4. node certificate contents
#-----------------------------------------------------------------------
# copied and modified from XB_SMIME::verify()
my $node_cert_f = $XB_Params::node_opts{"node_cert"};
my $node_cert_txt = "/tmp/node_cert.$$.txt";
my @cmd = ("openssl", "x509", "-in", $node_cert_f,
"-out", $node_cert_txt, "-text");
my $rc = 0xff & system(@cmd);
($rc == 0) or XB_Log::log "err", "@cmd failed : $!" and die("syscall");
open TEXT, $node_cert_txt or
XB_Log::log "err", "cannot open $node_cert_txt: $!" and die("open");
while (<TEXT>) {
if (/Subject/ and /CN=(.*)\/Email/i) {
my $node_cert_hostname = $1;
my $node_opts_hostname = $XB_Params::node_opts{"hostname"};
# actually matching up node cert and node opts hostnames
($node_cert_hostname eq $node_opts_hostname) or
XB_Log::log "err", "Hostname contained in the node certificate" .
" and system configuration differ\n" and
die "node_cert";
last;
}
}
close TEXT or
XB_Log::log "err", "cannot close $node_cert_txt: $!" and die("close");
unlink $node_cert_txt or
XB_Log::log "err", "cannot remove $node_cert_txt: $!" and die("unlink");
#=> Find out where c_rehash is. We need it before we proceed.
my $c_rehash = "";
my @path = ("/bin", "/sbin","/usr/bin","/usr/sbin",
"/usr/local/bin","/usr/local/sbin",
split(":", $ENV{PATH}));
foreach my $dir (@path){
if(-e "$dir/c_rehash" and -x "$dir/c_rehash" ){
$c_rehash = "$dir/c_rehash";
last;
};
};
if ($c_rehash eq ""){
XB_Log::log "err",
"Unable to find c_rehash in the PATH. Check OpenSSL installation. Further instructions can be found in /usr/local/xbone/install/REQUIREMENTS ";
die("c_rehash");
};
# Check whether the c_rehash works
@cmd = ("c_rehash", "/xxx");
my $msg;
($rc, $msg) = XB_Common::execcmd(\@cmd);
# XB_Log::log "debug5", "Executed c_rehash for initial ".
# "testing. Output=\"$msg\"\n";
($rc == 0) or
XB_Log::log "err",
"Unable to execute c_rehash. Check openssl installation "
and die("c_rehash");
#-----------------------------------------------------------------------
# 5. logging
#-----------------------------------------------------------------------
my $logfile =
"$XB_Params::node_opts{workdir}/$XB_Params::node_opts{log_file}";
if($XB_Params::DEBUGGING){
# if DEBUGGING, turn on everything and ignore log_mask & log_file
XB_Log::open $XB_Params::ERR,
"emerg alert crit err warning notice info ". #regular
"debug debug0 debug1 debug2 debug3 debug4 debug5 ". #debug
#"debug6 debug7 debug8". #extra
"", $logfile;
# turn on debug options for some other modules
$IO::Socket::SSL::DEBUG = $XB_Params::SSL_DEBUG;
}else{
XB_Log::open $XB_Params::log_dest, $XB_Params::node_opts{"log_mask"},
$logfile;
}
#-----------------------------------------------------------------------
# 6. ACL
#-----------------------------------------------------------------------
$XB_Params::node_opts{user_acl} =
XB_Common::parse_user_acl($XB_Params::node_opts{user_acl});
#-----------------------------------------------------------------------
# 7. OS
#-----------------------------------------------------------------------
unless($XB_Params::node_opts{os} =~ /cisco/i){
# don't auto-detect if it's a buddyhost for Cisco or the like
($XB_Params::node_opts{os},
$XB_Params::node_opts{os_version},
$XB_Params::node_opts{node_arch},
$XB_Params::node_opts{kern_version}) = XB_Common::node_os();
}
$XB_Params::NODEOS = $XB_Params::node_opts{os};
$XB_Params::node_opts{NODEOS} = $XB_Params::node_opts{os};
#-----------------------------------------------------------------------
# 8. overlay manager (meta) requires IPalloc & DDNS
#-----------------------------------------------------------------------
if($XB_Params::node_opts{daemon_type} eq 'meta'){
unless($XB_Params::node_opts{addrserv}){
XB_Log::log "err",
"! Node Daemon initialization failed." .
"Top-level overlay managers (meta) must have IP address server ".
"enabled.\n Please set \'addrserv\' to 1 in the conf file or \'-a\' in ".
"command line and\n specify the address ranges netv4/netv6/".
"linkv6 according to your\n IP versions (v4 or v6).";
die "addrserv";
# TODO when remote addr server works, change this check to either a
# TODO local server or specified remote server
}
unless($XB_Params::node_opts{dns} =~ /yes|1/i){
XB_Log::log "warning",
"! Node Daemon initialization warning. DNS (Dynamic DNS updates)\n".
" must be enabled in order to support overlays with virtual DNS \n".
" names. Please set \'dns\' to \'yes\' or \'-dns yes\' in the \n".
" command line to enable it, and fill in the DNS server parameters.";
}
}
#-----------------------------------------------------------------------
# 9. IP
#-----------------------------------------------------------------------
#-> protocol spec: ipv4, ipv6, both
$XB_Params::node_opts{ipproto} = lc $XB_Params::node_opts{ipproto};
unless($XB_Params::node_opts{ipproto} =~ /(ipv4|ipv6|both)/){
XB_Log::log "err",
"! Node Daemon initialization failed. ".
"Unknown IP protocol (ipv4|ipv6|both): ".
$XB_Params::node_opts{ipproto} . ". Please set the \"ipproto\"".
"variable in the configuration file or use \-ip option on the ".
"command line";
die "ipproto";
}
#-> Check and select the correct version. the "auto" check
# is done in the check_ipsupport. the returned values
# are assumed to be correct.
my ($ipversion, $mode) =
XB_Common::check_ipsupport
($XB_Params::node_opts{ipproto},
$XB_Params::node_opts{daemon_type});
if ($XB_Params::node_opts{ipproto} ne $ipversion){
XB_Log::log "notice",
"Automode warning: Unable to use configured setting for " .
"variable ipproto. Using $ipversion instead of configured " .
$XB_Params::node_opts{ipproto};
$XB_Params::node_opts{ipproto} = $ipversion;
};
if ($XB_Params::node_opts{daemon_type} ne $mode){
XB_Log::log "notice",
"Automode warning: Unable to use configured setting for " .
"variable daemon_type. Using value $mode instead of configured " .
"type " . $XB_Params::node_opts{daemon_type};
$XB_Params::node_opts{daemon_type} = $mode;
};
#-> IP addresses (ctl_addr, ctl_addr6, app_addr, app_addr6)
unless($XB_Params::node_opts{ipproto} eq 'ipv6'){
if($XB_Params::node_opts{ctl_addr} eq ""){
# lookup IP address from hostname if not specified
my $addrs = XB_Common::getaddr($XB_Params::node_opts{hostname},
'ipv4');
$XB_Params::node_opts{ctl_addr} = ${$addrs}[0];
}
if($XB_Params::node_opts{app_addr} eq ""){
$XB_Params::node_opts{app_addr} = $XB_Params::node_opts{ctl_addr};
}
}
my $ip;
unless($XB_Params::node_opts{ipproto} eq 'ipv4'){
if($XB_Params::node_opts{ctl_addr6} eq ''){
my $addrs = XB_Common::getaddr($XB_Params::node_opts{hostname},
'ipv6');
# retain Venkata's original check to pick one that's configured
my $found = 0;
my $ifcfg = `ifconfig -a`;
for $ip (@{$addrs}){
if ($ifcfg =~ /$ip/){
$XB_Params::node_opts{ctl_addr6} = $ip;
$found = 1;
last;
}
}
unless($found){
XB_Log::log "err",
"! Node Daemon initialization failed. ".
"None of the IP addresses are configured. ".
"Please check the DNS entries for the local host " .
"$XB_Params::node_opts{hostname} and ".
"addresses assigned to local interfaces.";
die "ifconfig";
}
}
if($XB_Params::node_opts{app_addr6} eq ''){
$XB_Params::node_opts{app_addr6} = $XB_Params::node_opts{ctl_addr6};
}
}
#-----------------------------------------------------------------------
# 10. Tunnels
#-----------------------------------------------------------------------
#-> gif nesting on freebsd
XB_Common::check_gifnesting($XB_Params::node_opts{'daemon_type'},
$XB_Params::node_opts{'auto'});
#-----------------------------------------------------------------------
# 11. IPsec
#-----------------------------------------------------------------------
# unless($XB_Params::node_opts{IPsec} =~ /(no|0)/i){
# init_IPsec;
# }
if (($XB_Params::node_opts{IPsec} =~ /yes/i)
and ($XB_Params::node_opts{daemon_type} !~ /meta/i)){
unless (XB_IPsec::is_present()){
if ($XB_Params::node_opts{'auto'} =~ /yes/i){
XB_Log::log "notice",
"Automode warning: This node does not support ".
"ipsec. Disabled IPsec as automatic default. ".
"Enable IPSec support in kernel to use IPSec";
} else {
XB_Log::log "err",
"! Node Daemon initialization failed. ".
"This node does not support ipsec. Disable IPsec in".
" xbone.conf or install appropriate ipsec packages.";
die ("ipsec");
};
};
};
#-----------------------------------------------------------------------
# 12. Routing
#-----------------------------------------------------------------------
unless ($XB_Params::node_opts{routing} =~ /(static|dynamic)/i){
XB_Log::log "err", "Routing configuration incorrect - ".
"should be static or dynamic";
die ("zebra");
}
if($XB_Params::node_opts{routing} =~ /dynamic/i){
if($XB_Params::node_opts{os} =~ /(freebsd|linux)/i){
my $dir = $XB_Params::node_opts{zebra_dir};
if ( ! -e $dir or ! -w $dir ){
# Try an alternative
my $found = 0;
foreach $dir ( "/usr/local/etc/quagga", "/usr/local/etc/zebra",
"/etc/zebra", "/etc/quagga" ) {
if ( -e $dir and -w $dir ){
$found = 1;
$XB_Params::node_opts{zebra_dir} = $dir;
last;
};
};
if ($found == 0) {
XB_Log::log "err", "Zebra directory " .
$XB_Params::node_opts{zebra_dir} . "does not exist";
die ("zebra");
}
};
};
};
#-----------------------------------------------------------------------
# 13. QoS
#-----------------------------------------------------------------------
if($XB_Params::node_opts{qos} =~ /yes/i){
if($XB_Params::node_opts{os} =~ /freebsd|linux/i){
unless(XB_Dummynet::is_present()){
XB_Log::log "err",
"! Node Daemon initialization failed. ".
"This node does not have Dummynet ".
"capability. Please set \'qos\' option to \'no\' in the ".
"configuration file or specify the '-q' option on the ".
"command line.";
die "dummynet";
}
if($XB_Params::node_opts{ipproto} =~ /(ipv6|both)/i){
XB_Log::log "warning",
"! QoS is not supported on IPv6 overlays.";
}
}elsif($XB_Params::node_opts{os} =~ /cisco/i){
XB_Log::log "err",
"! QoS-enabled overlay is not supported on ".
"$XB_Params::node_opts{os} platform. ".
"Please set \'qos\' option to \'no\' in the ".
"configuration file or specify the '-q' option on the ".
"command line.";
die "dummynet";
}else{
XB_Log::log "warning",
"! QoS-enabled overlay is not support on ".
"$XB_Params::node_opts{os} platform. ";
}
}
#-----------------------------------------------------------------------
# 14. check if there is another process running
#-----------------------------------------------------------------------
my $pidfile = $XB_Params::node_opts{'workdir'}. "/".
$XB_Params::node_opts{'pidfile'};
my $cpid = getsavedpid($pidfile);
if ($cpid){
XB_Log::log "err",
"! Node Daemon initialization failed. Another process ".
" with pid $cpid is running. Either remove kill the process" .
" or remove $pidfile. You can use xbonectl for the purpose.";
die ("pid");
}
#-----------------------------------------------------------------------
# 15. restore & verify state file
#-----------------------------------------------------------------------
XB_Common::restore_state;
#-----------------------------------------------------------------------
# 16. IP address server/allocator
#-----------------------------------------------------------------------
if($XB_Params::node_opts{addrserv}){
# check if already initialized from saved state
unless($XB_Params::node_state{ip_allocator}){
unless($XB_Params::new_alloc){
my %ip_hash;
XB_VN_IPalloc::init(\%ip_hash,
$XB_Params::node_opts{netv4}, $XB_Params::node_opts{linkv4},
$XB_Params::node_opts{netv6}, $XB_Params::node_opts{linkv6});
$XB_Params::node_state{ip_allocator} = 1;
$XB_Params::node_state{ip_blocks} = \%ip_hash;
#XB_Log::log "debug6", "==> IP address blocks: ". Dumper(\%ip_hash);
}else{
my @addrs;
push @addrs, $XB_Params::node_opts{netv4};
push @addrs, $XB_Params::node_opts{netv6};
$XB_Params::node_state{ip_blocks} = XB_VN_IPalloc::new_init(\@addrs);
$XB_Params::node_state{ip_allocator} = 1;
XB_Log::log "debug1", "==> IP address blocks: ".
Dumper($XB_Params::node_state{ip_blocks});
}
}
}else{
$XB_Params::node_state{ip_allocator} = 0;
}
#-----------------------------------------------------------------------
# 17. write state
#-----------------------------------------------------------------------
XB_Common::record_state;
#-----------------------------------------------------------------------
# 18. Register with the LDAP server
#-----------------------------------------------------------------------
if (($XB_Params::node_opts{'ldap'}->{'enable'} =~ /yes/i) and
($XB_Params::node_opts{'register'}{'enable'} =~ /yes/i) and
($XB_Params::node_opts{'daemon_type'} ne 'meta')){
my %attrhash = ();
foreach my $attr (keys %{$XB_Params::node_opts{'register'}}){
next if ($attr =~ /(enable|variable)/);
$attrhash{$attr} = $XB_Params::node_opts{'register'}{$attr};
}
if (defined $XB_Params::node_opts{'register'}{'variable'}){
my @arr = split(/[\s,]+/,
$XB_Params::node_opts{'register'}{'variable'});
foreach my $attr (@arr){
if (defined $XB_Params::node_opts{$attr}){
$attrhash{$attr} = $XB_Params::node_opts{$attr};
}
}
}
XB_Log::log "debug1", "==> " . Dumper(\%attrhash);
# Create a request
XB_LDAP::LDAP_register(\%attrhash);
$XB_Params::node_opts{'ldap'}->{'registered'} = "yes";
}
#-----------------------------------------------------------------------
# 19. misc.
#-----------------------------------------------------------------------
XB_Log::log "debug1", "==> node state: ". Dumper(\%XB_Params::node_state);
XB_Log::log "debug1", "==> node opts: ". Dumper(\%XB_Params::node_opts);
};
return 1 unless $@;
unless($@ =~ /(parse|file|config|addrserv|ipproto|addrlookup|ifconfig|pid)/
or $@ =~ /(check_create_dir|check_ipsupport|dummynet|ipsec|node_cert|c_rehash)/){
XB_Log::log "err",
"$modname: Node Daemon initialization failed. ".
"Function \"init\" caught unknown exception: $@";
}
die("init");
}
# ============================================================================
# Misc
# ============================================================================
# Description:
# Get the pid stored in the xbone.pid file
# Arguments:
#
# Returns:
# 0 or the pid of the already running process
# Exceptions:
#
sub getsavedpid($){
# if the pid stored in the
my $cpid = 0;
my $pidfile = shift;
if (-e $pidfile and -r $pidfile){
open(PID, "<$pidfile") or
XB_Log::log "err", "Cannot open $pidfile." and
die("pid");
chomp($cpid=<PID>);
close(PID);
};
if ($@){$cpid =0;}
return $cpid;
}
# Description:
# Cleanup and exit. This may save state at some later point
# in time.
# Arguments:
#
# Returns:
#
# Exceptions:
#
sub cleanup($$){
my $code = shift;
my $unregister = shift;
eval {
if ($XB_Params::node_opts{ldap}->{enable} =~ /(yes)/i and
$XB_Params::node_opts{ldap}->{registered} =~ /(yes)/i ){
XB_LDAP::LDAP_unregister() if ($unregister);
}
};
if ($@){
XB_Log::log "debug", " [cleanup] LDAP unregister failed. \n";
}
my $pidfile = $XB_Params::node_opts{'workdir'}. "/".
$XB_Params::node_opts{'pidfile'};
my $cpid = getsavedpid($pidfile);
if ($cpid == $$){
# remove traces of the process
unlink $pidfile; # dont worry about errors. you are
# exiting anyway.
}
exit($code);
}
# Description:
# Catch the signal and exit cleanly.
#
# Arguments:
#
# Returns:
#
# Exceptions:
#
sub sighandler($){
my $sig = shift;
XB_Log::log "debug", "Caught signal $sig";
cleanup(0,1);
}
# Description:
# Catch the signal but dont exit
#
# Arguments:
#
# Returns:
#
# Exceptions:
#
sub sighandler2($){
my $sig = shift;
XB_Log::log "debug", "Caught signal $sig";
}
# Description:
# note the pid and put the process in the background if
# necessary.
# Arguments:
#
# Returns:
#
# Exceptions:
#
sub demonize(){
if ($XB_Params::node_opts{"background"}){
cleanup(0,0) if (fork());
}
my $pidfile = $XB_Params::node_opts{'workdir'}. "/".
$XB_Params::node_opts{'pidfile'};
# save the PID
open(PID,">$pidfile");
print PID "$$\n";
close(PID);
# catch the signal for clean exit;
$SIG{TERM} = \&sighandler;
$SIG{KILL} = \&sighandler;
$SIG{INT} = \&sighandler;
$SIG{PIPE} = \&sighandler2;
}
# Description:
# Find the interface corresponding to ipaddress
# Arguments:
# ip address (v4/v6)
# Returns:
# interface name
# Exceptions:
#
sub find_mcast_interface($){
my $addr = shift;
die("Incorrect arguments") if (not defined $addr);
open(PIPE, "/sbin/ifconfig -a |" ) || die ("Cannot execute ifconfig");
my ($found, $itf) = (0, undef);
while (<PIPE>){
if (/^(\w+):/){
$itf = $1;
next;
}
last if (/$addr/);
}
close(PIPE);
die ("Cannot find interface corresponding address $addr")
if (not defined $itf);
return $itf;
}
# ========================================================================
# Bind All Listening Sockets
# ========================================================================
# Description:
# Bind to all the sockets depending on the node type.
# Arguments:
# -
# Returns:
# -
# Exceptions:
# "bind_sockets" on error, nothing to clean up by caller
# Notes:
# o api_sock
# bind to {Local IP}:{API port} and listen for API connections
# o ctl_sock
# bind to {Local IP}:{CTL port} and listen for Control connections
# o mcast_send_sock
# bind to {Local IP}:{CTL port} and send to the specified multicast
# group address
# * Because IO::Socket::Multicast creates socket bound to INADDR_ANY
# locally, need to do it this way to force it to bind to an IP addr
# instead of INADDR_ANY. This socket is also acting as UDP
# listening socket on {Local IP}:{CTL port}.
# o mcast_recv_sock
# bind to {Multicast IP}:{CTL port} and receive incoming multicast
# packets
# TODO: Check node type and determine which socket to bind to!
#
sub bind_sockets {
my $procname = "bind_sockets";
my $ipproto = $XB_Params::node_opts{ipproto};
XB_Log::log "info", "-> $modname$procname $ipproto (process $$)";
eval{
# select
unless ($sel = IO::Select->new()){
XB_Log::log "err", " ! OS resource unavailable for the Node Daemon. ".
"select failed: $!" and die "select";
}
#=> IPv4 ========================================================
if($ipproto ne 'ipv6'){
#-> XBone API socket
$api_sock = XB_Common::ssl_listen_sock('ipv4',
$XB_Params::node_opts{ctl_addr},
$XB_Params::node_opts{xbone_api_port});
$sel->add($api_sock);
#-> XBone CTL socket
$ctl_sock = XB_Common::ssl_listen_sock('ipv4',
$XB_Params::node_opts{ctl_addr},
$XB_Params::node_opts{xbone_ctl_port});
$sel->add($ctl_sock);
#-> XBone Multicast send socket
$mcast_send_sock = XB_Common::mcast_sock('ipv4',
$XB_Params::node_opts{ctl_addr},
$XB_Params::node_opts{xbone_ctl_port});
#-- don't join group, just specify specify destination
$mcast_send_sock->mcast_dest("$XB_Params::node_opts{xbone_mcast_addr}:".
"$XB_Params::node_opts{xbone_ctl_port}");
$sel->add($mcast_send_sock);
XB_Log::log "notice", " [$procname] send to multicast group ".
"$XB_Params::node_opts{xbone_mcast_addr}:".
"$XB_Params::node_opts{xbone_ctl_port}";
#-> XBone Multicast recv socket
$mcast_recv_sock = XB_Common::mcast_sock('ipv4',
$XB_Params::node_opts{xbone_mcast_addr},
$XB_Params::node_opts{xbone_ctl_port});
#-- join group, but don't care about destination
$mcast_recv_sock->mcast_add($XB_Params::node_opts{xbone_mcast_addr});
XB_Log::log "notice", " [$procname] join multicast group ".
"$XB_Params::node_opts{xbone_mcast_addr}:".
"$XB_Params::node_opts{xbone_ctl_port}";
$sel->add($mcast_recv_sock);
}
#=> IPv6 ========================================================
if($ipproto ne 'ipv4'){
#-> Find the interface of the ctl_addr first
my $iface = find_mcast_interface($XB_Params::node_opts{ctl_addr6});
#-> XBone API socket
$api_sock6 = XB_Common::ssl_listen_sock('ipv6',
$XB_Params::node_opts{ctl_addr6},
$XB_Params::node_opts{xbone_api_port});
$sel->add($api_sock6);
#-> XBone CTL socket
$ctl_sock6 = XB_Common::ssl_listen_sock('ipv6',
$XB_Params::node_opts{ctl_addr6},
$XB_Params::node_opts{xbone_ctl_port});
$sel->add($ctl_sock6);
#-> XBone Multicast send socket
$mcast_send_sock6 = XB_Common::mcast_sock('ipv6',
$XB_Params::node_opts{ctl_addr6},
$XB_Params::node_opts{xbone_ctl_port});
#-- don't join group, just specify specify destination
#$mcast_send_sock6->mcast_add($XB_Params::node_opts{xbone_mcast_addrv6},
# $iface);
my $mcastdest = pack_sockaddr_in6($XB_Params::node_opts{xbone_ctl_port},
inet_pton(AF_INET6, $XB_Params::node_opts{xbone_mcast_addrv6}));
$mcast_send_sock6->mcast_dest($mcastdest);
#$mcast_send_sock6->mcast_dest(
# "$XB_Params::node_opts{xbone_mcast_addrv6}:".
# "$XB_Params::node_opts{xbone_ctl_port}");
$sel->add($mcast_send_sock6);
XB_Log::log "notice", " [$procname] send to multicast group ".
"$XB_Params::node_opts{xbone_mcast_addrv6}:".
"$XB_Params::node_opts{xbone_ctl_port}";
#-> XBone Multicast recv socket
$mcast_recv_sock6 = XB_Common::mcast_sock('ipv6',
$XB_Params::node_opts{xbone_mcast_addrv6},
$XB_Params::node_opts{xbone_ctl_port});
#-- join group, but don't care about destination
$mcast_recv_sock6->mcast_add($XB_Params::node_opts{xbone_mcast_addrv6},
$iface);
XB_Log::log "notice", " [$procname] join multicast group ".
"$XB_Params::node_opts{xbone_mcast_addrv6}:".
"$XB_Params::node_opts{xbone_ctl_port}";
$sel->add($mcast_recv_sock6);
}
};
XB_Log::log "info", "<- $modname$procname";
return 1 unless $@;
# exception handling
unless ($@ =~ /(ssl_listen_sock|mcast_sock)/){
XB_Log::log "warning", " ! $procname caught unknown exception: $@";
}
die "$modname$procname";
}
# ========================================================================
# Process Periodic Checks
# ========================================================================
# Description:
# Perform periodic checks on whether to send refresh messages and
# whether any active overlay expires.
# Arguments:
# $now current time
# Returns:
# $nextchk time for the next refresh
# Exceptions:
# -
# Side Effects:
# - If refresh period is up, a refresh (heartbeat) message will be sent
# to all nodes of active overlays to reset their expiration timer.
# - If an overlay is past expiration time, it'll be removed unless it's
# persistent (an user-set, per-overlay option).
#
sub periodic_check($){
my $now = shift;
my $procname = "periodic_check";
my $timestr = localtime $now;
my $nextchk = $now + $XB_Params::refresh;
XB_Log::log "info", "-> $modname$procname $now [$timestr]";
eval{
my %refresh_list;
my $need_refresh = 0;
for my $t (keys %{$XB_Params::node_state{active_apps}}){
my @app_list = keys %{$XB_Params::node_state{active_apps}{$t}};
if(@app_list > 0){
my $type = $XB_Params::node_state{active_apps}{$t};
for my $app (@app_list){
if(exists $type->{$app}{application}){
# overlay created by this node, add to the %refresh_list
my $aref = $type->{$app}{application};
$need_refresh++;
my $ip = $aref->{network}{properties}{address_type};
if(not defined $ip){ $ip = "ipv4"; }
for my $u (keys %{$aref->{resources}}){
for my $n (keys %{$aref->{resources}{$u}}){
my %h = ( $t => $app );
push @{$refresh_list{$ip}{$n}}, \%h;
}
}
}elsif($now > $type->{$app}{expire}){
# overlay created by other node has expired; delete it
XB_Log::log "warning", "!! overlay $app expires now !!";
my $level = (exists $type->{$app}{node})?
$type->{$app}{node}{command}{level}:
$type->{$app}{network}{command}{level};
my $dummy = XB_CTL::ctl_stop('overlay', $app, $level,
"localhost", 0); #TODO unless persistent
}
}
}
}
if($need_refresh){
XB_API::api_refresh(\%refresh_list);
}
$timestr = localtime $nextchk;
};
return $nextchk unless $@;
unless ($@ =~ /(ctl_stop|api_refresh)/){
XB_Log::log "warning", " ! $procname caught unknown exception: $@";
}
return $nextchk;
}
# ========================================================================
# Process API Connections
# ========================================================================
# Description:
# Process incoming connection on XBone API port
# Arguments:
# $sock socket handle to accept
# $ipproto ipv4 or ipv6
# Returns:
# 1 on success
# 0 on failure
# Exceptions:
# -
sub api_connect($$){
my ($sock, $ipproto) = @_;
my ($client_fh);
my ($peerhost, $peerport, $peeraddr, $issuer, $cipher, $guest);
my ($msg, $api_cmd, $api_reply, $api_error);
my ($api_ver, $rel_ver, $cmd, $type, $name, $level);
my ($user_name, $user_email, $user_auth, $acl_ok, $uid);
my ($cmd_reply);
my $procname = "api_connect";
XB_Log::log "info", "-> $modname$procname $sock, $ipproto";
eval{
#=> accept
($client_fh) = XB_Common::ssl_accept($sock);
#=> dont buffer.
$client_fh->autoflush(1);
#=> get client info from the certificate
($peerhost, $issuer, $cipher)=XB_Common::ssl_read_cert($client_fh);
#=> make sure you are authorized to receive the connection
if ($XB_Params::node_opts{'daemon_type'} ne "meta"){
XB_Log::log "err",
" [$procname] This node is not configured as an overlay".
"manager (i.e., meta) \n";
die('om');
}
#=> if hostname (cert) matches the reverse lookup on socket peeraddr
if($peerhost ne $XB_Params::guesthost){
($peeraddr, $peerport) =
XB_Common::chk_sockaddr($client_fh, $peerhost, $ipproto);
#-> save socket handle for persistent connection
$XB_Params::persistent_socks{$ipproto}{$peerhost}{$peerport}=$client_fh;
$guest = 0;
}elsif($XB_Params::GUEST_OK){
#-> skip the check if using guest host certificate, will check later
# against the hostname in the command
$guest = 1;
}else{
XB_Log::log "err", " [$procname] Guest host not allowed!\n".
"To allow guest host certificate, set $XB_Params::GUEST_OK to 1.";
die "noguest";
}
#=> read command
$msg = XB_Common::fh_read_until($client_fh, $XB_Params::msg_delimiter);
#=> parse api command
#-- check for parser error
my $parser_err = XB_XML_scan::XB_XML_parse(\$msg);
if ($parser_err){
$_ = XB_XML_scan::XB_XML_choose_parse_error ($parser_err);
XB_Log::log "err", " [$procname] Unable to parse API message. ".
"The client (GUI/API Client) has generated a wrong".
"message. Contact X-Bone(xbone\@isi.edu) if you are using ".
"a default client.";
die "parser";
}
#-- parse the message into hash
$api_cmd = XB_XML_scan::XB_XML_hash (\$msg);
XB_XML_scan::XB_XOL_xbone_list_sub ($api_cmd);
my @cmds = keys %{$api_cmd->{command}};
if(@cmds > 1){
XB_Log::log "warning", " [$procname] multiple cmds in an API msg";
}
$api_cmd->{command}{command} = $cmds[0];
if($api_cmd->{command}{command} eq 'create_overlay'){
my $xolhref = $api_cmd->{command}{create_overlay}{xol_program};
XB_XML_scan::XB_XOL_synonym_sub ($api_cmd, $xolhref->{'equivto'});
}
XB_Log::log "debug1", " [$procname] API Command --\n". Dumper($api_cmd);
#=> extract command info
$api_ver = $api_cmd->{version};
$rel_ver = $api_cmd->{release};
$cmd = $api_cmd->{command}{command};
$type = 'overlay';
$name = (defined $api_cmd->{command}{$cmd}{property}{overlay_name})?
$api_cmd->{command}{$cmd}{property}{overlay_name} : '';
$level = 0;
$user_name = $api_cmd->{credential}{property}{user_name};
$user_email= $api_cmd->{credential}{property}{user_email};
$user_auth = $api_cmd->{credential}{property}{auth_type};
#=> check XBone software/protocol versions
unless(XB_Common::check_vers($rel_ver, $XB_Params::rel_ver, 'release')){
XB_Log::log "err", " [$procname] Different versions of XBone ".
"software!\n GUI/API client has $rel_ver & this node is running ".
"$XB_Params::rel_ver";
die "vers";
}
unless(XB_Common::check_vers($api_ver, $XB_Params::api_ver, 'api')){
XB_Log::log "err"," [$procname] Different versions of XBone API ".
"Protocols used!\n GUI/API client has $api_ver; this node is ".
"running $XB_Params::api_ver";
die "vers";
}
#=> check user ACL
($acl_ok, $uid) =
XB_Common::check_user_acl($user_name, $user_email, $user_auth, $cmd);
unless($acl_ok){
XB_Log::log "err", " [$procname] User ACL check failed. Make sure ".
"that $user_email matches one of the ACL rules.";
die "acl";
}
$api_cmd->{user_acl}{suid} = $uid;
#=> if guest flag is set, need to find hostname from the command and
# check if it matches the sock->peeraddr (IP)
if($guest and $peerhost eq $XB_Params::guesthost){
if(defined $api_cmd->{command}{sender}){
$peerhost = $api_cmd->{command}{sender};
($peeraddr, $peerport) =
XB_Common::chk_sockaddr($client_fh, $peerhost, $ipproto);
#-> check OM ACL
unless(XB_Common::check_list($peerhost,
$XB_Params::node_opts{"ovl_manager"})){
XB_Log::log "err", " [$procname] API client $peerhost not ".
"allowed. To use \"guest\" privileges the client ".
"(GUI/API client) must be one of the overlay managers."
and die "om";
}
#-> save socket handle for persistent connection
$XB_Params::persistent_socks{$ipproto}{$peerhost}{$peerport} =
$client_fh;
}else{
$peeraddr = $sock->peerhost; #returns the ip address in text
XB_Log::log "err", " [$procname] guesthost ($peeraddr) must ".
"embed hostname in the \n command for access control checks";
die "noname";
}
}
#=> embed command info
$api_cmd->{sender} = $peerhost;
$api_cmd->{sender_ip} = $peeraddr;
#-- make a credential section for later use
$api_cmd->{credential}{section} =
XB_Common::make_credential($user_name, $user_email, $user_auth);
#-- embed the original message in the hash
$api_cmd->{message} = \$msg;
XB_Log::log "info", " [$procname] recv API command $cmd from $peerhost";
#=> dispatch & process api command
$_ = $api_cmd->{command}{command};
SWITCH: {
/\bcreate_overlay\b/ && do {
my $aip = $api_cmd->{command}{create_overlay}{property}{address_type};
XB_Common::check_ip($aip);
my $msock = ($aip =~ /ipv6/i)? $mcast_send_sock6 : $mcast_send_sock;
$cmd_reply = XB_API::api_start($api_cmd, $msock);
last SWITCH;
};
/\bdiscover_daemons\b/ && do {
my @msocks;
if($XB_Params::node_opts{ipproto} eq "ipv6"){
push @msocks, $mcast_send_sock6;
}elsif($XB_Params::node_opts{ipproto} eq "ipv4"){
push @msocks, $mcast_send_sock;
}else{
push @msocks, ($mcast_send_sock, $mcast_send_sock6);
}
$cmd_reply = XB_API::api_discover($api_cmd, \@msocks);
last SWITCH;
};
/\blist_overlays\b/ && do {
XB_Log::log "info", " [$procname] process list command";
my @app_list = keys %{$XB_Params::node_state{active_apps}{overlay}};
my $app_list = join ' ', @app_list;
my %ahref = ( "protocol" => $XB_Params::api_ver,
"release" => $XB_Params::rel_ver );
$cmd_reply = XB_XML_GUI::XB_build_list_overlays_reply_msg(\%ahref,
\$app_list);
last SWITCH;
};
/\boverlay_status\b/ && do {
$cmd_reply = XB_API::api_status $type, $name, $api_cmd;
last SWITCH;
};
/\bdestroy_overlay\b/ && do {
$cmd_reply = XB_API::api_stop $type, $name, $api_cmd;
last SWITCH;
};
/\bdestroyall_overlays\b/ && do {
XB_Log::log "err", " [$procname] Destroy All Overlay command is ".
"not supported for security reason";
die "killall";
};
XB_Log::log "err", " [$procname] The client sent an unsupported cmd. ".
"Contact xbone\@isi.edu or look at the client source. : $_ ignored." and
die "command";
}
#=> send api command reply
$api_reply = $$cmd_reply . " $XB_Params::msg_delimiter\n";
XB_Log::log "debug1",
" [$procname] API command reply: ==============================".
"\n$api_reply\n".
" =============================================================";
print $client_fh $api_reply;
sleep 2;
};
XB_Log::log "info", "<- $procname";
my $re = 1;
if($@){
#=> Exception handling
$re = 0;
#-> gather error info
if($XB_Params::error_reply ne ""){
# from [XB_Log::log "err"]
$api_error = $XB_Params::error_reply;
$XB_Params::error_reply = "";
}elsif($@ =~ /(ssl_accept|ssl_read_cert|chk_sockaddr|om|fh_read_until)/
or $@ =~ /(parser|vers|acl|command|api_start|api_stop|killall)/){
# nothing recorded from [XB_Log::log "err":]
$api_error = "$procname caught exception: \'$@\' without further info.".
" Please enable \'err\' log_mask in XB_Params.pm or your node config".
" file to get more debugging outputs.";
}else{
$api_error = "$procname caught unknown exception \'$@\' without".
" further info.";
XB_Log::log "warning", " ! $api_error";
}
#-> construct API error reply
$user_name = ($user_name)? $user_name : "SysAdmin";
$user_email = ($user_email)? $user_email :
"root\@$XB_Params::node_opts{hostname}";
$user_auth = ($user_auth)? $user_auth : "x509";
$cmd = ($cmd)? $cmd : "unknown";
$cmd_reply = XB_Common::api_error_msg $user_name, $user_email,
$user_auth, $cmd, $api_error;
#-> send API error reply
$api_reply = $$cmd_reply . " $XB_Params::msg_delimiter\n";
if($client_fh && defined fileno($client_fh)){
print $client_fh $api_reply;
sleep 2;
}
XB_Log::log "debug1", " [$procname] sends API error reply:". $api_reply;
}
#-> close socket here
if($client_fh && defined fileno($client_fh)){
# writing the response and almost simultanous closing the file
# descriptor seems to be causing problems in SSL.pm
XB_Log::log "info", " [$procname] closing socket $client_fh";
close $client_fh or
XB_Log::log "warning", " [$procname] close failed: $!";
if(exists $XB_Params::persistent_socks{$ipproto}{$peerhost}{$peerport}){
XB_Log::log "debug1", " [$procname] delete persistent socket: ".
"$ipproto:$peerhost:$peerport";
delete $XB_Params::persistent_socks{$ipproto}{$peerhost}{$peerport};
}
}
return $re;
}
# ========================================================================
# Process Control Connections
# ========================================================================
# Description:
# Process XBone Control connection
# Arguments:
# $sock socket handle to accept
# $ipproto ipv4 or ipv6
# Returns:
# 1 on success
# 0 on failure
# Exceptions:
# -
sub ctl_connect($$){
my ($sock, $ipproto) = @_;
my ($client_fh);
my ($peerhost, $peerport, $peeraddr, $issuer, $cipher, $guest);
my ($msg, $ctl_cmd, $ctl_reply, $ctl_error);
my ($ctl_ver, $rel_ver, $cmd, $type, $name, $level);
my ($user_name, $user_email, $user_auth, $acl_ok, $uid);
my ($connected, $ctl_select);
my $procname = "ctl_connect";
XB_Log::log "info", "-> $modname$procname $sock, $ipproto";
eval{
#=> accept connection
$client_fh = XB_Common::ssl_accept($sock);
#=> verifiy certificate & get host info on cert
($peerhost, $issuer, $cipher)=XB_Common::ssl_read_cert($client_fh);
#=> if hostname (cert) matches the reverse lookup on socket peeraddr
if($peerhost ne $XB_Params::guesthost){
($peeraddr, $peerport) =
XB_Common::chk_sockaddr($client_fh, $peerhost, $ipproto);
#-> check OM ACL
unless(XB_Common::check_list($peerhost,
$XB_Params::node_opts{"ovl_manager"})){
XB_Log::log "err", " [$procname] Overlay manager $peerhost not allowed";
die "om";
}
#-> save socket handle for persistent connection
$XB_Params::persistent_socks{$ipproto}{$peerhost}{$peerport}=$client_fh;
$guest = 0;
}elsif($XB_Params::GUEST_OK){
#-> skip the check if using guest host certificate, will check later
# against the hostname in the command
$guest = 1;
}else{
XB_Log::log "err", " [$procname] Guest host not allowed!\n".
"To allow guest host certificate, set $XB_Params::GUEST_OK to 1.";
die "noguest";
}
$connected = 1;
$ctl_select = IO::Select->new;
while($connected){
#=> read command
$msg = XB_Common::fh_read_until($client_fh, $XB_Params::msg_delimiter);
#=> parse control command
$ctl_cmd = $XB_CTL_parser::parser->xb_ctl($msg);
unless (defined $ctl_cmd){
XB_Log::log "err", " [$procname] Error parsing control ".
"message exchanged between overlay manager and the resource daemon. ".
"This is a bug. Contact xbone\@isi.edu.\nmessage: $msg"
and die "parser";
}
#=> extract command info
$ctl_ver = $ctl_cmd->{version};
$rel_ver = $ctl_cmd->{release};
$cmd = $ctl_cmd->{command}{command};
$type = $ctl_cmd->{command}{app_type};
$name = $ctl_cmd->{command}{app_name};
$level = $ctl_cmd->{command}{level};
if(@{$ctl_cmd->{credential}} == 1){
# embed credential with the command
$ctl_cmd->{credential} = $ctl_cmd->{credential}[0];
}else{
my $a = @{$ctl_cmd->{credential}};
XB_Log::log "err", " [$procname] Unexpected extra credential ".
"information passed to the RD. Command has $a credential ".
"entries. ";
die 'credential';
}
$user_name = $ctl_cmd->{credential}{user_name};
$user_email= $ctl_cmd->{credential}{user_email};
$user_auth = $ctl_cmd->{credential}{auth_type};
#=> check XBone software/protocol versions
unless(XB_Common::check_vers($rel_ver, $XB_Params::rel_ver, 'release')){
XB_Log::log "err", " [$procname] Different versions of XBone ".
"software!\n Overlay Manager has $rel_ver & this node is running ".
"$XB_Params::rel_ver";
die "vers";
}
unless(XB_Common::check_vers($ctl_ver, $XB_Params::ctl_ver, 'ctl')){
XB_Log::log "err"," [$procname] Different versions of XBone CTL ".
"Protocols used!\n Overaly Manager has $ctl_ver; this node is ".
"running $XB_Params::ctl_ver";
die "vers";
}
#=> check user ACL
($acl_ok, $uid) =
XB_Common::check_user_acl($user_name, $user_email, $user_auth, $cmd);
unless($acl_ok){
XB_Log::log "err", " [$procname] User ACL check failed. Make sure ".
"that $user_email matches one of the ACL rules.";
die "acl";
}
$ctl_cmd->{user_acl}{suid} = $uid;
#=> if guest flag is set, need to find hostname from the command and
# check if it matches the sock->peeraddr (IP)
if($guest and $peerhost eq $XB_Params::guesthost){
if(defined $ctl_cmd->{command}{sender}){
$peerhost = $ctl_cmd->{command}{sender};
($peeraddr, $peerport) =
XB_Common::chk_sockaddr($client_fh, $peerhost, $ipproto);
#-> check OM ACL
unless(XB_Common::check_list($peerhost,
$XB_Params::node_opts{"ovl_manager"})){
XB_Log::log "err", " [$procname] Overlay manager $peerhost ".
"not allowed" and die "om";
}
#-> save socket handle for persistent connection
$XB_Params::persistent_socks{$ipproto}{$peerhost}{$peerport} =
$client_fh;
}else{
$peeraddr = $sock->peerhost; #returns the ip address in text
XB_Log::log "err", " [$procname] guesthost ($peeraddr) must ".
"embed hostname in the \n command for access control checks";
die "noname";
}
}
#=> embed command info
$ctl_cmd->{sender} = $peerhost;
$ctl_cmd->{sender_ip} = $peeraddr;
#$ctl_cmd->{ipproto} = $ipproto;
XB_Log::log "debug1", " [$procname] CTL command: ". Dumper($ctl_cmd);
XB_Log::log "info", " [$procname] recv command $cmd from $peerhost";
$ctl_reply = " ";
#=> dispatch & process multicast commands
$_ = $cmd;
SWITCH: {
/\bselect\b/ && do {
$ctl_reply = XB_CTL::ctl_select $ctl_cmd;
last SWITCH;
};
/\bdispatch\b/ && do {
my $api_message = $ctl_cmd->{command}{application};
my $api_cmd;
#-> extract & parse the application-specific message
XB_CTL::xb_control_dispatch($ctl_cmd, $api_cmd, $client_fh,
$mcast_send_sock);
last SWITCH;
};
/\bconfig\b/ && do {
$ctl_reply = XB_CTL::ctl_config $ctl_cmd, 0;
last SWITCH;
};
/\bstatus\b/ && do {
$ctl_reply = XB_CTL::ctl_status $type, $name, $level, $peerhost;
last SWITCH;
};
/\bstop\b/ && do {
$ctl_reply = XB_CTL::ctl_stop($type, $name, $level, $peerhost, 0);
last SWITCH;
};
XB_Log::log "err", " ! Unsupported control command from ".
" overlay manager to the resource daemon. This is a bug. ".
"Contact xbone\@isi.edu. Command: $_";
die "command";
}
#=> send ctl command reply
#TODO clear this if clause once every function above returns msg
if($ctl_reply ne " "){
XB_Log::log "debug1",
" [$procname] CTL command reply: ==============================".
"\n". $$ctl_reply ."\n".
" =============================================================";
print $client_fh $$ctl_reply;
}
#=> explicitly check if persistent socket is used on the sender
# (currently, there is no cleaner way to test whether the sender
# is using persistent socket or not)
if(defined $ctl_cmd->{command}{persistent_connection} &&
$ctl_cmd->{command}{persistent_connection} =~ /yes/i){
# persistent socket is used on the sender, do select and wait
XB_Log::log "debug1", " [$procname] persistent connection from ".
"$peerhost, waiting for the next command";
$ctl_select->add($client_fh);
my $ready = 0;
while (my @r = $ctl_select->can_read){
for my $f (@r){
if($f != $client_fh){
XB_Log::log "warning", " [$procname] wrong socket!";
}elsif($f->pending > 0){
$ready = 1;
$ctl_select->remove($client_fh);
last;
}
}
last if ($ready);
}
}else{
# persistent socket is not used, exit the whole loop and disconnect
XB_Log::log "debug1", " [$procname] non-persistent connection ".
"from $peerhost, exit";
$connected = 0;
last;
}
} # while($connected)
};
XB_Log::log "info", "<- $modname$procname";
my $re = 1;
# if die within eval, send error reply here
if($@){
$re = 0;
# reset the state
XB_Common::reset_state;
# generate error message
if($XB_Params::error_reply ne ""){
$ctl_error = $XB_Params::error_reply;
$XB_Params::error_reply = "";
}elsif($@ =~ /(ssl_accept|ssl_read_cert|chk_sockaddr|om|noguest)/ or
$@ =~ /(fh_read_until|parser|credential|vers|acl|noname)/ or
$@ =~ /(ctl_select|ctl_dispatch|ctl_config|ctl_status)/ or
$@ =~ /(ctl_stop|command)/){
# nothing recorded from XB_Log::log "err":
$ctl_error = "$procname caught exception: \'$@\' without further info.".
" Please enable \'err\' log_mask in XB_Params.pm or your node config".
" file to get more debugging outputs.";
}else{
$ctl_error = "$procname caught unknown exception \'$@\' without".
" further info.";
XB_Log::log "warning", " ! $ctl_error";
}
#-> construct CTL error reply
$ctl_reply = XB_Common::ctl_error_msg $cmd, $type, $name, $level,
\$ctl_error;
#-> send CTL error reply
if ($client_fh and defined fileno($client_fh)){
print $client_fh $$ctl_reply;
}
XB_Log::log "debug1", " [$procname] sends CTL error reply:". $$ctl_reply;
}
# close socket here
if($client_fh && defined fileno($client_fh)){
XB_Log::log "info", " [$procname] closing socket $client_fh";
close $client_fh or
XB_Log::log "warning", " [$procname] close failed: $!";
if(exists $XB_Params::persistent_socks{$ipproto}{$peerhost}{$peerport}){
XB_Log::log "debug1", " [$procname] delete persistent socket: ".
"$ipproto:$peerhost:$peerport";
delete $XB_Params::persistent_socks{$ipproto}{$peerhost}{$peerport};
}
}
return $re;
}
# ========================================================================
# Process Multicast & UDP Connections
# ========================================================================
# Description:
# Process XBone UDP (Multicast or Unicast) Control connection
# Arguments:
# $sock socket handle to accept
# $ipproto ipv4 or ipv6
# Returns:
# 1 on success
# 0 on failure
# Notes:
# o Functions processing multicast commands send reply within themselves
# because the main socket is multicast socket, not unicast socket.
# o Don't send error reply failed, just ignore the command.
#
sub mcast_connect($$){
my ($sock, $ipproto) = @_;
my ($sockaddr);
my ($peerhost, $peerport, $peeraddr, $guest);
my ($msg, $ctl_cmd, $ctl_reply, $ctl_error);
my ($ctl_ver, $rel_ver, $cmd, $type, $name, $level);
my ($user_name, $user_email, $user_auth, $acl_ok, $uid);
my $procname = $modname. "mcast_connect";
XB_Log::log "info", "-> $procname $sock, $ipproto";
eval{
#=> get message
unless ($sockaddr = $sock->recv($msg, 65536, 0)){
XB_Log::log "err", " [$procname] Error while reading multicast ".
"message from overlay manager. recv: $!" and die "recv";
}
#=> verify the SMIME signature & extract hostname from the certificate
($msg, $peerhost) = XB_SMIME::verify($msg);
$msg =~ s/$XB_Params::msg_delimiter//g; # remove the delimiter
#=> if hostname (cert) matches the reverse lookup on socket peeraddr
if($peerhost ne $XB_Params::guesthost){
($peeraddr, $peerport) =
XB_Common::chk_sockaddr($sock, $peerhost, $ipproto);
#-> check I AM OM AND NOT RD
my $daemon_type = $XB_Params::node_opts{"daemon_type"};
unless($daemon_type =~ /(host|router|node)/ and $daemon_type ne "meta"){
XB_Log::log "err", " [$procname] Current daemon type $daemon_type ".
"does not accept multicast connect requests";
die "daemon_type";
}
#-> check OM ACL
unless(XB_Common::check_list($peerhost,
$XB_Params::node_opts{"ovl_manager"})){
XB_Log::log "err", " [$procname] Overlay manager $peerhost not allowed";
die "om";
}
$guest = 0;
}elsif($XB_Params::GUEST_OK){
#-> skip the check if using guest host certificate, will check later
# against the hostname in the command
$guest = 1;
}else{
XB_Log::log "err", " [$procname] Guest host not allowed!\n".
"To allow guest host certificate, set $XB_Params::GUEST_OK to 1.";
die "noguest";
}
#=> parse control command
$ctl_cmd = $XB_CTL_parser::parser->xb_ctl($msg);
unless (defined $ctl_cmd){
XB_Log::log "err", " ! Error while parsing message from ".
"overlay manager. Contact xbone\@isi.edu with message:\n$msg" and die "parser";
}
#=> extract command info
$ctl_ver = $ctl_cmd->{version};
$rel_ver = $ctl_cmd->{release};
$cmd = $ctl_cmd->{command}{command};
$type = (defined $ctl_cmd->{command}{app_type})?
$ctl_cmd->{command}{app_type} : '';
$name = (defined $ctl_cmd->{command}{app_name})?
$ctl_cmd->{command}{app_name} : '';
$level = (defined $ctl_cmd->{command}{level})?
$ctl_cmd->{command}{level} : '';
if(@{$ctl_cmd->{credential}} == 1){
# embed credential with the command
$ctl_cmd->{credential} = $ctl_cmd->{credential}[0];
$user_name = $ctl_cmd->{credential}{user_name};
$user_email= $ctl_cmd->{credential}{user_email};
$user_auth = $ctl_cmd->{credential}{auth_type};
}elsif($cmd ne 'refresh'){
my $a = @{$ctl_cmd->{credential}};
XB_Log::log "err", " [$procname] Unexpected extra ".
"credential information passed to the RD. ".
"Command has $a credential entries";
die 'credential';
}
#=> check XBone software/protocol versions
unless(XB_Common::check_vers($rel_ver, $XB_Params::rel_ver, 'release')){
XB_Log::log "err", " [$procname] Different versions of XBone ".
"software!\n Overlay Manager has $rel_ver & this node is running ".
"$XB_Params::rel_ver";
die "vers";
}
unless(XB_Common::check_vers($ctl_ver, $XB_Params::ctl_ver, 'ctl')){
XB_Log::log "err"," [$procname] Different versions of XBone CTL ".
"Protocols used!\n Overaly Manager has $ctl_ver; this node is ".
"running $XB_Params::ctl_ver";
die "vers";
}
#=> check user ACL
unless($cmd eq 'refresh'){
($acl_ok, $uid) =
XB_Common::check_user_acl($user_name, $user_email, $user_auth, $cmd);
unless($acl_ok){
XB_Log::log "err", " [$procname] User ACL check failed. Make ".
"sure that $user_email matches one of the ACL rules.";
die "acl";
}
}
$ctl_cmd->{user_acl}{suid} = $uid;
#=> if guest flag is set, need to find hostname from the command and
# check if it matches the sock->peeraddr (IP)
if($guest and $peerhost eq $XB_Params::guesthost){
if(defined $ctl_cmd->{command}{sender}){
$peerhost = $ctl_cmd->{command}{sender};
($peeraddr, $peerport) =
XB_Common::chk_sockaddr($sock, $peerhost, $ipproto);
#-> check OM ACL
unless(XB_Common::check_list($peerhost,
$XB_Params::node_opts{"ovl_manager"})){
XB_Log::log "err", " [$procname] Overlay manager ".
"$peerhost not allowed";
die "om";
}
}else{
$peeraddr = $sock->peerhost; #returns the ip address in text
XB_Log::log "err", " [$procname] guesthost ($peeraddr) must ".
"embed hostname in the \n command for access control checks";
die "noname";
}
}
#=> embed command info
$ctl_cmd->{sender} = $peerhost;
$ctl_cmd->{sender_ip} = $peeraddr;
$ctl_cmd->{ipproto} = $ipproto;
$ctl_cmd->{control_protocol} = $ipproto;
XB_Log::log "debug1", " [$procname] CTL message:\n". $msg;
XB_Log::log "debug1", " [$procname] CTL command:\n". Dumper($ctl_cmd);
XB_Log::log "info", " [$procname] recv UDP command $cmd from $peerhost";
#=> dispatch & process multicast commands
$_ = $ctl_cmd->{command}{command};
SWITCH: {
/\binvite\b/ && do {
XB_CTL::xb_control_invite($ctl_cmd);
last SWITCH;
};
/\brelease\b/ && do {
XB_CTL::xb_control_release($ctl_cmd);
last SWITCH;
};
/\brefresh\b/ && do {
XB_CTL::ctl_refresh($ctl_cmd);
last SWITCH;
};
/\bdiscover\b/ && do {
XB_CTL::ctl_discover($ctl_cmd);
last SWITCH;
};
XB_Log::log "warning", " ! unsupported multicast command: $_ ignored.";
}
};
XB_Log::log "info", "<- $procname";
return 1 unless $@;
unless($@ =~ /\b(recv|XB_SMIME|chk_sockaddr|om|noguest|parser|credential)\b/
or $@ =~ /\b(vers|acl|noname|daemon_type)\b/
or $@ =~ /\b(ctl_invite|ctl_release|ctl_refresh|ctl_discover)\b/){
XB_Log::log "warning", " ! $procname caught unknown exception: $@";
}
return 0;
}
#=========================================================================
# Main program
#=========================================================================
sub main () {
#=> banner
XB_Log::log "notice",
"##########################################################\n".
"# #\n".
"# X-Bone Node Daemon #\n".
"# http://www.isi.edu/xbone #\n".
"# #\n".
"# #\n".
"##########################################################\n";
#=> initialization
init;
#=> put the process in the background if necessary.
demonize;
#=> Refresh the certificates before binding
refresh_shared_data(1);
#=> bind listening sockets
bind_sockets;
#=> set/start timers
$now = time;
$next_refresh = $now + $XB_Params::refresh;
$next_data_refresh = $now + $XB_Params::data_refresh_period;
#=> main loop
while(1){
$now = time;
#=> refresh the CAs
if ($now >= $next_data_refresh){
refresh_shared_data();
$next_data_refresh += $XB_Params::data_refresh_period;
}
#=> periodic task: refresh & check for expiration
if($now >= $next_refresh){
$next_refresh = periodic_check($now);
}
#=> wait for connection request
while(@ready = $sel->can_read($XB_Params::period)){
foreach my $fh (@ready){
#=> clear error logs before we start
unless($XB_Params::error_reply eq ''){
XB_Log::log "warning", "=> Uncleared error logs:\n".
$XB_Params::error_reply;
$XB_Params::error_reply = '';
}
if(defined $api_sock and $fh == $api_sock){
#=> XBone API connection
api_connect($fh, 'ipv4');
}elsif(defined $ctl_sock and $fh == $ctl_sock){
#=> XBone Control connection
ctl_connect $fh, 'ipv4';
}elsif(defined $api_sock6 and $fh == $api_sock6){
#=> XBone API connection
api_connect($fh, 'ipv6');
}elsif(defined $ctl_sock6 and $fh == $ctl_sock6){
#=> XBone Control connection
ctl_connect $fh, 'ipv6';
}elsif(defined $mcast_send_sock and $fh == $mcast_send_sock){
#=> XBone UDP Control connection
mcast_connect $fh, 'ipv4';
}elsif(defined $mcast_recv_sock and $fh == $mcast_recv_sock){
#=> XBone multicast connection (incoming from multicast group)
mcast_connect $fh, 'ipv4';
}elsif(defined $mcast_send_sock6 and $fh == $mcast_send_sock6){
#=> XBone UDP Control connection
mcast_connect $fh, 'ipv6';
}elsif(defined $mcast_recv_sock6 and $fh == $mcast_recv_sock6){
#=> XBone multicast connection (incoming from multicast group)
mcast_connect $fh, 'ipv6';
}else{
XB_Log::log "info", "Unkown socket connected";
}
}
}
} # while(1)
}
eval {
main;
};
cleanup(0,1);
1;
syntax highlighted by Code2HTML, v. 0.9.1