#!/usr/bin/perl -w
# virt-tools
# Copyright (C) 2009 Red Hat Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

use strict;

use Net::SNMP;
use Sys::Virt;
use Pod::Usage;
use Getopt::Long;
use Locale::TextDomain 'virt-tools';

=encoding utf8

=head1 NAME

virt-ps, virt-ping, virt-uname, virt-uptime - virtual machine information and statistics

=head1 SYNOPSIS

 virt-ifconfig [--options] [domname]

 virt-ps [--options] [domname]

 virt-ping [--options] [domname]

 virt-uname [--options] [domname]

 virt-uptime [--options] [domname]

=head1 COMMON OPTIONS

All the tools take either a single C<domname> parameter, which is the
name of the virtual machine as known to libvirt (C<virsh list>), or no
parameter in which case they operate on all currently running guests.

I<Note:> You must install the C<virt-tools-guest> package in each
Linux guest, otherwise these programs will not work.

There are some common options which can be supplied to any tool:

=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>

If using libvirt, connect to the given I<URI>.  If omitted, then we
connect to the default libvirt hypervisor.

=cut

my $csv;

=item B<--csv>

Write out the results in CSV format (comma-separated values).  This
format can be imported easily into databases and spreadsheets, but
read L</NOTE ABOUT CSV FORMAT> below.

=cut

my $verbose;

=item B<--verbose> | B<-v>

Enable verbose messages, useful for debugging.

=back

=cut

GetOptions ("help|?" => \$help,
            "version" => \$version,
            "connect|c=s" => \$uri,
            "csv" => \$csv,
            "verbose|v" => \$verbose,
    ) or pod2usage (2);
pod2usage (1) if $help;
if ($version) {
    print "@PACKAGE_STRING@\n";
    exit
}

my %subcommands = (
    "virt-ps" => [ \&do_ps, \&title_ps ],
    "virt-ping" => [ \&do_ping, \&title_ping ],
    "virt-uname" => [ \&do_uname, \&title_uname ],
    "virt-uptime" => [ \&do_uptime, \&title_uptime ],
);

# Which subcommand?
my ($do_it, $title_it);
foreach (keys %subcommands) {
    if ($0 =~ /$_/) {
        print STDERR "subcommand = $_\n" if $verbose;
        $do_it = $subcommands{$_}->[0];
        $title_it = $subcommands{$_}->[1];
        last;
    }
}
die "$0: cannot determine which sub-command to run\n" unless $do_it;

# If we are being run from a local directory, add that directory to
# the path, so we can be run from the source directory without being
# installed.
if (substr ($0, 0, 1) ne "/") {
    $_ = $0;
    s{/[^/]+$}{};
    $ENV{PATH} = "$_:$ENV{PATH}"; # XXX Windows?
    print STDERR "PATH set to $ENV{PATH}\n" if $verbose;
}

our $errors = 0;

# Do we have named guests?
if (@ARGV == 0) {
    my $conn;

    if ($uri) {
        $conn = Sys::Virt->new (readonly => 1, address => $uri);
    } else {
        $conn = Sys::Virt->new (readonly => 1);
    }

    # Ignore inactive domains.
    my @doms = $conn->list_domains ();

    my @domnames = map { $_->get_name () } @doms;

    if (@domnames) {
	&$title_it ();
        foreach (@domnames) {
            get_and_do_it ($_);
        }
    }
} else {
    &$title_it ();
    foreach (@ARGV) {
        get_and_do_it ($_);
    }
}

sub get_and_do_it
{
    # Turn any errors into warnings.
    eval {
	my ($key, $transport);
	$key = get_key ($_);
	$transport = get_transport ($_);
	&$do_it ($_, $key, $transport);
    };
    if ($@) {
	$errors++;
	warn "$@";
    }
}

print STDERR "errors = $errors\n" if $verbose;

exit ($errors == 0 ? 0 : 1);

# virt-ifconfig is implemented as a separate program.

=head1 virt-ifconfig

C<virt-ifconfig> displays the IP address of the guest.

=head1 virt-ps

C<virt-ps> displays the process list of the guest.

=cut

sub title_ps
{
    print_row (__"Guest");
}

