view release on metacpan or  search on metacpan

lib/HoneyClient/Manager/VM.pm  view on Meta::CPAN

# 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

lib/HoneyClient/Manager/VM.pm  view on Meta::CPAN

    if (!exists($vmSemaphoreHash{$config})) {
        # Semaphore does not exist, create it.
        $vmSemaphoreHash{$config} = Thread::Semaphore->new(1);
    }
        
    $vmSemaphore = $vmSemaphoreHash{$config};

    $hashSemaphore->up();

    return ($vmSemaphore);
}

# Helper function designed to retrieve the semaphore lock for
# a specific VM, in order to perform exclusive operations on
# the specified VM.  This function blocks the calling thread,
# whenever semaphore retrieval cannot be guaranteed.
#
# If the VM's semaphore was found, it will be removed from the
# global hashtable, prior to returning the extracted semaphore.
#
# If the VM's semaphore does not exist in the global hashtable,
# then undef will be returned.
#
# Input: config
# Output: None
sub _destroyVMlock {
    
    # Extract arguments.
    my ($class, $config) = @_;
    my $vmSemaphore = undef;
    
    $hashSemaphore->down();

    # Check to see if the hash key exists...
    if (exists($vmSemaphoreHash{$config})) {
        $vmSemaphore = $vmSemaphoreHash{$config};
        delete $vmSemaphoreHash{$config};
    }

    $hashSemaphore->up();
    
    return ($vmSemaphore);
}

# Connects to the specified host.
#
# Inputs: serverName, tcpPort, username, passwd 
# Outputs: None
sub _connect {

    # Extract arguments.
    my $class = shift;
    ($serverName, $tcpPort, $username, $passwd) = @_;
    
    # Sanity check.  Make sure there are no queued faults.
    _emitQueuedFault();
    

    # Define the parameters used to connect to the VMware Server / GSX server.
    # If any of these parameters are undefined, defaults will be used.
    # For example, the process owner's credentials will be used
    # for username/passwd if undefined.
    $connectParams = VMware::VmPerl::ConnectParams::new($serverName, $tcpPort, $username, $passwd);
    
    # Establish a persistent connection with server.
    $server = VMware::VmPerl::Server::new();
    
    # Check to make sure we're connected.
    if (!$server->connect($connectParams)) {
        my ($errorNumber, $errorString) = $server->get_last_error();
        $LOG->warn("Could not connect to host system \"" . $serverName .
                   "\". (" . $errorNumber . ": " . $errorString . ")");
        die SOAP::Fault->faultcode(__PACKAGE__ . "->_connect()")
                       ->faultstring("Could not connect to host system \"" . $serverName . "\".")
                       ->faultdetail(bless { errNo  => $errorNumber,
                                             errStr => $errorString },
                                     'err');
    }
}

# Disconnects from the host.
#
# Inputs: None
# Outputs: None
sub _disconnect {
    # Disconnect from any connected VMs.
    _disconnectVM();

    # Destroys the server object, thus disconnecting from the server.
    undef $server;
    
    # Sanity check.  Make sure there are no queued faults.
    _emitQueuedFault();
}

# Helper function, designed to generate a new unique VM ID that persists
# across snapshot operations and any other VM migrations.
#
# Note: This code was taken from the Apache::SessionX::Generate::MD5
# package.  It was replicated here, to avoid unwanted dependencies.
#
# The resultant VMID is a hexadecimal string of length $VM_ID_LENGTH
# (where this length is between 1 and 32, inclusive).  These VMIDs
# are supposed to be unique, so it is recommended that $VM_ID_LENGTH
# be as large as possible.
#
# The VMIDs are generated using a two-round MD5 of a random number,
# the time since the epoch, the process ID, and the address of an
# anonymous hash.  The resultant VMID string is highly entropic on
# Linux and other platforms that have good random number generators.
#
# Inputs: None
# Outputs: vmID
sub _generateVMID {

    return (substr(md5_hex(md5_hex(time(), {}, rand(), $$)), 0, $VM_ID_LENGTH));

}

#######################################################################
# Public Methods Implemented                                          #