X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl%2Flib%2FSys%2FGuestfs%2FLib.pm;h=c97fae38105adbeea719de7180ab017e74e26c67;hb=a7a88083f0c9d83828dc9154c1c053fcd735d9ba;hp=96ada0d6cf51f91b63257ec922c0cb235b701ddb;hpb=0a016df319420f9291c806bf8c8b528705b1bdc5;p=libguestfs.git diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm index 96ada0d..c97fae3 100644 --- a/perl/lib/Sys/Guestfs/Lib.pm +++ b/perl/lib/Sys/Guestfs/Lib.pm @@ -64,7 +64,8 @@ require Exporter; 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); @@ -100,7 +101,7 @@ read-write handle, this function will refuse to use active libvirt domains. The handle is still in the config state when it is returned, so you -have to call C<$g-Elaunch ()> and C<$g-Ewait_ready>. +have to call C<$g-Elaunch ()>. The optional C
parameter can be added to specify the libvirt URI. In addition, L lists other parameters which are @@ -208,6 +209,30 @@ sub open_guest 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-Eavailable> call. + +C<$g-Eavailable> 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. + +=cut + +sub feature_available { + my $g = shift; + + eval { $g->available (\@_); }; + return $@ ? 0 : 1; +} + =head2 get_partitions @partitions = get_partitions ($g); @@ -230,7 +255,8 @@ sub get_partitions 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); } @@ -267,38 +293,12 @@ by C characters. Do not use C<\>, drive names, etc. 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 @@ -569,13 +569,23 @@ C flag are explained below. =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 @@ -1494,7 +1504,7 @@ sub _check_for_kernels { 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}