| 1 | #!/usr/bin/perl
|
|---|
| 2 | use strict;
|
|---|
| 3 | use SOAP::Lite;
|
|---|
| 4 | use Getopt::Long;
|
|---|
| 5 | use soap_ext;
|
|---|
| 6 | use vboxService;
|
|---|
| 7 |
|
|---|
| 8 | sub print_usage {
|
|---|
| 9 | print("Usage:\n$0 [options] <vm_uuid> <snapshot_name>\n");
|
|---|
| 10 | print("\n");
|
|---|
| 11 | print("Optional parameters:\n");
|
|---|
| 12 | print("--user=<username> Webservice username\n");
|
|---|
| 13 | print("--pass=<password> Webservice password\n");
|
|---|
| 14 | print("--early_unlock Unlock session without waiting for IProgress to show completion.\n");
|
|---|
| 15 | print("--ignore_completed Ignore the IProgress::Completed field and instead wait until \n");
|
|---|
| 16 | print(" Percent reaches 100.\n");
|
|---|
| 17 | }
|
|---|
| 18 |
|
|---|
| 19 | sub check_doneness {
|
|---|
| 20 | our $ignore_completed;
|
|---|
| 21 | my $prog = shift;
|
|---|
| 22 | if($ignore_completed == 0) {
|
|---|
| 23 | return vboxService->IProgress_getCompleted($prog);
|
|---|
| 24 | } else {
|
|---|
| 25 | return (vboxService->IProgress_getPercent($prog) >= 100);
|
|---|
| 26 | }
|
|---|
| 27 | }
|
|---|
| 28 |
|
|---|
| 29 | sub get_machine {
|
|---|
| 30 | our $vbws;
|
|---|
| 31 | my $target_uuid = shift;
|
|---|
| 32 | my @machineids = vboxService->IVirtualBox_getMachines($vbws);
|
|---|
| 33 | foreach my $machine (@machineids) {
|
|---|
| 34 | my $machineuuid = vboxService->IMachine_getId($machine);
|
|---|
| 35 | if ($machineuuid eq $target_uuid) {
|
|---|
| 36 | return $machine;
|
|---|
| 37 | }
|
|---|
| 38 | }
|
|---|
| 39 | return undef;
|
|---|
| 40 | }
|
|---|
| 41 | $| = 1; # Auto-flush after every print, regardless of presence of EOL
|
|---|
| 42 |
|
|---|
| 43 | my $user = "";
|
|---|
| 44 | my $pass = "";
|
|---|
| 45 | my $early_unlock = 0;
|
|---|
| 46 | our $ignore_completed = 0;
|
|---|
| 47 | GetOptions("user=s" => \$user,
|
|---|
| 48 | "pass=s" => \$pass,
|
|---|
| 49 | "early_unlock" => \$early_unlock,
|
|---|
| 50 | "ignore_completed" => \$ignore_completed);
|
|---|
| 51 | my ($uuid, $snapname) = @ARGV;
|
|---|
| 52 | if(not defined $uuid) {
|
|---|
| 53 | print_usage();
|
|---|
| 54 | exit(-1);
|
|---|
| 55 | }
|
|---|
| 56 | if(not defined $snapname) {
|
|---|
| 57 | print_usage();
|
|---|
| 58 | exit(-1);
|
|---|
| 59 | }
|
|---|
| 60 | print("Connecting to webservice... ");
|
|---|
| 61 | #select()->flush();
|
|---|
| 62 | our $vbws = vboxService->IWebsessionManager_logon($user, $pass);
|
|---|
| 63 | if(!$vbws) {
|
|---|
| 64 | print(" Failed.\n");
|
|---|
| 65 | print("Unable to connect. Maybe the credentials are wrong?\n");
|
|---|
| 66 | exit(1);
|
|---|
| 67 | }
|
|---|
| 68 | print(" Success.\n");
|
|---|
| 69 | print("Looking for UUID $uuid... ");
|
|---|
| 70 | my $machine = get_machine($uuid);
|
|---|
| 71 | if(not defined $machine) {
|
|---|
| 72 | print(" Not found.\n");
|
|---|
| 73 | print("Check your UUID?\n");
|
|---|
| 74 | exit(-1);
|
|---|
| 75 | }
|
|---|
| 76 | print(" Found $machine.\n");
|
|---|
| 77 | print("Getting session... ");
|
|---|
| 78 | my $session = vboxService->IWebsessionManager_getSessionObject($machine);
|
|---|
| 79 | if(not defined $session) {
|
|---|
| 80 | print(" Failed.\n");
|
|---|
| 81 | print("Maybe the machine is in the wrong state?\n");
|
|---|
| 82 | exit(-1);
|
|---|
| 83 | }
|
|---|
| 84 | print(" Done.\n");
|
|---|
| 85 | print("Locking session for shared use... ");
|
|---|
| 86 | vboxService->IMachine_lockMachine($machine, $session, 'Shared');
|
|---|
| 87 | print("\nHopefully that worked. Getting a result code from SOAP is a PITA.\n");
|
|---|
| 88 | print("Getting a mutable machine reference... ");
|
|---|
| 89 | my $mutable = vboxService->ISession_getMachine($session);
|
|---|
| 90 | if(not defined $mutable) {
|
|---|
| 91 | print(" Failed.\n");
|
|---|
| 92 | print("Not sure what happened in this case!\n");
|
|---|
| 93 | vboxService->IWebsessionManager_logoff($vbws);
|
|---|
| 94 | exit(-1);
|
|---|
| 95 | }
|
|---|
| 96 | print(" Done.\n");
|
|---|
| 97 | print("Starting snapshot process... ");
|
|---|
| 98 | my ($snapid, $snapprog) = vboxService->IMachine_takeSnapshot($mutable, $snapname, "", '0');
|
|---|
| 99 | if(not defined $snapid|| !($snapprog > 0)) {
|
|---|
| 100 | print(" Error.\n");
|
|---|
| 101 | print("Something went wrong trying to start the snapshot.\n");
|
|---|
| 102 | vboxService->ISession_unlockMachine($session);
|
|---|
| 103 | vboxService->IWebsessionManager_logoff($vbws);
|
|---|
| 104 | exit(-1);
|
|---|
| 105 | }
|
|---|
| 106 | print(" Done.\n");
|
|---|
| 107 | if($early_unlock > 0) {
|
|---|
| 108 | print("--early_unlock specified; calling unlock API now!\n");
|
|---|
| 109 | vboxService->ISession_unlockMachine($session);
|
|---|
| 110 | }
|
|---|
| 111 | print("Checking progress every second...\n");
|
|---|
| 112 | while(!check_doneness($snapprog)) {
|
|---|
| 113 | printf("Operation: %s\n", vboxService->IProgress_getOperationDescription($snapprog));
|
|---|
| 114 | printf("Operation progress: %d %%\n", vboxService->IProgress_getOperationPercent($snapprog));
|
|---|
| 115 | printf("Total progress: %d %%\n", vboxService->IProgress_getPercent($snapprog));
|
|---|
| 116 | sleep(1);
|
|---|
| 117 | }
|
|---|
| 118 | print("IProgress reports completion.\n");
|
|---|
| 119 | if($early_unlock == 0) {
|
|---|
| 120 | print("Unlocking machine...\n");
|
|---|
| 121 | vboxService->ISession_unlockMachine($session);
|
|---|
| 122 | }
|
|---|
| 123 | print("Disconnecting...\n");
|
|---|
| 124 | vboxService->IWebsessionManager_logoff($vbws);
|
|---|
| 125 |
|
|---|