root/honeyclient/branches/bug/42/lib/HoneyClient/Manager/VM.pm

#######################################################################
# Created on:  Dec 29, 2005
# Package:     HoneyClient::Manager::VM
# File:        VM.pm
# Description: A SOAP server that provides programmatic access to all
#              VM clients.
#
# CVS: $Id$
#
# @author kindlund
#
# Copyright (C) 2006 The MITRE Corporation.  All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation, using version 2
# of the License.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.
#
#######################################################################

=pod

=head1 NAME

HoneyClient::Manager::VM - Perl extension to instantiate a SOAP server
that provides programmmatic access to all VM clients within the locally
running VMware Server / GSX server.

=head1 VERSION

This documentation refers to HoneyClient::Manager:VM version 1.0.

=head1 SYNOPSIS

=head2 CREATING THE SOAP SERVER

  use HoneyClient::Manager::VM;

  # Handle SOAP requests on the default address:port.
  my $URL = HoneyClient::Manager::VM->init();

  # Handle SOAP requests on TCP port localhost:9090
  my $URL = HoneyClient::Manager::VM->init(address => "localhost", 
                                           port    => 9090);

  print "Server URL: " . $URL . "\n";

  # Create a cleanup function, to execute whenever
  # the SOAP server needs to be destroyed.
  sub cleanup {
      HoneyClient::Manager::VM->destroy();
      exit;
  }

  # Install the cleanup handler, in case parent process
  # dies unexpectedly.
  $SIG{HUP}       = \&cleanup;
  $SIG{INT}       = \&cleanup;
  $SIG{QUIT}      = \&cleanup;
  $SIG{ABRT}      = \&cleanup;
  $SIG{PIPE}      = \&cleanup;
  $SIG{TERM}      = \&cleanup;

  # Catch all parent code errors, in order to perform cleanup
  # on all child processes before exiting.
  eval {
      # Do rest of the parent processing here...
  };

  # We assume you still want to still want to "die" on
  # any errors found within the eval block.
  if ($@) {
      HoneyClient::Manager::VM->destroy();
      die $@; 
  }

  # Even if no errors occurred, initiate cleanup.
  cleanup();

