mirrors/libguestfs
1
0
Fork 0
mirror of https://github.com/libguestfs/libguestfs.git synced 2026-03-21 22:53:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add Erlang bindings.

Browse Source
This commit is contained in:
Richard W.M. Jones
2011-09-20 18:03:58 +01:00
parent 917f947590
commit 84763d7fca
25 changed files with 1235 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
.gitignore vendored
View File

@@ -73,6 +73,12 @@ edit/stamp-virt-*.pod
edit/virt-edit
edit/virt-edit.1
emptydisk
erlang/erl-guestfs
erlang/erl-guestfs.c
erlang/examples/guestfs-erlang.3
erlang/examples/stamp-guestfs-erlang.pod
erlang/guestfs.beam
erlang/guestfs.erl
examples/create_disk
examples/guestfs-examples.3
examples/guestfs-recipes.1
@@ -118,6 +124,7 @@ haskell/Guestfs.hs
*.hi
html/guestfish.1.html
html/guestfs.3.html
html/guestfs-erlang.3.html
html/guestfs-examples.3.html
html/guestfs-java.3.html
html/guestfs-ocaml.3.html

4
Makefile.am
View File

@@ -60,6 +60,9 @@ endif
if HAVE_PHP
SUBDIRS += php
endif
if HAVE_ERLANG
SUBDIRS += erlang erlang/examples
endif
# Unconditional because nothing is built yet.
SUBDIRS += csharp
@@ -131,6 +134,7 @@ EXTRA_DIST = \
HTMLFILES = \
html/guestfs.3.html \
html/guestfs-examples.3.html \
html/guestfs-erlang.3.html \
html/guestfs-java.3.html \
html/guestfs-ocaml.3.html \
html/guestfs-perl.3.html \

42
configure.ac
View File

