Changeset 810

Timestamp:

08/31/07 16:34:50 (1 year ago)

Author:

kindlund

Message:

Completed initial VM::Clone support.

Files:

• honeyclient/branches/exp/kindlund-dynamic_updates/etc/honeyclient_log.conf (modified) (1 diff)
• honeyclient/branches/exp/kindlund-dynamic_updates/lib/HoneyClient/Manager/VM.pm (modified) (2 diffs)
• honeyclient/branches/exp/kindlund-dynamic_updates/lib/HoneyClient/Manager/VM/Clone.pm (modified) (10 diffs)
• honeyclient/branches/exp/kindlund-dynamic_updates/t/honeyclient_manager_vm_clone.t (modified) (4 diffs)

honeyclient/branches/exp/kindlund-dynamic_updates/etc/honeyclient_log.conf

@@ -64 +64 @@
-#log4perl.logger.HoneyClient.Agent.Integrity.Registry=DEBUG, Screen
-#log4perl.logger.HoneyClient.DB=DEBUG, Screen
+#log4perl.logger.HoneyClient.Manager.VM.Clone=DEBUG, Screen
-# Suppress Parser Debugging Messages
-#log4perl.logger.HoneyClient.Agent.Integrity.Registry.Parser=INFO, Screen

honeyclient/branches/exp/kindlund-dynamic_updates/lib/HoneyClient/Manager/VM.pm

