#!/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 Sys::Virt;
use Sys::Guestfs;
use Sys::Guestfs::Lib qw(open_guest get_partitions);
use Pod::Usage;
use Getopt::Long;
use Locale::TextDomain 'virt-tools';

=encoding utf8

=head1 NAME

virt-tools-get-key - virt-tools helper to get the guest's key

=head1 SYNOPSIS

 virt-tools-get-key [--options] domname

=head1 DESCRIPTION

This helper program is used by L<virt-tools(8)> to get the guest's
secret key.  If you don't know anything about this, you probably want
to start by reading L<virt-tools(8)>.  Otherwise read on.

The single command line argument should be a libvirt domain name (see
C<virsh list --all>).

=head2 KEY CACHE

The cache is described in detail in L<virt-tools(8)>.  In brief, if
C<@localstatedir@/lib/virt-tools/keys/E<lt>UUIDE<gt>> exists (where
E<lt>UUIDE<gt> is the guest's UUID), then the contents of that file
are returned directly.  Otherwise we will try to create this file
after reading the key so that we don't have to read the key out of the
guest's filesystem each time.

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

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

=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,
            "verbose|v" => \$verbose,
    ) or pod2usage (2);
pod2usage (1) if $help;
if ($version) {
    print "@PACKAGE_STRING@\n";
    exit
}

die __"no domain name listed on the command line\n" unless @ARGV == 1;

my ($g, $conn, $dom);

if ($uri) {
    ($g, $conn, $dom) = open_guest (\@ARGV, address => $uri);
} else {
    ($g, $conn, $dom) = open_guest (\@ARGV);
}

my $uuid = $dom->get_uuid_string ();

undef $dom;
undef $conn;

# See if the UUID exists in the cache already.
print STDERR "checking for UUID $uuid in the cache directory\n" if $verbose;

my $cachedir = "@localstatedir@/lib/virt-tools/keys";
if (-r "$cachedir/$uuid") {
    print STDERR "$cachedir/$uuid exists, returning contents\n" if $verbose;
    open FILE, "$cachedir/$uuid" or die "$cachedir/$uuid: $!";
    my $key = <FILE>;
    chomp $key;
    close FILE;
    print $key, "\n";
    exit 0;
}

print STDERR "$cachedir/$uuid not found, looking inside guest\n" if $verbose;

$g->launch ();

# Don't care about mountpoints.  Instead, just look for a
# directory with one of a selection of names on one of the
# partitions that we found.
my @partitions = get_partitions ($g);

my $key;

foreach my $partition (@partitions) {
    eval {
	$g->mount_ro ($partition, "/");
	my $dir;
	my @dirs = ("/var/lib/virt-tools", "/lib/virt-tools");
	foreach $dir (@dirs) {
	    if ($g->is_dir ($dir) && $g->is_file ("$dir/key")) {
		$key = $g->cat ("$dir/key");
		last;
	    }
	}
    };
    $g->umount_all ();
    last if $key;
}

undef $g;

die __x("{n}: no key found in guest.\nDoes it have the virt-tool-guest package installed?\n",
	n => $ARGV[0])
    unless $key;

print STDERR "try to write key to $cachedir/$uuid\n" if $verbose;

if (open FILE, ">$cachedir/$uuid") {
    print FILE $key;
    close FILE
}

print $key;

exit 0;

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