@@ -886,6 +886,44 @@ AS_IF([test "x$enable_php" != "xno"],
])
AM_CONDITIONAL([HAVE_PHP], [test "x$PHP" != "xno" && test "x$PHPIZE" != "xno"])
dnl Erlang
ERLC=no
ERL_INTERFACEDIR=no
AC_ARG_ENABLE([erlang],
AS_HELP_STRING([--disable-erlang], [Disable Erlang language bindings]),
[],
[enable_erlang=yes])
AS_IF([test "x$enable_erlang" != "xno"],
[
ERLC=
AC_CHECK_PROG([ERLC],[erlc],[erlc],[no])
if test "x$ERLC" != "xno"; then
dnl Look for erl_interface directory in various places.
AC_MSG_CHECKING([for erl_interface])
for d in \
$libdir /usr/lib /usr/lib64 /usr/local/lib /usr/local/lib64
do
dir=`ls -1d $d/erlang/lib/erl_interface-* 2>/dev/null`
if test "x$dir" != "x" && test -d "$dir"; then
AC_MSG_RESULT([$dir])
ERL_INTERFACEDIR=$dir
break
fi
done
if test "x$ERL_INTERFACEDIR" = "xno"; then
AC_MSG_RESULT([not found])
fi
fi
AC_SUBST([ERLC])
AC_SUBST([ERL_INTERFACEDIR])
])
AM_CONDITIONAL([HAVE_ERLANG],
[test "x$ERLC" != "xno" && test "x$ERL_INTERFACEDIR" != "xno"])
dnl Check for Perl modules needed by Perl virt tools (virt-df, etc.)
AS_IF([test "x$PERL" != "xno"],
[
@@ -933,6 +971,8 @@ AC_CONFIG_FILES([Makefile
debian/changelog
df/Makefile
edit/Makefile
erlang/Makefile
erlang/examples/Makefile
examples/Makefile
fish/Makefile
fuse/Makefile
@@ -994,6 +1034,8 @@ echo -n "Haskell bindings .................... "
if test "x$HAVE_HASKELL_TRUE" = "x"; then echo "yes"; else echo "no"; fi
echo -n "PHP bindings ........................ "
if test "x$HAVE_PHP_TRUE" = "x"; then echo "yes"; else echo "no"; fi
echo -n "Erlang bindings ..................... "
if test "x$HAVE_ERLANG_TRUE" = "x"; then echo "yes"; else echo "no"; fi
echo "guestfish and C virt tools .......... yes"
echo -n "Perl virt tools ..................... "
if test "x$HAVE_TOOLS_TRUE" = "x"; then echo "yes"; else echo "no"; fi

54
erlang/Makefile.am Normal file
View File

@@ -0,0 +1,54 @@
# libguestfs Erlang bindings
# 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.
include $(top_srcdir)/subdir-rules.mk
generator_built = \
guestfs.erl \
erl-guestfs.c
EXTRA_DIST = \
$(generator_built) \
README
if HAVE_ERLANG
erlang_bindir = $(libdir)/erlang/lib/$(PACKAGE_NAME)-$(PACKAGE_VERSION)/ebin
erlang_bin_DATA = guestfs.beam
guestfs.beam: guestfs.erl
$(ERLC) +debug_info guestfs.erl
bin_PROGRAMS = erl-guestfs
erl_guestfs_SOURCES = erl-guestfs.c erl-guestfs-proto.c
erl_guestfs_CFLAGS = \
-I$(top_srcdir)/src -I$(top_builddir)/src \
-I$(srcdir)/../gnulib/lib -I../gnulib/lib \
-I$(ERL_INTERFACEDIR)/include \
$(WARN_CFLAGS) $(WERROR_CFLAGS)
erl_guestfs_LDADD = \
$(ERL_INTERFACEDIR)/lib/liberl_interface.a \
$(ERL_INTERFACEDIR)/lib/libei.a \
-lpthread \
$(top_builddir)/src/libguestfs.la \
../gnulib/lib/libgnu.la
endif

53
erlang/README Normal file
View File

@@ -0,0 +1,53 @@
REAMDE for the Erlang bindings to libguestfs
----------------------------------------------------------------------
To get started, take a look at the man page guestfs-erlang(3) and the
example programs.
Note that to run the examples, the "erl-guestfs" binary must be on the
path. To run the examples without installing, do:
cd erlang
PATH=.:$PATH ../run ./examples/create_disk.erl
PATH=.:$PATH ../run ./examples/inspect_vm.erl /path/to/vm_disk.img
To simplify the implementation we currently don't support events or
user cancellation. However it would be pretty simple to add both of
these. Patches welcome!
Implementation notes
----------------------------------------------------------------------
These bindings are done using a port that launches an external
program, following this example:
http://www.erlang.org/doc/tutorial/erl_interface.html
The reason for this is that the libguestfs API is synchronous and
calls may take a long time. If we used a linked-in driver then that
would require us to start a POSIX thread in the Erlang interpreter and
manage concurrency issues. Using an external process per handle
simplifies the implementation and makes it much less likely to break
the Erlang interpreter.
The external C program is called "erl-guestfs". It is normally
installed in $(bindir), eg. /usr/bin/erl-guestfs.
You need to make sure that the Erlang code and erl-guestfs are the
same version. The protocol used between the Erlang code (guestfs.erl)
and erl-guestfs might change in future versions.
There is not really any type checking done in the erl-guestfs binary,
which means you can get undefined behaviour if you send incorrect
argument types. Patches welcome to improve this situation.
Licensing
----------------------------------------------------------------------
Because the C program runs in a separate process, it is licensed as
GPLv2+. The Erlang part which "links" into the Erlang interpreter is
licensed as LGPLv2+. We believe this means there is no impediment to
using libguestfs from closed source Erlang programs.
The example programs are under a separate, very permissive license,
which basically allows you to do what you want with them. See
erlang/examples/LICENSE.

278
erlang/erl-guestfs-proto.c Normal file
View File

@@ -0,0 +1,278 @@
/* libguestfs Erlang bindings.
* 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.,
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <erl_interface.h>
#include <ei.h>
#include "error.h"
#include "full-read.h"
#include "full-write.h"
#include "guestfs.h"
guestfs_h *g;
extern ETERM *dispatch (ETERM *message);
extern int atom_equals (ETERM *atom, const char *name);
extern ETERM *make_error (const char *funname);
extern ETERM *unknown_optarg (const char *funname, ETERM *optargname);
extern ETERM *unknown_function (ETERM *fun);
extern ETERM *make_string_list (char **r);
extern ETERM *make_table (char **r);
extern ETERM *make_bool (int r);
extern char **get_string_list (ETERM *term);
extern int get_bool (ETERM *term);
extern void free_strings (char **r);
/* This stops things getting out of hand, but also lets us detect
* protocol problems quickly.
*/
#define MAX_MESSAGE_SIZE (32*1024*1024)
static unsigned char *read_message (void);
static void write_reply (ETERM *);
int
main (void)
{
unsigned char *buf;
ETERM *ret, *message;
erl_init (NULL, 0);
/* This process has a single libguestfs handle. If the Erlang
* system creates more than one handle, then more than one of these
* processes will be running.
*/
g = guestfs_create ();
if (g == NULL)
error (EXIT_FAILURE, 0, "could not create guestfs handle");
guestfs_set_error_handler (g, NULL, NULL);
while ((buf = read_message ()) != NULL) {
message = erl_decode (buf);
free (buf);
ret = dispatch (message);
erl_free_term (message);
write_reply (ret);
erl_free_term (ret);
}
guestfs_close (g);
exit (EXIT_SUCCESS);
}
/* The Erlang port always sends the length of the buffer as 4
* bytes in network byte order, followed by the message buffer.
*/
static unsigned char *
read_message (void)
{
unsigned char buf[4];
size_t size;
unsigned char *r;
errno = 0;
if (full_read (0, buf, 4) != 4) {
if (errno == 0) /* ok - closed connection normally */
return NULL;
else
error (EXIT_FAILURE, errno, "read message size");
}
size = buf[0] << 24 | buf[1] << 16 | buf[2] << 8 | buf[3];
if (size > MAX_MESSAGE_SIZE)
error (EXIT_FAILURE, 0, "message larger than MAX_MESSAGE_SIZE");
r = malloc (size);
if (r == NULL)
error (EXIT_FAILURE, errno, "malloc");
if (full_read (0, r, size) != size)
error (EXIT_FAILURE, errno, "read message content");
return r;
}
static void
write_reply (ETERM *term)
{
size_t size;
unsigned char sbuf[4];
unsigned char *buf;
size = erl_term_len (term);
buf = malloc (size);
if (buf == NULL)
error (EXIT_FAILURE, errno, "malloc");
erl_encode (term, buf);
sbuf[0] = (size >> 24) & 0xff;
sbuf[1] = (size >> 16) & 0xff;
sbuf[2] = (size >> 8) & 0xff;
sbuf[3] = size & 0xff;
if (full_write (1, sbuf, 4) != 4)
error (EXIT_FAILURE, errno, "write message size");
if (full_write (1, buf, size) != size)
error (EXIT_FAILURE, errno, "write message content");
free (buf);
}
/* Note that all published Erlang code/examples etc uses strncmp in
* a buggy way. This is the right way to do it.
*/
int
atom_equals (ETERM *atom, const char *name)
{
size_t namelen = strlen (name);
size_t atomlen = ERL_ATOM_SIZE (atom);
if (namelen != atomlen) return 0;
return strncmp (ERL_ATOM_PTR (atom), name, atomlen) == 0;
}
ETERM *
make_error (const char *funname)
{
ETERM *error = erl_mk_atom ("error");
ETERM *msg = erl_mk_string (guestfs_last_error (g));
ETERM *num = erl_mk_int (guestfs_last_errno (g));
ETERM *t[3] = { error, msg, num };
return erl_mk_tuple (t, 3);
}
ETERM *
unknown_function (ETERM *fun)
{
ETERM *unknown = erl_mk_atom ("unknown");
ETERM *funcopy = erl_copy_term (fun);
ETERM *t[2] = { unknown, funcopy };
return erl_mk_tuple (t, 2);
}
ETERM *
unknown_optarg (const char *funname, ETERM *optargname)
{
ETERM *unknownarg = erl_mk_atom ("unknownarg");
ETERM *copy = erl_copy_term (optargname);
ETERM *t[2] = { unknownarg, copy };
return erl_mk_tuple (t, 2);
}
ETERM *
make_string_list (char **r)
{
size_t i, size;
for (size = 0; r[size] != NULL; ++size)
;
ETERM *t[size];
for (i = 0; r[i] != NULL; ++i)
t[i] = erl_mk_string (r[i]);
return erl_mk_list (t, size);
}
/* Make a hash table. The number of elements returned by the C
* function is always even.
*/
ETERM *
make_table (char **r)
{
size_t i, size;
for (size = 0; r[size] != NULL; ++size)
;
ETERM *t[size/2];
ETERM *a[2];
for (i = 0; r[i] != NULL; i += 2) {
a[0] = erl_mk_string (r[i]);
a[1] = erl_mk_string (r[i+1]);
t[i/2] = erl_mk_tuple (a, 2);
}
return erl_mk_list (t, size/2);
}
ETERM *
make_bool (int r)
{
if (r)
return erl_mk_atom ("true");
else
return erl_mk_atom ("false");
}
char **
get_string_list (ETERM *term)
{
ETERM *t;
size_t i, size;
char **r;
for (size = 0, t = term; !ERL_IS_EMPTY_LIST (t);
size++, t = ERL_CONS_TAIL (t))
;
r = malloc ((size+1) * sizeof (char *));
if (r == NULL)
error (EXIT_FAILURE, errno, "malloc");
for (i = 0, t = term; !ERL_IS_EMPTY_LIST (t); i++, t = ERL_CONS_TAIL (t))
r[i] = erl_iolist_to_string (ERL_CONS_HEAD (t));
r[size] = NULL;
return r;
}
int
get_bool (ETERM *term)
{
if (atom_equals (term, "true"))
return 1;
else
return 0;
}
void
free_strings (char **r)
{
size_t i;
for (i = 0; r[i] != NULL; ++i)
free (r[i]);
free (r);
}

2
erlang/examples/LICENSE Normal file
View File

@@ -0,0 +1,2 @@
All the examples in the erlang/examples/ subdirectory may be freely
copied without any restrictions.

39
erlang/examples/Makefile.am Normal file
View File

@@ -0,0 +1,39 @@
# libguestfs Erlang 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.erl \
inspect_vm.erl \
guestfs-erlang.pod
CLEANFILES = stamp-guestfs-erlang.pod
man_MANS = guestfs-erlang.3
noinst_DATA = $(top_builddir)/html/guestfs-erlang.3.html
guestfs-erlang.3 $(top_builddir)/html/guestfs-erlang.3.html: stamp-guestfs-erlang.pod
stamp-guestfs-erlang.pod: guestfs-erlang.pod create_disk.erl inspect_vm.erl
$(top_builddir)/podwrapper.sh \
--section 3 \
--man guestfs-erlang.3 \
--html $(top_builddir)/html/guestfs-erlang.3.html \
--verbatim $(srcdir)/create_disk.erl:@EXAMPLE1@ \
--verbatim $(srcdir)/inspect_vm.erl:@EXAMPLE2@ \
$<
touch $@

65
erlang/examples/create_disk.erl Executable file
View File

@@ -0,0 +1,65 @@
#!/usr/bin/env escript
%%! -smp enable -sname create_disk debug verbose
% Example showing how to create a disk image.
main(_) ->
Output = "disk.img",
{ok, G} = guestfs:create(),
% Create a raw-format sparse disk image, 512 MB in size.
{ok, File} = file:open(Output, [raw, write, binary]),
{ok, _} = file:position(File, 512 * 1024 * 1024 - 1),
ok = file:write(File, " "),
ok = file:close(File),
% Set the trace flag so that we can see each libguestfs call.
ok = guestfs:set_trace(G, true),
% Set the autosync flag so that the disk will be synchronized
% automatically when the libguestfs handle is closed.
ok = guestfs:set_autosync(G, true),
% Attach the disk image to libguestfs.
ok = guestfs:add_drive_opts(G, Output,
[{format, "raw"}, {readonly, false}]),
% Run the libguestfs back-end.
ok = guestfs:launch(G),
% Get the list of devices. Because we only added one drive
% above, we expect that this list should contain a single
% element.
[Device] = guestfs:list_devices(G),
% Partition the disk as one single MBR partition.
ok = guestfs:part_disk(G, Device, "mbr"),
% Get the list of partitions. We expect a single element, which
% is the partition we have just created.
[Partition] = guestfs:list_partitions(G),
% Create a filesystem on the partition.
ok = guestfs:mkfs(G, "ext4", Partition),
% Now mount the filesystem so that we can add files. *)
ok = guestfs:mount_options(G, "", Partition, "/"),
% Create some files and directories. *)
ok = guestfs:touch(G, "/empty"),
Message = "Hello, world\n",
ok = guestfs:write(G, "/hello", Message),
ok = guestfs:mkdir(G, "/foo"),
% This one uploads the local file /etc/resolv.conf into
% the disk image.
ok = guestfs:upload(G, "/etc/resolv.conf", "/foo/resolv.conf"),
% Because 'autosync' was set (above) we can just close the handle
% and the disk contents will be synchronized. You can also do
% this manually by calling guestfs:umount_all and guestfs:sync.
%
% Note also that handles are automatically closed if they are
% reaped by the garbage collector. You only need to call close
% if you want to close the handle right away.
ok = guestfs:close(G).

133
erlang/examples/guestfs-erlang.pod Normal file
View File

@@ -0,0 +1,133 @@
=encoding utf8
=head1 NAME
guestfs-erlang - How to use libguestfs from Erlang
=head1 SYNOPSIS
{ok, G} = guestfs:create(),
ok = guestfs:add_drive_opts(G, Disk,
[{format, "raw"}, {readonly, true}]),
ok = guestfs:launch(G),
[Device] = guestfs:list_devices(G),
ok = guestfs:close(G).
=head1 DESCRIPTION
This manual page documents how to call libguestfs from the Erlang
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<guestfs(3)>.
=head2 OPENING AND CLOSING THE HANDLE
The Erlang bindings are implemented using an external program called
C<erl-guestfs>. This program must be on the current PATH, or else you
should specify the full path to the program:
{ok, G} = guestfs:create().
{ok, G} = guestfs:create("/path/to/erl-guestfs").
C<G> is the libguestfs handle which you should pass to other
functions.
To close the handle:
ok = guestfs:close(G).
=head2 FUNCTIONS WITH OPTIONAL ARGUMENTS
For functions that take optional arguments, the first arguments are
the non-optional ones. The last argument is a list of tuples
supplying the remaining optional arguments.
ok = guestfs:add_drive_opts(G, Disk,
[{format, "raw"}, {readonly, true}]).
If the last argument would be an empty list, you can also omit it:
ok = guestfs:add_drive_opts(G, Disk).
=head2 RETURN VALUES AND ERRORS
On success, most functions return a C<Result> term (which could be a
list, string, tuple etc.). If there is nothing for the function to
return, then the atom C<ok> is returned.
On error, you would see one of the following tuples:
=over 4
=item C<{error, Msg, Errno}>
This indicates an ordinary error from the function.
C<Msg> is the error message (string) and C<Errno> is the Unix error
(integer).
C<Errno> can be zero. See L<guestfs(3)/guestfs_last_errno>.
=item C<{unknown, Function}>
This indicates that the function you called is not known. Generally
this means you are mixing C<erl-guestfs> from another version of
libguestfs, which you should not do.
C<Function> is the name of the unknown function.
=item C<{unknownarg, Arg}>
This indicates that you called a function with optional arguments,
with an unknown argument name.
C<Arg> is the name of the unknown argument.
=back
=head1 EXAMPLE 1: CREATE A DISK IMAGE
@EXAMPLE1@
=head1 EXAMPLE 2: INSPECT A VIRTUAL MACHINE DISK IMAGE
@EXAMPLE2@
=head1 SEE ALSO
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-java(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,
L<guestfs-python(3)>,
L<guestfs-recipes(1)>,
L<guestfs-ruby(3)>,
L<http://www.erlang.org/>.
L<http://libguestfs.org/>.
=head1 AUTHORS
Richard W.M. Jones (C<rjones at redhat dot com>)
=head1 COPYRIGHT
Copyright (C) 2011 Red Hat Inc. L<http://libguestfs.org/>
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

79
erlang/examples/inspect_vm.erl Executable file
View File

@@ -0,0 +1,79 @@
#!/usr/bin/env escript
%%! -smp enable -sname inspect_vm debug verbose
% Example showing how to inspect a virtual machine disk.
main([Disk]) ->
{ok, G} = guestfs:create(),
% Attach the disk image read-only to libguestfs.
ok = guestfs:add_drive_opts(G, Disk, [{readonly, true}]),
% Run the libguestfs back-end.
ok = guestfs:launch(G),
% Ask libguestfs to inspect for operating systems.
case guestfs:inspect_os(G) of
[] ->
io:fwrite("inspect_vm: no operating systems found~n"),
exit(no_operating_system);
Roots ->
list_os(G, Roots)
end.
list_os(_, []) ->
ok;
list_os(G, [Root|Roots]) ->
io:fwrite("Root device: ~s~n", [Root]),
% Print basic information about the operating system.
Product_name = guestfs:inspect_get_product_name(G, Root),
io:fwrite(" Product name: ~s~n", [Product_name]),
Major = guestfs:inspect_get_major_version(G, Root),
Minor = guestfs:inspect_get_minor_version(G, Root),
io:fwrite(" Version: ~w.~w~n", [Major, Minor]),
Type = guestfs:inspect_get_type(G, Root),
io:fwrite(" Type: ~s~n", [Type]),
Distro = guestfs:inspect_get_distro(G, Root),
io:fwrite(" Distro: ~s~n", [Distro]),
% Mount up the disks, like guestfish -i.
Mps = sort_mps(guestfs:inspect_get_mountpoints(G, Root)),
mount_mps(G, Mps),
% If /etc/issue.net file exists, print up to 3 lines. *)
Filename = "/etc/issue.net",
Is_file = guestfs:is_file(G, Filename),
if Is_file ->
io:fwrite("--- ~s ---~n", [Filename]),
Lines = guestfs:head_n(G, 3, Filename),
write_lines(Lines);
true -> ok
end,
% Unmount everything.
ok = guestfs:umount_all(G),
list_os(G, Roots).
% Sort keys by length, shortest first, so that we end up
% mounting the filesystems in the correct order.
sort_mps(Mps) ->
Cmp = fun ({A,_}, {B,_}) ->
length(A) =< length(B) end,
lists:sort(Cmp, Mps).
mount_mps(_, []) ->
ok;
mount_mps(G, [{Mp, Dev}|Mps]) ->
case guestfs:mount_ro(G, Dev, Mp) of
ok -> ok;
{ error, Msg, _ } ->
io:fwrite("~s (ignored)~n", [Msg])
end,
mount_mps(G, Mps).
write_lines([]) ->
ok;
write_lines([Line|Lines]) ->
io:fwrite("~s~n", [Line]),
write_lines(Lines).

1
examples/guestfs-examples.pod
View File

@@ -33,6 +33,7 @@ libguestfs, you also need to read L<guestfs(3)>.
=head1 SEE ALSO
L<guestfs(3)>,
L<guestfs-erlang(3)>,
L<guestfs-java(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,

1
examples/guestfs-recipes.pod
View File

@@ -386,6 +386,7 @@ https://rwmj.wordpress.com/2011/05/10/tip-use-libguestfs-on-vmware-esx-guests/#c
L<guestfs(3)>,
L<guestfish(1)>,
L<guestfs-examples(3)>,
L<guestfs-erlang(3)>,
L<guestfs-java(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,

20
generator/.depend
View File

@@ -124,6 +124,14 @@ generator_php.cmo: generator_utils.cmi generator_types.cmo \
generator_php.cmx: generator_utils.cmx generator_types.cmx \
generator_structs.cmx generator_pr.cmx generator_optgroups.cmx \
generator_docstrings.cmx generator_c.cmx generator_actions.cmx
generator_erlang.cmo: generator_utils.cmi generator_types.cmo \
generator_structs.cmi generator_pr.cmi generator_optgroups.cmo \
generator_events.cmo generator_docstrings.cmo generator_c.cmo \
generator_actions.cmi
generator_erlang.cmx: generator_utils.cmx generator_types.cmx \
generator_structs.cmx generator_pr.cmx generator_optgroups.cmx \
generator_events.cmx generator_docstrings.cmx generator_c.cmx \
generator_actions.cmx
generator_bindtests.cmo: generator_utils.cmi generator_types.cmo \
generator_structs.cmi generator_pr.cmi generator_optgroups.cmo \
generator_docstrings.cmo generator_c.cmo generator_actions.cmi
@@ -138,13 +146,13 @@ generator_main.cmo: generator_xdr.cmo generator_structs.cmi \
generator_ruby.cmo generator_python.cmo generator_pr.cmi \
generator_php.cmo generator_perl.cmo generator_ocaml.cmo \
generator_java.cmo generator_haskell.cmo generator_fish.cmo \
generator_errnostring.cmo generator_daemon.cmo generator_csharp.cmo \
generator_capitests.cmo generator_c.cmo generator_bindtests.cmo \
generator_api_versions.cmi
generator_errnostring.cmo generator_erlang.cmo generator_daemon.cmo \
generator_csharp.cmo generator_capitests.cmo generator_c.cmo \
generator_bindtests.cmo generator_api_versions.cmi
generator_main.cmx: generator_xdr.cmx generator_structs.cmx \
generator_ruby.cmx generator_python.cmx generator_pr.cmx \
generator_php.cmx generator_perl.cmx generator_ocaml.cmx \
generator_java.cmx generator_haskell.cmx generator_fish.cmx \
generator_errnostring.cmx generator_daemon.cmx generator_csharp.cmx \
generator_capitests.cmx generator_c.cmx generator_bindtests.cmx \
generator_api_versions.cmx
generator_errnostring.cmx generator_erlang.cmx generator_daemon.cmx \
generator_csharp.cmx generator_capitests.cmx generator_c.cmx \
generator_bindtests.cmx generator_api_versions.cmx

3
generator/Makefile.am
View File

@@ -1,5 +1,5 @@
# libguestfs
# Copyright (C) 2010 Red Hat Inc.
# Copyright (C) 2010-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
@@ -46,6 +46,7 @@ SOURCES = \
generator_haskell.ml \
generator_csharp.ml \
generator_php.ml \
generator_erlang.ml \
generator_bindtests.ml \
generator_errnostring.ml \
generator_main.ml

5
generator/generator_docstrings.ml
View File

@@ -62,6 +62,7 @@ let copyright_years =
(* Generate a header block in a number of standard styles. *)
type comment_style =
CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
| ErlangStyle
type license = GPLv2plus | LGPLv2plus
let generate_header ?(extra_inputs = []) comment license =
@@ -71,7 +72,8 @@ let generate_header ?(extra_inputs = []) comment license =
| CPlusPlusStyle -> pr "// "; "//"
| HashStyle -> pr "# "; "#"
| OCamlStyle -> pr "(* "; " *"
| HaskellStyle -> pr "{- "; " " in
| HaskellStyle -> pr "{- "; " "
| ErlangStyle -> pr "%% "; "% " in
pr "libguestfs generated file\n";
pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
List.iter (pr "%s %s\n" c) inputs;
@@ -113,6 +115,7 @@ let generate_header ?(extra_inputs = []) comment license =
(match comment with
| CStyle -> pr " */\n"
| CPlusPlusStyle
| ErlangStyle
| HashStyle -> ()
| OCamlStyle -> pr " *)\n"
| HaskellStyle -> pr "-}\n"

438
generator/generator_erlang.ml Normal file
View File

@@ -0,0 +1,438 @@
(* libguestfs
* 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*)
(* Please read generator/README first. *)
open Printf
open Generator_types
open Generator_utils
open Generator_pr
open Generator_docstrings
open Generator_optgroups
open Generator_actions
open Generator_structs
open Generator_c
open Generator_events
let rec generate_erlang_erl () =
generate_header ErlangStyle LGPLv2plus;
pr "-module(guestfs).\n";
pr "\n";
pr "-export([create/0, create/1, close/1, init/1]).\n";
pr "\n";
(* Export the public actions. *)
List.iter (
fun (name, (_, args, optargs), _, _, _, _, _) ->
let nr_args = List.length args in
if optargs = [] then
pr "-export([%s/%d]).\n" name (nr_args+1)
else
pr "-export([%s/%d, %s/%d]).\n" name (nr_args+1) name (nr_args+2)
) all_functions_sorted;
pr "\n";
pr "\
create() ->
create(\"erl-guestfs\").
create(ExtProg) ->
G = spawn(?MODULE, init, [ExtProg]),
{ok, G}.
close(G) ->
G ! close,
ok.
call_port(G, Args) ->
G ! {call, self(), Args},
receive
{guestfs, Result} ->
Result
end.
init(ExtProg) ->
process_flag(trap_exit, true),
Port = open_port({spawn, ExtProg}, [{packet, 4}, binary]),
loop(Port).
loop(Port) ->
receive
{call, Caller, Args} ->
Port ! { self(), {command, term_to_binary(Args)}},
receive
{Port, {data, Result}} ->
Caller ! { guestfs, binary_to_term(Result)}
end,
loop(Port);
close ->
port_close(Port),
exit(normal);
{ 'EXIT', Port, _ } ->
exit(port_terminated)
end.
";
(* These bindings just marshal the parameters and call the back-end
* process which dispatches them to the port.
*)
List.iter (
fun (name, (_, args, optargs), _, _, _, _, _) ->
pr "%s(G" name;
List.iter (
fun arg ->
pr ", %s" (String.capitalize (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
pr ") ->\n";
pr " call_port(G, {%s" name;
List.iter (
fun arg ->
pr ", %s" (String.capitalize (name_of_argt arg))
) args;
if optargs <> [] then
pr ", Optargs";
pr "}).\n";
(* For functions with optional arguments, make a variant that
* has no optarg array, which just calls the function above with
* an empty list as the final arg.
*)
if optargs <> [] then (
pr "%s(G" name;
List.iter (
fun arg ->
pr ", %s" (String.capitalize (name_of_argt arg))
) args;
pr ") ->\n";
pr " %s(G" name;
List.iter (
fun arg ->
pr ", %s" (String.capitalize (name_of_argt arg))
) args;
pr ", []";
pr ").\n"
);
pr "\n"
) all_functions_sorted
and generate_erlang_c () =
generate_header CStyle GPLv2plus;
pr "\
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <erl_interface.h>
#include <ei.h>
#include \"guestfs.h\"
extern guestfs_h *g;
extern ETERM *dispatch (ETERM *message);
extern int atom_equals (ETERM *atom, const char *name);
extern ETERM *make_error (const char *funname);
extern ETERM *unknown_optarg (const char *funname, ETERM *optargname);
extern ETERM *unknown_function (ETERM *fun);
extern ETERM *make_string_list (char **r);
extern ETERM *make_table (char **r);
extern ETERM *make_bool (int r);
extern char **get_string_list (ETERM *term);
extern int get_bool (ETERM *term);
extern void free_strings (char **r);
#define ARG(i) (ERL_TUPLE_ELEMENT(message,(i)+1))
";
(* Struct copy functions. *)
let emit_copy_list_function typ =
pr "static ETERM *\n";
pr "make_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
pr "{\n";
pr " ETERM *t[%ss->len];\n" typ;
pr " size_t i;\n";
pr "\n";
pr " for (i = 0; i < %ss->len; ++i)\n" typ;
pr " t[i] = make_%s (&%ss->val[i]);\n" typ typ;
pr "\n";
pr " return erl_mk_list (t, %ss->len);\n" typ;
pr "}\n";
pr "\n";
in
List.iter (
fun (typ, cols) ->
pr "static ETERM *\n";
pr "make_%s (const struct guestfs_%s *%s)\n" typ typ typ;
pr "{\n";
pr " ETERM *t[%d];\n" (List.length cols);
pr "\n";
iteri (
fun i col ->
(match col with
| name, FString ->
pr " t[%d] = erl_mk_string (%s->%s);\n" i typ name
| name, FBuffer ->
pr " t[%d] = erl_mk_estring (%s->%s, %s->%s_len);\n"
i typ name typ name
| name, FUUID ->
pr " t[%d] = erl_mk_estring (%s->%s, 32);\n" i typ name
| name, (FBytes|FInt64|FUInt64) ->
pr " t[%d] = erl_mk_longlong (%s->%s);\n" i typ name
| name, (FInt32|FUInt32) ->
pr " t[%d] = erl_mk_int (%s->%s);\n" i typ name
| name, FOptPercent ->
pr " if (%s->%s >= 0)\n" typ name;
pr " t[%d] = erl_mk_float (%s->%s);\n" i typ name;
pr " else\n";
pr " t[%d] = erl_mk_atom (\"undefined\");\n" i;
| name, FChar ->
pr " t[%d] = erl_mk_int (%s->%s);\n" i typ name
);
) cols;
pr "\n";
pr " return erl_mk_list (t, %d);\n" (List.length cols);
pr "}\n";
pr "\n";
) structs;
(* Emit a copy_TYPE_list function definition only if that function is used. *)
List.iter (
function
| typ, (RStructListOnly | RStructAndList) ->
(* generate the function for typ *)
emit_copy_list_function typ
| typ, _ -> () (* empty *)
) (rstructs_used_by all_functions);
(* The wrapper functions. *)
List.iter (
fun (name, ((ret, args, optargs) as style), _, _, _, _, _) ->
pr "static ETERM *\n";
pr "run_%s (ETERM *message)\n" name;
pr "{\n";
iteri (
fun i ->
function
| Pathname n
| Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n
| Key n ->
pr " char *%s = erl_iolist_to_string (ARG (%d));\n" n i
| OptString n ->
pr " char *%s;\n" n;
pr " if (atom_equals (ARG (%d), \"undefined\"))\n" i;
pr " %s = NULL;\n" n;
pr " else\n";
pr " %s = erl_iolist_to_string (ARG (%d));\n" n i
| BufferIn n ->
pr " size_t %s_size = erl_iolist_length (ARG (%d));\n" n i;
pr " char *%s = erl_iolist_to_string (ARG (%d));\n" n i
| StringList n | DeviceList n ->
pr " char **%s = get_string_list (ARG (%d));\n" n i
| Bool n ->
pr " int %s = get_bool (ARG (%d));\n" n i
| Int n ->
pr " int %s = ERL_INT_VALUE (ARG (%d));\n" n i
| Int64 n ->
pr " int64_t %s = ERL_LL_VALUE (ARG (%d));\n" n i
| Pointer (t, n) ->
assert false
) args;
let uc_name = String.uppercase name in
(* Optional arguments. *)
if optargs <> [] then (
pr "\n";
pr " struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
pr " struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
pr " ETERM *optargst = ARG (%d);\n" (List.length args);
pr " while (!ERL_IS_EMPTY_LIST (optargst)) {\n";
pr " ETERM *hd = ERL_CONS_HEAD (optargst);\n";
pr " ETERM *hd_name = ERL_TUPLE_ELEMENT (hd, 0);\n";
pr " ETERM *hd_value = ERL_TUPLE_ELEMENT (hd, 1);\n";
pr "\n";
List.iter (
fun argt ->
let n = name_of_argt argt in
let uc_n = String.uppercase n in
pr " if (atom_equals (hd_name, \"%s\")) {\n" n;
pr " optargs_s.bitmask |= GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
pr " optargs_s.%s = " n;
(match argt with
| Bool _ -> pr "get_bool (hd_value)"
| Int _ -> pr "ERL_INT_VALUE (hd_value)"
| Int64 _ -> pr "ERL_LL_VALUE (hd_value)"
| String _ -> pr "erl_iolist_to_string (hd_value)"
| _ -> assert false
);
pr ";\n";
pr " }\n";
pr " else\n";
) optargs;
pr " return unknown_optarg (\"%s\", hd_name);\n" name;
pr " optargst = ERL_CONS_TAIL (optargst);\n";
pr " }\n";
pr "\n";
);
(match ret with
| RErr -> pr " int r;\n"
| RInt _ -> pr " int r;\n"
| RInt64 _ -> pr " int64_t r;\n"
| RBool _ -> pr " int r;\n"
| RConstString _ | RConstOptString _ ->
pr " const char *r;\n"
| RString _ -> pr " char *r;\n"
| RStringList _ ->
pr " size_t i;\n";
pr " char **r;\n"
| RStruct (_, typ) ->
pr " struct guestfs_%s *r;\n" typ
| RStructList (_, typ) ->
pr " struct guestfs_%s_list *r;\n" typ
| RHashtable _ ->
pr " size_t i;\n";
pr " char **r;\n"
| RBufferOut _ ->
pr " char *r;\n";
pr " size_t size;\n"
);
pr "\n";
if optargs = [] then
pr " r = guestfs_%s " name
else
pr " r = guestfs_%s_argv " name;
generate_c_call_args ~handle:"g" style;
pr ";\n";
(* Free strings if we copied them above. *)
List.iter (
function
| Pathname n | Device n | Dev_or_Path n | String n | OptString n
| FileIn n | FileOut n | BufferIn n | Key n ->
pr " free (%s);\n" n
| StringList n | DeviceList n ->
pr " free_strings (%s);\n" n;
| Bool _ | Int _ | Int64 _ | Pointer _ -> ()
) args;
List.iter (
function
| String n ->
let uc_n = String.uppercase n in
pr " if ((optargs_s.bitmask & GUESTFS_%s_%s_BITMASK))\n"
uc_name uc_n;
pr " free ((char *) optargs_s.%s);\n" n
| Bool _ | Int _ | Int64 _
| Pathname _ | Device _ | Dev_or_Path _ | OptString _
| FileIn _ | FileOut _ | BufferIn _ | Key _
| StringList _ | DeviceList _ | Pointer _ -> ()
) optargs;
(match errcode_of_ret ret with
| `CannotReturnError -> ()
| `ErrorIsMinusOne ->
pr " if (r == -1)\n";
pr " return make_error (\"%s\");\n" name;
| `ErrorIsNULL ->
pr " if (r == NULL)\n";
pr " return make_error (\"%s\");\n" name;
);
pr "\n";
(match ret with
| RErr -> pr " return erl_mk_atom (\"ok\");\n"
| RInt _ -> pr " return erl_mk_int (r);\n"
| RInt64 _ -> pr " return erl_mk_longlong (r);\n"
| RBool _ -> pr " return make_bool (r);\n"
| RConstString _ -> pr " return erl_mk_string (r);\n"
| RConstOptString _ ->
pr " ETERM *rt;\n";
pr " if (r)\n";
pr " rt = erl_mk_string (r);\n";
pr " else\n";
pr " rt = erl_mk_atom (\"undefined\");\n";
pr " return rt;\n"
| RString _ ->
pr " ETERM *rt = erl_mk_string (r);\n";
pr " free (r);\n";
pr " return rt;\n"
| RStringList _ ->
pr " ETERM *rt = make_string_list (r);\n";
pr " free_strings (r);\n\n";
pr " return rt;\n"
| RStruct (_, typ) ->
pr " ETERM *rt = make_%s (r);\n" typ;
pr " guestfs_free_%s (r);\n" typ;
pr " return rt;\n"
| RStructList (_, typ) ->
pr " ETERM *rt = make_%s_list (r);\n" typ;
pr " guestfs_free_%s_list (r);\n" typ;
pr " return rt;\n"
| RHashtable _ ->
pr " ETERM *rt = make_table (r);\n";
pr " free_strings (r);\n";
pr " return rt;\n"
| RBufferOut _ ->
pr " ETERM *rt = erl_mk_estring (r, size);\n";
pr " free (r);\n";
pr " return rt;\n"
);
pr "}\n";
pr "\n";
) all_functions_sorted;
pr "\
ETERM *
dispatch (ETERM *message)
{
ETERM *fun;
fun = ERL_TUPLE_ELEMENT (message, 0);
/* XXX We should use gperf here. */
";
List.iter (
fun (name, (ret, args, optargs), _, _, _, _, _) ->
pr "if (atom_equals (fun, \"%s\"))\n" name;
pr " return run_%s (message);\n" name;
pr " else ";
) all_functions_sorted;
pr "return unknown_function (fun);
}
";

3
generator/generator_main.ml
View File

@@ -38,6 +38,7 @@ open Generator_java
open Generator_haskell
open Generator_csharp
open Generator_php
open Generator_erlang
open Generator_bindtests
open Generator_errnostring
@@ -132,6 +133,8 @@ Run it from the top source directory using the command
output_to "csharp/Libguestfs.cs" generate_csharp;
output_to "php/extension/php_guestfs_php.h" generate_php_h;
output_to "php/extension/guestfs_php.c" generate_php_c;
output_to "erlang/guestfs.erl" generate_erlang_erl;
output_to "erlang/erl-guestfs.c" generate_erlang_c;
(* Generate the list of files generated -- last. *)
printf "generated %d lines of code\n" (get_lines_generated ());

1
java/examples/guestfs-java.pod
View File

@@ -46,6 +46,7 @@ Calling any method on a closed handle raises the same exception.
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-erlang(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,
L<guestfs-python(3)>,

1
ocaml/examples/guestfs-ocaml.pod
View File

@@ -79,6 +79,7 @@ function that you called.
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-erlang(3)>,
L<guestfs-java(3)>,
L<guestfs-perl(3)>,
L<guestfs-python(3)>,

1
perl/examples/guestfs-perl.pod
View File

@@ -41,6 +41,7 @@ C<croak> (see L<Carp(3)>).
L<Sys::Guestfs(3)>,
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-erlang(3)>,
L<guestfs-java(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-python(3)>,

2
po/POTFILES.in
View File

@@ -81,6 +81,8 @@ df/domains.c
df/main.c
df/output.c
edit/virt-edit.c
erlang/erl-guestfs-proto.c
erlang/erl-guestfs.c
fish/alloc.c
fish/cmds.c
fish/cmds_gperf.c

1
python/examples/guestfs-python.pod
View File

@@ -43,6 +43,7 @@ Type:
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-erlang(3)>,
L<guestfs-java(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,

1
ruby/examples/guestfs-ruby.pod
View File

@@ -37,6 +37,7 @@ string).
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-erlang(3)>,
L<guestfs-java(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,

11
src/guestfs.pod
View File

@@ -42,8 +42,8 @@ FUSE.
Libguestfs is a library that can be linked with C and C++ management
programs (or management programs written in OCaml, Perl, Python, Ruby,
Java, PHP, Haskell or C#). You can also use it from shell scripts or the
command line.
Java, PHP, Erlang, Haskell or C#). You can also use it from shell
scripts or the command line.
You don't need to be root to use libguestfs, although obviously you do
need enough permissions to access the disk images.
@@ -719,6 +719,10 @@ used.
The C# bindings are highly experimental. Please read the warnings
at the top of C<csharp/Libguestfs.cs>.
=item B<Erlang>
See L<guestfs-erlang(3)>.
=item B<Haskell>
This is the only language binding that is working but incomplete.
@@ -2898,6 +2902,8 @@ will work with libguestfs.
=item C<csharp>
=item C<erlang>
=item C<haskell>
=item C<java>
@@ -3135,6 +3141,7 @@ enough.
=head1 SEE ALSO
L<guestfs-examples(3)>,
L<guestfs-erlang(3)>,
L<guestfs-java(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,