@@ -719 +719 @@
-    my ($class, %args) = @_;
-
+    # Log resolved arguments.
+    $LOG->debug(sub {
+        # Make Dumper format more terse.
+        $Data::Dumper::Terse = 1;
+        $Data::Dumper::Indent = 0;
+        Dumper(\%args);
+    });
+
-    # Sanity check.  Make sure the daemon isn't already running.
-    if (defined($DAEMON_PID)) {
@@ -806 +814 @@
-
-sub destroy {
+    # Log resolved arguments.
+    $LOG->debug(sub {
+        # Make Dumper format more terse.
+        $Data::Dumper::Terse = 1;
+        $Data::Dumper::Indent = 0;
+        Dumper();
+    });
+
-    my $ret = undef;
-    # Make sure the PID is defined and not

honeyclient/branches/exp/kindlund-dynamic_updates/lib/HoneyClient/Manager/VM/Clone.pm

@@ -167 +167 @@
-
-=begin testing
+
+# Make sure ExtUtils::MakeMaker loads.
+BEGIN { use_ok('ExtUtils::MakeMaker', qw(prompt)) or diag("Can't load ExtUtils::MakeMaker package.  Check to make sure the package library is correctly listed within the path."); }
+require_ok('ExtUtils::MakeMaker');
+can_ok('ExtUtils::MakeMaker', 'prompt');
+use ExtUtils::MakeMaker qw(prompt);
-
-# Make sure Log::Log4perl loads
@@ -293 +299 @@
-# The global variable, used to count the number of
-# Clone objects that have been created.
-0
+-1
-
-=pod
@@ -352 +358 @@
-
-=cut
-
-my %PARAMS = (
-    # The full absolute path to the master VM's configuration file, whose
-    # contents will be the basis for each subsequently cloned VM.
-    master_vm_config => getVar(name => "master_vm_config"),
-
-    # A variable containing the absolute path to the cloned VM's
-    # configuration file.
-    config => undef,
-
-    # A variable containing the MAC address of the cloned VM's primary
-    # interface.
-    mac_address => undef,
-    
-    # A variable containing the IP address of the cloned VM's primary
-    # interface.
-    ip_address => undef,
-    
-    # A variable containing the name the cloned VM.
-    name => undef,
-    
-    # A SOAP handle to the VM manager daemon.  (This internal variable
-    # should never be modified externally.)
-    _vm_handle => undef,
-
-    # A variable indicated how long the object should wait for
-    # between subsequent retries to the HoneyClient::Manager::VM
-    # daemon (in seconds).  (This internal variable should never
-    # be modified externally.)
-    _retry_period => 2,
-);
-
-#######################################################################
@@ -449 +424 @@
-    my $self = shift;
-
-
-
+
+
+
-        if (!$som->result()) {
-            $LOG->error("Unable to suspend VM (" . $self->{'config'} . ").");
@@ -458 +434 @@
-    # Decrement our global object count.
-    $OBJECT_COUNT--;
-
-
-
+
+
+
+
+
-        HoneyClient::Manager::VM->destroy();
-    }
-}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-    # Extract arguments.
@@ -668 +477 @@
-    my $ret = undef;
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-    # Wait until the VM gets registered, before proceeding.
-info
+debug
-    $ret = undef;
-    while (!defined($ret) or !$ret) {
@@ -693 +513 @@
-
-    # Once registered, check if the VM is ON yet.
+    $LOG->debug("Checking if clone VM (" . $self->{'config'} . ") is powered on.");
-    $ret = undef;
-    while (!defined($ret) or ($ret != VM_EXECUTION_STATE_ON)) {
@@ -705 +526 @@
-
-    # Now, get the VM's MAC address.
+    $LOG->debug("Retrieving MAC address of clone VM (" . $self->{'config'} . ").");
-    $som = $self->{'_vm_handle'}->getMACaddrVM(config => $self->{'config'});
-    $self->{'mac_address'} = $som->result();
-
-    # Now, get the VM's name.
+    $LOG->debug("Retrieving name of clone VM (" . $self->{'config'} . ").");
-    $som = $self->{'_vm_handle'}->getNameVM(config => $self->{'config'});
-    $self->{'name'} = $som->result();
-
-    # Now, get the VM's IP address.
+    $LOG->debug("Retrieving IP address of clone VM (" . $self->{'config'} . ").");
-    $ret = undef;
-    my $stubAgent = undef;
@@ -725 +549 @@
-            next; # skip further processing
-        } elsif (!$logMsgPrinted) {
-Creat
-
+Initializ
+)
-            $logMsgPrinted = 1;
-        }
@@ -753 +577 @@
-}
-
+#######################################################################
+# Public Methods Implemented                                          #
+#######################################################################
+
-=pod
-
-
+
+
+
+
+
-
-=over 4
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-=back
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-=cut
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-    # Get the class name.
-    my $self = shift;
-
+
+
+
+
+
+
+
-    # Check to see if the class name is inherited or defined.
-    my $class = ref($self) || $self;
+
+    # Initialize default parameters.
+    $self = { };
+    my %params = (
+        # The full absolute path to the master VM's configuration file, whose
+        # contents will be the basis for each subsequently cloned VM.
+        master_vm_config => getVar(name => "master_vm_config"),
+
+        # A variable containing the absolute path to the cloned VM's
+        # configuration file.
+        config => undef,
+
+        # A variable containing the MAC address of the cloned VM's primary
+        # interface.
+        mac_address => undef,
-    
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-}
-
-=pod
-
-=head2 $object->next()
-
-=over 4
-
-Returns the next set of server hostnames and/or IP addresses that the
-back-end application will contact, upon the next subsequent call to
-the B<$object>'s drive() method.
-
-Specifically, the returned data is a reference to a hashtable, containing
-detailed information about which resources, hostnames, IPs, protocols, and 
-ports that the application will contact upon the next iteration.
-
-Here is an example of such returned data:
-
-  $hashref = {
-  
-      # The set of servers that the driver will contact upon
-      # the next drive() operation.
-      targets => {
-          # The application will contact 'site.com' using
-          # TCP ports 80 and 81.
-          'site.com' => {
-              'tcp' => [ 80, 81 ],
-          },
-
-          # The application will contact '192.168.1.1' using
-          # UDP ports 53 and 123.
-          '192.168.1.1' => {
-              'udp' => [ 53, 123 ],
-          },
- 
-          # Or, more generically:
-          'hostname_or_IP' => {
-              'protocol_type' => [ portnumbers_as_list ],
-          },
-      },
-
-      # The set of resources that the driver will operate upon
-      # the next drive() operation.
-      resources => {
-          'http://www.mitre.org/' => 1,
-      },
-  };
-
-B<Note>: For each hostname or IP address specified, if B<no>
-corresponding protocol/port sub-hastables are given, then it
-must be B<assumed> that the back-end application may contact
-the hostname or IP address using B<ANY> protocol/port.
-
-I<Output>: The aforementioned B<$hashref> containing the next set of
-resources that the back-end application will attempt to contact upon
-the next drive() iteration.
-
-# XXX: Resolve this.
-
-B<Note>: Eventually this B<$hashref> will become a structured object,
-created via a HoneyClient::Util::* package.  However, the underlying
-structure of this hashtable is not expected to change. 
-
-=back
-
-#=begin testing
-#
-# Create a generic driver, with test state data.
-#my $driver = HoneyClient::Agent::Driver->new(test => 1);
-#dies_ok {$driver->next()} 'next()' or diag("The next() call failed.  Expected next() to throw an exception.");
-#
-#=end testing
-
-=cut
-
-sub next {
-    # Get the class name.
-    my $self = shift;
-    
-    # Check to see if the class name is inherited or defined.
-    my $class = ref($self) || $self;
-    
-    # Sanity check: Make sure we've been fed an object.
-    unless (ref($self)) {
-        $LOG->error("Error: Function must be called in reference to a " .
-                    __PACKAGE__ . "->new() object!");
-        Carp::croak "Error: Function must be called in reference to a " .
-                    __PACKAGE__ . "->new() object!";
-    }
-
-    # Emit generic "not implemented" error message.
-    $LOG->error($class . "->next() is not implemented!");
-    Carp::croak "Error: " . $class . "->next() is not implemented!\n";
-}
-
-=pod
-
-=head2 $object->status()
-
-=over 4
-
-Returns the current status of the Driver B<$object>, as it's state
-exists, between subsequent calls to $object->driver().
-
-Specifically, the data returned is a reference to a hashtable,
-containing specific statistical information about the status
-of the Driver's progress during back-end application automation.
-
-As such, the exact structure of this returned hashtable is not strictly
-defined.  Instead, it is left up to each specific Driver implementation
-to return useful, statistical information back to the Agent that
-makes sense for the driven application.
-
-For example, if an Internet Explorer specific Driver were implemented,
-then the corresponding status hashtable reference returned may look
-something like:
-
-  $hashref = {
-      'links_remaining'  =>       56, # Number of URLs left to process.
-      'links_processed'  =>       44, # Number of URLs processed.
-      'links_total'      =>      100, # Total number of URLs given.
-      'percent_complete' => '44.00%', # Percent complete.
-  };
-
-For another example, if an Outlook specific Driver were implemented,
-then the corresponding status hashtable reference returned may look
-something like:
-
-  $hashref = {
-      'mail_remaining'   =>       56, # Number of messages left to process.
-      'mail_processed'   =>       44, # Number of messages processed.
-      'mail_total'       =>      100, # Total number of messages given.
-      'percent_complete' => '44.00%', # Percent complete.
-  };
-
-I<Output>: A corresponding B<$hashref>, containing statistical information
-about the Driver's progress, as previously mentioned.
-
-# XXX: Resolve this.
-
-B<Note>: The exact structure of this status hashtable may become more
-concrete, as we define a generic concept of a "unit of work" per every
-iteration of the $object->drive() method.  For example, it may be
-likely that each Driver will attempt to contact a series of resources
-per every "unit of work" iteration.  As such, we may generically
-record how many "work units" are remaining, processed, and total --
-rather than specifically state "links" or "mail" within the hashtable
-key names, accordingly.
-
-At the least, it can be assumed that even if a generic structure were
-defined, we would leave room available in the status hashtable to
-capture additional, implementation-specific statistics that are not
-generic among every Driver implementation.
-
-=back
-
-#=begin testing
-#
-# Create a generic driver, with test state data.
-#my $driver = HoneyClient::Agent::Driver->new(test => 1);
-#dies_ok {$driver->status()} 'status()' or diag("The status() call failed.  Expected status() to throw an exception.");
-#
-#=end testing
-
-=cut
-
-sub status {
-    # Get the class name.
-    my $self = shift;
-    
-    # Check to see if the class name is inherited or defined.
-    my $class = ref($self) || $self;
-    
-    # Sanity check: Make sure we've been fed an object.
-    unless (ref($self)) {
-        $LOG->error("Error: Function must be called in reference to a " .
-                    __PACKAGE__ . "->new() object!");
-        Carp::croak "Error: Function must be called in reference to a " .
-                    __PACKAGE__ . "->new() object!";
-    }
-
-    # Emit generic "not implemented" error message.
-    $LOG->error($class . "->next() is not implemented!");
-    Carp::croak "Error: " . $class . "->next() is not implemented!\n";
-}
-
-
-#######################################################################