=head2 INTERACTING WITH THE SOAP SERVER 

  use HoneyClient::Util::SOAP qw(getClientHandle);

  # Create a new SOAP client, to talk to the HoneyClient::Manager::VM
  # module.
  my $stub = getClientHandle(namespace => "HoneyClient::Manager::VM");
  my $som;

  # Enumerate all registered VMs.
  $som = $stub->enumerate();
  my @list = $som->paramsall;
  print "\t$_\n" foreach (@list);
  print "\n";

  # Assume we have a particular VM.
  my $vmConfig = "/path/to/vm.vmx";

  # See if a particular VM is registered.
  $som = $stub->isRegisteredVM(config => $vmConfig);
  if ($som->result) {
      print "Yes, the VM is registered.";
  } else {
      print "No, the VM is not registered.";
  }

  # Register a particular VM.
  $som = $stub->registerVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }

  # Unregister a particular VM.
  $som = $stub->unregisterVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }

  # Get the state of a particular VM.
  use VMware::VmPerl qw(VM_EXECUTION_STATE_ON
                        VM_EXECUTION_STATE_OFF
                        VM_EXECUTION_STATE_STUCK
                        VM_EXECUTION_STATE_SUSPENDED);
  $som = $stub->getStateVM(config => $vmConfig);
  if ($som->result == VM_EXECUTION_STATE_ON) {
      print "ON\n";
  } elsif ($som->result == VM_EXECUTION_STATE_OFF) {
      print "OFF\n";
  } elsif ($som->result == VM_EXECUTION_STATE_SUSPENDED) {
      print "SUSPENDED\n";
  } elsif ($som->result == VM_EXECUTION_STATE_STUCK) {
      print "STUCK\n";
  } else {
      print "UNKNOWN\n";
  }

  # Start a particular VM.
  $som = $stub->startVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }
  
  # Stop a particular VM.
  $som = $stub->stopVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }
  
  # Reboot a particular VM.
  $som = $stub->rebootVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }
  
  # Suspend a particular VM.
  $som = $stub->suspendVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }

  # After starting a particular VM, if the VM's
  # state is STUCK, we can try automatically answering
  # any pending questions that the VMware Server / GSX
  # daemon is waiting for.
  #
  # Note: In most cases, this call doesn't need to
  # be made, since startVM() will try this call
  # automatically, if needed.
  $som = $stub->answerVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }

  # Create a new full clone from a particular VM 
  # and put the clone in the "/vm/TEST" directory.
  my $destDir = "/vm/TEST";
  $som = $stub->fullCloneVM(src_config => $vmConfig, dest_dir => $destDir);
  my $cloneConfig = $som->result;
  if ($som->result) {
      print "Successfully created clone VM at ($cloneConfig)!\n";
  } else {
      print "Failed to create clone!\n";
  }
  
  # Create a new quick clone from a particular VM
  # and put the clone in the "/vm/TEST" directory.
  my $destDir = "/vm/TEST";
  $som = $stub->quickCloneVM(src_config => $vmConfig, dest_dir => $destDir);
  my $cloneConfig = $som->result;
  if ($som->result) {
      print "Successfully created clone VM at ($cloneConfig)!\n";
  } else {
      print "Failed to create clone!\n";
  }
  
  # Set a particular VM to be a master image,
  # allowing us to call quickCloneVM() without
  # any arguments.
  $som = $stub->setMasterVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }

  # Get the name of a particular VM.
  $som = $stub->getNameVM(config => $vmConfig);
  my $dispName = $som->result;
  if ($som->result) {
      print "VM Name: \"$dispName\"\n";
  } else {
      print "Failed to get VM name!\n";
  }

  # Set the name of a particular VM to "BLAH".
  $som = $stub->setNameVM(config => $vmConfig, name => "BLAH");
  my $dispName = $som->result;
  if ($som->result) {
      print "VM Renamed To: \"$dispName\"\n";
  } else {
      print "Failed to rename VM!\n";
  }

  # Get the MAC address of a particular VM's first NIC.
  $som = $stub->getMACaddrVM(config => $vmConfig);
  my $macAddress = $som->result;
  if ($som->result) {
      print "VM MAC Address: \"$macAddress\"\n";
  } else {
      print "Failed to get VM MAC address!\n";
  }
  
  # Get the IP address of a particular VM's first NIC.
  $som = $stub->getIPaddrVM(config => $vmConfig);
  my $ipAddress = $som->result;
  if ($som->result) {
      print "VM IP Address: \"$ipAddress\"\n";
  } else {
      print "Failed to get VM IP address!\n";
  }

  # Destroy a particular VM.
  $som = $stub->destroyVM(config => $vmConfig);
  if ($som->result) {
      print "Success!\n";
  } else {
      print "Failed!\n";
  }

  # Save a snapshot of a particular VM, saving the
  # snapshot to "/path/to/snapshot.tar.gz".
  $som = $stub->snapshotVM(config => $vmConfig, snapshot_file => "/path/to/snapshot.tar.gz");
  my $destSnapshot = $som->result;
  if ($som->result) {
      print "Successfully snapshotted VM at ($destSnapshot)!\n";
  } else {
      print "Failed to snapshot VM!\n";
  }

  # Revert a particular VM back to a previous snapshot,
  # where the snapshot file is located at
  # "/path/to/snapshot.tar.gz".
  $som = $stub->revertVM(config => $vmConfig, snapshot_file => "/path/to/snapshot.tar.gz");
  my $revertConfig = $som->result;
  if ($som->result) {
      print "Successfully reverted VM at ($revertConfig)!\n";
  } else {
      print "Failed to revert VM!\n";
  }