sub do_ps
{
    my $domname = shift;
    my $key = shift;
    my $transport = shift;



}

=head1 virt-ping

C<virt-ping> pings the guest by making an empty virt-tools request,
and checking that it replies.  This can be used as a simple test that
virt-tools is available and working inside the guest.

=cut

sub title_ping
{
    print_row (__"Guest");
}

sub do_ping
{
    my $domname = shift;
    my $key = shift;
    my $transport = shift;



}

=head1 virt-uname

C<virt-uname> displays the system information (kernel version etc) of
the guest.

=cut

sub title_uname
{
    print_row (__"Guest", __"System name");
}

sub do_uname
{
    my $domname = shift;
    my $key = shift;
    my $transport = shift;

    my $session = get_snmp_session ($key, $transport);
    my $sysDescr = "1.3.6.1.2.1.1.1.0";
    my $r = $session->get_request (-varbindlist => [$sysDescr])
	or die __x("SNMP error: {e}", $session->error);
    print_row ($domname, $r->{$sysDescr});
    $session->close;
}

=head1 virt-uptime

C<virt-uptime> displays the uptime of the guest

=cut

sub title_uptime
{
    print_row (__"Guest", __"Uptime");
}

sub do_uptime
{
    my $domname = shift;
    my $key = shift;
    my $transport = shift;

    my $session = get_snmp_session ($key, $transport);
    my $sysUpTime = "1.3.6.1.2.1.1.3.0";
    my $r = $session->get_request (-varbindlist => [$sysUpTime])
	or die __x("SNMP error: {e}", $session->error);
    print_row ($domname, $r->{$sysUpTime});
    $session->close;
}

sub print_row
{
    my @fields = @_;

    local $_;
    my $comma = 0;

    foreach (@fields) {
	if (!$csv) {
	    printf "%-16s ", $_
	} else {
	    print "," if $comma;
	    $comma = 1;

	    # XXX Use Text::CSV here.
	    if ($_ =~ /"/) {
		s/"/""/;
		printf "\"%s\"", $_;
	    } elsif ($_ =~ /,/ || $_ =~ /\n/) {
		printf "\"%s\"", $_;
	    } else {
		print $_;
	    }
	}
    }
    print "\n";
}

=head1 OVERVIEW

Virt-tools are a set of tools that you can install in your virtual
machines (host and guests) to get enhanced information about the
guests.

Unlike VMWare Tools, virt-tools is hypervisor agnostic.  Also
virt-tools is just about collecting statistics and does not include
any performance or functionality enhancements for guests (see virtio
if you want that).

There are two parts to any virt-tools installation: some client
programs like C<virt-uname> and C<virt-ps> that you run on the host,
to query guest information.  On the guest, you have to install and run
a virt-tools service.  Between the host and guest is a transport which
should be secured.

The L</GUEST ARCHITECTURE> section describes how virt-tools appears
from the guest side.

The L</HOST ARCHITECTURE> section describes the architecture of
virt-tools on the host side.

=head1 GUEST ARCHITECTURE

In most cases, you can just install the C<virt-tools-guest> package in
your Linux guests, or the Windows virt-tools guest package in your
Windows guests, and everything should just work.  In this section we
describe more about how it works (or is supposed to work) from the
guest side.

=head2 COMMUNICATIONS DIRECTORY

The guest writes various static, mostly unchanging, information into
its own directory.  On Linux the directory is
C<@localstatedir@/lib/virt-tools/> and under Windows it is
C<%systemroot%\virttool\>.  In the discussion below, this
communications directory is referred to as C<$GUESTCOMMSDIR>.

The host is able to read files out of this directory using
L<libguestfs(3)> (without any cooperation needed by the guest).

=head2 IP ADDRESSES

The host can't easily see the guest's IP address.  The host provides
the guest with a network interface connected to a bridge, but the
guest can use any IP address it likes (although well-behaved guests
will usually have some static IPs or are allocated one by DHCP).

So when the guest starts up, or its IP address changes (usually these
are rare events) the guest writes a file
C<$GUESTCOMMSDIR/ip-E<lt>ifaceE<gt>> which contains details of the IP
address of the interface E<lt>ifaceE<gt> (eg. the file might be called
C<ip-eth0> under Linux).

