Show
Ignore:
Timestamp:
04/09/08 15:47:11 (8 months ago)
Author:
kindlund
Message:

Merging simpler_agent branch into trunk.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • honeyclient/trunk/t/honeyclient_manager_vm_clone.t

    r1008 r1499  
    6060use HoneyClient::Manager::VM; 
    6161 
     62# Make sure HoneyClient::Manager::Database loads. 
     63BEGIN { use_ok('HoneyClient::Manager::Database') or diag("Can't load HoneyClient::Manager::Database package.  Check to make sure the package library is correctly listed within the path."); } 
     64require_ok('HoneyClient::Manager::Database'); 
     65use HoneyClient::Manager::Database; 
     66 
    6267# Make sure VMware::VmPerl loads. 
    6368BEGIN { 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."); } 
    …… 
    8186 
    8287# Make sure Storable loads. 
    83 BEGIN { use_ok('Storable', qw(dclone)) or diag("Can't load Storable package.  Check to make sure the package library is correctly listed within the path."); } 
     88BEGIN { use_ok('Storable', qw(dclone thaw)) or diag("Can't load Storable package.  Check to make sure the package library is correctly listed within the path."); } 
    8489require_ok('Storable'); 
    8590can_ok('Storable', 'dclone'); 
    86 use Storable qw(dclone); 
     91can_ok('Storable', 'thaw'); 
     92use Storable qw(dclone thaw); 
     93 
     94# Make sure MIME::Base64 loads. 
     95BEGIN { use_ok('MIME::Base64', qw(encode_base64 decode_base64)) or diag("Can't load MIME::Base64 package.  Check to make sure the package library is correctly listed within the path."); } 
     96require_ok('MIME::Base64'); 
     97can_ok('MIME::Base64', 'encode_base64'); 
     98can_ok('MIME::Base64', 'decode_base64'); 
     99use MIME::Base64 qw(encode_base64 decode_base64); 
    87100 
    88101# Make sure Data::Dumper loads 
    …… 
    108121can_ok('File::Basename', 'basename'); 
    109122use File::Basename qw(dirname basename); 
     123 
     124# Make sure Sys::Hostname loads. 
     125BEGIN { use_ok('Sys::Hostname') or diag("Can't load Sys::Hostname package.  Check to make sure the package library is correctly listed within the path."); } 
     126require_ok('Sys::Hostname'); 
     127use Sys::Hostname; 
     128 
     129# Make sure Sys::HostIP loads. 
     130BEGIN { use_ok('Sys::HostIP') or diag("Can't load Sys::HostIP package.  Check to make sure the package library is correctly listed within the path."); } 
     131require_ok('Sys::HostIP'); 
     132use Sys::HostIP; 
     133 
     134# Make sure DateTime::HiRes loads. 
     135BEGIN { use_ok('DateTime::HiRes') or diag("Can't load Sys::HostIP package.  Check to make sure the package library is correctly listed within the path."); } 
     136require_ok('DateTime::HiRes'); 
     137use DateTime::HiRes; 
     138 
     139# Make sure IO::File loads. 
     140BEGIN { use_ok('IO::File') or diag("Can't load IO::File package.  Check to make sure the package library is correctly listed within the path."); } 
     141require_ok('IO::File'); 
     142use IO::File; 
     143 
     144# Make sure Filesys::DfPortable loads 
     145BEGIN { use_ok('Filesys::DfPortable') 
     146        or diag("Can't load Filesys::DfPortable package. Check to make sure the package library is correctly listed within the path."); } 
     147require_ok('Filesys::DfPortable'); 
     148use Filesys::DfPortable; 
    110149} 
    111150 
    …… 
    163202    # Now, kill the VM daemon. 
    164203    HoneyClient::Manager::VM->destroy(); 
    165     # XXX: See if this is still needed. 
    166     #sleep (10); 
    167204 
    168205    # Create a generic empty clone, with test state data. 
    169     my $clone = HoneyClient::Manager::VM::Clone->new(test => 1, master_vm_config => $masterVM, _dont_init => 1); 
    170     is($clone->{test}, 1, "new(test => 1, master_vm_config => '$masterVM', _dont_init => 1)") or diag("The new() call failed."); 
    171     isa_ok($clone, 'HoneyClient::Manager::VM::Clone', "new(test => 1, master_vm_config => '$masterVM', _dont_init => 1)") or diag("The new() call failed."); 
     206    my $clone = HoneyClient::Manager::VM::Clone->new(test => 1, master_vm_config => $masterVM, _dont_init => 1, _bypass_firewall => 1); 
     207    is($clone->{test}, 1, "new(test => 1, master_vm_config => '$masterVM', _dont_init => 1, _bypass_firewall => 1)") or diag("The new() call failed."); 
     208    isa_ok($clone, 'HoneyClient::Manager::VM::Clone', "new(test => 1, master_vm_config => '$masterVM', _dont_init => 1, _bypass_firewall => 1)") or diag("The new() call failed."); 
    172209    $clone = undef; 
    173210 
    …… 
    180217                       "# with a fully functional master VM that has the HoneyClient code\n" . 
    181218                       "# loaded upon boot-up.\n" . 
     219                       "#\n" . 
     220                       "# This test also requires that the firewall VM is registered,\n" . 
     221                       "# powered on, and operational.\n" . 
    182222                       "#\n" . 
    183223                       "# Your master VM is: " . getVar(name => "master_vm_config", namespace => "HoneyClient::Manager::VM") . "\n" . 
    …… 
    198238# Kill the child daemon, if it still exists. 
    199239HoneyClient::Manager::VM->destroy(); 
    200 # XXX: See if this is still needed. 
    201 #sleep (1); 
    202240 
    203241# Report any failure found. 
    …… 
    231269    my $question; 
    232270    $question = prompt("#\n" . 
    233                        "# Note: Testing real archive operations will *ONLY* work\n" . 
     271                       "# Note: Testing real suspend/archive operations will *ONLY* work\n" . 
    234272                       "# with a fully functional master VM that has the HoneyClient code\n" . 
    235273                       "# loaded upon boot-up.\n" . 
    236274                       "#\n" . 
     275                       "# This test also requires that the firewall VM is registered,\n" . 
     276                       "# powered on, and operational.\n" . 
     277                       "#\n" . 
    237278                       "# Your master VM is: " . getVar(name => "master_vm_config", namespace => "HoneyClient::Manager::VM") . "\n" . 
    238279                       "#\n" . 
    239                        "# Do you want to test cloning this master VM?", "no"); 
     280                       "# Do you want to test cloning and archiving this master VM?", "no"); 
    240281    if ($question =~ /^y.*/i) { 
    241282 
    242283        # Create a generic empty clone, with test state data. 
    243         my $clone = HoneyClient::Manager::VM::Clone->new(); 
     284        my $clone = HoneyClient::Manager::VM::Clone->new(_bypass_firewall => 1); 
    244285        my $cloneConfig = $clone->{config}; 
    245286 
    246287        # Archive the clone. 
    247         $clone->archive(snapshot_file => $snapshot); 
    248  
    249         # Wait for the archive to complete. 
     288        $clone->suspend(perform_archive => 1, snapshot_file => $snapshot); 
     289 
     290        # Wait for the suspend/archive to complete. 
    250291        sleep (45); 
    251292     
    252         # Test if the archive worked. 
    253         is(-f $snapshot, 1, "archive(snapshot_file => '$snapshot')") or diag("The archive() call failed."); 
     293        # Test if the operations worked. 
     294        is(-f $snapshot, 1, "suspend(perform_archive => 1, snapshot_file => '$snapshot')") or diag("The suspend() call failed."); 
    254295    
    255296        unlink $snapshot; 
    …… 
    266307# Kill the child daemon, if it still exists. 
    267308HoneyClient::Manager::VM->destroy(); 
    268 # XXX: See if this is still needed. 
    269 #sleep (1); 
    270309 
    271310# Report any failure found. 
    …… 
    277316 
    278317 
     318# =begin testing 
     319{ 
     320# Shared test variables. 
     321my ($stub, $som, $URL); 
     322my $testVM = $ENV{PWD} . "/" . getVar(name      => "test_vm_config", 
     323                                      namespace => "HoneyClient::Manager::VM::Test"); 
     324 
     325# Catch all errors, in order to make sure child processes are 
     326# properly killed. 
     327eval { 
     328 
     329    # Pretend as though no other Clone objects have been created prior 
     330    # to this point. 
     331    $HoneyClient::Manager::VM::Clone::OBJECT_COUNT = -1; 
     332     
     333    my $question; 
     334    $question = prompt("#\n" . 
     335                       "# Note: Testing real drive operations will *ONLY* work\n" . 
     336                       "# with a fully functional master VM that has the HoneyClient code\n" . 
     337                       "# loaded upon boot-up.\n" . 
     338                       "#\n" . 
     339                       "# This test also requires that the firewall VM is registered,\n" . 
     340                       "# powered on, and operational.\n" . 
     341                       "#\n" . 
     342                       "# Your master VM is: " . getVar(name => "master_vm_config", namespace => "HoneyClient::Manager::VM") . "\n" . 
     343                       "#\n" . 
     344                       "# Do you want to test cloning and driving this master VM?", "no"); 
     345    if ($question =~ /^y.*/i) { 
     346 
     347        # Create a generic empty clone, with test state data. 
     348        my $clone = HoneyClient::Manager::VM::Clone->new(_bypass_firewall => 1); 
     349        my $cloneConfig = $clone->{config}; 
     350 
     351        $clone = $clone->drive(work => { 'http://www.google.com/' => 1 }); 
     352        isa_ok($clone, 'HoneyClient::Manager::VM::Clone', "drive(work => { 'http://www.google.com/' => 1})") or diag("The drive() call failed."); 
     353        $clone = undef; 
     354 
     355        # Connect to daemon as a client. 
     356        $stub = getClientHandle(namespace => "HoneyClient::Manager::VM"); 
     357     
     358        # Destroy the clone VM. 
     359        $som = $stub->destroyVM(config => $cloneConfig); 
     360    } 
     361}; 
     362 
     363# Kill the child daemon, if it still exists. 
     364HoneyClient::Manager::VM->destroy(); 
     365 
     366# Report any failure found. 
     367if ($@) { 
     368    fail($@); 
     369} 
     370} 
     371 
     372 
     373 
    279374 
    2803751;