=head1 DESCRIPTION

Once created, the daemon acts as a stand-alone SOAP server,
processing individual requests and manipulating VMs on the 
locally running VMware Server / GSX server.

=cut

package HoneyClient::Manager::VM;

use strict;
use warnings;
use Config;
use Carp ();

# Traps signals, allowing END: blocks to perform cleanup.
use sigtrap qw(die untrapped normal-signals error-signals);

#######################################################################
# Module Initialization                                               #
#######################################################################

BEGIN {
    # Defines which functions can be called externally.
    require Exporter;
    our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);

    # Set our package version.
    $VERSION = 0.9;

    @ISA = qw(Exporter);

    # Symbols to export on request
    @EXPORT = qw();

    # Items to export into callers namespace by default. Note: do not export
    # names by default without a very good reason. Use EXPORT_OK instead.
    # Do not simply export all your public functions/methods/constants.

    # This allows declaration use HoneyClient::Manager::VM ':all';
    # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
    # will save memory.

    %EXPORT_TAGS = ( 
        'all' => [ qw() ],
    );

    # Symbols to autoexport (:DEFAULT tag)
    @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

    # Check to see if ithreads are compiled into this version of Perl.
    if (!$Config{useithreads}) {
        Carp::croak "Error: Recompile Perl with ithread support, in order to use this module.\n";
    }

    $SIG{PIPE} = 'IGNORE'; # Do not exit on broken pipes.
}
our (@EXPORT_OK, $VERSION);

=pod

=begin testing

# Generate a notice, to clarify our assumptions.
diag("Note: These unit tests *expect* the VMware Server / GSX daemon to be operational on this system beforehand.");

# Make sure Log::Log4perl loads
BEGIN { use_ok('Log::Log4perl', qw(:nowarn))
        or diag("Can't load Log::Log4perl package. Check to make sure the package library is correctly listed within the path.");
       
        # Suppress all logging messages, since we need clean output for unit testing.
        Log::Log4perl->init({
            "log4perl.rootLogger"                               => "DEBUG, Buffer",
            "log4perl.appender.Buffer"                          => "Log::Log4perl::Appender::TestBuffer",
            "log4perl.appender.Buffer.min_level"                => "fatal",
            "log4perl.appender.Buffer.layout"                   => "Log::Log4perl::Layout::PatternLayout",
            "log4perl.appender.Buffer.layout.ConversionPattern" => "%d{yyyy-MM-dd HH:mm:ss} %5p [%M] (%F:%L) - %m%n",
        });
}
require_ok('Log::Log4perl');
use Log::Log4perl qw(:easy);

# Make sure HoneyClient::Util::Config loads.
BEGIN { use_ok('HoneyClient::Util::Config', qw(getVar))
        or diag("Can't load HoneyClient::Util::Config package.  Check to make sure the package library is correctly listed within the path.");

        # Suppress all logging messages, since we need clean output for unit testing.
        Log::Log4perl->init({
            "log4perl.rootLogger"                               => "DEBUG, Buffer",
            "log4perl.appender.Buffer"                          => "Log::Log4perl::Appender::TestBuffer",
            "log4perl.appender.Buffer.min_level"                => "fatal",
            "log4perl.appender.Buffer.layout"                   => "Log::Log4perl::Layout::PatternLayout",
            "log4perl.appender.Buffer.layout.ConversionPattern" => "%d{yyyy-MM-dd HH:mm:ss} %5p [%M] (%F:%L) - %m%n",
        });
}
require_ok('HoneyClient::Util::Config');
can_ok('HoneyClient::Util::Config', 'getVar');
use HoneyClient::Util::Config qw(getVar);

