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