| 1 | #!/usr/bin/perl | 
|---|
| 2 |  | 
|---|
| 3 | # NOTE: In development; not actually used yet. | 
|---|
| 4 |  | 
|---|
| 5 | #Collates the results of listvms from multiple VM servers.  Part of the xvm | 
|---|
| 6 | #suite. | 
|---|
| 7 |  | 
|---|
| 8 | use Net::Remctl (); | 
|---|
| 9 | use JSON; | 
|---|
| 10 |  | 
|---|
| 11 | our @servers = qw/black-mesa.mit.edu sx-blade-2.mit.edu/; | 
|---|
| 12 |  | 
|---|
| 13 | our %connections; | 
|---|
| 14 |  | 
|---|
| 15 | sub openConnections() { | 
|---|
| 16 |     foreach (@servers) { openConnection($_); } | 
|---|
| 17 | } | 
|---|
| 18 |  | 
|---|
| 19 | sub openConnection($) { | 
|---|
| 20 |     my ($server) = @_; | 
|---|
| 21 |     my $remctl = Net::Remctl->new; | 
|---|
| 22 |     $remctl->open($server) | 
|---|
| 23 |         or die "Cannot connect to $server: ", $remctl->error, "\n"; | 
|---|
| 24 |     $connections{$server} = $remctl; | 
|---|
| 25 | } | 
|---|
| 26 |  | 
|---|
| 27 | sub doListVMs() { | 
|---|
| 28 |     foreach my $remctl (values %connections) { | 
|---|
| 29 |         $remctl->command("remote", "web", "listvms", "--json"); | 
|---|
| 30 |     } | 
|---|
| 31 |     my %vmstate; | 
|---|
| 32 |     foreach my $server (keys %connections) { | 
|---|
| 33 |         my $remctl = $connections{$server}; | 
|---|
| 34 |         my $jsonData = ''; | 
|---|
| 35 |         do { | 
|---|
| 36 |             $output = $remctl->output; | 
|---|
| 37 |             if ($output->type eq 'output') { | 
|---|
| 38 |                 if ($output->stream == 1) { | 
|---|
| 39 |                     $jsonData .= $output->data; | 
|---|
| 40 |                 } elsif ($output->stream == 2) { | 
|---|
| 41 |                     print STDERR $output->data; | 
|---|
| 42 |                 } | 
|---|
| 43 |             } elsif ($output->type eq 'error') { | 
|---|
| 44 |                 warn $output->error, "\n"; | 
|---|
| 45 |             } elsif ($output->type eq 'status') { | 
|---|
| 46 |                 if ($output->status != 0) { | 
|---|
| 47 |                     warn "Exit status was ".$output->status; | 
|---|
| 48 |                 } | 
|---|
| 49 |             } elsif ($output->type eq 'done') { | 
|---|
| 50 |                 #next; | 
|---|
| 51 |             } else { | 
|---|
| 52 |                 die "Unknown output token from library: ", $output->type, "\n"; | 
|---|
| 53 |             } | 
|---|
| 54 |         } while ($output->type ne 'done'); | 
|---|
| 55 |         my $vmlist = jsonToObj($jsonData); | 
|---|
| 56 |         foreach my $key (keys %$vmlist) { | 
|---|
| 57 |             $vmstate{$key} = $vmlist->{$key}; | 
|---|
| 58 |             $vmstate{$key}{"host"} = $server; | 
|---|
| 59 |         } | 
|---|
| 60 |     } | 
|---|
| 61 |     return %vmstate; | 
|---|
| 62 | } | 
|---|
| 63 |  | 
|---|
| 64 | openConnections(); | 
|---|
| 65 |  | 
|---|
| 66 | use Data::Dumper; | 
|---|
| 67 | use Benchmark; | 
|---|
| 68 | print Dumper({doListVMs()}); | 
|---|
| 69 | timethis(100, sub {doListVMs()}); | 
|---|
| 70 |  | 
|---|
| 71 | # vim:et:sw=4:ts=4 | 
|---|