use vars qw(@EXPORT_OK @ISA);
@ISA = qw(Exporter);
-@EXPORT_OK = qw(open_guest get_partitions resolve_windows_path
+@EXPORT_OK = qw(open_guest feature_available
+ get_partitions resolve_windows_path
inspect_all_partitions inspect_partition
inspect_operating_systems mount_operating_system inspect_in_detail
inspect_linux_kernel);
have to call C<$g-E<gt>launch ()>.
The optional C<address> parameter can be added to specify the libvirt
-URI. In addition, L<Sys::Virt(3)> lists other parameters which are
-passed through to C<Sys::Virt-E<gt>new> unchanged.
+URI.
The implicit libvirt handle is closed after this function, I<unless>
you call the function in C<wantarray> context, in which case the
If the C<Sys::Virt> module is not available, then libvirt is bypassed,
and this function can only open disk images.
+The optional C<interface> parameter can be used to open devices with
+C<add_drive{,_ro}_with_if>. See
+L<Sys::Guestfs/guestfs_add_drive_with_if> for more details.
+
=cut
sub open_guest
my $first = shift;
my %params = @_;
- my $readwrite = $params{rw};
+ my $rw = $params{rw};
+ my $address = $params{address};
+ my $interface = $params{interface};
my @images = ();
if (ref ($first) eq "ARRAY") {
die __"open_guest: too many domains listed on command line"
if @images > 1;
- $conn = Sys::Virt->new (readonly => 1, @_);
+ my @libvirt_args = ();
+ push @libvirt_args, address => $address if defined $address;
+
+ $conn = Sys::Virt->new (readonly => 1, @libvirt_args);
die __"open_guest: cannot connect to libvirt" unless $conn;
my @doms = $conn->list_defined_domains ();
my $isitinactive = 1;
- unless ($readwrite) {
+ unless ($rw) {
# In the case where we want read-only access to a domain,
# allow the user to specify an active domain too.
push @doms, $conn->list_domains ();
# We've now got the list of @images, so feed them to libguestfs.
my $g = Sys::Guestfs->new ();
foreach (@images) {
- if ($readwrite) {
- $g->add_drive ($_);
+ if ($rw) {
+ if ($interface) {
+ $g->add_drive_with_if ($_, $interface);
+ } else {
+ $g->add_drive ($_);
+ }
} else {
- $g->add_drive_ro ($_);
+ if ($interface) {
+ $g->add_drive_ro_with_if ($_, $interface);
+ } else {
+ $g->add_drive_ro ($_);
+ }
}
}
return wantarray ? ($g, $conn, $dom, @images) : $g
}
+=head2 feature_available
+
+ $bool = feature_available ($g, $feature [, $feature ...]);
+
+This function is a useful wrapper around the basic
+C<$g-E<gt>available> call.
+
+C<$g-E<gt>available> tests for availability of a list of features and
+dies with an error if any is not available.
+
+This call tests for the list of features and returns true if all are
+available, or false otherwise.
+
+For a list of features you can test for, see L<guestfs(3)/AVAILABILITY>.
+
+=cut
+
+sub feature_available {
+ my $g = shift;
+
+ eval { $g->available (\@_); };
+ return $@ ? 0 : 1;
+}
+
=head2 get_partitions
@partitions = get_partitions ($g);
my @pvs = $g->pvs ();
@partitions = grep { ! _is_pv ($_, @pvs) } @partitions;
- my @lvs = $g->lvs ();
+ my @lvs;
+ @lvs = $g->lvs () if feature_available ($g, "lvm2");
return sort (@lvs, @partitions);
}
sub resolve_windows_path
{
- local $_;
my $g = shift;
my $path = shift;
- if (substr ($path, 0, 1) ne "/") {
- warn __"resolve_windows_path: path must start with a / character";
- return undef;
- }
-
- my @elems = split (/\//, $path);
- shift @elems;
-
- # Start reconstructing the path at the top.
- $path = "/";
-
- foreach my $dir (@elems) {
- my $found = 0;
- foreach ($g->ls ($path)) {
- if (lc ($_) eq lc ($dir)) {
- if ($path eq "/") {
- $path = "/$_";
- $found = 1;
- } else {
- $path = "$path/$_";
- $found = 1;
- }
- }
- }
- return undef unless $found;
- }
-
- return $path;
+ my $r;
+ eval { $r = $g->case_sensitive_path ($path); };
+ return $r;
}
=head2 file_architecture
=cut
+# Turn /dev/vd* and /dev/hd* into canonical device names
+# (see BLOCK DEVICE NAMING in guestfs(3)).
+
+sub _canonical_dev ($)
+{
+ my ($dev) = @_;
+ return "/dev/sd$1" if $dev =~ m{^/dev/[vh]d(\w+)};
+ return $dev;
+}
+
sub inspect_all_partitions
{
local $_;
my $g = shift;
my $parts = shift;
my @parts = @$parts;
- return map { $_ => inspect_partition ($g, $_, @_) } @parts;
+ return map { _canonical_dev ($_) => inspect_partition ($g, $_, @_) } @parts;
}
=head2 inspect_partition
if($ro) {
$g->mount_ro ($mounts->{$_}, $_)
} else {
- $g->mount ($mounts->{$_}, $_)
+ $g->mount_options ("", $mounts->{$_}, $_)
}
}
}
foreach (@lines) {
if (m/^(.*) (.*) (.*) (.*) (.*)$/) {
my $epoch = $2;
- $epoch = "" if $epoch eq "(none)";
+ undef $epoch if $epoch eq "(none)";
my $app = {
name => $1,
epoch => $epoch,
{
my ($g, $os) = @_;
- if ($os->{os} eq "linux") {
+ if ($os->{os} eq "linux" && feature_available ($g, "augeas")) {
# Iterate over entries in grub.conf, populating $os->{boot}
# For every kernel we find, inspect it and add to $os->{kernels}
git.annexia.org / libguestfs.git / blobdiff