tools/virt-tools-get-transport.pl

   1 #!/usr/bin/perl -w
   2 # virt-tools
   3 # Copyright (C) 2009 Red Hat Inc.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18
  19 use Sys::Virt;
  20 use Sys::Guestfs;
  21 use Sys::Guestfs::Lib qw(open_guest get_partitions);
  22 use Pod::Usage;
  23 use Getopt::Long;
  24 use Locale::TextDomain 'virt-tools';
  25 use Net::SNMP;
  26
  27 =encoding utf8
  28
  29 =head1 NAME
  30
  31 virt-tools-get-transport - virt-tools helper to get the guest's transport
  32
  33 =head1 SYNOPSIS
  34
  35  virt-tools-get-transport [--options] domname
  36
  37 =head1 DESCRIPTION
  38
  39 This helper program is used by L<virt-tools(8)> to get the transport
  40 that should be used to connect to the SNMP daemon inside the guest.
  41 If you don't know anything about this, you probably want to start by
  42 reading L<virt-tools(8)>.  Otherwise read on.
  43
  44 The single command line argument should be a libvirt domain name (see
  45 C<virsh list --all>).
  46
  47 =head2 TRANSPORTS
  48
  49 Transports look somewhat like a URL, with a transport schema followed
  50 by some specific details.  Currently we have defined these transports:
  51
  52 =over 4
  53
  54 =item udp:ip-address[:port]
  55
  56 Connect via UDP to C<ip-address>, optionally on the non-default port
  57 C<port> (the usual SNMP port 161 is used otherwise).
  58
  59 =item tcp:ip-address[:port]
  60
  61 Connect via TCP to C<ip-address>, optionally on the non-default port
  62 C<port> (the usual SNMP port 161 is used otherwise).
  63
  64 =item unix:path
  65
  66 Connect via Unix domain socket C<path>.  This would be used in future
  67 for vmchannel implementations, but it is not used at the moment.
  68
  69 =back
  70
  71 =head2 TRANSPORT CACHE
  72
  73 The cache is described in detail in L<virt-tools(8)>.  In brief, if
  74 C<@localstatedir@/lib/virt-tools/transports/E<lt>UUIDE<gt>> exists
  75 (where E<lt>UUIDE<gt> is the guest's UUID), then the contents of that
  76 file are returned directly.  Otherwise we will try to create this file
  77 after reading the transport so that we don't have to determine the
  78 guest's transport each time.
  79
  80 =head1 OPTIONS
  81
  82 =over 4
  83
  84 =cut
  85
  86 my $help;
  87
  88 =item B<--help>
  89
  90 Display brief help.
  91
  92 =cut
  93
  94 my $version;
  95
  96 =item B<--version>
  97
  98 Display version number and exit.
  99
 100 =cut
 101
 102 my $uri;
 103
 104 =item B<--connect URI> | B<-c URI>
 105
 106 If using libvirt, connect to the given I<URI>.  If omitted, then we
 107 connect to the default libvirt hypervisor.
 108
 109 =cut
 110
 111 my $verbose;
 112
 113 =item B<--verbose> | B<-v>
 114
 115 Enable verbose messages, useful for debugging.
 116
 117 =cut
 118
 119 my $no_ping;
 120
 121 =item B<--no-ping> | B<-n>
 122
 123 Do not try to check that the transport is working by pinging the
 124 guest.
 125
 126 If this option is I<not> given, then this program will expire the
 127 cache entry for the guest if the transport from the cache doesn't
 128 work, then it will try to determine the new transport, test that, and
 129 fail if it still doesn't work.
 130
 131 =back
 132
 133 =cut
 134
 135 GetOptions ("help|?" => \$help,
 136             "version" => \$version,
 137             "connect|c=s" => \$uri,
 138             "verbose|v" => \$verbose,
 139             "no-ping|n" => \$no_ping,
 140     ) or pod2usage (2);
 141 pod2usage (1) if $help;
 142 if ($version) {
 143     print "@PACKAGE_STRING@\n";
 144     exit
 145 }
 146
 147 die __"no domain name listed on the command line\n" unless @ARGV == 1;
 148
 149 my ($g, $conn, $dom);
 150
 151 if ($uri) {
 152     ($g, $conn, $dom) = open_guest (\@ARGV, address => $uri);
 153 } else {
 154     ($g, $conn, $dom) = open_guest (\@ARGV);
 155 }
 156
 157 my $uuid = $dom->get_uuid_string ();
 158 my $domname = $dom->get_name ();
 159
 160 # See if the UUID exists in the cache already.
 161 print STDERR "checking for UUID $uuid in the cache directory\n" if $verbose;
 162
 163 my $cachedir = "@localstatedir@/lib/virt-tools/transports";
 164 if (-r "$cachedir/$uuid") {
 165     print STDERR "$cachedir/$uuid exists\n" if $verbose;
 166     open FILE, "$cachedir/$uuid" or die "$cachedir/$uuid: $!";
 167     my $transport = <FILE>;
 168     chomp $transport;
 169     close FILE;
 170
 171     unless ($no_ping) {
 172         # Test if it works.
 173         if (!test_transport ($transport)) {
 174             unlink "$cachedir/$uuid"; # allow this to fail
 175             goto keep_looking;
 176         }
 177     }
 178
 179     print $transport, "\n";
 180
 181     exit 0;
 182 }
 183
 184 print STDERR "$cachedir/$uuid not found, looking inside guest\n" if $verbose;
 185
 186 keep_looking:
 187 $g->launch ();
 188
 189 # Do not care about mountpoints.  Instead, just look for a
 190 # directory with one of a selection of names on one of the
 191 # partitions that we found.
 192 my @partitions = get_partitions ($g);
 193
 194 my ($transport, $key, $ip);
 195
 196 foreach my $partition (@partitions) {
 197     eval {
 198         $g->mount_ro ($partition, "/");
 199         my $dir;
 200         my @dirs = ("/var/lib/virt-tools", "/lib/virt-tools");
 201         foreach $dir (@dirs) {
 202             if ($g->is_dir ($dir)) {
 203                 if ($g->is_file ("$dir/transport")) {
 204                     $transport = $g->cat ("$dir/transport");
 205                 }
 206                 if ($g->is_file ("$dir/key")) {
 207                     $key = $g->cat ("$dir/key");
 208                 }
 209                 if ($g->is_file ("$dir/ip-eth0")) {
 210                     $ip = $g->cat ("$dir/ip-eth0");
 211                 }
 212             }
 213         }
 214     };
 215     $g->umount_all ();
 216     last if $transport || $key;
 217 }
 218
 219 undef $g;
 220
 221 die __x("{n}: no transport or key found in guest.\nDoes it have the virt-tool-guest package installed?\n",
 222         n => $ARGV[0])
 223     unless $transport && $key;
 224
 225 if ($ip) {
 226     if ($ip =~ m{inet (\S+)/}) {
 227         $ip = $1;
 228     } elsif ($ip =~ m{inet6 (\S+)/}) {
 229         $ip = $1;
 230     } else {
 231         die __"could not parse the content of ip-eth0 file from the guest";
 232     }
 233 }
 234
 235 if ($transport =~ /^udp:(\d+)/) {
 236     die __"UDP transport, but no IP address in guest" unless $ip;
 237     $transport = "udp:$ip:$1";
 238 }
 239 elsif ($transport =~ /^udp/) {
 240     die __"UDP transport, but no IP address in guest" unless $ip;
 241     $transport = "udp:$ip:161";
 242 }
 243 elsif ($transport =~ /^tcp:(\d+)/) {
 244     die __"TCP transport, but no IP address in guest" unless $ip;
 245     $transport = "tcp:$ip:$1";
 246 }
 247 elsif ($transport =~ /^tcp/) {
 248     die __"TCP transport, but no IP address in guest" unless $ip;
 249     $transport = "tcp:$ip:161";
 250 }
 251 else {
 252     die __x("unknown transport type: {t}", t => $transport);
 253 }
 254
 255 # Test the transport works.
 256 die __x("transport {t} does not work", t => $transport)
 257     unless test_transport ($transport, $key);
 258
 259 print STDERR "try to write $transport to $cachedir/$uuid\n" if $verbose;
 260
 261 if (open FILE, ">$cachedir/$uuid") {
 262     print FILE $transport;
 263     close FILE
 264 }
 265
 266 print $transport;
 267
 268 exit 0;
 269
 270 sub test_transport
 271 {
 272     my $transport = shift;
 273     my $key = shift;
 274
 275     unless ($key) {
 276         my $cmd = "virt-tools-get-key";
 277         $cmd .= " -v" if $verbose;
 278         # XXX quoting
 279         $cmd .= " -c '$uri'" if $uri;
 280         $cmd .= " '$domname'";
 281
 282         print STDERR "$cmd\n" if $verbose;
 283
 284         open PIPE, "$cmd |" or die "$cmd: $!";
 285         $key = <PIPE>;
 286         die __"no response from virt-tools-get-key\n" unless $key;
 287         chomp $key;
 288         close PIPE;
 289     }
 290
 291     print "XXX PING XXX\n";
 292
 293     1;
 294 }
 295
 296 =head1 SEE ALSO
 297
 298 L<virt-ifconfig(8)>,
 299 L<guestfs(3)>,
 300 L<guestfish(1)>,
 301 L<Sys::Guestfs(3)>,
 302 L<Sys::Guestfs::Lib(3)>,
 303 L<Sys::Virt(3)>,
 304 L<http://libguestfs.org/>.
 305
 306 =head1 AUTHORS
 307
 308 =over 4
 309
 310 =item *
 311
 312 Richard W.M. Jones (C<rjones at redhat dot com>)
 313
 314 =item *
 315
 316 Matthew Booth (C<mbooth at redhat dot com>)
 317
 318 =back
 319
 320 =head1 COPYRIGHT
 321
 322 Copyright (C) 2009 Red Hat Inc.
 323
 324 This program is free software; you can redistribute it and/or modify
 325 it under the terms of the GNU General Public License as published by
 326 the Free Software Foundation; either version 2 of the License, or
 327 (at your option) any later version.
 328
 329 This program is distributed in the hope that it will be useful,
 330 but WITHOUT ANY WARRANTY; without even the implied warranty of
 331 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 332 GNU General Public License for more details.
 333
 334 You should have received a copy of the GNU General Public License
 335 along with this program; if not, write to the Free Software
 336 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.