VirtualBox

Ticket #19074: get_stuck.pl

File get_stuck.pl, 3.9 KB (added by Brian of the Pines, 5 years ago)

Updated get_stuck.pl with --ignore_completed option

Line 
1#!/usr/bin/perl
2use strict;
3use SOAP::Lite;
4use Getopt::Long;
5use soap_ext;
6use vboxService;
7
8sub 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
19sub 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
29sub 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
43my $user = "";
44my $pass = "";
45my $early_unlock = 0;
46our $ignore_completed = 0;
47GetOptions("user=s" => \$user,
48 "pass=s" => \$pass,
49 "early_unlock" => \$early_unlock,
50 "ignore_completed" => \$ignore_completed);
51my ($uuid, $snapname) = @ARGV;
52if(not defined $uuid) {
53 print_usage();
54 exit(-1);
55}
56if(not defined $snapname) {
57 print_usage();
58 exit(-1);
59}
60print("Connecting to webservice... ");
61#select()->flush();
62our $vbws = vboxService->IWebsessionManager_logon($user, $pass);
63if(!$vbws) {
64 print(" Failed.\n");
65 print("Unable to connect. Maybe the credentials are wrong?\n");
66 exit(1);
67}
68print(" Success.\n");
69print("Looking for UUID $uuid... ");
70my $machine = get_machine($uuid);
71if(not defined $machine) {
72 print(" Not found.\n");
73 print("Check your UUID?\n");
74 exit(-1);
75}
76print(" Found $machine.\n");
77print("Getting session... ");
78my $session = vboxService->IWebsessionManager_getSessionObject($machine);
79if(not defined $session) {
80 print(" Failed.\n");
81 print("Maybe the machine is in the wrong state?\n");
82 exit(-1);
83}
84print(" Done.\n");
85print("Locking session for shared use... ");
86vboxService->IMachine_lockMachine($machine, $session, 'Shared');
87print("\nHopefully that worked. Getting a result code from SOAP is a PITA.\n");
88print("Getting a mutable machine reference... ");
89my $mutable = vboxService->ISession_getMachine($session);
90if(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}
96print(" Done.\n");
97print("Starting snapshot process... ");
98my ($snapid, $snapprog) = vboxService->IMachine_takeSnapshot($mutable, $snapname, "", '0');
99if(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}
106print(" Done.\n");
107if($early_unlock > 0) {
108 print("--early_unlock specified; calling unlock API now!\n");
109 vboxService->ISession_unlockMachine($session);
110}
111print("Checking progress every second...\n");
112while(!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}
118print("IProgress reports completion.\n");
119if($early_unlock == 0) {
120 print("Unlocking machine...\n");
121 vboxService->ISession_unlockMachine($session);
122}
123print("Disconnecting...\n");
124vboxService->IWebsessionManager_logoff($vbws);
125

© 2024 Oracle Support Privacy / Do Not Sell My Info Terms of Use Trademark Policy