01 #!/usr/local/bin/perl -w
02 use strict;
03 use Sysadm::Install qw(:all);
04 use Proc::Simple;
05 use Net::Ping;
06 use Log::Log4perl qw(:easy);
07 
08 my( $tarball) = @ARGV;
09 
10 die "usage: $0 tarball" if 
11   !defined $tarball;
12 
13 Log::Log4perl->easy_init($ERROR);
14 
15 my $vbm    = "VBoxManage";
16 my $vbh    = "VBoxHeadless";
17 my $vm     = "Ubuntu 10.04";
18 my $ippath = 
19   "/VirtualBox/GuestInfo/Net/0/V4/IP";
20 my $snap   = "CPAN Smoke";
21 
22   # in case it's up in foreground
23 tap $vbm, "controlvm", $vm, "poweroff";
24 tap $vbm, "snapshot", 
25     $vm, "restore", $snap;
26 
27 my $proc = Proc::Simple->new();
28 $proc->start("$vbh --startvm '$vm'");
29 END {
30     $proc->kill();
31 }
32 
33 INFO "Waiting for VM to come up";
34 
35 while( !$proc->poll() ) {
36     DEBUG "Waiting for VM process";
37     sleep 1;
38 }
39 
40 my $ip;
41 
42 while( !defined($ip = ip()) ) {
43     DEBUG "Waiting for IP";
44     sleep 1;
45 }
46 
47 my $ping = Net::Ping->new();
48 while( !$ping->ping($ip) ) {
49     DEBUG "Waiting for Ping";
50     sleep 1;
51 }
52 
53 INFO "VM is up: $ip";
54 
55 tap "scp", $tarball, "$ip:/tmp/$tarball";
56 sysrun "ssh", $ip, 
57   qq{eval \$(/usr/bin/perl -Mlocal::lib); 
58      cpanm /tmp/$tarball};
59 
60 tap $vbm, "controlvm", $vm, "poweroff";
61 tap $vbm, "snapshot", 
62     $vm, "restore", $snap;
63 
64 ###########################################
65 sub ip {
66 ###########################################
67   my($stdout) = tap $vbm, "guestproperty", 
68                     "get", $vm, $ippath;
69 
70   if( $stdout =~ /Value: (.*)/ ) {
71     return $1;
72   }
73 
74   return undef;
75 }