# Suppress all logging messages, since we need clean output for unit testing.
Log::Log4perl->init({
    "log4perl.rootLogger"                               => "DEBUG, Buffer",
    "log4perl.appender.Buffer"                          => "Log::Log4perl::Appender::TestBuffer",
    "log4perl.appender.Buffer.min_level"                => "fatal",
    "log4perl.appender.Buffer.layout"                   => "Log::Log4perl::Layout::PatternLayout",
    "log4perl.appender.Buffer.layout.ConversionPattern" => "%d{yyyy-MM-dd HH:mm:ss} %5p [%M] (%F:%L) - %m%n",
});

# Make sure the module loads properly, with the exportable
# functions shared.
BEGIN { use_ok('HoneyClient::Manager::VM') or diag("Can't load HoneyClient::Manager:VM package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('HoneyClient::Manager::VM');
can_ok('HoneyClient::Manager::VM', 'init');
can_ok('HoneyClient::Manager::VM', 'destroy');
use HoneyClient::Manager::VM;

# Make sure HoneyClient::Util::SOAP loads.
BEGIN { use_ok('HoneyClient::Util::SOAP', qw(getServerHandle getClientHandle)) or diag("Can't load HoneyClient::Util::SOAP package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('HoneyClient::Util::SOAP');
can_ok('HoneyClient::Util::SOAP', 'getServerHandle');
can_ok('HoneyClient::Util::SOAP', 'getClientHandle');
use HoneyClient::Util::SOAP qw(getServerHandle getClientHandle);

# Make sure File::Basename loads.
BEGIN { use_ok('File::Basename', qw(dirname basename)) or diag("Can't load File::Basename package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('File::Basename');
can_ok('File::Basename', 'dirname');
can_ok('File::Basename', 'basename');
use File::Basename qw(dirname basename);

# Make sure File::Copy::Recursive loads.
BEGIN { use_ok('File::Copy::Recursive', qw(dircopy pathrmdir)) or diag("Can't load File::Copy::Recursive package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('File::Copy::Recursive');
can_ok('File::Copy::Recursive', 'dircopy');
can_ok('File::Copy::Recursive', 'pathrmdir');
use File::Copy::Recursive qw(dircopy pathrmdir);

# Make sure Data::Dumper loads.
BEGIN { use_ok('Data::Dumper') or diag("Can't load Data::Dumper package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('Data::Dumper');
use Data::Dumper;

# Make sure File::stat loads.
BEGIN { use_ok('File::stat') or diag("Can't load File::stat package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('File::stat');
use File::stat;

# Make sure Digest::MD5 loads.
BEGIN { use_ok('Digest::MD5', qw(md5_hex)) or diag("Can't load Digest::MD5 package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('Digest::MD5');
can_ok('Digest::MD5', 'md5_hex');
use Digest::MD5 qw(md5_hex);

# Make sure DateTime::HiRes loads.
BEGIN { use_ok('DateTime::HiRes') or diag("Can't load DateTime::HiRes package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('DateTime::HiRes');
use DateTime::HiRes;

# Make sure Fcntl loads.
BEGIN { use_ok('Fcntl', qw(O_RDONLY)) or diag("Can't load Fcntl package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('Fcntl');
use Fcntl qw(O_RDONLY);

# Make sure VMware::VmPerl loads.
BEGIN { use_ok('VMware::VmPerl', qw(VM_EXECUTION_STATE_ON VM_EXECUTION_STATE_OFF VM_EXECUTION_STATE_STUCK VM_EXECUTION_STATE_SUSPENDED)) or diag("Can't load VMware::VmPerl package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('VMware::VmPerl');
use VMware::VmPerl qw(VM_EXECUTION_STATE_ON VM_EXECUTION_STATE_OFF VM_EXECUTION_STATE_STUCK VM_EXECUTION_STATE_SUSPENDED);

# Make sure VMware::VmPerl::Server loads.
BEGIN { use_ok('VMware::VmPerl::Server') or diag("Can't load VMware::VmPerl::Server package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('VMware::VmPerl::Server');
use VMware::VmPerl::Server;

# Make sure VMware::VmPerl::ConnectParams loads.
BEGIN { use_ok('VMware::VmPerl::ConnectParams') or diag("Can't load VMware::VmPerl::ConnectParams package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('VMware::VmPerl::ConnectParams');
use VMware::VmPerl::ConnectParams;

# Make sure VMware::VmPerl::VM loads.
BEGIN { use_ok('VMware::VmPerl::VM') or diag("Can't load VMware::VmPerl::VM package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('VMware::VmPerl::VM');
use VMware::VmPerl::VM;

# Make sure VMware::VmPerl::VM loads.
BEGIN { use_ok('VMware::VmPerl::Question') or diag("Can't load VMware::VmPerl::Question package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('VMware::VmPerl::Question');
use VMware::VmPerl::Question;

# Make sure threads loads.
BEGIN { use_ok('threads') or diag("Can't load threads package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('threads');
use threads;

# Make sure threads::shared loads.
BEGIN { use_ok('threads::shared') or diag("Can't load threads::shared package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('threads::shared');
use threads::shared;

# Make sure Thread::Queue loads.
BEGIN { use_ok('Thread::Queue') or diag("Can't load Thread::Queue package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('Thread::Queue');
use Thread::Queue;

# Make sure Thread::Semaphore loads.
BEGIN { use_ok('Thread::Semaphore') or diag("Can't load Thread::Semaphore package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('Thread::Semaphore');
use Thread::Semaphore;

# TODO: Remove this once unit testing should actually be used.
# Ideally, this should be handled programmatically, based upon user prompt.
exit;

# Generate a notice, to inform the tester that these tests are not
# exactly quick.
diag("Note: These unit tests will take *significant* time to complete (10-30 minutes).");

=end testing

=cut

#######################################################################
# Path Variables                                                      #
#######################################################################

# Include Global Configuration Processing Library
use HoneyClient::Util::Config qw(getVar);

# Include Data Dumper API
use Data::Dumper;

# Include Logging Library
use Log::Log4perl qw(:easy);

# The global logging object.
our $LOG = get_logger();

# Make Dumper format more terse.
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 0;

# Default absolute path to use when cloning new VMs.
our $DATASTORE_PATH = getVar(name => "datastore_path");

# Default absolute path to use when storing snapshots.
our $SNAPSHOT_PATH = getVar(name => "snapshot_path");

# Make sure the $DATASTORE_PATH is a valid directory and exists.
if (!-d $DATASTORE_PATH) {
    $LOG->fatal("Current datastore path ($DATASTORE_PATH) does not exist!");
    Carp::croak "Error: Current datastore path ($DATASTORE_PATH) does not exist!\n";
}

# Make sure the $SNAPSHOT_PATH is a valid directory and exists.
if (!-d $SNAPSHOT_PATH) {
    $LOG->fatal("Error: Current datastore path ($SNAPSHOT_PATH) does not exist!");
    Carp::croak "Error: Current datastore path ($SNAPSHOT_PATH) does not exist!\n";
}
#######################################################################

# Include the SOAP Utility Library
use HoneyClient::Util::SOAP qw(getServerHandle getClientHandle);

# Include the VMware APIs
use VMware::VmPerl;
use VMware::VmPerl::Server;
use VMware::VmPerl::ConnectParams;
use VMware::VmPerl::VM;
use VMware::VmPerl::Question;

# Include POSIX Libraries
use POSIX qw(strftime);

# Include File/Directory Manipulation Libraries
use File::Copy;
use File::Copy::Recursive qw(dircopy pathrmdir);
use File::Basename qw(dirname basename);
use Tie::File;
use Fcntl qw(O_RDONLY);

# Include Thread Libraries
use threads;
use threads::shared;
use Thread::Queue;
use Thread::Semaphore;

# Include MD5 Libraries
use Digest::MD5 qw(md5_hex);

# Include ISO8601 Date/Time Library
use DateTime::HiRes;

# Global fault queue.
# Used to convey faults that have occurred within
# asynchronous threads back to synchronous, external
# function calls.
our $faultQueue = Thread::Queue->new();

# Global semaphore, designed to limit the maximum
# number of child threads that run.
#
# By default, we limit the number of children to 5.
# If more than 5 child threads are created, subsequent 
# ones will block, until one of the running threads
# finishes.
our $maxThreadSemaphore = Thread::Semaphore->new(5);

# Hashtable used to contain VM-specific semaphores,
# used to guarantee only one operation per VM is performed
# at any given time.
our %vmSemaphoreHash;

# Global semaphore, designed to limit exclusive access
# to the %vmSemaphoreHash object. This lock is designed
# to prevent multiple threads from creating/deleting entries
# simultaneously, which would cause nasty race conditions.
our $hashSemaphore = Thread::Semaphore->new(1);

# Global semaphore, designed to guarantee only one thread
# may set the master VM configuration file at any given
# time.
our $masterVMSemaphore = Thread::Semaphore->new(1);

# Global semaphore, designed to allow only 1 thread
# at a time to perform chdir operations.
our $chdirSemaphore = Thread::Semaphore->new(1);

# Constants used to authenticate with the VMware Server / 
# GSX server.
# If username and password are left undefined,
# the process owner's credentials will be used.
our $serverName     : shared = undef;
our $tcpPort        : shared = getVar(name => "vmware_port");
our $username       : shared = undef;
our $passwd         : shared = undef;

# VmPerl Objects used only by the parent thread.
our $server         = undef;
our $connectParams  = undef;
our $vm             = undef;

# Path to master config file, for eventual cloning.
our $vmMasterConfig : shared = undef;

# Complete URL of SOAP server, when initialized.
our $URL_BASE       : shared = undef;
our $URL            : shared = undef;

# If connectivity to the VMware Server / GSX server is 
# ever lost, this indicates how may reconnection attempts 
# will be made before failing completely.
our $MAX_RETRIES    : shared = 5;

# The process ID of the SOAP server daemon, once created.
our $DAEMON_PID     : shared = undef;

# The maximum length of any VMID generated.
our $VM_ID_LENGTH   : shared = getVar(name => "vm_id_length");

# The log file that contains DHCP lease log entries.
our $DHCP_LOGFILE   : shared = getVar(name => "dhcp_log");

#######################################################################
# Daemon Initialization / Destruction                                 #
#######################################################################

=pod

=head1 LOCAL FUNCTIONS

The following init() and destroy() functions are the only direct
calls required to startup and shutdown the SOAP server.

All other interactions with this daemon should be performed as
C<SOAP::Lite> function calls, in order to ensure consistency across
client sessions.  See the L<"EXTERNAL SOAP FUNCTIONS"> section, for
more details.

=head2 HoneyClient::Manager::VM->init(address => $localAddr, port => $localPort)

=over 4

Starts a new SOAP server, within a child process.

I<Inputs>:
 B<$localAddr> is an optional argument, specifying the IP address for the SOAP server to listen on.
 B<$localPort> is an optional argument, specifying the TCP port for the SOAP server to listen on.

I<Output>: The full URL of the web service provided by the SOAP server.

=back

=begin testing

# Shared test variables.
my $PORT = getVar(name      => "port",
                  namespace => "HoneyClient::Manager::VM");
my ($stub, $som, $URL);
my $testVM = $ENV{PWD} . "/" . getVar(name      => "test_vm_config",
                                      namespace => "HoneyClient::Manager::VM::Test");

# Test init() method.
$URL = HoneyClient::Manager::VM->init();
is($URL, "http://localhost:$PORT/HoneyClient/Manager/VM", "init()") or diag("Failed to start up the VM SOAP server.  Check to see if any other daemon is listening on TCP port $PORT.");

=end testing

=cut

sub init {
    # Extract arguments.
    my ($class, %args) = @_;

    # Sanity check.  Make sure the daemon isn't already running.
    if (defined($DAEMON_PID)) {
        $LOG->fatal( __PACKAGE__ . " daemon is already running (PID = $DAEMON_PID)!");
        Carp::croak "Error: " . __PACKAGE__ . " daemon is already running (PID = $DAEMON_PID)!\n";
    }

    my $argsExist = scalar(%args);

    if (!($argsExist &&
          exists($args{'address'}) &&
          defined($args{'address'}))) {
        $args{'address'} = getVar(name => "address");
    }

    if (!($argsExist &&
          exists($args{'port'}) &&
          defined($args{'port'}))) {
        $args{'port'} = getVar(name => "port");
    }


    $URL_BASE = "http://" . $args{'address'} . ":" . $args{'port'};
    $URL = $URL_BASE . "/" . join('/', split(/::/, __PACKAGE__));

    my $pid = undef;
    if ($pid = fork()) {

        # Wait at least a second, in order to initialize the daemon.
        sleep (1);
        $DAEMON_PID = $pid;
        return ($URL);

    } else {

        # Make sure the fork was successful.
        if (!defined($pid)) {
            $LOG->fatal("Error: Unable to fork child process. $!");
            Carp::croak "Error: Unable to fork child process.\n$!";
        }

        # Do not attempt to rejoin parent process tree,
        # if any type of termination signal is received.
        local $SIG{HUP} = sub { exit; };
        local $SIG{INT} = sub { exit; };
        local $SIG{QUIT} = sub { exit; };
        local $SIG{ABRT} = sub { exit; };
        local $SIG{PIPE} = sub { exit; };
        local $SIG{TERM} = sub { exit; };

        my $daemon = getServerHandle(address => $args{'address'},
                                     port    => $args{'port'});

        for (;;) {
            $daemon->handle();
        }
    }
}

=pod

=head2 HoneyClient::Manager::VM->destroy()

=over 4

Terminates the SOAP server within the child process.

I<Output>: True if successful, false otherwise.

=back

=begin testing

# Shared test variables.
my $PORT = getVar(name      => "port",
                  namespace => "HoneyClient::Manager::VM");
my ($stub, $som, $URL);
my $testVM = $ENV{PWD} . "/" . getVar(name      => "test_vm_config",
                                      namespace => "HoneyClient::Manager::VM::Test");

# Test destroy() method.
is(HoneyClient::Manager::VM->destroy(), 1, "destroy()") or diag("Unable to terminate VM SOAP server.  Be sure to check for any stale or lingering processes.");

=end testing

=cut

sub destroy {
    my $ret = undef;
    # Make sure the PID is defined and not
    # the parent process...
    if (defined($DAEMON_PID) && $DAEMON_PID) {
        $ret = kill("QUIT", $DAEMON_PID);
    }
    if ($ret) {
        $DAEMON_PID = undef;
    }
    return ($ret);
}

#######################################################################
# Private Methods Implemented                                         #
#######################################################################

# Helper function designed to connect to a specified VM.
# Requires specifying the full, absolute
# path to the VM's local configuration file.
#
# Inputs: config
# Outputs: None
sub _connectVM {
    # Extract arguments.
    my ($class, $config) = @_;

    # Sanity check. Make sure we're connected.
    if (!defined($server) || !defined($server->is_connected())) {
        _connect();
    }

    # If possible, reuse the preexisting VM connection.
    if (defined($vm) && 
        $vm->is_connected() && 
        ($vm->get_config_file_name() eq $config)) {
        return;
    }

    # If we're trying to connect up to an unregistered VM, go ahead
    # and register it...
    if (!isRegisteredVM($class, (config => $config))) {
        registerVM($class, (config => $config));
    }

    $vm = VMware::VmPerl::VM::new();

    # Connect to the VM, using the same ConnectParams object.
    # Throttle repeat connections to the VMware Server / GSX server.
    my $count    = 0;
    my $status = undef;
    do {
        sleep (2);
        $status = $vm->connect($connectParams, $config);
        $count++;
    } while (!$status && $count < $MAX_RETRIES);
    if ($count >= $MAX_RETRIES) {
        my ($errorNumber, $errorString) = $server->get_last_error();
        $LOG->warn("Could not connect to VM (" . $config . "). (" .
                   $errorNumber . ": " . $errorString . ")");
        die SOAP::Fault->faultcode(__PACKAGE__ . "->_connectVM()")
                       ->faultstring("Could not connect to VM ($config).")
                       ->faultdetail(bless { errNo  => $errorNumber,
                                             errStr => $errorString },
                                     'err');
    }
}

# Helper function designed to disconnect from a previously specified VM.
#
# Inputs: None
# Outputs: None
sub _disconnectVM {
    undef $vm;
}

# Helper function designed to emit the first queued fault.
# If any exist, automatically die with the earliest queued fault.
#
# Inputs: None
# Outputs: None
sub _emitQueuedFault {

    my $fault = $faultQueue->dequeue_nb();
    if (defined($fault)) {
        my $deserializer = SOAP::Deserializer->new();
        my $som = $deserializer->deserialize($fault);
        if (defined($som->faultdetail)) {
            die SOAP::Fault->faultcode($som->faultcode)
                           ->faultstring($som->faultstring)
                           ->faultdetail(bless { errNo  => $som->faultdetail->{"err"}->{"errNo"},
                                                 errStr => $som->faultdetail->{"err"}->{"errStr"} },
                                         'err');
        } else {
            die SOAP::Fault->faultcode($som->faultcode)
                           ->faultstring($som->faultstring);
        }
    }
}

# Helper function designed to store faults in a globally shared queue.A
# Faults are serialized into XML form, then stored in the queue.
#
# Inputs: SOAP::Fault
# Outputs: None
sub _queueFault {

    my $fault = shift;
    my $serializer = SOAP::Serializer->new();
    my $xml = $serializer->fault($fault->faultcode, 
                                 $fault->faultstring, 
                                 $fault->faultdetail, 
                                 $fault->faultactor);
    $faultQueue->enqueue($xml);
}

# Helper function designed to return true if the "$serverName"
# is local; useful for functions that are designed to perform
# filesystem operations that can only be performed on a local
# server.
#
# Inputs: None
# Outputs: True if server is local, false otherwise. 
sub _isServerLocal {
    
    return (!defined($serverName) || 
            $serverName eq "localhost" ||
            $serverName =~ /^127\.\d{1,3}\.\d{1,3}\.\d{1,3}$/);
}

# Helper function used by child threads to handle faults that
# occur during callbacks made to the parent SOAP server.
#
# When a fault is handled, it is converted back into a SOAP::Fault
# object and subsequently queued for final emission by the
# parent upon subsequent remote calls.
#
# Inputs: SOAP::SOM
# Outputs: None
sub _callbackFaultHandler {

    # Extract arguments.
    my ($class, $res) = @_;

    # Reconstruct the SOAP::Fault.
    # Figure out if the error occurred in transport or
    # over on the other side.
    my $errMsg = $class->transport->status; # Assume transport error.
    if (ref $res) {
        
        if (defined($res->faultdetail)) {
            # Detailed fault occurred.
            die SOAP::Fault->faultcode($res->faultcode)
                           ->faultstring($res->faultstring)
                           ->faultdetail(bless { errNo  => $res->faultdetail->{"err"}->{"errNo"},
                                                 errStr => $res->faultdetail->{"err"}->{"errStr"} },
                                         'err');
        } else {
            # Basic fault occurred.
            die SOAP::Fault->faultcode($res->faultcode)
                           ->faultstring($res->faultstring);
        }