honeyclient/branches/exp/kindlund-dynamic_updates/t/honeyclient_manager_vm_clone.t

@@ -9 +9 @@
-# =begin testing
-{
+# Make sure ExtUtils::MakeMaker loads.
+BEGIN { use_ok('ExtUtils::MakeMaker', qw(prompt)) or diag("Can't load ExtUtils::MakeMaker package.  Check to make sure the package library is correctly listed within the path."); }
+require_ok('ExtUtils::MakeMaker');
+can_ok('ExtUtils::MakeMaker', 'prompt');
+use ExtUtils::MakeMaker qw(prompt);
+
-# Make sure Log::Log4perl loads
-BEGIN { use_ok('Log::Log4perl', qw(:nowarn))
@@ -107 +113 @@
-                                      namespace => "HoneyClient::Manager::VM::Test");
-
+# Include notice, to clarify our assumptions.
+diag("About to run basic unit tests; these may take some time.");
+diag("Note: These tests *expect* VMware Server or VMware GSX to be installed and running on this system beforehand.");
+
-# Catch all errors, in order to make sure child processes are
-# properly killed.
@@ -130 +140 @@
-    # Wait a small amount of time for the asynchronous clone
-    # to complete.
-6
+1
-
-    # The master VM should be on.
-    $som = $stub->getStateVM(config => $masterVM);
-
+
-    # Since the master VM doesn't have an OS installed on it,
-    # the VM may be considered stuck.  Go ahead and answer
@@ -142 +152 @@
-    }
-
+    # Turn off the master VM.
+    $som = $stub->stopVM(config => $masterVM);
+
+    # Now, kill the VM daemon.
-    HoneyClient::Manager::VM->destroy();
-    sleep (1);
-
-
-
-
-
+
+
+
+
+
-
-    # Destroy the master VM.
-    $som = $stub->destroyVM(config => $masterVM);
+
+    my $question;
+    $question = prompt("#\n" .
+                       "# Note: Testing real clone operations will *ONLY* work\n" .
+                       "# with a fully functional master VM that has the HoneyClient code\n" .
+                       "# loaded upon boot-up.\n" .
+                       "#\n" .
+                       "# Your master VM is: " . getVar(name => "master_vm_config", namespace => "HoneyClient::Manager::VM") . "\n" .
+                       "#\n" .
+                       "# Do you want to test cloning this master VM?", "no");
+    if ($question =~ /^y.*/i) {
+        $clone = HoneyClient::Manager::VM::Clone->new(test => 1);
+        is($clone->{test}, 1, "new(test => 1)") or diag("The new() call failed.");
+        isa_ok($clone, 'HoneyClient::Manager::VM::Clone', "new(test => 1)") or diag("The new() call failed.");
+        my $cloneConfig = $clone->{config};
+        $clone = undef;
+    
+        # Destroy the clone VM.
+        $som = $stub->destroyVM(config => $cloneConfig);
+    }
-};
-