From 9908e03e922b670437bcd89b6873f9ebc914567e Mon Sep 17 00:00:00 2001 From: Richard Jones Date: Wed, 8 Apr 2009 15:02:39 +0100 Subject: [PATCH] Fixed Perl bindings, they now work properly. --- perl/Guestfs.xs | 115 +++++++++++++++++++++++++++---- perl/Makefile.am | 3 + perl/examples/LICENSE | 2 + perl/examples/README | 17 +++++ perl/examples/lvs.pl | 29 ++++++++ perl/lib/Sys/Guestfs.pm | 56 +++++++++++++++ perl/run-perl-tests | 19 ++++++ perl/t/005-pod.t | 24 +++++++ perl/t/006-pod-coverage.t | 24 +++++++ perl/t/010-load.t | 29 ++++++++ src/generator.ml | 169 +++++++++++++++++++++++++++++++++++++++++++--- 11 files changed, 465 insertions(+), 22 deletions(-) create mode 100644 perl/examples/LICENSE create mode 100644 perl/examples/README create mode 100755 perl/examples/lvs.pl create mode 100755 perl/run-perl-tests create mode 100644 perl/t/005-pod.t create mode 100644 perl/t/006-pod-coverage.t create mode 100644 perl/t/010-load.t diff --git a/perl/Guestfs.xs b/perl/Guestfs.xs index e3f17c2..58def0d 100644 --- a/perl/Guestfs.xs +++ b/perl/Guestfs.xs @@ -25,8 +25,6 @@ #include -/* #include cannot be used for local files in XS */ - #ifndef PRId64 #define PRId64 "lld" #endif @@ -79,19 +77,112 @@ MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs guestfs_h * _create () -CODE: - RETVAL = guestfs_create (); - if (!RETVAL) - croak ("could not create guestfs handle"); - guestfs_set_error_handler (RETVAL, error_handler, NULL); -OUTPUT: - RETVAL + CODE: + RETVAL = guestfs_create (); + if (!RETVAL) + croak ("could not create guestfs handle"); + guestfs_set_error_handler (RETVAL, error_handler, NULL); + OUTPUT: + RETVAL void DESTROY (g) - guestfs_h *g; -PPCODE: - guestfs_close (g); + guestfs_h *g; + PPCODE: + guestfs_close (g); + +void +add_drive (g, filename) + guestfs_h *g; + const char *filename; + CODE: + if (guestfs_add_drive (g, filename) == -1) + croak ("add_drive: %s", last_error); + +void +add_cdrom (g, filename) + guestfs_h *g; + const char *filename; + CODE: + if (guestfs_add_cdrom (g, filename) == -1) + croak ("add_cdrom: %s", last_error); + +void +config (g, param, value) + guestfs_h *g; + const char *param; + const char *value; + CODE: + if (guestfs_config (g, param, value) == -1) + croak ("config: %s", last_error); + +void +launch (g) + guestfs_h *g; + CODE: + if (guestfs_launch (g) == -1) + croak ("launch: %s", last_error); + +void +wait_ready (g) + guestfs_h *g; + CODE: + if (guestfs_wait_ready (g) == -1) + croak ("wait_ready: %s", last_error); + +void +set_path (g, path) + guestfs_h *g; + const char *path; + CODE: + guestfs_set_path (g, path); + +SV * +get_path (g) + guestfs_h *g; +PREINIT: + const char *path; + CODE: + path = guestfs_get_path (g); + RETVAL = newSVpv (path, 0); + OUTPUT: + RETVAL + +void +set_autosync (g, autosync) + guestfs_h *g; + int autosync; + CODE: + guestfs_set_autosync (g, autosync); + +SV * +get_autosync (g) + guestfs_h *g; +PREINIT: + int autosync; + CODE: + autosync = guestfs_get_autosync (g); + RETVAL = newSViv (autosync); + OUTPUT: + RETVAL + +void +set_verbose (g, verbose) + guestfs_h *g; + int verbose; + CODE: + guestfs_set_verbose (g, verbose); + +SV * +get_verbose (g) + guestfs_h *g; +PREINIT: + int verbose; + CODE: + verbose = guestfs_get_verbose (g); + RETVAL = newSViv (verbose); + OUTPUT: + RETVAL void mount (g, device, mountpoint) diff --git a/perl/Makefile.am b/perl/Makefile.am index ea9835b..2b5b1dd 100644 --- a/perl/Makefile.am +++ b/perl/Makefile.am @@ -26,6 +26,9 @@ if HAVE_PERL # Interfacing automake and ExtUtils::MakeMaker known to be # a nightmare, news at 11. + +TESTS = run-perl-tests + all: perl Makefile.PL make -f Makefile-pl diff --git a/perl/examples/LICENSE b/perl/examples/LICENSE new file mode 100644 index 0000000..ff23700 --- /dev/null +++ b/perl/examples/LICENSE @@ -0,0 +1,2 @@ +All the examples in the perl/examples/ subdirectory may be freely +copied without any restrictions. diff --git a/perl/examples/README b/perl/examples/README new file mode 100644 index 0000000..a7c654f --- /dev/null +++ b/perl/examples/README @@ -0,0 +1,17 @@ +This directory contains various example programs which use the perl +Sys::Guestfs bindings to the libguestfs API. + +As they are examples, these are licensed so they can be freely copied +and used without any restrictions. + +Tips: + +(1) To enable verbose messages, set environment variable LIBGUESTFS_DEBUG=1 + +(2) To run a program without installing the library, set PERL5LIB and +LIBGUESTFS_PATH as in this example (if run from the root directory of +the source distribution): + + LIBGUESTFS_PATH=$(pwd) \ + PERL5LIB=$(pwd)/perl/blib/lib:$(pwd)/perl/blib/arch/auto/Sys/Guestfs \ + perl/examples/foo diff --git a/perl/examples/lvs.pl b/perl/examples/lvs.pl new file mode 100755 index 0000000..152db08 --- /dev/null +++ b/perl/examples/lvs.pl @@ -0,0 +1,29 @@ +#!/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 ($ARGV[0]); + +print "Launching, this can take a few seconds\n"; +$h->launch (); +$h->wait_ready (); + +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/perl/lib/Sys/Guestfs.pm b/perl/lib/Sys/Guestfs.pm index c0a9b79..0a8226f 100644 --- a/perl/lib/Sys/Guestfs.pm +++ b/perl/lib/Sys/Guestfs.pm @@ -91,6 +91,62 @@ sub new { return $self; } +=item $h->add_drive ($filename); + +=item $h->add_cdrom ($filename); + +This function adds a virtual machine disk image C to the +guest. The first time you call this function, the disk appears as IDE +disk 0 (C) in the guest, the second time as C, and +so on. + +You don't necessarily need to be root when using libguestfs. However +you obviously do need sufficient permissions to access the filename +for whatever operations you want to perform (ie. read access if you +just want to read the image or write access if you want to modify the +image). + +The C variation adds a CD-ROM device. + +=item $h->config ($param, $value); + +=item $h->config ($param); + +Use this to add arbitrary parameters to the C command line. +See L. + +=item $h->launch (); + +=item $h->wait_ready (); + +Internally libguestfs is implemented by running a virtual machine +using L. These calls are necessary in order to boot the +virtual machine. + +You should call these two functions after configuring the handle +(eg. adding drives) but before performing any actions. + +=item $h->set_path ($path); + +=item $path = $h->get_path (); + +See the discussion of C in the L +manpage. + +=item $h->set_autosync ($autosync); + +=item $autosync = $h->get_autosync (); + +See the discussion of I in the L +manpage. + +=item $h->set_verbose ($verbose); + +=item $verbose = $h->get_verbose (); + +This sets or gets the verbose messages flag. Verbose +messages are sent to C. + =item $content = $h->cat (path); Return the contents of the file named C. diff --git a/perl/run-perl-tests b/perl/run-perl-tests new file mode 100755 index 0000000..7fc2921 --- /dev/null +++ b/perl/run-perl-tests @@ -0,0 +1,19 @@ +#!/bin/sh - +# libguestfs Perl bindings +# Copyright (C) 2009 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. + +make -f Makefile-pl test diff --git a/perl/t/005-pod.t b/perl/t/005-pod.t new file mode 100644 index 0000000..54025f1 --- /dev/null +++ b/perl/t/005-pod.t @@ -0,0 +1,24 @@ +# libguestfs Perl bindings -*- perl -*- +# Copyright (C) 2009 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. + +use Test::More; +use strict; +use warnings; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok (); diff --git a/perl/t/006-pod-coverage.t b/perl/t/006-pod-coverage.t new file mode 100644 index 0000000..fd1c405 --- /dev/null +++ b/perl/t/006-pod-coverage.t @@ -0,0 +1,24 @@ +# libguestfs Perl bindings -*- perl -*- +# Copyright (C) 2009 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. + +use Test::More; +use strict; +use warnings; + +eval "use Test::Pod::Coverage 1.00"; +plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD" if $@; +all_pod_coverage_ok (); diff --git a/perl/t/010-load.t b/perl/t/010-load.t new file mode 100644 index 0000000..4aeffb7 --- /dev/null +++ b/perl/t/010-load.t @@ -0,0 +1,29 @@ +# libguestfs Perl bindings -*- perl -*- +# Copyright (C) 2009 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. + +use strict; +use warnings; +use Test::More; + +plan tests => 1; + +BEGIN { + use_ok ("Sys::Guestfs") or die; +} + +my $h = Sys::Guestfs::create (); +ok ($h); diff --git a/src/generator.ml b/src/generator.ml index 8b27798..98faa0f 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -1574,19 +1574,112 @@ MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs guestfs_h * _create () -CODE: - RETVAL = guestfs_create (); - if (!RETVAL) - croak (\"could not create guestfs handle\"); - guestfs_set_error_handler (RETVAL, error_handler, NULL); -OUTPUT: - RETVAL + CODE: + RETVAL = guestfs_create (); + if (!RETVAL) + croak (\"could not create guestfs handle\"); + guestfs_set_error_handler (RETVAL, error_handler, NULL); + OUTPUT: + RETVAL void DESTROY (g) - guestfs_h *g; -PPCODE: - guestfs_close (g); + guestfs_h *g; + PPCODE: + guestfs_close (g); + +void +add_drive (g, filename) + guestfs_h *g; + const char *filename; + CODE: + if (guestfs_add_drive (g, filename) == -1) + croak (\"add_drive: %%s\", last_error); + +void +add_cdrom (g, filename) + guestfs_h *g; + const char *filename; + CODE: + if (guestfs_add_cdrom (g, filename) == -1) + croak (\"add_cdrom: %%s\", last_error); + +void +config (g, param, value) + guestfs_h *g; + const char *param; + const char *value; + CODE: + if (guestfs_config (g, param, value) == -1) + croak (\"config: %%s\", last_error); + +void +launch (g) + guestfs_h *g; + CODE: + if (guestfs_launch (g) == -1) + croak (\"launch: %%s\", last_error); + +void +wait_ready (g) + guestfs_h *g; + CODE: + if (guestfs_wait_ready (g) == -1) + croak (\"wait_ready: %%s\", last_error); + +void +set_path (g, path) + guestfs_h *g; + const char *path; + CODE: + guestfs_set_path (g, path); + +SV * +get_path (g) + guestfs_h *g; +PREINIT: + const char *path; + CODE: + path = guestfs_get_path (g); + RETVAL = newSVpv (path, 0); + OUTPUT: + RETVAL + +void +set_autosync (g, autosync) + guestfs_h *g; + int autosync; + CODE: + guestfs_set_autosync (g, autosync); + +SV * +get_autosync (g) + guestfs_h *g; +PREINIT: + int autosync; + CODE: + autosync = guestfs_get_autosync (g); + RETVAL = newSViv (autosync); + OUTPUT: + RETVAL + +void +set_verbose (g, verbose) + guestfs_h *g; + int verbose; + CODE: + guestfs_set_verbose (g, verbose); + +SV * +get_verbose (g) + guestfs_h *g; +PREINIT: + int verbose; + CODE: + verbose = guestfs_get_verbose (g); + RETVAL = newSViv (verbose); + OUTPUT: + RETVAL "; @@ -1770,6 +1863,62 @@ sub new { return $self; } +=item $h->add_drive ($filename); + +=item $h->add_cdrom ($filename); + +This function adds a virtual machine disk image C to the +guest. The first time you call this function, the disk appears as IDE +disk 0 (C) in the guest, the second time as C, and +so on. + +You don't necessarily need to be root when using libguestfs. However +you obviously do need sufficient permissions to access the filename +for whatever operations you want to perform (ie. read access if you +just want to read the image or write access if you want to modify the +image). + +The C variation adds a CD-ROM device. + +=item $h->config ($param, $value); + +=item $h->config ($param); + +Use this to add arbitrary parameters to the C command line. +See L. + +=item $h->launch (); + +=item $h->wait_ready (); + +Internally libguestfs is implemented by running a virtual machine +using L. These calls are necessary in order to boot the +virtual machine. + +You should call these two functions after configuring the handle +(eg. adding drives) but before performing any actions. + +=item $h->set_path ($path); + +=item $path = $h->get_path (); + +See the discussion of C in the L +manpage. + +=item $h->set_autosync ($autosync); + +=item $autosync = $h->get_autosync (); + +See the discussion of I in the L +manpage. + +=item $h->set_verbose ($verbose); + +=item $verbose = $h->get_verbose (); + +This sets or gets the verbose messages flag. Verbose +messages are sent to C. + "; (* Actions. We only need to print documentation for these as -- 1.8.3.1