Hostinfo day 6: RPM packaging, initscripts, hostinfo-status, hostinfo-test.
[virt-hostinfo.git] / hostinfo-status / hostinfo-status.pl
index b367206..fed5c25 100755 (executable)
 
 use strict;
 
 
 use strict;
 
-#use Sys::Virt;
-
-=pod
+use Pod::Usage;
+use Getopt::Long;
+use Sys::Virt;
+use XML::XPath;
+use XML::XPath::XMLParser;
 
 =head1 NAME
 
 
 =head1 NAME
 
@@ -39,7 +41,10 @@ particular guest.
 For example:
 
  # hostinfo-status myguest
 For example:
 
  # hostinfo-status myguest
- myguest: hostinfo is enabled on serial port 1 (ttyS1/COM2)
+ myguest: hostinfo is enabled on serial port 1 (ttyS1, COM2)
+
+ # hostinfo-status anotherguest
+ anotherguest: hostinfo is disabled
 
 If no guest names are listed on the command line, this command
 displays the status of all guests known to libvirt.
 
 If no guest names are listed on the command line, this command
 displays the status of all guests known to libvirt.
@@ -51,12 +56,39 @@ host as a whole, you should use this command instead:
 
 (see L<hostinfo(8)>).
 
 
 (see L<hostinfo(8)>).
 
-=cut
-
 =head1 OPTIONS
 
 =over 4
 
 =head1 OPTIONS
 
 =over 4
 
+=cut
+
+my $help;
+
+=item B<--help>
+
+Display brief help.
+
+=cut
+
+my $version;
+
+=item B<--version>
+
+Display version number and exit.
+
+=cut
+
+my $uri;
+
+=item B<--connect URI> | B<-c URI>
+
+Connect to libvirt using the given URI.  If omitted then
+we connect to the default libvirt hypervisor.
+
+=cut
+
+my $quiet;
+
 =item B<--quiet>
 
 Use this option from scripts to test if hostinfo is enabled
 =item B<--quiet>
 
 Use this option from scripts to test if hostinfo is enabled
@@ -72,8 +104,114 @@ for a single guest without the verbose messages:
 
 =cut
 
 
 =cut
 
-
-
+GetOptions ("help|?" => \$help,
+           "version" => \$version,
+           "connect|c=s" => \$uri,
+           "quiet" => \$quiet,
+    ) or pod2usage (2);
+pod2usage (1) if $help;
+if ($version) {
+    print "@VERSION@\n";
+    exit
+}
+
+sub main
+{
+    my $ret = 0;
+
+    # Connect to libvirt.
+    my @libvirt_params = (readonly => 1);
+    push @libvirt_params, address => $uri if $uri;
+    my $conn = Sys::Virt->new (@libvirt_params);
+    die "could not connect to libvirt daemon" unless $conn;
+
+    # Get domains we're going to examine.
+    my @names = @ARGV;
+    my @doms;
+    if (@names == 0) {
+       die "'--quiet' option given with no guest names" if $quiet;
+       @doms = $conn->list_domains ();
+       push @doms, $conn->list_defined_domains ();
+    } else {
+       die "'--quiet' option given with more than one guest name"
+           if $quiet && @names > 1;
+       @doms = map { $conn->get_domain_by_name ($_) } @names;
+    }
+
+    # Examine each domain.
+    foreach my $dom (@doms) {
+       my $name = $dom->get_name;
+       my $xml = $dom->get_xml_description ();
+       my $path = XML::XPath->new (xml => $xml);
+
+       # Get all <serial type='unix'> devices.
+       my @serials =
+           $path->findnodes (q{//devices/serial[@type='unix']});
+
+       # Get the zero/one serial port which looks like a hostinfo device.
+       # It's an error if a domain has more than one of these.
+       my $errors = 0;
+       my $hostinfo_serial;
+       my $hostinfo_port;
+
+       foreach my $serial (@serials) {
+           my $spath =
+               XML::XPath->new (xml =>
+                                XML::XPath::XMLParser::as_string ($serial));
+
+           # Check it's a hostinfo serial port.
+           my @srcs =
+               $spath->findnodes (q{//source[starts-with(@path,"@localstatedir@/lib/hostinfo")]});
+           next if @srcs == 0;
+
+           if (@srcs > 1) {
+               warn "error: $name: malformed domain XML: multiple <source path> elements\n";
+               $errors++;
+               next;
+           }
+
+           unless ($hostinfo_serial) {
+               $hostinfo_serial = $serial;
+           } else {
+               warn "error: $name: domain appears to have multiple hostinfo serial ports\n";
+               $errors++;
+               next;
+           }
+
+           # Get the target port.
+           my @targports =
+               $spath->findnodes (q{//target/@port});
+           if (@targports == 0) {
+               warn "error: $name: malformed domain XML: no <target port> elements\n";
+               $errors++;
+               next;
+           }
+           if (@targports > 1) {
+               warn "error: $name: malformed domain XML: multiple <target port> elements\n";
+               $errors++;
+               next;
+           }
+           $hostinfo_port = $targports[0]->getData;
+       }
+
+       if ($quiet) {
+           $ret = $errors ? 2 : defined ($hostinfo_serial) ? 0 : 1;
+       } else {
+           if ($hostinfo_serial) {
+               if (defined $hostinfo_port) {
+                   my $windows_port = $hostinfo_port+1;
+                   print "$name: hostinfo is enabled on serial port $hostinfo_port (ttyS$hostinfo_port, COM$windows_port)\n";
+               } else {
+                   print "$name: hostinfo is enabled on an undefined serial port\n";
+               }
+           } else {
+               print "$name: hostinfo is disabled\n";
+           }
+       }
+    }
+
+    $ret;
+}
 
 =head1 RETURN VALUE
 
 
 =head1 RETURN VALUE
 
@@ -85,7 +223,13 @@ is enabled, 1 if hostinfo is disabled, or 2 if there was an error.
 
 =cut
 
 
 =cut
 
-
+my $ret = eval { &main };
+if ($@) {
+    print STDERR "$@\n";
+    exit 2;
+}
+exit $ret if $quiet;
+exit 0;
 
 =head1 SEE ALSO
 
 
 =head1 SEE ALSO