File: inspect_vm.pl

package info (click to toggle)
libguestfs 1%3A1.40.2-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 123,660 kB
  • sloc: ansic: 460,074; ml: 63,059; sh: 14,955; java: 9,512; makefile: 9,133; cs: 6,300; haskell: 5,652; python: 3,856; perl: 3,619; erlang: 2,435; xml: 1,683; ruby: 350; pascal: 255; lex: 135; yacc: 128; cpp: 10
file content (65 lines) | stat: -rwxr-xr-x 1,843 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
#!/usr/bin/perl

# Example showing how to inspect a virtual machine disk.

use strict;
use warnings;
use Sys::Guestfs;

if (@ARGV < 1) {
    die "usage: inspect_vm disk.img"
}

my $disk = $ARGV[0];

my $g = new Sys::Guestfs ();

# Attach the disk image read-only to libguestfs.
# You could also add an optional format => ... argument here.  This is
# advisable since automatic format detection is insecure.
$g->add_drive_opts ($disk, readonly => 1);

# Run the libguestfs back-end.
$g->launch ();

# Ask libguestfs to inspect for operating systems.
my @roots = $g->inspect_os ();
if (@roots == 0) {
    die "inspect_vm: no operating systems found";
}

for my $root (@roots) {
    printf "Root device: %s\n", $root;

    # Print basic information about the operating system.
    printf "  Product name: %s\n", $g->inspect_get_product_name ($root);
    printf "  Version:      %d.%d\n",
        $g->inspect_get_major_version ($root),
        $g->inspect_get_minor_version ($root);
    printf "  Type:         %s\n", $g->inspect_get_type ($root);
    printf "  Distro:       %s\n", $g->inspect_get_distro ($root);

    # Mount up the disks, like guestfish -i.
    #
    # Sort keys by length, shortest first, so that we end up
    # mounting the filesystems in the correct order.
    my %mps = $g->inspect_get_mountpoints ($root);
    my @mps = sort { length $a <=> length $b } (keys %mps);
    for my $mp (@mps) {
        eval { $g->mount_ro ($mps{$mp}, $mp) };
        if ($@) {
            print "$@ (ignored)\n"
        }
    }

    # If /etc/issue.net file exists, print up to 3 lines.
    my $filename = "/etc/issue.net";
    if ($g->is_file ($filename)) {
        printf "--- %s ---\n", $filename;
        my @lines = $g->head_n (3, $filename);
        print "$_\n" foreach @lines;
    }

    # Unmount everything.
    $g->umount_all ()
}