C<virt-ifconfig> reads this file directly using L<libguestfs(3)>.

=head2 KEYS

When the guest is first installed (or more precisely, when the
virt-tools-guest package is first installed in the guest), a random
secret key is generated.  This is used to encrypt communications with
the guest, and it is described in more detail below.

The key is written to C<$GUESTCOMMSDIR/key>.

=head2 SNMP DAEMON

For process listings, and just about every other piece of data except
for IP address, guests run a completely standard SNMP (Simple Network
Management Protocol) server.  The host client tools access this server
in order to query information about the guest.  They query this using
standard SNMP calls.

The protocol used is SNMPv3 (RFC 2571) which addresses security
concerns in earlier versions of the protocol.  In order to ensure that
only the host can access the SNMP server and see the results, all
communications are encrypted and authenticated using the guest's key.

=head2 TRANSPORT

There is not necessarily a network connection between the host and the
guest.  There are many configurations of virtualization in which the
host has no network access to the guest: for example, if the host
firewalls itself off from the guest (or vice versa), or if the guest
has a physically separate network card from the host.

Therefore the guest to host SNMP transport is not necessarily over an
IP network.  Other transports are possible, including "vmchannel"
(where "vmchannel" is the generic name for a collection of specialized
host-guest communication channels implemented in different ways by
different hypervisors).

The transport is written to C<$GUESTCOMMSDIR/transport>.

=head1 HOST ARCHITECTURE

On the host side, the host uses L<libguestfs(3)> to read the guest's
IP address and key, and uses some heuristics to determine the
transport to use.

Once the key and the transport to the guest are worked out, programs
like C<virt-ps>, C<virt-uname> and so on are just making
straightforward SNMP calls:

 +-----------------+      +-----------------+
 | host            |      | guest           |
 |  virt-ps --- request ---> snmpd          |
 |         <---- reply -----                |
 +-----------------+      +-----------------+

The difficulty is in determining the key and the transport to use,
which is what this section covers.  You can also use this knowledge to
diagnose problems or to create non-standard configurations.

=head2 DETERMINE KEY

All the host tools use an external helper program called
C<virt-tools-get-key> to get the key of the guest.  (See
L<virt-tools-get-key(8)> for the precise usage of this program).

The key is generated by the guest once -- when the virt-tools-guest
package is installed in the guest.  The key is written to a file
C<$GUESTCOMMSDIR/key> (in the guest) which is readable only by root.

Using L<libguestfs(3)> the host can read any file in the guest, so it
can read this key out directly.  This is what the
C<virt-tools-get-key> program does, and you can run it by hand to
verify its operation:

 # virt-tools-get-key -v domname
 abcdef1234567890

=head3 KEY CACHE

C<virt-tools-get-key> caches the keys of guests that it has seen
before so it doesn't have to read them each time.  The cache is in
C<@localstatedir@/lib/virt-tools/keys/> (in the host).

You can just delete the files in this directory at any time, I<or> you
can drop a file in here which contains the key of a guest.

To do this, create a file
C<@localstatedir@/lib/virt-tools/keys/E<lt>UUIDE<gt>> where
E<lt>UUIDE<gt> is the guest's UUID as displayed by this command:

 virsh domuuid <name>

The contents of the file should be the key.

You can test this works by running C<virt-tools-get-key> by hand.

This cache never expires, unless you remove the files by hand.

=cut

sub get_key
{
    my $domname = shift;

    my $cmd = "virt-tools-get-key";
    $cmd .= " -v" if $verbose;
    # XXX quoting
    $cmd .= " -c '$uri'" if $uri;
    $cmd .= " '$domname'";

    print STDERR "$cmd\n" if $verbose;

    open PIPE, "$cmd |" or die "$cmd: $!";
    my $line = <PIPE>;
    die __"no response from virt-tools-get-key\n" unless $line;
    chomp $line;
    close PIPE;

    $line
}

=head2 DETERMINE TRANSPORT

