use strict;
-#use Sys::Virt;
-
-=pod
+use Pod::Usage;
+use Getopt::Long;
+use Sys::Virt;
+use XML::XPath;
+use XML::XPath::XMLParser;
=head1 NAME
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.
(see L<hostinfo(8)>).
-=cut
-
=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
=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
=cut
-
+my $ret = eval { &main };
+if ($@) {
+ print STDERR "$@\n";
+ exit 2;
+}
+exit $ret if $quiet;
+exit 0;
=head1 SEE ALSO