From 477eebc83dcd33d00d34398692692dae6af04f22 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sun, 30 Jan 2011 23:41:05 +0000 Subject: [PATCH] perl: Translate C examples into Perl and include a manual page. --- .gitignore | 3 ++ Makefile.am | 3 +- configure.ac | 2 +- examples/guestfs-examples.pod | 1 + ocaml/examples/guestfs-ocaml.pod | 1 + perl/examples/Makefile.am | 39 +++++++++++++++++++++ perl/examples/create_disk.pl | 67 +++++++++++++++++++++++++++++++++++ perl/examples/guestfs-perl.pod | 72 ++++++++++++++++++++++++++++++++++++++ perl/examples/inspect_vm.pl | 64 +++++++++++++++++++++++++++++++++ perl/examples/lvs.pl | 28 --------------- python/examples/guestfs-python.pod | 1 + ruby/examples/guestfs-ruby.pod | 1 + src/guestfs.pod | 2 +- 13 files changed, 253 insertions(+), 31 deletions(-) create mode 100644 perl/examples/Makefile.am create mode 100755 perl/examples/create_disk.pl create mode 100644 perl/examples/guestfs-perl.pod create mode 100755 perl/examples/inspect_vm.pl delete mode 100755 perl/examples/lvs.pl diff --git a/.gitignore b/.gitignore index 46d5af7..438e126 100644 --- a/.gitignore +++ b/.gitignore @@ -109,6 +109,7 @@ html/guestfish.1.html html/guestfs.3.html html/guestfs-examples.3.html html/guestfs-ocaml.3.html +html/guestfs-perl.3.html html/guestfs-python.3.html html/guestfs-ruby.3.html html/guestmount.1.html @@ -213,6 +214,8 @@ perl/blib perl/Guestfs.bs perl/Guestfs.c perl/Guestfs.xs +perl/examples/guestfs-perl.3 +perl/examples/stamp-guestfs-perl.pod perl/lib/Sys/Guestfs.pm perl/Makefile-pl perl/Makefile-pl.old diff --git a/Makefile.am b/Makefile.am index d2c90fc..d6b4077 100644 --- a/Makefile.am +++ b/Makefile.am @@ -40,7 +40,7 @@ SUBDIRS += cat df inspector rescue # Language bindings. if HAVE_PERL -SUBDIRS += perl +SUBDIRS += perl perl/examples endif if HAVE_OCAML SUBDIRS += ocaml ocaml/examples @@ -109,6 +109,7 @@ HTMLFILES = \ html/guestfs.3.html \ html/guestfs-examples.3.html \ html/guestfs-ocaml.3.html \ + html/guestfs-perl.3.html \ html/guestfs-python.3.html \ html/guestfs-ruby.3.html \ html/guestfish.1.html \ diff --git a/configure.ac b/configure.ac index a5d704a..576f399 100644 --- a/configure.ac +++ b/configure.ac @@ -793,7 +793,7 @@ AC_CONFIG_FILES([Makefile regressions/Makefile test-tool/Makefile ocaml/Makefile ocaml/examples/Makefile - perl/Makefile + perl/Makefile perl/examples/Makefile python/Makefile python/examples/Makefile ruby/Makefile ruby/Rakefile ruby/examples/Makefile java/Makefile diff --git a/examples/guestfs-examples.pod b/examples/guestfs-examples.pod index 787a370..f4c82a7 100644 --- a/examples/guestfs-examples.pod +++ b/examples/guestfs-examples.pod @@ -34,6 +34,7 @@ libguestfs, you also need to read L. L, L, +L, L, L, L, diff --git a/ocaml/examples/guestfs-ocaml.pod b/ocaml/examples/guestfs-ocaml.pod index 21c4a70..6ea46f2 100644 --- a/ocaml/examples/guestfs-ocaml.pod +++ b/ocaml/examples/guestfs-ocaml.pod @@ -79,6 +79,7 @@ function that you called. L, L, +L, L, L, L, diff --git a/perl/examples/Makefile.am b/perl/examples/Makefile.am new file mode 100644 index 0000000..354531a --- /dev/null +++ b/perl/examples/Makefile.am @@ -0,0 +1,39 @@ +# libguestfs Perl examples +# Copyright (C) 2011 Red Hat Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +EXTRA_DIST = \ + LICENSE \ + create_disk.pl \ + inspect_vm.pl \ + guestfs-perl.pod + +CLEANFILES = stamp-guestfs-perl.pod + +man_MANS = guestfs-perl.3 +noinst_DATA = $(top_builddir)/html/guestfs-perl.3.html + +guestfs-perl.3 $(top_builddir)/html/guestfs-perl.3.html: stamp-guestfs-perl.pod + +stamp-guestfs-perl.pod: guestfs-perl.pod create_disk.pl inspect_vm.pl + $(top_srcdir)/podwrapper.sh \ + --section 3 \ + --man guestfs-perl.3 \ + --html $(top_builddir)/html/guestfs-perl.3.html \ + --verbatim create_disk.pl:@EXAMPLE1@ \ + --verbatim inspect_vm.pl:@EXAMPLE2@ \ + $< + touch $@ diff --git a/perl/examples/create_disk.pl b/perl/examples/create_disk.pl new file mode 100755 index 0000000..5a81663 --- /dev/null +++ b/perl/examples/create_disk.pl @@ -0,0 +1,67 @@ +#!/usr/bin/perl -w + +# Example showing how to create a disk image. + +use strict; +use Sys::Guestfs; + +my $output = "disk.img"; + +my $g = new Sys::Guestfs (); + +# Create a raw-format sparse disk image, 512 MB in size. +open FILE, ">$output" or die "$output: $!"; +truncate FILE, 512 * 1024 * 1024 or die "$output: truncate: $!"; +close FILE or die "$output: $!"; + +# Set the trace flag so that we can see each libguestfs call. +$g->set_trace (1); + +# Set the autosync flag so that the disk will be synchronized +# automatically when the libguestfs handle is closed. +$g->set_autosync (1); + +# Attach the disk image to libguestfs. +$g->add_drive_opts ($output, format => "raw", readonly => 0); + +# Run the libguestfs back-end. +$g->launch (); + +# Get the list of devices. Because we only added one drive +# above, we expect that this list should contain a single +# element. +my @devices = $g->list_devices (); +if (@devices != 1) { + die "error: expected a single device from list-devices"; +} + +# Partition the disk as one single MBR partition. +$g->part_disk ($devices[0], "mbr"); + +# Get the list of partitions. We expect a single element, which +# is the partition we have just created. +my @partitions = $g->list_partitions (); +if (@partitions != 1) { + die "error: expected a single partition from list-partitions"; +} + +# Create a filesystem on the partition. +$g->mkfs ("ext4", $partitions[0]); + +# Now mount the filesystem so that we can add files. +$g->mount_options ("", $partitions[0], "/"); + +# Create some files and directories. +$g->touch ("/empty"); +my $message = "Hello, world\n"; +$g->write ("/hello", $message); +$g->mkdir ("/foo"); + +# This one uploads the local file /etc/resolv.conf into +# the disk image. +$g->upload ("/etc/resolv.conf", "/foo/resolv.conf"); + +# Because 'autosync' was set (above) we can just exit here +# and the disk contents will be synchronized. You can also do +# this manually by calling $g->umount_all and $g->sync. +exit 0 diff --git a/perl/examples/guestfs-perl.pod b/perl/examples/guestfs-perl.pod new file mode 100644 index 0000000..4840890 --- /dev/null +++ b/perl/examples/guestfs-perl.pod @@ -0,0 +1,72 @@ +=encoding utf8 + +=head1 NAME + +guestfs-perl - How to use libguestfs from Perl + +=head1 SYNOPSIS + + use Sys::Guestfs; + + my $h = Sys::Guestfs->new (); + $h->add_drive_opts ('guest.img', format => 'raw'); + $h->launch (); + $h->mount_options ('', '/dev/sda1', '/'); + $h->touch ('/hello'); + $h->sync (); + +=head1 DESCRIPTION + +This manual page documents how to call libguestfs from the Perl +programming language. This page just documents the differences from +the C API and gives some examples. If you are not familiar with using +libguestfs, you also need to read L. To read the +full Perl API, see L. + +=head2 ERRORS + +Errors from libguestfs functions turn into calls to +C (see L). + +=head1 EXAMPLE 1: CREATE A DISK IMAGE + +@EXAMPLE1@ + +=head1 EXAMPLE 2: INSPECT A VIRTUAL MACHINE DISK IMAGE + +@EXAMPLE2@ + +=head1 SEE ALSO + +L, +L, +L, +L, +L, +L, +L. + +=head1 AUTHORS + +Richard W.M. Jones (C) + +=head1 COPYRIGHT + +Copyright (C) 2011 Red Hat Inc. L + +The examples in this manual page may be freely copied, modified and +distributed without any restrictions. + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA diff --git a/perl/examples/inspect_vm.pl b/perl/examples/inspect_vm.pl new file mode 100755 index 0000000..447c889 --- /dev/null +++ b/perl/examples/inspect_vm.pl @@ -0,0 +1,64 @@ +#!/usr/bin/perl -w + +# Example showing how to inspect a virtual machine disk. + +use strict; +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 $_ foreach @lines; + } + + # Unmount everything. + $g->umount_all () +} diff --git a/perl/examples/lvs.pl b/perl/examples/lvs.pl deleted file mode 100755 index 1755c89..0000000 --- a/perl/examples/lvs.pl +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Sys::Guestfs; - -# Look for LVM LVs, VGs and PVs in a guest image. - -die "Usage: lvs.pl guest.img\n" if @ARGV != 1 || ! -f $ARGV[0]; - -print "Creating the libguestfs handle\n"; -my $h = Sys::Guestfs->new (); -$h->add_drive_opts ($ARGV[0], format => "raw"); - -print "Launching, this can take a few seconds\n"; -$h->launch (); - -print "Looking for PVs on the disk image\n"; -my @pvs = $h->pvs (); -print "PVs found: (", join (", ", @pvs), ")\n"; - -print "Looking for VGs on the disk image\n"; -my @vgs = $h->vgs (); -print "VGs found: (", join (", ", @vgs), ")\n"; - -print "Looking for LVs on the disk image\n"; -my @lvs = $h->lvs (); -print "LVs found: (", join (", ", @lvs), ")\n"; diff --git a/python/examples/guestfs-python.pod b/python/examples/guestfs-python.pod index 9cf7809..032d784 100644 --- a/python/examples/guestfs-python.pod +++ b/python/examples/guestfs-python.pod @@ -44,6 +44,7 @@ Type: L, L, L, +L, L, L. diff --git a/ruby/examples/guestfs-ruby.pod b/ruby/examples/guestfs-ruby.pod index d3ce928..f09016a 100644 --- a/ruby/examples/guestfs-ruby.pod +++ b/ruby/examples/guestfs-ruby.pod @@ -38,6 +38,7 @@ string). L, L, L, +L, L, L. diff --git a/src/guestfs.pod b/src/guestfs.pod index b8b8ca2..cfd58c9 100644 --- a/src/guestfs.pod +++ b/src/guestfs.pod @@ -737,7 +737,7 @@ See L. =item B -See L. +See L and L. =item B -- 1.8.3.1