All the host tools use a second helper program called
C<virt-tools-get-transport> to get the transport and address to use
for a guest.  (See L<virt-tools-get-transport(8)> for the precise
usage of this program).

This program tries a series of methods to determine how to access a
guest, be it through a direct network connection or over some
hypervisor-specific vmchannel.

 # virt-tools-get-transport -v domname
 udp:192.168.122.33

You can diagnose problems with the transport by trying to run this
command by hand.

=head3 TRANSPORT CACHE

C<virt-tools-get-transport> caches the transports of guests that it
has seen before so it doesn't have to determine them each time.  The
cache is in C<@localstatedir@/lib/virt-tools/transports/> (in the
host).

As for the L</KEY CACHE>, this directory is just some files that are
named after the UUID of the guest, containing the transport.

Unlike the key cache, C<virt-tools-get-transport> will check that a
transport is still valid, and will expire (ie. delete) the
corresponding entry in the transport cache if it is not valid.

=cut

sub get_transport
{
    my $domname = shift;

    my $cmd = "virt-tools-get-transport";
    $cmd .= " -v" if $verbose;
    # XXX quoting
    $cmd .= " -c '$uri'" if $uri;
    $cmd .= " '$domname'";

    print STDERR "$cmd\n" if $verbose;

    open PIPE, "$cmd |" or die "$cmd: $!";
    my $line = <PIPE>;
    die __"no response from virt-tools-get-transport\n" unless $line;
    chomp $line;
    close PIPE;

    $line
}

=head2 SNMP QUERIES

Standard SNMP queries are used between the host and guest.

SNMP already supports many of the features we are trying to query
(eg. the UCD SNMP MIB provides a way to query the process list of a
machine in a form which is a de facto standard).

To determine what precise queries are sent, run the tools in verbose
mode or examine the source.

=cut

sub get_snmp_session
{
    my $key = shift;
    my $transport = shift;

    my ($hostname, $port, $domain);
    if ($transport =~ /^udp:(.*):(.*)/) {
	$domain = "udp";
	$hostname = $1;
	$port = $2;
    } elsif ($transport =~ /^tcp:(.*):(.*)/) {
	$domain = "tcp";
	$hostname = $1;
	$port = $2;
    } else {
	die __x("unknown transport type: {t}", t => $transport);
    }

    if ($verbose) {
	print STDERR "creating Net::SNMP session to $domain:$hostname:$port with key $key\n"
    }

    my ($session, $error) = Net::SNMP->session (
	-version => 3,
	-username => "virttools",
	-authpassword => $key,
	-authprotocol => "sha",
	-privpassword => $key,
	-privprotocol => "aes",
	-hostname => $hostname,
	-port => $port,
	-domain => $domain,
	);
    die __x("SNMP failure: {e}", e => $error) unless $session;

    $session;
}

=head2 RUNNING YOUR OWN SNMP SERVER IN A GUEST

I<(To be written)>

=head1 NOTE ABOUT CSV FORMAT

Comma-separated values (CSV) is a deceptive format.  It I<seems> like
it should be easy to parse, but it is definitely not easy to parse.

Myth: Just split fields at commas.  Reality: This does I<not> work
reliably.  This example has two columns:

 "foo,bar",baz

Myth: Read the file one line at a time.  Reality: This does I<not>
work reliably.  This example has one row:

 "foo
 bar",baz

For shell scripts, use C<csvtool> (L<http://merjis.com/developers/csv>
also packaged in major Linux distributions).

For other languages, use a CSV processing library (eg. C<Text::CSV>
for Perl or Python's built-in csv library).

Most spreadsheets and databases can import CSV directly.

=head1 SEE ALSO

L<virt-ifconfig(8)>,
L<guestfs(3)>,
L<guestfish(1)>,
L<Sys::Guestfs(3)>,
L<Sys::Guestfs::Lib(3)>,
L<Sys::Virt(3)>,
L<http://libguestfs.org/>.

=head1 AUTHORS

=over 4

=item *

Richard W.M. Jones (C<rjones at redhat dot com>)

=item *

Matthew Booth (C<mbooth at redhat dot com>)

=back

=head1 COPYRIGHT

Copyright (C) 2009 Red Hat Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
