clienttest.pl revision 23179f1443b03947d85eccc81cbc6b5153a4abf3
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync#!/usr/bin/perl
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync#
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# This little perl program attempts to connect to a running VirtualBox
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# webservice and calls various methods on it. Please refer to the SDK
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# programming reference (SDKRef.pdf) for how to use this sample.
b0e88382fa6cab5a202902e8e3fbbd8a7ce5e4edvboxsync#
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# Copyright (C) 2008-2009 Sun Microsystems, Inc.
e06c59a0dd265fb36fc3ade96b83ced3aec14c37vboxsync#
e06c59a0dd265fb36fc3ade96b83ced3aec14c37vboxsync# The following license applies to this file only:
e06c59a0dd265fb36fc3ade96b83ced3aec14c37vboxsync#
e06c59a0dd265fb36fc3ade96b83ced3aec14c37vboxsync# Permission is hereby granted, free of charge, to any person
e06c59a0dd265fb36fc3ade96b83ced3aec14c37vboxsync# obtaining a copy of this software and associated documentation
e06c59a0dd265fb36fc3ade96b83ced3aec14c37vboxsync# files (the "Software"), to deal in the Software without
e06c59a0dd265fb36fc3ade96b83ced3aec14c37vboxsync# restriction, including without limitation the rights to use,
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# copy, modify, merge, publish, distribute, sublicense, and/or
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# sell copies of the Software, and to permit persons to whom the
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# Software is furnished to do so, subject to the following conditions:
772269936494ffaddd0750ba9e28e805ba81398cvboxsync#
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# The above copyright notice and this permission notice shall be
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# included in all copies or substantial portions of the Software.
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync#
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync# OTHER DEALINGS IN THE SOFTWARE.
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync#
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsyncuse strict;
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsyncuse SOAP::Lite;
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsyncuse vboxService; # generated by stubmaker, see SDKRef.pdf
7519a1c4323fa86fbb19a36a91cd25abfd7af714vboxsyncuse Data::Dumper;
7519a1c4323fa86fbb19a36a91cd25abfd7af714vboxsync
7519a1c4323fa86fbb19a36a91cd25abfd7af714vboxsyncmy $cmd = 'clienttest';
7519a1c4323fa86fbb19a36a91cd25abfd7af714vboxsyncmy $optMode;
7519a1c4323fa86fbb19a36a91cd25abfd7af714vboxsyncmy $vmname;
7519a1c4323fa86fbb19a36a91cd25abfd7af714vboxsyncmy $disk;
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync
f575b91c75af94bb069e1a3c481dc2e5f2334728vboxsyncwhile (my $this = shift(@ARGV))
3b3bc8a9383a065307e540b83fc3a3d6c548a082vboxsync{
3b3bc8a9383a065307e540b83fc3a3d6c548a082vboxsync if (($this =~ /^-h/) || ($this =~ /^--help/))
7519a1c4323fa86fbb19a36a91cd25abfd7af714vboxsync {
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync print "$cmd: test the VirtualBox web service.\n".
7519a1c4323fa86fbb19a36a91cd25abfd7af714vboxsync "Usage:\n".
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync " $cmd <mode>\n".
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync "with <mode> being one of 'version', 'list', 'start'; default is 'list'.\n".
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync " $cmd version: print version of VirtualBox web service.\n".
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync " $cmd list: list installed virtual machines.\n".
512facdec74744adf03a688eae5ae00628d89d82vboxsync " $cmd startvm <vm>: start the virtual machine named <vm>.\n";
512facdec74744adf03a688eae5ae00628d89d82vboxsync exit 0;
512facdec74744adf03a688eae5ae00628d89d82vboxsync }
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync elsif ( ($this eq 'version')
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync || ($this eq 'list')
18470279db8a9fdd714617adbe1aa8b63cc80aeevboxsync )
772269936494ffaddd0750ba9e28e805ba81398cvboxsync {
6eb6d0439d67fd4833f1d058b63bc9a56277b0b2vboxsync $optMode = $this;
}
elsif ($this eq 'startvm')
{
$optMode = $this;
if (!($vmname = shift(@ARGV)))
{
die "[$cmd] Missing parameter: You must specify the name of the VM to start.\nStopped";
}
}
elsif ($this eq 'openhd')
{
$optMode = $this;
if (!($disk = shift(@ARGV)))
{
die "[$cmd] Missing parameter: You must specify the name of the disk to open.\nStopped";
}
}
else
{
die "[$cmd] Unknown option \"$this\"; stopped";
}
}
$optMode = "list"
if (!$optMode);
my $vbox = vboxService->IWebsessionManager_logon("test", "test");
if (!$vbox)
{
die "[$cmd] Logon to session manager with user \"test\" and password \"test\" failed.\nStopped";
}
if ($optMode eq "version")
{
my $v = vboxService->IVirtualBox_getVersion($vbox);
print "[$cmd] Version number of running VirtualBox web service: $v\n";
}
elsif ($optMode eq "list")
{
print "[$cmd] Listing machines:\n";
my @result = vboxService->IVirtualBox_getMachines($vbox);
foreach my $idMachine (@result)
{
my $if = vboxService->IManagedObjectRef_getInterfaceName($idMachine);
my $name = vboxService->IMachine_getName($idMachine);
print "machine $if $idMachine: $name\n";
}
}
elsif ($optMode eq "startvm")
{
# assume it's a UUID
my $machine = vboxService->IVirtualBox_getMachine($vbox, $vmname);
if (!$machine)
{
# no: then try a name
$machine = vboxService->IVirtualBox_findMachine($vbox, $vmname);
}
die "[$cmd] Cannot find VM \"$vmname\"; stopped"
if (!$machine);
my $session = vboxService->IWebsessionManager_getSessionObject($vbox);
die "[$cmd] Cannot get session object; stopped"
if (!$session);
my $uuid = vboxService->IMachine_getId($machine);
die "[$cmd] Cannot get uuid for machine; stopped"
if (!$uuid);
print "[$cmd] UUID: $uuid\n";
my $progress = vboxService->IVirtualBox_openRemoteSession($vbox,
$session,
$uuid,
"vrdp",
"");
die "[$cmd] Cannot open remote session; stopped"
if (!$progress);
print("[$cmd] Waiting for the remote session to open...\n");
vboxService->IProgress_waitForCompletion($progress, -1);
my $fCompleted;
$fCompleted = vboxService->IProgress_getCompleted($progress);
print("[$cmd] Completed: $fCompleted\n");
my $resultCode;
$resultCode = vboxService->IProgress_getResultCode($progress);
print("[$cmd] Result: $resultCode\n");
vboxService->ISession_close($session);
vboxService->IWebsessionManager_logoff($vbox);
}
elsif ($optMode eq "openhd")
{
my $harddisk = vboxService->IVirtualBox_openHardDisk($vbox, $disk, 1, 0, "", 0, "");
}