| [656] | 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 | 
|---|