ocaml/*.cmxa
ocaml/*.a
ocaml/*.so
+perl/Guestfs.c
+perl/Makefile-pl
+perl/Makefile.PL
+perl/blib
+perl/pm_to_blib
stamp-h1
test*.img
update-initramfs.sh
python/Makefile
make-initramfs.sh update-initramfs.sh
libguestfs.spec
- ocaml/META])
+ ocaml/META perl/Makefile.PL])
AC_OUTPUT
dnl WTF?
--- /dev/null
+/* libguestfs generated file
+ * WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.
+ * ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.
+ *
+ * Copyright (C) 2009 Red Hat Inc.
+ *
+ * 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
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <guestfs.h>
+
+/* #include cannot be used for local files in XS */
+
+#ifndef PRId64
+#define PRId64 "lld"
+#endif
+
+static SV *
+my_newSVll(long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSViv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, "%" PRId64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+#ifndef PRIu64
+#define PRIu64 "llu"
+#endif
+
+static SV *
+my_newSVull(unsigned long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSVuv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, "%" PRIu64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+/* XXX Not thread-safe, and in general not safe if the caller is
+ * issuing multiple requests in parallel (on different guestfs
+ * handles). We should use the guestfs_h handle passed to the
+ * error handle to distinguish these cases.
+ */
+static char *last_error = NULL;
+
+static void
+error_handler (guestfs_h *g,
+ void *data,
+ const char *msg)
+{
+ if (last_error != NULL) free (last_error);
+ last_error = strdup (msg);
+}
+
+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
+
+void
+DESTROY (g)
+ guestfs_h *g;
+PPCODE:
+ guestfs_close (g);
+
+void
+mount (g, device, mountpoint)
+ guestfs_h *g;
+ char *device;
+ char *mountpoint;
+ PPCODE:
+ if (guestfs_mount (g, device, mountpoint) == -1)
+ croak ("mount: %s", last_error);
+
+void
+sync (g)
+ guestfs_h *g;
+ PPCODE:
+ if (guestfs_sync (g) == -1)
+ croak ("sync: %s", last_error);
+
+void
+touch (g, path)
+ guestfs_h *g;
+ char *path;
+ PPCODE:
+ if (guestfs_touch (g, path) == -1)
+ croak ("touch: %s", last_error);
+
+SV *
+cat (g, path)
+ guestfs_h *g;
+ char *path;
+PREINIT:
+ char *content;
+ CODE:
+ content = guestfs_cat (g, path);
+ if (content == NULL)
+ croak ("cat: %s", last_error);
+ RETVAL = newSVpv (content, 0);
+ free (content);
+ OUTPUT:
+ RETVAL
+
+SV *
+ll (g, directory)
+ guestfs_h *g;
+ char *directory;
+PREINIT:
+ char *listing;
+ CODE:
+ listing = guestfs_ll (g, directory);
+ if (listing == NULL)
+ croak ("ll: %s", last_error);
+ RETVAL = newSVpv (listing, 0);
+ free (listing);
+ OUTPUT:
+ RETVAL
+
+void
+ls (g, directory)
+ guestfs_h *g;
+ char *directory;
+PREINIT:
+ char **listing;
+ int i, n;
+ PPCODE:
+ listing = guestfs_ls (g, directory);
+ if (listing == NULL)
+ croak ("ls: %s", last_error);
+ for (n = 0; listing[n] != NULL; ++n) /**/;
+ EXTEND (SP, n);
+ for (i = 0; i < n; ++i) {
+ PUSHs (sv_2mortal (newSVpv (listing[i], 0)));
+ free (listing[i]);
+ }
+ free (listing);
+
+void
+list_devices (g)
+ guestfs_h *g;
+PREINIT:
+ char **devices;
+ int i, n;
+ PPCODE:
+ devices = guestfs_list_devices (g);
+ if (devices == NULL)
+ croak ("list_devices: %s", last_error);
+ for (n = 0; devices[n] != NULL; ++n) /**/;
+ EXTEND (SP, n);
+ for (i = 0; i < n; ++i) {
+ PUSHs (sv_2mortal (newSVpv (devices[i], 0)));
+ free (devices[i]);
+ }
+ free (devices);
+
+void
+list_partitions (g)
+ guestfs_h *g;
+PREINIT:
+ char **partitions;
+ int i, n;
+ PPCODE:
+ partitions = guestfs_list_partitions (g);
+ if (partitions == NULL)
+ croak ("list_partitions: %s", last_error);
+ for (n = 0; partitions[n] != NULL; ++n) /**/;
+ EXTEND (SP, n);
+ for (i = 0; i < n; ++i) {
+ PUSHs (sv_2mortal (newSVpv (partitions[i], 0)));
+ free (partitions[i]);
+ }
+ free (partitions);
+
+void
+pvs (g)
+ guestfs_h *g;
+PREINIT:
+ char **physvols;
+ int i, n;
+ PPCODE:
+ physvols = guestfs_pvs (g);
+ if (physvols == NULL)
+ croak ("pvs: %s", last_error);
+ for (n = 0; physvols[n] != NULL; ++n) /**/;
+ EXTEND (SP, n);
+ for (i = 0; i < n; ++i) {
+ PUSHs (sv_2mortal (newSVpv (physvols[i], 0)));
+ free (physvols[i]);
+ }
+ free (physvols);
+
+void
+vgs (g)
+ guestfs_h *g;
+PREINIT:
+ char **volgroups;
+ int i, n;
+ PPCODE:
+ volgroups = guestfs_vgs (g);
+ if (volgroups == NULL)
+ croak ("vgs: %s", last_error);
+ for (n = 0; volgroups[n] != NULL; ++n) /**/;
+ EXTEND (SP, n);
+ for (i = 0; i < n; ++i) {
+ PUSHs (sv_2mortal (newSVpv (volgroups[i], 0)));
+ free (volgroups[i]);
+ }
+ free (volgroups);
+
+void
+lvs (g)
+ guestfs_h *g;
+PREINIT:
+ char **logvols;
+ int i, n;
+ PPCODE:
+ logvols = guestfs_lvs (g);
+ if (logvols == NULL)
+ croak ("lvs: %s", last_error);
+ for (n = 0; logvols[n] != NULL; ++n) /**/;
+ EXTEND (SP, n);
+ for (i = 0; i < n; ++i) {
+ PUSHs (sv_2mortal (newSVpv (logvols[i], 0)));
+ free (logvols[i]);
+ }
+ free (logvols);
+
+void
+pvs_full (g)
+ guestfs_h *g;
+PREINIT:
+ struct guestfs_lvm_pv_list *physvols;
+ int i;
+ HV *hv;
+ PPCODE:
+ physvols = guestfs_pvs_full (g);
+ if (physvols == NULL)
+ croak ("pvs_full: %s", last_error);
+ EXTEND (SP, physvols->len);
+ for (i = 0; i < physvols->len; ++i) {
+ hv = newHV ();
+ (void) hv_store (hv, "pv_name", 7, newSVpv (physvols->val[i].pv_name, 0), 0);
+ (void) hv_store (hv, "pv_uuid", 7, newSVpv (physvols->val[i].pv_uuid, 32), 0);
+ (void) hv_store (hv, "pv_fmt", 6, newSVpv (physvols->val[i].pv_fmt, 0), 0);
+ (void) hv_store (hv, "pv_size", 7, my_newSVull (physvols->val[i].pv_size), 0);
+ (void) hv_store (hv, "dev_size", 8, my_newSVull (physvols->val[i].dev_size), 0);
+ (void) hv_store (hv, "pv_free", 7, my_newSVull (physvols->val[i].pv_free), 0);
+ (void) hv_store (hv, "pv_used", 7, my_newSVull (physvols->val[i].pv_used), 0);
+ (void) hv_store (hv, "pv_attr", 7, newSVpv (physvols->val[i].pv_attr, 0), 0);
+ (void) hv_store (hv, "pv_pe_count", 11, my_newSVll (physvols->val[i].pv_pe_count), 0);
+ (void) hv_store (hv, "pv_pe_alloc_count", 17, my_newSVll (physvols->val[i].pv_pe_alloc_count), 0);
+ (void) hv_store (hv, "pv_tags", 7, newSVpv (physvols->val[i].pv_tags, 0), 0);
+ (void) hv_store (hv, "pe_start", 8, my_newSVull (physvols->val[i].pe_start), 0);
+ (void) hv_store (hv, "pv_mda_count", 12, my_newSVll (physvols->val[i].pv_mda_count), 0);
+ (void) hv_store (hv, "pv_mda_free", 11, my_newSVull (physvols->val[i].pv_mda_free), 0);
+ PUSHs (sv_2mortal ((SV *) hv));
+ }
+ guestfs_free_lvm_pv_list (physvols);
+
+void
+vgs_full (g)
+ guestfs_h *g;
+PREINIT:
+ struct guestfs_lvm_vg_list *volgroups;
+ int i;
+ HV *hv;
+ PPCODE:
+ volgroups = guestfs_vgs_full (g);
+ if (volgroups == NULL)
+ croak ("vgs_full: %s", last_error);
+ EXTEND (SP, volgroups->len);
+ for (i = 0; i < volgroups->len; ++i) {
+ hv = newHV ();
+ (void) hv_store (hv, "vg_name", 7, newSVpv (volgroups->val[i].vg_name, 0), 0);
+ (void) hv_store (hv, "vg_uuid", 7, newSVpv (volgroups->val[i].vg_uuid, 32), 0);
+ (void) hv_store (hv, "vg_fmt", 6, newSVpv (volgroups->val[i].vg_fmt, 0), 0);
+ (void) hv_store (hv, "vg_attr", 7, newSVpv (volgroups->val[i].vg_attr, 0), 0);
+ (void) hv_store (hv, "vg_size", 7, my_newSVull (volgroups->val[i].vg_size), 0);
+ (void) hv_store (hv, "vg_free", 7, my_newSVull (volgroups->val[i].vg_free), 0);
+ (void) hv_store (hv, "vg_sysid", 8, newSVpv (volgroups->val[i].vg_sysid, 0), 0);
+ (void) hv_store (hv, "vg_extent_size", 14, my_newSVull (volgroups->val[i].vg_extent_size), 0);
+ (void) hv_store (hv, "vg_extent_count", 15, my_newSVll (volgroups->val[i].vg_extent_count), 0);
+ (void) hv_store (hv, "vg_free_count", 13, my_newSVll (volgroups->val[i].vg_free_count), 0);
+ (void) hv_store (hv, "max_lv", 6, my_newSVll (volgroups->val[i].max_lv), 0);
+ (void) hv_store (hv, "max_pv", 6, my_newSVll (volgroups->val[i].max_pv), 0);
+ (void) hv_store (hv, "pv_count", 8, my_newSVll (volgroups->val[i].pv_count), 0);
+ (void) hv_store (hv, "lv_count", 8, my_newSVll (volgroups->val[i].lv_count), 0);
+ (void) hv_store (hv, "snap_count", 10, my_newSVll (volgroups->val[i].snap_count), 0);
+ (void) hv_store (hv, "vg_seqno", 8, my_newSVll (volgroups->val[i].vg_seqno), 0);
+ (void) hv_store (hv, "vg_tags", 7, newSVpv (volgroups->val[i].vg_tags, 0), 0);
+ (void) hv_store (hv, "vg_mda_count", 12, my_newSVll (volgroups->val[i].vg_mda_count), 0);
+ (void) hv_store (hv, "vg_mda_free", 11, my_newSVull (volgroups->val[i].vg_mda_free), 0);
+ PUSHs (sv_2mortal ((SV *) hv));
+ }
+ guestfs_free_lvm_vg_list (volgroups);
+
+void
+lvs_full (g)
+ guestfs_h *g;
+PREINIT:
+ struct guestfs_lvm_lv_list *logvols;
+ int i;
+ HV *hv;
+ PPCODE:
+ logvols = guestfs_lvs_full (g);
+ if (logvols == NULL)
+ croak ("lvs_full: %s", last_error);
+ EXTEND (SP, logvols->len);
+ for (i = 0; i < logvols->len; ++i) {
+ hv = newHV ();
+ (void) hv_store (hv, "lv_name", 7, newSVpv (logvols->val[i].lv_name, 0), 0);
+ (void) hv_store (hv, "lv_uuid", 7, newSVpv (logvols->val[i].lv_uuid, 32), 0);
+ (void) hv_store (hv, "lv_attr", 7, newSVpv (logvols->val[i].lv_attr, 0), 0);
+ (void) hv_store (hv, "lv_major", 8, my_newSVll (logvols->val[i].lv_major), 0);
+ (void) hv_store (hv, "lv_minor", 8, my_newSVll (logvols->val[i].lv_minor), 0);
+ (void) hv_store (hv, "lv_kernel_major", 15, my_newSVll (logvols->val[i].lv_kernel_major), 0);
+ (void) hv_store (hv, "lv_kernel_minor", 15, my_newSVll (logvols->val[i].lv_kernel_minor), 0);
+ (void) hv_store (hv, "lv_size", 7, my_newSVull (logvols->val[i].lv_size), 0);
+ (void) hv_store (hv, "seg_count", 9, my_newSVll (logvols->val[i].seg_count), 0);
+ (void) hv_store (hv, "origin", 6, newSVpv (logvols->val[i].origin, 0), 0);
+ (void) hv_store (hv, "snap_percent", 12, newSVnv (logvols->val[i].snap_percent), 0);
+ (void) hv_store (hv, "copy_percent", 12, newSVnv (logvols->val[i].copy_percent), 0);
+ (void) hv_store (hv, "move_pv", 7, newSVpv (logvols->val[i].move_pv, 0), 0);
+ (void) hv_store (hv, "lv_tags", 7, newSVpv (logvols->val[i].lv_tags, 0), 0);
+ (void) hv_store (hv, "mirror_log", 10, newSVpv (logvols->val[i].mirror_log, 0), 0);
+ (void) hv_store (hv, "modules", 7, newSVpv (logvols->val[i].modules, 0), 0);
+ PUSHs (sv_2mortal ((SV *) hv));
+ }
+ guestfs_free_lvm_lv_list (logvols);
+
--- /dev/null
+# 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.
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile (
+ FIRST_MAKEFILE => 'Makefile-pl',
+
+ NAME => 'Sys::Guestfs',
+ VERSION => '@PACKAGE_VERSION@',
+
+ LIBS => '-L@abs_top_builddir@/src/.libs -lguestfs',
+ INC => '-Wall @CFLAGS@ -I@abs_top_builddir@/src',
+ );
# 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 = \
+ Makefile.PL.in \
+ Guestfs.xs \
+ guestfs_perl.c \
+ typemap \
+ perl/lib/Sys/Guestfs.pm
+
+if HAVE_PERL
+
+# Interfacing automake and ExtUtils::MakeMaker known to be
+# a nightmare, news at 11.
+all:
+ perl Makefile.PL
+ make -f Makefile-pl
+
+install-data-hook:
+ make -f Makefile-pl DESTDIR=$(DESTDIR) install
+
+endif
--- /dev/null
+# libguestfs generated file
+# WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.
+# ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.
+#
+# Copyright (C) 2009 Red Hat Inc.
+#
+# 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
+
+=pod
+
+=head1 NAME
+
+Sys::Guestfs - Perl bindings for libguestfs
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs;
+
+ my $h = Sys::Guestfs->new ();
+ $h->add_drive ('guest.img');
+ $h->launch ();
+ $h->wait_ready ();
+ $h->mount ('/dev/sda1', '/');
+ $h->touch ('/hello');
+ $h->sync ();
+
+=head1 DESCRIPTION
+
+The C<Sys::Guestfs> module provides a Perl XS binding to the
+libguestfs API for examining and modifying virtual machine
+disk images.
+
+Amongst the things this is good for: making batch configuration
+changes to guests, getting disk used/free statistics (see also:
+virt-df), migrating between virtualization systems (see also:
+virt-p2v), performing partial backups, performing partial guest
+clones, cloning guests and changing registry/UUID/hostname info, and
+much else besides.
+
+Libguestfs uses Linux kernel and qemu code, and can access any type of
+guest filesystem that Linux and qemu can, including but not limited
+to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
+schemes, qcow, qcow2, vmdk.
+
+Libguestfs provides ways to enumerate guest storage (eg. partitions,
+LVs, what filesystem is in each LV, etc.). It can also run commands
+in the context of the guest. Also you can access filesystems over FTP.
+
+=head1 ERRORS
+
+All errors turn into calls to C<croak> (see L<Carp(3)>).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Sys::Guestfs;
+
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load ('Sys::Guestfs');
+
+=item $h = Sys::Guestfs->new ();
+
+Create a new guestfs handle.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref ($proto) || $proto;
+
+ my $self = Sys::Guestfs::_create ();
+ bless $self, $class;
+ return $self;
+}
+
+=item $content = $h->cat (path);
+
+Return the contents of the file named C<path>.
+
+Note that this function cannot correctly handle binary files
+(specifically, files containing C<\0> character which is treated
+as end of string). For those you need to use the C<$h-E<gt>read_file>
+function which has a more complex interface.
+
+Because of the message protocol, there is a transfer limit
+of somewhere between 2MB and 4MB. To transfer large files you should use
+FTP.
+
+=item @devices = $h->list_devices ();
+
+List all the block devices.
+
+The full block device names are returned, eg. C</dev/sda>
+
+=item @partitions = $h->list_partitions ();
+
+List all the partitions detected on all block devices.
+
+The full partition device names are returned, eg. C</dev/sda1>
+
+This does not return logical volumes. For that you will need to
+call C<$h-E<gt>lvs>.
+
+=item $listing = $h->ll (directory);
+
+List the files in C<directory> (relative to the root directory,
+there is no cwd) in the format of 'ls -la'.
+
+This command is mostly useful for interactive sessions. It
+is I<not> intended that you try to parse the output string.
+
+=item @listing = $h->ls (directory);
+
+List the files in C<directory> (relative to the root directory,
+there is no cwd). The '.' and '..' entries are not returned, but
+hidden files are shown.
+
+This command is mostly useful for interactive sessions. Programs
+should probably use C<$h-E<gt>readdir> instead.
+
+=item @logvols = $h->lvs ();
+
+List all the logical volumes detected. This is the equivalent
+of the L<lvs(8)> command.
+
+This returns a list of the logical volume device names
+(eg. C</dev/VolGroup00/LogVol00>).
+
+See also C<$h-E<gt>lvs_full>.
+
+=item @logvols = $h->lvs_full ();
+
+List all the logical volumes detected. This is the equivalent
+of the L<lvs(8)> command. The "full" version includes all fields.
+
+=item $h->mount (device, mountpoint);
+
+Mount a guest disk at a position in the filesystem. Block devices
+are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
+the guest. If those block devices contain partitions, they will have
+the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
+names can be used.
+
+The rules are the same as for L<mount(2)>: A filesystem must
+first be mounted on C</> before others can be mounted. Other
+filesystems can only be mounted on directories which already
+exist.
+
+The mounted filesystem is writable, if we have sufficient permissions
+on the underlying device.
+
+The filesystem options C<sync> and C<noatime> are set with this
+call, in order to improve reliability.
+
+=item @physvols = $h->pvs ();
+
+List all the physical volumes detected. This is the equivalent
+of the L<pvs(8)> command.
+
+This returns a list of just the device names that contain
+PVs (eg. C</dev/sda2>).
+
+See also C<$h-E<gt>pvs_full>.
+
+=item @physvols = $h->pvs_full ();
+
+List all the physical volumes detected. This is the equivalent
+of the L<pvs(8)> command. The "full" version includes all fields.
+
+=item $h->sync ();
+
+This syncs the disk, so that any writes are flushed through to the
+underlying disk image.
+
+You should always call this if you have modified a disk image, before
+closing the handle.
+
+=item $h->touch (path);
+
+Touch acts like the L<touch(1)> command. It can be used to
+update the timestamps on a file, or, if the file does not exist,
+to create a new zero-length file.
+
+=item @volgroups = $h->vgs ();
+
+List all the volumes groups detected. This is the equivalent
+of the L<vgs(8)> command.
+
+This returns a list of just the volume group names that were
+detected (eg. C<VolGroup00>).
+
+See also C<$h-E<gt>vgs_full>.
+
+=item @volgroups = $h->vgs_full ();
+
+List all the volumes groups detected. This is the equivalent
+of the L<vgs(8)> command. The "full" version includes all fields.
+
+=cut
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<guestfs(3)>, L<guestfish(1)>.
+
+=cut
--- /dev/null
+TYPEMAP
+char * T_PV
+const char * T_PV
+guestfs_h * O_OBJECT_guestfs_h
+
+INPUT
+O_OBJECT_guestfs_h
+ if (sv_isobject ($arg) && SvTYPE (SvRV ($arg)) == SVt_PVMG)
+ $var = ($type) SvIV ((SV *) SvRV ($arg));
+ else {
+ warn (\"${Package}::$func_name(): $var is not a blessed SV reference\");
+ XSRETURN_UNDEF;
+ }
+
+OUTPUT
+O_OBJECT_guestfs_h
+ sv_setref_pv ($arg, "Sys::Guestfs", (void *) $var);
type flags = ProtocolLimitWarning
+(* Note about long descriptions: When referring to another
+ * action, use the format C<guestfs_other> (ie. the full name of
+ * the C function). This will be replaced as appropriate in other
+ * language bindings.
+ *
+ * Apart from that, long descriptions are just perldoc paragraphs.
+ *)
+
let functions = [
("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
"mount a guest disk at a position in the filesystem",
underlying disk image.
You should always call this if you have modified a disk image, before
-calling C<guestfs_close>.");
+closing the handle.");
("touch", (Err, P1 (String "path")), 3, [],
"update file timestamps or create a new file",
"\
List all the block devices.
-The full block device names are returned, eg. C</dev/sda>
-");
+The full block device names are returned, eg. C</dev/sda>");
("list_partitions", (RStringList "partitions", P0), 8, [],
"list the partitions",
let sorted_functions =
List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) functions
-(* Useful functions. *)
+(* Useful functions.
+ * Note we don't want to use any external OCaml libraries which
+ * makes this a bit harder than it should be.
+ *)
let failwithf fs = ksprintf failwith fs
-let replace s c1 c2 =
+
+let replace_char s c1 c2 =
let s2 = String.copy s in
let r = ref false in
for i = 0 to String.length s2 - 1 do
done;
if not !r then s else s2
+let rec find s sub =
+ let len = String.length s in
+ let sublen = String.length sub in
+ let rec loop i =
+ if i <= len-sublen then (
+ let rec loop2 j =
+ if j < sublen then (
+ if s.[i+j] = sub.[j] then loop2 (j+1)
+ else -1
+ ) else
+ i (* found *)
+ in
+ let r = loop2 0 in
+ if r = -1 then loop (i+1) else r
+ ) else
+ -1 (* not found *)
+ in
+ loop 0
+
+let rec replace_str s s1 s2 =
+ let len = String.length s in
+ let sublen = String.length s1 in
+ let i = find s s1 in
+ if i = -1 then s
+ else (
+ let s' = String.sub s 0 i in
+ let s'' = String.sub s (i+sublen) (len-i-sublen) in
+ s' ^ s2 ^ replace_str s'' s1 s2
+ )
+
(* 'pr' prints to the current output file. *)
let chan = ref stdout
let pr fs = ksprintf (output_string !chan) fs
(* Check function names etc. for consistency. *)
let check_functions () =
List.iter (
- fun (name, _, _, _, _, _) ->
+ fun (name, _, _, _, _, longdesc) ->
if String.contains name '-' then
failwithf "Function name '%s' should not contain '-', use '_' instead."
- name
+ name;
+ if longdesc.[String.length longdesc-1] = '\n' then
+ failwithf "Long description of %s should not end with \\n." name
) functions;
let proc_nrs =
pr " list_builtin_commands ();\n";
List.iter (
fun (name, _, _, _, shortdesc, _) ->
- let name = replace name '_' '-' in
+ let name = replace_char name '_' '-' in
pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
name shortdesc
) sorted_functions;
pr "{\n";
List.iter (
fun (name, style, _, flags, shortdesc, longdesc) ->
- let name2 = replace name '_' '-' in
+ let name2 = replace_char name '_' '-' in
+ let longdesc = replace_str longdesc "C<guestfs_" "C<" in
let synopsis =
match snd style with
| P0 -> name2
pr "{\n";
List.iter (
fun (name, _, _, _, _, _) ->
- let name2 = replace name '_' '-' in
+ let name2 = replace_char name '_' '-' in
pr " if (";
pr "strcasecmp (cmd, \"%s\") == 0" name;
if name <> name2 then
and generate_fish_actions_pod () =
List.iter (
fun (name, style, _, _, _, longdesc) ->
- let name = replace name '_' '-' in
+ let longdesc = replace_str longdesc "C<guestfs_" "C<" in
+ let name = replace_char name '_' '-' in
pr "=head2 %s\n\n" name;
pr " %s" name;
iter_args (
if is_external then pr " = \"ocaml_guestfs_%s\"" name;
pr "\n"
+(* Generate Perl xs code, a sort of crazy variation of C with macros. *)
+and generate_perl_xs () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include \"EXTERN.h\"
+#include \"perl.h\"
+#include \"XSUB.h\"
+
+#include <guestfs.h>
+
+#ifndef PRId64
+#define PRId64 \"lld\"
+#endif
+
+static SV *
+my_newSVll(long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSViv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, \"%%\" PRId64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+#ifndef PRIu64
+#define PRIu64 \"llu\"
+#endif
+
+static SV *
+my_newSVull(unsigned long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSVuv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, \"%%\" PRIu64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+/* XXX Not thread-safe, and in general not safe if the caller is
+ * issuing multiple requests in parallel (on different guestfs
+ * handles). We should use the guestfs_h handle passed to the
+ * error handle to distinguish these cases.
+ */
+static char *last_error = NULL;
+
+static void
+error_handler (guestfs_h *g,
+ void *data,
+ const char *msg)
+{
+ if (last_error != NULL) free (last_error);
+ last_error = strdup (msg);
+}
+
+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
+
+void
+DESTROY (g)
+ guestfs_h *g;
+PPCODE:
+ guestfs_close (g);
+
+";
+
+ List.iter (
+ fun (name, style, _, _, _, _) ->
+ (match fst style with
+ | Err -> pr "void\n"
+ | RString _ -> pr "SV *\n"
+ | RStringList _
+ | RPVList _ | RVGList _ | RLVList _ ->
+ pr "void\n" (* all lists returned implictly on the stack *)
+ );
+ (* Call and arguments. *)
+ pr "%s " name;
+ generate_call_args ~handle:"g" style;
+ pr "\n";
+ pr " guestfs_h *g;\n";
+ iter_args (
+ function
+ | String n -> pr " char *%s;\n" n
+ ) (snd style);
+ (* Code. *)
+ (match fst style with
+ | Err ->
+ pr " PPCODE:\n";
+ pr " if (guestfs_%s " name;
+ generate_call_args ~handle:"g" style;
+ pr " == -1)\n";
+ pr " croak (\"%s: %%s\", last_error);\n" name
+ | RString n ->
+ pr "PREINIT:\n";
+ pr " char *%s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " free (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+ | RStringList n ->
+ pr "PREINIT:\n";
+ pr " char **%s;\n" n;
+ pr " int i, n;\n";
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
+ pr " EXTEND (SP, n);\n";
+ pr " for (i = 0; i < n; ++i) {\n";
+ pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
+ pr " free (%s[i]);\n" n;
+ pr " }\n";
+ pr " free (%s);\n" n;
+ | RPVList n ->
+ generate_perl_lvm_code "pv" pv_cols name style n;
+ | RVGList n ->
+ generate_perl_lvm_code "vg" vg_cols name style n;
+ | RLVList n ->
+ generate_perl_lvm_code "lv" lv_cols name style n;
+ );
+ pr "\n"
+ ) functions
+
+and generate_perl_lvm_code typ cols name style n =
+ pr "PREINIT:\n";
+ pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
+ pr " int i;\n";
+ pr " HV *hv;\n";
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " EXTEND (SP, %s->len);\n" n;
+ pr " for (i = 0; i < %s->len; ++i) {\n" n;
+ pr " hv = newHV ();\n";
+ List.iter (
+ function
+ | name, `String ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
+ name (String.length name) n name
+ | name, `UUID ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
+ name (String.length name) n name
+ | name, `Bytes ->
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ | name, `Int ->
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ | name, `OptPercent ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ ) cols;
+ pr " PUSHs (sv_2mortal ((SV *) hv));\n";
+ pr " }\n";
+ pr " guestfs_free_lvm_%s_list (%s);\n" typ n
+
+(* Generate Sys/Guestfs.pm. *)
+and generate_perl_pm () =
+ generate_header HashStyle LGPLv2;
+
+ pr "\
+=pod
+
+=head1 NAME
+
+Sys::Guestfs - Perl bindings for libguestfs
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs;
+
+ my $h = Sys::Guestfs->new ();
+ $h->add_drive ('guest.img');
+ $h->launch ();
+ $h->wait_ready ();
+ $h->mount ('/dev/sda1', '/');
+ $h->touch ('/hello');
+ $h->sync ();
+
+=head1 DESCRIPTION
+
+The C<Sys::Guestfs> module provides a Perl XS binding to the
+libguestfs API for examining and modifying virtual machine
+disk images.
+
+Amongst the things this is good for: making batch configuration
+changes to guests, getting disk used/free statistics (see also:
+virt-df), migrating between virtualization systems (see also:
+virt-p2v), performing partial backups, performing partial guest
+clones, cloning guests and changing registry/UUID/hostname info, and
+much else besides.
+
+Libguestfs uses Linux kernel and qemu code, and can access any type of
+guest filesystem that Linux and qemu can, including but not limited
+to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
+schemes, qcow, qcow2, vmdk.
+
+Libguestfs provides ways to enumerate guest storage (eg. partitions,
+LVs, what filesystem is in each LV, etc.). It can also run commands
+in the context of the guest. Also you can access filesystems over FTP.
+
+=head1 ERRORS
+
+All errors turn into calls to C<croak> (see L<Carp(3)>).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Sys::Guestfs;
+
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load ('Sys::Guestfs');
+
+=item $h = Sys::Guestfs->new ();
+
+Create a new guestfs handle.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref ($proto) || $proto;
+
+ my $self = Sys::Guestfs::_create ();
+ bless $self, $class;
+ return $self;
+}
+
+";
+
+ (* Actions. We only need to print documentation for these as
+ * they are pulled in from the XS code automatically.
+ *)
+ List.iter (
+ fun (name, style, _, flags, _, longdesc) ->
+ let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
+ pr "=item ";
+ generate_perl_prototype name style;
+ pr "\n\n";
+ pr "%s\n\n" longdesc;
+ if List.mem ProtocolLimitWarning flags then
+ pr "Because of the message protocol, there is a transfer limit
+of somewhere between 2MB and 4MB. To transfer large files you should use
+FTP.\n\n";
+ ) sorted_functions;
+
+ (* End of file. *)
+ pr "\
+=cut
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<guestfs(3)>, L<guestfish(1)>.
+
+=cut
+"
+
+and generate_perl_prototype name style =
+ (match fst style with
+ | Err -> ()
+ | RString n -> pr "$%s = " n
+ | RStringList n
+ | RPVList n
+ | RVGList n
+ | RLVList n -> pr "@%s = " n
+ );
+ pr "$h->%s (" name;
+ let comma = ref false in
+ iter_args (
+ fun arg ->
+ if !comma then pr ", ";
+ comma := true;
+ match arg with
+ | String n -> pr "%s" n
+ ) (snd style);
+ pr ");"
+
let output_to filename =
let filename_new = filename ^ ".new" in
chan := open_out filename_new;
let close = output_to "ocaml/guestfs_c_actions.c" in
generate_ocaml_c ();
close ();
+
+ let close = output_to "perl/Guestfs.xs" in
+ generate_perl_xs ();
+ close ();
+
+ let close = output_to "perl/lib/Sys/Guestfs.pm" in
+ generate_perl_pm ();
+ close ();
git.annexia.org / libguestfs.git / commitdiff