Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 00/12] Allow APIs to be implemented in OCaml.
Version 1 was here: https://www.redhat.com/archives/libguestfs/2017-June/msg00003.html This patch series reimplements a few more APIs in OCaml, including some very important core APIs like ?list_filesystems? and ?mount?. All the tests pass after this. The selection of APIs that I have moved may look a little random, but in fact they are all APIs consumed by the inspection code (and some more which I haven't submitted yet). This patch series makes it easier to implement inspection in the daemon. Code size is smaller, and code is simpler. The major security benefits will come as we move more APIs, especially inspection, into the daemon where they run in a sandbox. That is only possible because we don't have to write everything in C. The daemon grows in disk size slightly, from 3.1 MB to 4.6 MB. That growth (1.5 MB) compared to the whole appliance (296 MB) is a third of one percent, so not really noticable. Rich.
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 01/12] daemon: Allow parts of the daemon to be written in OCaml.
This change allows parts of the daemon to be written in the OCaml
programming language. I am using the ?Main Program in C? method along
with ?-output-obj? to create an object file from the OCaml code /
runtime, as described here:
https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html
This change doesn't make any functional changes yet. There is simply
an empty ?daemon.ml? file.
Note that the OCaml compiler (either ocamlc or ocamlopt) is now
required even for building from tarballs.
---
.gitignore | 9 ++++-
daemon/Makefile.am | 85 +++++++++++++++++++++++++++++++++++++++++++++--
daemon/daemon.ml | 17 ++++++++++
daemon/guestfsd.c | 5 +++
docs/guestfs-building.pod | 10 +++---
mllib/Makefile.am | 2 +-
6 files changed, 120 insertions(+), 8 deletions(-)
create mode 100644 daemon/daemon.ml
diff --git a/.gitignore b/.gitignore
index 69e1ae160..08d6e1863 100644
--- a/.gitignore
+++ b/.gitignore
@@ -154,22 +154,29 @@ Makefile.in
/customize/test-settings-*.sh
/customize/virt-customize
/customize/virt-customize.1
+/daemon/.depend
/daemon/actions.h
+/daemon/common_utils.ml
+/daemon/common_utils.mli
/daemon/dispatch.c
+/daemon/guestfs_config.ml
/daemon/guestfsd
/daemon/guestfsd.8
/daemon/guestfsd.exe
/daemon/install-sh
+/daemon/lvm-tokenization.c
/daemon/missing
/daemon/names.c
/daemon/optgroups.c
/daemon/optgroups.h
-/daemon/lvm-tokenization.c
/daemon/stamp-guestfsd.pod
/daemon/structs-cleanups.c
/daemon/structs-cleanups.h
/daemon/stubs-?.c
/daemon/stubs.h
+/daemon/unix_utils-c.c
+/daemon/unix_utils.ml
+/daemon/unix_utils.mli
/depcomp
/df/stamp-virt-df.pod
/df/virt-df
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 0d3dde516..3054fc444 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -38,6 +38,7 @@ BUILT_SOURCES = \
EXTRA_DIST = \
$(BUILT_SOURCES) \
+ $(SOURCES_MLI) $(SOURCES_ML) \
guestfsd.pod
if INSTALL_DAEMON
@@ -165,6 +166,7 @@ guestfsd_SOURCES = \
truncate.c \
umask.c \
upload.c \
+ unix_utils-c.c \
utimens.c \
utsname.c \
uuids.c \
@@ -175,9 +177,13 @@ guestfsd_SOURCES = \
zero.c \
zerofree.c
+guestfsd_LDFLAGS = \
+ -L$(shell $(OCAMLC) -where) \
+ -L$(shell $(OCAMLC) -where)/hivex
guestfsd_LDADD = \
../common/errnostring/liberrnostring.la \
../common/protocol/libprotocol.la \
+ camldaemon.o \
$(ACL_LIBS) \
$(CAP_LIBS) \
$(YAJL_LIBS) \
@@ -196,9 +202,12 @@ guestfsd_LDADD = \
$(PCRE_LIBS) \
$(TSK_LIBS) \
$(RPC_LIBS) \
- $(YARA_LIBS)
+ $(YARA_LIBS) \
+ $(OCAML_LIBS)
guestfsd_CPPFLAGS = \
+ -I$(shell $(OCAMLC) -where) \
+ -I$(shell $(OCAMLC) -where)/hivex \
-I$(top_srcdir)/gnulib/lib \
-I$(top_builddir)/gnulib/lib \
-I$(top_srcdir)/lib \
@@ -216,6 +225,78 @@ guestfsd_CFLAGS = \
$(YAJL_CFLAGS) \
$(PCRE_CFLAGS)
+# Parts of the daemon are written in OCaml. These are linked into a
+# library and then linked to the daemon. See
+# https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html
+SOURCES_MLI = \
+ common_utils.mli \
+ unix_utils.mli
+
+SOURCES_ML = \
+ guestfs_config.ml \
+ unix_utils.ml \
+ common_utils.ml \
+ daemon.ml
+
+BOBJECTS = $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+OCAMLPACKAGES = -package str,unix,hivex
+
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_FLAGS)
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+OCAML_LIBS = -lmlhivex -lcamlstr -lunix -lcamlrun -ldl -lm
+else
+OBJECTS = $(XOBJECTS)
+OCAML_LIBS = -lmlhivex -lcamlstr -lunix -lasmrun -ldl -lm
+endif
+
+CLEANFILES += camldaemon.o
+
+camldaemon.o: $(OBJECTS)
+ $(OCAMLFIND) $(BEST) -output-obj -o $@ \
+ $(OCAMLFLAGS) $(OCAMLPACKAGES) -linkpkg $(OBJECTS)
+
+# We share common_utils.ml{,i}, guestfs_config.ml and unix_utils*
+# with the mllib directory.
+#
+# For common_utils we have to remove functions which depend on any
+# modules which are not part of the OCaml stdlib.
+common_utils.ml: $(top_srcdir)/mllib/common_utils.ml
+ rm -f $@ $@-t
+ echo '(* This file is generated from mllib/common_utils.ml *)' >
$@-t
+ sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $<
>> $@-t
+ mv $@-t $@
+common_utils.mli: $(top_srcdir)/mllib/common_utils.mli
+ rm -f $@ $@-t
+ echo '(* This file is generated from mllib/common_utils.mli *)' >
$@-t
+ sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $<
>> $@-t
+ mv $@-t $@
+guestfs_config.ml: ../mllib/guestfs_config.ml
+ cp $< $@
+unix_utils-c.c: ../mllib/unix_utils-c.c
+ cp $< $@
+unix_utils.ml: ../mllib/unix_utils.ml
+ cp $< $@
+unix_utils.mli: ../mllib/unix_utils.mli
+ cp $< $@
+
+# OCaml dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
common_utils.ml common_utils.mli guestfs_config.ml unix_utils.ml unix_utils.mli
+ rm -f $@ $@-t
+ $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I
$(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \
+ $(SED) 's/ *$$//' | \
+ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+ sort > $@-t
+ mv $@-t $@
+
+-include .depend
+
# Manual pages and HTML files for the website.
if INSTALL_DAEMON
man_MANS = guestfsd.8
@@ -237,4 +318,4 @@ stamp-guestfsd.pod: guestfsd.pod
$<
touch $@
-.PHONY: force
+.PHONY: depend force
diff --git a/daemon/daemon.ml b/daemon/daemon.ml
new file mode 100644
index 000000000..27d77a161
--- /dev/null
+++ b/daemon/daemon.ml
@@ -0,0 +1,17 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
diff --git a/daemon/guestfsd.c b/daemon/guestfsd.c
index db2bb702f..02fc27d32 100644
--- a/daemon/guestfsd.c
+++ b/daemon/guestfsd.c
@@ -56,6 +56,8 @@
#include <augeas.h>
+#include <caml/callback.h>
+
#include "sockets.h"
#include "c-ctype.h"
#include "ignore-value.h"
@@ -348,6 +350,9 @@ main (int argc, char *argv[])
*/
udev_settle ();
+ /* Initialize the OCaml stubs. */
+ caml_startup (argv);
+
/* Send the magic length message which indicates that
* userspace is up inside the guest.
*/
diff --git a/docs/guestfs-building.pod b/docs/guestfs-building.pod
index 0f9ed2893..4e1ff7df4 100644
--- a/docs/guestfs-building.pod
+++ b/docs/guestfs-building.pod
@@ -120,8 +120,7 @@ I<Required>. Part of Perl core.
=item OCaml findlib
-I<Required> if compiling from git.
-Optional (but recommended) if compiling from tarball.
+I<Required>.
=item autoconf
@@ -594,8 +593,11 @@ See L</USING A PREBUILT BINARY APPLIANCE> below.
Disable specific language bindings, even if C<./configure> finds all
the necessary libraries are installed so that they could be compiled.
-Note that disabling OCaml or Perl will have the knock-on effect of
-disabling large numbers of virt tools and parts of the test suite.
+Note that disabling Perl will have the knock-on effect of disabling
+parts of the test suite and some tools.
+
+Disabling OCaml only disables the bindings and several virt tools.
+OCaml is required to build libguestfs.
=item B<--disable-fuse>
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index ee2f1a7a8..8e2d3a8a0 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -49,9 +49,9 @@ SOURCES_ML = \
$(OCAML_BYTES_COMPAT_ML) \
libdir.ml \
stringMap.ml \
+ unix_utils.ml \
common_gettext.ml \
getopt.ml \
- unix_utils.ml \
common_utils.ml \
progress.ml \
URI.ml \
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 02/12] generator: Allow APIs to be implemented in OCaml.
Change the generator to allow individual APIs to be implemented in
OCaml. This is picked by setting:
impl = OCaml <ocaml_function>;
The generator creates ?do_function? (the same one you would have to
write by hand in C), with the function calling the named
?ocaml_function? and dealing with marshalling/unmarshalling the OCaml
parameters.
---
.gitignore | 3 +
daemon/Makefile.am | 36 ++++++++--
daemon/chroot.ml | 85 ++++++++++++++++++++++
daemon/chroot.mli | 35 +++++++++
daemon/daemon-c.c | 35 +++++++++
daemon/daemon.ml | 22 ++++++
daemon/guestfsd.c | 40 +++++++++++
daemon/sysroot-c.c | 37 ++++++++++
daemon/sysroot.ml | 19 +++++
daemon/sysroot.mli | 22 ++++++
daemon/utils.ml | 156 ++++++++++++++++++++++++++++++++++++++++
daemon/utils.mli | 65 +++++++++++++++++
docs/guestfs-hacking.pod | 7 ++
generator/actions.ml | 5 ++
generator/actions.mli | 4 ++
generator/daemon.ml | 183 +++++++++++++++++++++++++++++++++++++++++++++++
generator/daemon.mli | 3 +
generator/main.ml | 6 ++
generator/types.ml | 7 +-
19 files changed, 765 insertions(+), 5 deletions(-)
create mode 100644 daemon/chroot.ml
create mode 100644 daemon/chroot.mli
create mode 100644 daemon/daemon-c.c
create mode 100644 daemon/sysroot-c.c
create mode 100644 daemon/sysroot.ml
create mode 100644 daemon/sysroot.mli
create mode 100644 daemon/utils.ml
create mode 100644 daemon/utils.mli
diff --git a/.gitignore b/.gitignore
index 08d6e1863..69b824a74 100644
--- a/.gitignore
+++ b/.gitignore
@@ -156,6 +156,8 @@ Makefile.in
/customize/virt-customize.1
/daemon/.depend
/daemon/actions.h
+/daemon/callbacks.ml
+/daemon/caml-stubs.c
/daemon/common_utils.ml
/daemon/common_utils.mli
/daemon/dispatch.c
@@ -174,6 +176,7 @@ Makefile.in
/daemon/structs-cleanups.h
/daemon/stubs-?.c
/daemon/stubs.h
+/daemon/types.ml
/daemon/unix_utils-c.c
/daemon/unix_utils.ml
/daemon/unix_utils.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 3054fc444..30d24f1ad 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -19,6 +19,7 @@ include $(top_srcdir)/subdir-rules.mk
generator_built = \
actions.h \
+ caml-stubs.c \
dispatch.c \
names.c \
lvm-tokenization.c \
@@ -31,13 +32,29 @@ generator_built = \
stubs-4.c \
stubs-5.c \
stubs-6.c \
- stubs.h
+ stubs.h \
+ callbacks.ml \
+ types.ml
BUILT_SOURCES = \
- $(generator_built)
+ actions.h \
+ caml-stubs.c \
+ dispatch.c \
+ names.c \
+ lvm-tokenization.c \
+ structs-cleanups.c \
+ structs-cleanups.h \
+ stubs-0.c \
+ stubs-1.c \
+ stubs-2.c \
+ stubs-3.c \
+ stubs-4.c \
+ stubs-5.c \
+ stubs-6.c \
+ stubs.h
EXTRA_DIST = \
- $(BUILT_SOURCES) \
+ $(generator_built) \
$(SOURCES_MLI) $(SOURCES_ML) \
guestfsd.pod
@@ -60,6 +77,7 @@ guestfsd_SOURCES = \
blkid.c \
blockdev.c \
btrfs.c \
+ caml-stubs.c \
cap.c \
checksum.c \
cleanups.c \
@@ -71,6 +89,7 @@ guestfsd_SOURCES = \
copy.c \
cpio.c \
cpmv.c \
+ daemon-c.c \
daemon.h \
dd.c \
debug.c \
@@ -161,6 +180,7 @@ guestfsd_SOURCES = \
swap.c \
sync.c \
syslinux.c \
+ sysroot-c.c \
tar.c \
tsk.c \
truncate.c \
@@ -229,13 +249,21 @@ guestfsd_CFLAGS = \
# library and then linked to the daemon. See
# https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html
SOURCES_MLI = \
+ chroot.mli \
common_utils.mli \
- unix_utils.mli
+ sysroot.mli \
+ unix_utils.mli \
+ utils.mli
SOURCES_ML = \
guestfs_config.ml \
unix_utils.ml \
common_utils.ml \
+ types.ml \
+ utils.ml \
+ sysroot.ml \
+ chroot.ml \
+ callbacks.ml \
daemon.ml
BOBJECTS = $(SOURCES_ML:.ml=.cmo)
diff --git a/daemon/chroot.ml b/daemon/chroot.ml
new file mode 100644
index 000000000..14dcbc494
--- /dev/null
+++ b/daemon/chroot.ml
@@ -0,0 +1,85 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Printf
+open Unix
+
+open Common_utils
+open Unix_utils
+
+type t = {
+ name : string;
+ chroot : string;
+}
+
+let create ?(name = prog) chroot + { name = name; chroot = chroot }
+
+let f t func arg + if verbose () then
+ eprintf "chroot: %s: running ?%s?\n%!" t.chroot t.name;
+
+ let rfd, wfd = pipe () in
+
+ let pid = fork () in
+ if pid = 0 then (
+ (* Child. *)
+ close rfd;
+
+ chdir t.chroot;
+ chroot t.chroot;
+
+ let ret + try Either (func arg)
+ with exn -> Or exn in
+
+ try
+ let chan = out_channel_of_descr wfd in
+ output_value chan ret;
+ Pervasives.flush chan;
+ Exit._exit 0
+ with
+ exn ->
+ prerr_endline (Printexc.to_string exn);
+ Exit._exit 1
+ );
+
+ (* Parent. *)
+ close wfd;
+
+ let _, status = waitpid [] pid in
+ (match status with
+ | WEXITED 0 -> ()
+ | WEXITED i ->
+ close rfd;
+ failwithf "chroot ?%s? exited with non-zero error %d" t.name i
+ | WSIGNALED i ->
+ close rfd;
+ failwithf "chroot ?%s? killed by signal %d" t.name i
+ | WSTOPPED i ->
+ close rfd;
+ failwithf "chroot ?%s? stopped by signal %d" t.name i
+ );
+
+ let chan = in_channel_of_descr rfd in
+ let ret = input_value chan in
+ close_in chan;
+
+ match ret with
+ | Either ret -> ret
+ | Or exn -> raise exn
diff --git a/daemon/chroot.mli b/daemon/chroot.mli
new file mode 100644
index 000000000..eda3a785f
--- /dev/null
+++ b/daemon/chroot.mli
@@ -0,0 +1,35 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+(** This is a generic module for running functions in a chroot.
+ The function runs in a forked subprocess too so that we can
+ restore the root afterwards.
+
+ It handles passing the parmeter, forking, running the
+ function and marshalling the result or any exceptions. *)
+
+type t
+
+val create : ?name:string -> string -> t
+(** Create a chroot handle. [?name] is an optional name used in
+ debugging and error messages. The string is the chroot
+ directory. *)
+
+val f : t -> ('a -> 'b) -> 'a -> 'b
+(** Run a function in the chroot, returning the result or re-raising
+ any exception thrown. *)
diff --git a/daemon/daemon-c.c b/daemon/daemon-c.c
new file mode 100644
index 000000000..da382bc35
--- /dev/null
+++ b/daemon/daemon-c.c
@@ -0,0 +1,35 @@
+/* guestfs-inspection
+ * Copyright (C) 2017 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 <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <caml/mlvalues.h>
+
+#include "daemon.h"
+
+extern value guestfs_int_daemon_get_verbose_flag (value unitv);
+
+/* NB: This is a "noalloc" call. */
+value
+guestfs_int_daemon_get_verbose_flag (value unitv)
+{
+ return Val_bool (verbose);
+}
diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index 27d77a161..5a103f6a6 100644
--- a/daemon/daemon.ml
+++ b/daemon/daemon.ml
@@ -15,3 +15,25 @@
* with this program; if not, write to the Free Software Foundation, Inc.,
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+
+open Printf
+
+external get_verbose_flag : unit -> bool +
"guestfs_int_daemon_get_verbose_flag" "noalloc"
+
+(* When guestfsd starts up, after initialization but before accepting
+ * messages, it calls 'caml_startup' which runs all initialization code
+ * in the OCaml modules, including this one. Therefore this is where
+ * we can place OCaml initialization code for the daemon.
+ *)
+let () + (* Connect the guestfsd [-v] (verbose) flag into 'verbose ()'
+ * used in OCaml code to print debugging messages.
+ *)
+ if get_verbose_flag () then (
+ Common_utils.set_verbose ();
+ eprintf "OCaml daemon loaded\n%!"
+ );
+
+ (* Register the callbacks which are used to call OCaml code from C. *)
+ Callbacks.init_callbacks ()
diff --git a/daemon/guestfsd.c b/daemon/guestfsd.c
index 02fc27d32..9b6ae02b1 100644
--- a/daemon/guestfsd.c
+++ b/daemon/guestfsd.c
@@ -57,6 +57,8 @@
#include <augeas.h>
#include <caml/callback.h>
+#include <caml/mlvalues.h>
+#include <caml/unixsupport.h>
#include "sockets.h"
#include "c-ctype.h"
@@ -1274,3 +1276,41 @@ cleanup_free_mountable (mountable_t *mountable)
free (mountable->volume);
}
}
+
+/* Convert an OCaml exception to a reply_with_error_errno call
+ * as best we can.
+ */
+extern void ocaml_exn_to_reply_with_error (const char *func, value exn);
+
+void
+ocaml_exn_to_reply_with_error (const char *func, value exn)
+{
+ const char *exn_name;
+
+ /* This is not the official way to do this, but I could not get the
+ * official way to work, and this way does work. See
+ *
http://caml.inria.fr/pub/ml-archives/caml-list/2006/05/097f63cfb39a80418f95c70c3c520aa8.en.html
+ *
http://caml.inria.fr/pub/ml-archives/caml-list/2009/06/797e2f797f57b8ea2a2c0e431a2df312.en.html
+ */
+ exn_name = String_val (Field (Field (exn, 0), 0));
+ if (verbose)
+ fprintf (stderr, "ocaml_exn: '%s' raised '%s'
exception\n",
+ func, exn_name);
+
+ if (STREQ (exn_name, "Unix.Unix_error")) {
+ int errcode = code_of_unix_error (Field (exn, 1));
+ reply_with_perror_errno (errcode, "%s: %s",
+ String_val (Field (exn, 2)),
+ String_val (Field (exn, 3)));
+ }
+ else if (STREQ (exn_name, "Failure"))
+ reply_with_error ("%s", String_val (Field (exn, 1)));
+ else if (STREQ (exn_name, "Sys_error"))
+ reply_with_error ("%s", String_val (Field (exn, 1)));
+ else if (STREQ (exn_name, "Invalid_argument"))
+ reply_with_error ("invalid argument: %s",
+ String_val (Field (exn, 1)));
+ else
+ reply_with_error ("internal error: %s: unknown exception thrown:
%s",
+ func, exn_name);
+}
diff --git a/daemon/sysroot-c.c b/daemon/sysroot-c.c
new file mode 100644
index 000000000..ad31d36ee
--- /dev/null
+++ b/daemon/sysroot-c.c
@@ -0,0 +1,37 @@
+/* guestfs-inspection
+ * Copyright (C) 2017 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 <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#include "daemon.h"
+
+extern value guestfs_int_daemon_sysroot (value unitv);
+
+value
+guestfs_int_daemon_sysroot (value unitv)
+{
+ return caml_copy_string (sysroot);
+}
diff --git a/daemon/sysroot.ml b/daemon/sysroot.ml
new file mode 100644
index 000000000..ecf0d7362
--- /dev/null
+++ b/daemon/sysroot.ml
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+external sysroot : unit -> string = "guestfs_int_daemon_sysroot"
diff --git a/daemon/sysroot.mli b/daemon/sysroot.mli
new file mode 100644
index 000000000..88f976476
--- /dev/null
+++ b/daemon/sysroot.mli
@@ -0,0 +1,22 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val sysroot : unit -> string
+(** Return the current sysroot path where filesystems are mounted.
+ This comes from the daemon command line ([-r] option) or a built
+ in default. *)
diff --git a/daemon/utils.ml b/daemon/utils.ml
new file mode 100644
index 000000000..a97892d99
--- /dev/null
+++ b/daemon/utils.ml
@@ -0,0 +1,156 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Unix
+open Printf
+
+open Common_utils
+
+let prog_exists prog + try ignore (which prog); true
+ with Executable_not_found _ -> false
+
+let commandr prog args + if verbose () then
+ eprintf "command: %s %s\n%!"
+ prog (String.concat " " args);
+
+ let argv = Array.of_list (prog :: args) in
+
+ let stdout_file, stdout_chan = Filename.open_temp_file "cmd"
".out" in
+ let stderr_file, stderr_chan = Filename.open_temp_file "cmd"
".err" in
+ let stdout_fd = descr_of_out_channel stdout_chan in
+ let stderr_fd = descr_of_out_channel stderr_chan in
+ let stdin_fd = openfile "/dev/null" [O_RDONLY] 0 in
+
+ let pid = fork () in
+ if pid = 0 then (
+ (* Child process. *)
+ dup2 stdin_fd stdin;
+ close stdin_fd;
+ dup2 stdout_fd stdout;
+ close stdout_fd;
+ dup2 stderr_fd stderr;
+ close stderr_fd;
+
+ execvp prog argv
+ );
+
+ (* Parent process. *)
+ close stdin_fd;
+ close stdout_fd;
+ close stderr_fd;
+ let _, status = waitpid [] pid in
+ let r + match status with
+ | WEXITED i -> i
+ | WSIGNALED i ->
+ failwithf "external command ?%s? killed by signal %d" prog i
+ | WSTOPPED i ->
+ failwithf "external command ?%s? stopped by signal %d" prog i
in
+
+ if verbose () then
+ eprintf "command: %s returned %d\n" prog r;
+
+ let stdout = read_whole_file stdout_file in
+ let stderr = read_whole_file stderr_file in
+
+ if verbose () then (
+ if stdout <> "" then (
+ eprintf "command: %s: stdout:\n%s" prog stdout;
+ if not (String.is_suffix stdout "\n") then eprintf
"\n"
+ );
+ if stderr <> "" then (
+ eprintf "command: %s: stderr:\n%s" prog stderr;
+ if not (String.is_suffix stderr "\n") then eprintf
"\n"
+ )
+ );
+
+ (* Strip trailing \n from stderr but NOT from stdout. *)
+ let stderr + let n = String.length stderr in
+ if n > 0 && stderr.[n-1] = '\n' then
+ String.sub stderr 0 (n-1)
+ else
+ stderr in
+
+ (r, stdout, stderr)
+
+let command prog args + let r, stdout, stderr = commandr prog args in
+ if r <> 0 then
+ failwithf "%s exited with status %d: %s" prog r stderr;
+ stdout
+
+let udev_settle ?filename () + let args = ref [] in
+ if verbose () then
+ push_back args "--debug";
+ push_back args "settle";
+ (match filename with
+ | None -> ()
+ | Some filename ->
+ push_back args "-E";
+ push_back args filename
+ );
+ let args = !args in
+ let r, _, err = commandr "udevadm" args in
+ if r <> 0 then
+ eprintf "udevadm settle: %s\n" err
+
+let root_device = lazy ((stat "/").st_dev)
+
+let is_root_device_stat statbuf + statbuf.st_rdev = Lazy.force root_device
+
+let is_root_device device + udev_settle ~filename:device ();
+ try
+ let statbuf = stat device in
+ is_root_device_stat statbuf
+ with
+ Unix_error (err, func, arg) ->
+ eprintf "is_root_device: %s: %s: %s: %s\n"
+ device func arg (error_message err);
+ false
+
+let proc_unmangle_path path + let n = String.length path in
+ let b = Buffer.create n in
+ let rec loop i + if i < n-3 && path.[i] = '\\' then (
+ let to_int c = Char.code c - Char.code '0' in
+ let v + (to_int path.[i+1] lsl 6) lor
+ (to_int path.[i+2] lsl 3) lor
+ to_int path.[i+3] in
+ Buffer.add_char b (Char.chr v);
+ loop (i+4)
+ )
+ else if i < n then (
+ Buffer.add_char b path.[i];
+ loop (i+1)
+ )
+ else
+ Buffer.contents b
+ in
+ loop 0
+
+let is_small_file path + is_regular_file path &&
+ (stat path).st_size <= 2 * 1048 * 1024
diff --git a/daemon/utils.mli b/daemon/utils.mli
new file mode 100644
index 000000000..57f703c6c
--- /dev/null
+++ b/daemon/utils.mli
@@ -0,0 +1,65 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val prog_exists : string -> bool
+(** Return true iff the program is found on [$PATH]. *)
+
+val udev_settle : ?filename:string -> unit -> unit
+(**
+ * LVM and other commands aren't synchronous, especially when udev is
+ * involved. eg. You can create or remove some device, but the
+ * [/dev] device node won't appear until some time later. This means
+ * that you get an error if you run one command followed by another.
+ *
+ * Use [udevadm settle] after certain commands, but don't be too
+ * fussed if it fails.
+ *
+ * The optional [?filename] passes the [udevadm settle -E filename]
+ * option, which means udevadm stops waiting as soon as the named
+ * file is created (or if it exists at the start).
+ *)
+
+val is_root_device : string -> bool
+(** Return true if this is the root (appliance) device. *)
+
+val is_root_device_stat : Unix.stats -> bool
+(** As for {!is_root_device} but operates on a statbuf instead of
+ a device name. *)
+
+val proc_unmangle_path : string -> string
+(** Reverse kernel path escaping done in fs/seq_file.c:mangle_path.
+ This is inconsistently used for /proc fields. *)
+
+val command : string -> string list -> string
+(** Run an external command without using the shell, and collect
+ stdout and stderr separately. Returns stdout if the command
+ runs successfully.
+
+ On failure of the command, this throws an exception containing
+ the stderr from the command. *)
+
+val commandr : string -> string list -> (int * string * string)
+(** Run an external command without using the shell, and collect
+ stdout and stderr separately.
+
+ Returns [status, stdout, stderr]. As with the C function in
+ [daemon/command.c], this strips the trailing [\n] from stderr,
+ but {b not} from stdout. *)
+
+val is_small_file : string -> bool
+(** Return true if the path is a small regular file. *)
diff --git a/docs/guestfs-hacking.pod b/docs/guestfs-hacking.pod
index 098869bbd..2d3eb46c6 100644
--- a/docs/guestfs-hacking.pod
+++ b/docs/guestfs-hacking.pod
@@ -386,6 +386,13 @@ in the C<lib/> directory.
In either case, use another function as an example of what to do.
+=item 3.
+
+As an alternative to step 2: Since libguestfs 1.37.15, daemon actions
+can be implemented in OCaml. You have to set the C<impl = OCaml ...>
+flag in the generator. Take a look at F<daemon/file.ml> for an
+example.
+
=back
After making these changes, use C<make> to compile.
diff --git a/generator/actions.ml b/generator/actions.ml
index 2722f3dcd..db69321e4 100644
--- a/generator/actions.ml
+++ b/generator/actions.ml
@@ -185,6 +185,11 @@ let is_fish { visibility = v; style = (_, args, _) }
not (List.exists (function Pointer _ -> true | _ -> false) args)
let fish_functions = List.filter is_fish
+let is_ocaml_function = function
+ | { impl = OCaml _ } -> true
+ | { impl = C } -> false
+let impl_ocaml_functions = List.filter is_ocaml_function
+
(* In some places we want the functions to be displayed sorted
* alphabetically, so this is useful:
*)
diff --git a/generator/actions.mli b/generator/actions.mli
index 0d326b609..82217cbdc 100644
--- a/generator/actions.mli
+++ b/generator/actions.mli
@@ -40,6 +40,10 @@ val internal_functions : Types.action list -> Types.action
list
val fish_functions : Types.action list -> Types.action list
(** Filter {!actions}, returning only functions in guestfish. *)
+val impl_ocaml_functions : Types.action list -> Types.action list
+(** Filter {!actions}, returning only functions implemented
+ in OCaml (in the daemon). *)
+
val documented_functions : Types.action list -> Types.action list
(** Filter {!actions}, returning only functions requiring documentation. *)
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 84686973c..1b5db4c4c 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -471,6 +471,189 @@ let generate_daemon_stubs actions () pr
"}\n\n";
) (actions |> daemon_functions |> sort)
+let generate_daemon_caml_types_ml () + generate_header OCamlStyle GPLv2plus
+
+let generate_daemon_caml_callbacks_ml () + generate_header OCamlStyle
GPLv2plus;
+
+ pr "let init_callbacks () =\n";
+ pr " (* Initialize callbacks to OCaml code. *)\n";
+ List.iter (
+ fun ({ name = name; style = ret, args, optargs } as f) ->
+ let ocaml_function + match f.impl with
+ | OCaml f -> f
+ | C -> assert false in
+
+ pr " Callback.register %S %s;\n" ocaml_function ocaml_function
+ ) (actions |> impl_ocaml_functions |> sort)
+
+(* Generate stubs for the functions implemented in OCaml.
+ * Basically we implement the do_<name> function here, and
+ * have it call out to OCaml code.
+ *)
+let generate_daemon_caml_stubs () + generate_header CStyle GPLv2plus;
+
+ pr "\
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <string.h>
+#include <inttypes.h>
+#include <errno.h>
+
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#include \"daemon.h\"
+#include \"actions.h\"
+
+/* This is not declared in <daemon.h> because we don't want to
+ * include the OCaml headers (to get 'value') for the whole daemon.
+ */
+extern void ocaml_exn_to_reply_with_error (const char *func, value exn);
+
+";
+
+ List.iter (
+ fun ({ name = name; style = ret, args, optargs } as f) ->
+ let ocaml_function + match f.impl with
+ | OCaml f -> f
+ | C -> assert false in
+
+ pr "/* Wrapper for OCaml function ?%s?. */\n" ocaml_function;
+
+ let args_do_function = args @ args_of_optargs optargs in
+ let args_do_function + List.filter (function
+ | String ((FileIn|FileOut), _) -> false | _ -> true)
+ args_do_function in
+ let style = ret, args_do_function, [] in
+ generate_prototype ~extern:false ~semicolon:false
+ ~single_line:false ~newline:false
+ ~in_daemon:true ~prefix:"do_"
+ name style;
+ pr "\n";
+
+ let add_unit_arg + let args = List.filter
+ (function
+ | String ((FileIn|FileOut), _) -> false | _ ->
true)
+ args in
+ args = [] in
+ let nr_args = List.length args_do_function in
+
+ pr "{\n";
+ pr " static value *cb = NULL;\n";
+ pr " CAMLparam0 ();\n";
+ pr " CAMLlocal2 (v, retv);\n";
+ pr " CAMLlocalN (args, %d);\n"
+ (nr_args + if add_unit_arg then 1 else 0);
+ pr "\n";
+ pr " if (cb == NULL)\n";
+ pr " cb = caml_named_value (\"%s\");\n"
ocaml_function;
+ pr "\n";
+
+ (* Construct the actual call, but note that we want to pass
+ * the optional arguments first in the list.
+ *)
+ let i = ref 0 in
+ List.iter (
+ fun optarg ->
+ let n = name_of_optargt optarg in
+ let uc_n = String.uppercase_ascii n in
+
+ (* optargs are all passed as [None|Some _] *)
+ pr " if ((optargs_bitmask & %s_%s_BITMASK) == 0)\n"
+ f.c_optarg_prefix uc_n;
+ pr " args[%d] = Val_int (0); /* None */\n" !i;
+ pr " else {\n";
+ pr " v = ";
+ (match optarg with
+ | OBool _ ->
+ pr "Val_bool (%s)" n;
+ | OInt _ -> assert false
+ | OInt64 _ -> assert false
+ | OString _ -> assert false
+ | OStringList _ -> assert false
+ );
+ pr ";\n";
+ pr " args[%d] = caml_alloc (1, 0);\n" !i;
+ pr " Store_field (args[%d], 0, v);\n" !i;
+ pr " }\n";
+ incr i
+ ) optargs;
+ List.iter (
+ fun arg ->
+ pr " args[%d] = " !i;
+ (match arg with
+ | Bool n -> pr "Val_bool (%s)" n
+ | Int n -> pr "Val_int (%s)" n
+ | Int64 n -> pr "caml_copy_int64 (%s)" n
+ | String (_, n) -> pr "caml_copy_string (%s)" n
+ | OptString _ -> assert false
+ | StringList _ -> assert false
+ | BufferIn _ -> assert false
+ | Pointer _ -> assert false
+ );
+ pr ";\n";
+ incr i
+ ) args;
+ assert (!i = nr_args);
+
+ (* If there are no non-optional arguments, we add a unit arg. *)
+ if add_unit_arg then
+ pr " args[%d] = Val_unit;\n" !i;
+
+ pr " retv = caml_callbackN_exn (*cb, %d, args);\n"
+ (nr_args + if add_unit_arg then 1 else 0);
+ pr "\n";
+ pr " if (Is_exception_result (retv)) {\n";
+ pr " retv = Extract_exception (retv);\n";
+ pr " ocaml_exn_to_reply_with_error (%S, retv);\n" name;
+ (match errcode_of_ret ret with
+ | `CannotReturnError ->
+ pr " CAMLreturn0;\n"
+ | `ErrorIsMinusOne ->
+ pr " CAMLreturnT (int, -1);\n"
+ | `ErrorIsNULL ->
+ pr " CAMLreturnT (void *, NULL);\n"
+ );
+ pr " }\n";
+ pr "\n";
+
+ (match ret with
+ | RErr -> assert false
+ | RInt _ -> assert false
+ | RInt64 _ -> assert false
+ | RBool _ -> assert false
+ | RConstString _ -> assert false
+ | RConstOptString _ -> assert false
+ | RString _ ->
+ pr " char *ret = strdup (String_val (retv));\n";
+ pr " if (ret == NULL) {\n";
+ pr " reply_with_perror (\"strdup\");\n";
+ pr " CAMLreturnT (char *, NULL);\n";
+ pr " }\n";
+ pr " CAMLreturnT (char *, ret); /* caller frees */\n"
+ | RStringList _ -> assert false
+ | RStruct _ -> assert false
+ | RStructList _ -> assert false
+ | RHashtable _ -> assert false
+ | RBufferOut _ -> assert false
+ );
+ pr "}\n";
+ pr "\n"
+ ) (actions |> impl_ocaml_functions |> sort)
+
let generate_daemon_dispatch () generate_header CStyle GPLv2plus;
diff --git a/generator/daemon.mli b/generator/daemon.mli
index ff008bf85..314a6da8f 100644
--- a/generator/daemon.mli
+++ b/generator/daemon.mli
@@ -19,6 +19,9 @@
val generate_daemon_actions_h : unit -> unit
val generate_daemon_stubs_h : unit -> unit
val generate_daemon_stubs : Types.action list -> unit -> unit
+val generate_daemon_caml_stubs : unit -> unit
+val generate_daemon_caml_callbacks_ml : unit -> unit
+val generate_daemon_caml_types_ml : unit -> unit
val generate_daemon_dispatch : unit -> unit
val generate_daemon_lvm_tokenization : unit -> unit
val generate_daemon_names : unit -> unit
diff --git a/generator/main.ml b/generator/main.ml
index d4316c085..cb39cb610 100644
--- a/generator/main.ml
+++ b/generator/main.ml
@@ -133,6 +133,12 @@ Run it from the top source directory using the command
Daemon.generate_daemon_stubs_h;
output_to_subset "daemon/stubs-%d.c"
Daemon.generate_daemon_stubs;
+ output_to "daemon/caml-stubs.c"
+ Daemon.generate_daemon_caml_stubs;
+ output_to "daemon/callbacks.ml"
+ Daemon.generate_daemon_caml_callbacks_ml;
+ output_to "daemon/types.ml"
+ Daemon.generate_daemon_caml_types_ml;
output_to "daemon/dispatch.c"
Daemon.generate_daemon_dispatch;
output_to "daemon/names.c"
diff --git a/generator/types.ml b/generator/types.ml
index 740bc7750..fb6c3bc06 100644
--- a/generator/types.ml
+++ b/generator/types.ml
@@ -379,11 +379,16 @@ type deprecated_by | Replaced_by of string (*
replaced by another function *)
| Deprecated_no_replacement (* deprecated with no replacement *)
+type impl + | C (* implemented in C by
"do_<name>" *)
+ | OCaml of string (* implemented in OCaml by named function *)
+
(* Type of an action as declared in Actions module. *)
type action = {
name : string; (* name, not including "guestfs_"
*)
added : version; (* which version was the API first added *)
style : style; (* args and return value *)
+ impl : impl; (* implementation language (C or OCaml) *)
proc_nr : int option; (* proc number, None for non-daemon *)
tests : c_api_tests; (* C API tests *)
test_excuse : string; (* if there's no tests ... *)
@@ -439,7 +444,7 @@ type action = {
*)
let defaults = { name = "";
added = (-1,-1,-1);
- style = RErr, [], []; proc_nr = None;
+ style = RErr, [], []; impl = C; proc_nr = None;
tests = []; test_excuse = "";
shortdesc = ""; longdesc = "";
protocol_limit_warning = false; fish_alias = [];
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 03/12] daemon: Reimplement ‘file’ API in OCaml.
?file? is a small, self-contained API which runs a single command, so
it's a good test case for reimplementing APIs.
---
daemon/Makefile.am | 2 ++
daemon/file.c | 80 -----------------------------------------------
daemon/file.ml | 60 +++++++++++++++++++++++++++++++++++
daemon/file.mli | 19 +++++++++++
generator/actions_core.ml | 1 +
5 files changed, 82 insertions(+), 80 deletions(-)
create mode 100644 daemon/file.ml
create mode 100644 daemon/file.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 30d24f1ad..1e16bf328 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -252,6 +252,7 @@ SOURCES_MLI = \
chroot.mli \
common_utils.mli \
sysroot.mli \
+ file.mli \
unix_utils.mli \
utils.mli
@@ -263,6 +264,7 @@ SOURCES_ML = \
utils.ml \
sysroot.ml \
chroot.ml \
+ file.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/file.c b/daemon/file.c
index 84874dc6f..ee79eb507 100644
--- a/daemon/file.c
+++ b/daemon/file.c
@@ -30,7 +30,6 @@
#include "actions.h"
#include "optgroups.h"
-GUESTFSD_EXT_CMD(str_file, file);
GUESTFSD_EXT_CMD(str_zcat, zcat);
GUESTFSD_EXT_CMD(str_bzcat, bzcat);
@@ -449,85 +448,6 @@ do_pwrite_device (const char *device, const char *content,
size_t size,
return pwrite_fd (fd, content, size, offset, device, 1);
}
-/* This runs the 'file' command. */
-char *
-do_file (const char *path)
-{
- CLEANUP_FREE char *buf = NULL;
- const char *display_path = path;
- const int is_dev = STRPREFIX (path, "/dev/");
- struct stat statbuf;
-
- if (!is_dev) {
- buf = sysroot_path (path);
- if (!buf) {
- reply_with_perror ("malloc");
- return NULL;
- }
- path = buf;
-
- /* For non-dev, check this is a regular file, else just return the
- * file type as a string (RHBZ#582484).
- */
- if (lstat (path, &statbuf) == -1) {
- reply_with_perror ("lstat: %s", display_path);
- return NULL;
- }
-
- if (! S_ISREG (statbuf.st_mode)) {
- char *ret;
-
- if (S_ISDIR (statbuf.st_mode))
- ret = strdup ("directory");
- else if (S_ISCHR (statbuf.st_mode))
- ret = strdup ("character device");
- else if (S_ISBLK (statbuf.st_mode))
- ret = strdup ("block device");
- else if (S_ISFIFO (statbuf.st_mode))
- ret = strdup ("FIFO");
- else if (S_ISLNK (statbuf.st_mode))
- ret = strdup ("symbolic link");
- else if (S_ISSOCK (statbuf.st_mode))
- ret = strdup ("socket");
- else
- ret = strdup ("unknown, not regular file");
-
- if (ret == NULL)
- reply_with_perror ("strdup");
- return ret;
- }
- }
-
- /* Which flags to use? For /dev paths, follow links because
- * /dev/VG/LV is a symbolic link.
- */
- const char *flags = is_dev ? "-zbsL" : "-zb";
-
- char *out;
- CLEANUP_FREE char *err = NULL;
- int r = command (&out, &err, str_file, flags, path, NULL);
-
- if (r == -1) {
- free (out);
- reply_with_error ("%s: %s", display_path, err);
- return NULL;
- }
-
- /* We need to remove the trailing \n from output of file(1). */
- size_t len = strlen (out);
- if (len > 0 && out[len-1] == '\n')
- out[--len] = '\0';
-
- /* Some upstream versions of file add a space at the end of the
- * output. This is fixed in the Fedora version, but we might as
- * well fix it here too. (RHBZ#928995).
- */
- if (len > 0 && out[len-1] == ' ')
- out[--len] = '\0';
-
- return out; /* caller frees */
-}
-
/* zcat | file */
char *
do_zfile (const char *method, const char *path)
diff --git a/daemon/file.ml b/daemon/file.ml
new file mode 100644
index 000000000..cd7dbb91c
--- /dev/null
+++ b/daemon/file.ml
@@ -0,0 +1,60 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Unix
+open Printf
+
+open Common_utils
+
+open Utils
+
+(* This runs the [file] command. *)
+let file path + let is_dev = String.is_prefix path "/dev/" in
+
+ (* For non-dev, check this is a regular file, else just return the
+ * file type as a string (RHBZ#582484).
+ *)
+ if not is_dev then (
+ let sysroot = Sysroot.sysroot () in
+ let chroot = Chroot.create sysroot ~name:(sprintf "file: %s"
path) in
+
+ let statbuf = Chroot.f chroot lstat path in
+ match statbuf.st_kind with
+ | S_DIR -> "directory"
+ | S_CHR -> "character device"
+ | S_BLK -> "block device"
+ | S_FIFO -> "FIFO"
+ | S_LNK -> "symbolic link"
+ | S_SOCK -> "socket"
+ | S_REG ->
+ (* Regular file, so now run [file] on it. *)
+ let out = command "file" ["-zb"; sysroot // path] in
+
+ (* We need to remove the trailing \n from output of file(1).
+ *
+ * Some upstream versions of file add a space at the end of the
+ * output. This is fixed in the Fedora version, but we might as
+ * well fix it here too. (RHBZ#928995).
+ *)
+ String.trimr out
+ )
+ else (* it's a device *) (
+ let out = command "file" ["-zbsL"; path] in
+ String.trimr out
+ )
diff --git a/daemon/file.mli b/daemon/file.mli
new file mode 100644
index 000000000..bd49bad0b
--- /dev/null
+++ b/daemon/file.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val file : string -> string
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 0e667eff1..26ed1274e 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -2321,6 +2321,7 @@ and physical volumes." };
{ defaults with
name = "file"; added = (1, 9, 1);
style = RString (RPlainString, "description"), [String
(Dev_or_Path, "path")], [];
+ impl = OCaml "File.file";
tests = [
InitISOFS, Always, TestResultString (
[["file"; "/empty"]], "empty"), [];
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 04/12] daemon: Reimplement ‘vfs_type’ API in OCaml.
This also implements support for String (Mountable, _)
parameters.
---
daemon/Makefile.am | 4 ++++
daemon/blkid.c | 6 ------
daemon/blkid.ml | 40 ++++++++++++++++++++++++++++++++++++++++
daemon/blkid.mli | 19 +++++++++++++++++++
daemon/mountable.ml | 43 +++++++++++++++++++++++++++++++++++++++++++
daemon/mountable.mli | 34 ++++++++++++++++++++++++++++++++++
generator/actions_core.ml | 1 +
generator/daemon.ml | 38 ++++++++++++++++++++++++++++++++++++--
8 files changed, 177 insertions(+), 8 deletions(-)
create mode 100644 daemon/blkid.ml
create mode 100644 daemon/blkid.mli
create mode 100644 daemon/mountable.ml
create mode 100644 daemon/mountable.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 1e16bf328..4f326177c 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -249,10 +249,12 @@ guestfsd_CFLAGS = \
# library and then linked to the daemon. See
# https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html
SOURCES_MLI = \
+ blkid.mli \
chroot.mli \
common_utils.mli \
sysroot.mli \
file.mli \
+ mountable.mli \
unix_utils.mli \
utils.mli
@@ -263,7 +265,9 @@ SOURCES_ML = \
types.ml \
utils.ml \
sysroot.ml \
+ mountable.ml \
chroot.ml \
+ blkid.ml \
file.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/blkid.c b/daemon/blkid.c
index 1fe5ff93a..7757b5ad0 100644
--- a/daemon/blkid.c
+++ b/daemon/blkid.c
@@ -69,12 +69,6 @@ get_blkid_tag (const char *device, const char *tag)
}
char *
-do_vfs_type (const mountable_t *mountable)
-{
- return get_blkid_tag (mountable->device, "TYPE");
-}
-
-char *
do_vfs_label (const mountable_t *mountable)
{
CLEANUP_FREE char *type = do_vfs_type (mountable);
diff --git a/daemon/blkid.ml b/daemon/blkid.ml
new file mode 100644
index 000000000..3f09590ac
--- /dev/null
+++ b/daemon/blkid.ml
@@ -0,0 +1,40 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Common_utils
+
+open Utils
+
+let rec vfs_type { Mountable.m_device = device } + get_blkid_tag device
"TYPE"
+
+and get_blkid_tag device tag + let r, out, err + commandr "blkid"
+ [(* Adding -c option kills all caching, even on RHEL 5. *)
+ "-c"; "/dev/null";
+ "-o"; "value"; "-s"; tag; device]
in
+ match r with
+ | 0 -> (* success *)
+ String.trimr out
+
+ | 2 -> (* means tag not found, we return
"" *)
+ ""
+
+ | _ ->
+ failwithf "blkid: %s: %s" tag err
diff --git a/daemon/blkid.mli b/daemon/blkid.mli
new file mode 100644
index 000000000..59a86ac2c
--- /dev/null
+++ b/daemon/blkid.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val vfs_type : Mountable.t -> string
diff --git a/daemon/mountable.ml b/daemon/mountable.ml
new file mode 100644
index 000000000..96dffb80b
--- /dev/null
+++ b/daemon/mountable.ml
@@ -0,0 +1,43 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Printf
+
+type t = {
+ m_type : mountable_type;
+ m_device : string;
+}
+and mountable_type + | MountableDevice
+ | MountablePath
+ | MountableBtrfsVol of string (* volume *)
+
+let to_string { m_type = t; m_device = device } + match t with
+ | MountableDevice | MountablePath -> device
+ | MountableBtrfsVol volume ->
+ sprintf "btrfsvol:%s/%s" device volume
+
+let of_device device + { m_type = MountableDevice; m_device = device }
+
+let of_path path + { m_type = MountablePath; m_device = path }
+
+let of_btrfsvol device volume + { m_type = MountableBtrfsVol volume; m_device
= device }
diff --git a/daemon/mountable.mli b/daemon/mountable.mli
new file mode 100644
index 000000000..52f1ad45b
--- /dev/null
+++ b/daemon/mountable.mli
@@ -0,0 +1,34 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+type t = {
+ m_type : mountable_type;
+ m_device : string;
+}
+and mountable_type + | MountableDevice
+ | MountablePath
+ | MountableBtrfsVol of string (* volume *)
+
+val to_string : t -> string
+(** Convert the mountable back to the string used in the public API. *)
+
+val of_device : string -> t
+val of_path : string -> t
+val of_btrfsvol : string -> string -> t
+(** Create a mountable from various objects. *)
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 26ed1274e..a6eb2c273 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -4872,6 +4872,7 @@ See also C<guestfs_realpath>." };
{ defaults with
name = "vfs_type"; added = (1, 0, 75);
style = RString (RPlainString, "fstype"), [String (Mountable,
"mountable")], [];
+ impl = OCaml "Blkid.vfs_type";
tests = [
InitScratchFS, Always, TestResultString (
[["vfs_type"; "/dev/sdb1"]], "ext2"), []
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 1b5db4c4c..ef388850f 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -520,6 +520,35 @@ let generate_daemon_caml_stubs () */
extern void ocaml_exn_to_reply_with_error (const char *func, value exn);
+/* Implement String (Mountable, _) parameter. */
+static value
+copy_mountable (const mountable_t *mountable)
+{
+ CAMLparam0 ();
+ CAMLlocal4 (r, typev, devicev, volumev);
+
+ switch (mountable->type) {
+ case MOUNTABLE_DEVICE:
+ typev = Val_int (0); /* MountableDevice */
+ break;
+ case MOUNTABLE_PATH:
+ typev = Val_int (1); /* MountablePath */
+ break;
+ case MOUNTABLE_BTRFSVOL:
+ volumev = caml_copy_string (mountable->volume);
+ typev = caml_alloc (1, 0); /* MountableBtrfsVol */
+ Store_field (typev, 0, volumev);
+ }
+
+ devicev = caml_copy_string (mountable->device);
+
+ r = caml_alloc_tuple (2);
+ Store_field (r, 0, typev);
+ Store_field (r, 1, devicev);
+
+ CAMLreturn (r);
+}
+
";
List.iter (
@@ -598,7 +627,11 @@ extern void ocaml_exn_to_reply_with_error (const char
*func, value exn);
| Bool n -> pr "Val_bool (%s)" n
| Int n -> pr "Val_int (%s)" n
| Int64 n -> pr "caml_copy_int64 (%s)" n
- | String (_, n) -> pr "caml_copy_string (%s)" n
+ | String ((PlainString|Device|Dev_or_Path), n) ->
+ pr "caml_copy_string (%s)" n
+ | String (Mountable, n) ->
+ pr "copy_mountable (%s)" n
+ | String _ -> assert false
| OptString _ -> assert false
| StringList _ -> assert false
| BufferIn _ -> assert false
@@ -637,13 +670,14 @@ extern void ocaml_exn_to_reply_with_error (const char
*func, value exn);
| RBool _ -> assert false
| RConstString _ -> assert false
| RConstOptString _ -> assert false
- | RString _ ->
+ | RString (RPlainString, _) ->
pr " char *ret = strdup (String_val (retv));\n";
pr " if (ret == NULL) {\n";
pr " reply_with_perror (\"strdup\");\n";
pr " CAMLreturnT (char *, NULL);\n";
pr " }\n";
pr " CAMLreturnT (char *, ret); /* caller frees */\n"
+ | RString _ -> assert false
| RStringList _ -> assert false
| RStruct _ -> assert false
| RStructList _ -> assert false
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 05/12] daemon: Reimplement several devsparts APIs in OCaml.
The reimplemented APIs are:
* list_devices
* list_partitions
* part_to_dev
* part_to_partnum
* is_whole_device
---
daemon/Makefile.am | 2 +
daemon/daemon.h | 3 -
daemon/devsparts.c | 257 ----------------------------------------------
daemon/devsparts.ml | 109 ++++++++++++++++++++
daemon/devsparts.mli | 25 +++++
daemon/guestfsd.c | 75 --------------
daemon/utils.ml | 84 +++++++++++++++
daemon/utils.mli | 15 +++
generator/actions_core.ml | 5 +
generator/daemon.ml | 32 +++++-
10 files changed, 268 insertions(+), 339 deletions(-)
create mode 100644 daemon/devsparts.ml
create mode 100644 daemon/devsparts.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 4f326177c..6d189b368 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -253,6 +253,7 @@ SOURCES_MLI = \
chroot.mli \
common_utils.mli \
sysroot.mli \
+ devsparts.mli \
file.mli \
mountable.mli \
unix_utils.mli \
@@ -268,6 +269,7 @@ SOURCES_ML = \
mountable.ml \
chroot.ml \
blkid.ml \
+ devsparts.ml \
file.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/daemon.h b/daemon/daemon.h
index 400116514..42b77f0ca 100644
--- a/daemon/daemon.h
+++ b/daemon/daemon.h
@@ -114,9 +114,6 @@ extern void sort_strings (char **argv, size_t len);
extern void free_strings (char **argv);
extern void free_stringslen (char **argv, size_t len);
-extern void sort_device_names (char **argv, size_t len);
-extern int compare_device_names (const char *a, const char *b);
-
/* Concatenate strings, optionally with a separator string between
* each. On error, these return NULL but do NOT call reply_with_* nor
* free anything.
diff --git a/daemon/devsparts.c b/daemon/devsparts.c
index 82467b92f..1aacb8e16 100644
--- a/daemon/devsparts.c
+++ b/daemon/devsparts.c
@@ -33,263 +33,6 @@
#include "daemon.h"
#include "actions.h"
-typedef int (*block_dev_func_t) (const char *dev, struct stringsbuf *r);
-
-/* Execute a given function for each discovered block device */
-static char **
-foreach_block_device (block_dev_func_t func, bool return_md)
-{
- CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (r);
- DIR *dir;
- int err = 0;
- struct dirent *d;
- int fd;
-
- dir = opendir ("/sys/block");
- if (!dir) {
- reply_with_perror ("opendir: /sys/block");
- return NULL;
- }
-
- for (;;) {
- errno = 0;
- d = readdir (dir);
- if (!d) break;
-
- if (STREQLEN (d->d_name, "sd", 2) ||
- STREQLEN (d->d_name, "hd", 2) ||
- STREQLEN (d->d_name, "ubd", 3) ||
- STREQLEN (d->d_name, "vd", 2) ||
- STREQLEN (d->d_name, "sr", 2) ||
- (return_md &&
- STREQLEN (d->d_name, "md", 2) && c_isdigit
(d->d_name[2]))) {
- CLEANUP_FREE char *dev_path = NULL;
- if (asprintf (&dev_path, "/dev/%s", d->d_name) == -1) {
- reply_with_perror ("asprintf");
- closedir (dir);
- return NULL;
- }
-
- /* Ignore the root device. */
- if (is_root_device (dev_path))
- continue;
-
- /* RHBZ#514505: Some versions of qemu <= 0.10 add a
- * CD-ROM device even though we didn't request it. Try to
- * detect this by seeing if the device contains media.
- */
- fd = open (dev_path, O_RDONLY|O_CLOEXEC);
- if (fd == -1) {
- perror (dev_path);
- continue;
- }
- close (fd);
-
- /* Call the map function for this device */
- if ((*func)(d->d_name, &r) != 0) {
- err = 1;
- break;
- }
- }
- }
-
- /* Check readdir didn't fail */
- if (errno != 0) {
- reply_with_perror ("readdir: /sys/block");
- closedir (dir);
- return NULL;
- }
-
- /* Close the directory handle */
- if (closedir (dir) == -1) {
- reply_with_perror ("closedir: /sys/block");
- return NULL;
- }
-
- if (err)
- return NULL;
-
- /* Sort the devices. */
- if (r.size > 0)
- sort_device_names (r.argv, r.size);
-
- /* NULL terminate the list */
- if (end_stringsbuf (&r) == -1) {
- return NULL;
- }
-
- return take_stringsbuf (&r);
-}
-
-/* Add a device to the list of devices */
-static int
-add_device (const char *device, struct stringsbuf *r)
-{
- char *dev_path;
-
- if (asprintf (&dev_path, "/dev/%s", device) == -1) {
- reply_with_perror ("asprintf");
- return -1;
- }
-
- if (add_string_nodup (r, dev_path) == -1)
- return -1;
-
- return 0;
-}
-
-char **
-do_list_devices (void)
-{
- /* For backwards compatibility, don't return MD devices in the list
- * returned by guestfs_list_devices. This is because most API users
- * expect that this list is effectively the same as the list of
- * devices added by guestfs_add_drive.
- *
- * Also, MD devices are special devices - unlike the devices exposed
- * by QEMU, and there is a special API for them,
- * guestfs_list_md_devices.
- */
- return foreach_block_device (add_device, false);
-}
-
-static int
-add_partitions (const char *device, struct stringsbuf *r)
-{
- CLEANUP_FREE char *devdir = NULL;
-
- /* Open the device's directory under /sys/block */
- if (asprintf (&devdir, "/sys/block/%s", device) == -1) {
- reply_with_perror ("asprintf");
- return -1;
- }
-
- DIR *dir = opendir (devdir);
- if (!dir) {
- reply_with_perror ("opendir: %s", devdir);
- return -1;
- }
-
- /* Look in /sys/block/<device>/ for entries starting with
<device>
- * e.g. /sys/block/sda/sda1
- */
- errno = 0;
- struct dirent *d;
- while ((d = readdir (dir)) != NULL) {
- if (STREQLEN (d->d_name, device, strlen (device))) {
- CLEANUP_FREE char *part = NULL;
- if (asprintf (&part, "/dev/%s", d->d_name) == -1) {
- perror ("asprintf");
- closedir (dir);
- return -1;
- }
-
- if (add_string (r, part) == -1) {
- closedir (dir);
- return -1;
- }
- }
- }
-
- /* Check if readdir failed */
- if (0 != errno) {
- reply_with_perror ("readdir: %s", devdir);
- closedir (dir);
- return -1;
- }
-
- /* Close the directory handle */
- if (closedir (dir) == -1) {
- reply_with_perror ("closedir: /sys/block/%s", device);
- return -1;
- }
-
- return 0;
-}
-
-char **
-do_list_partitions (void)
-{
- return foreach_block_device (add_partitions, true);
-}
-
-char *
-do_part_to_dev (const char *part)
-{
- int err = 1;
- size_t n = strlen (part);
-
- while (n >= 1 && c_isdigit (part[n-1])) {
- err = 0;
- n--;
- }
-
- if (err) {
- reply_with_error ("device name is not a partition");
- return NULL;
- }
-
- /* Deal with <device>p<N> partition names such as /dev/md0p1. */
- if (part[n-1] == 'p')
- n--;
-
- char *r = strndup (part, n);
- if (r == NULL) {
- reply_with_perror ("strdup");
- return NULL;
- }
-
- return r;
-}
-
-int
-do_part_to_partnum (const char *part)
-{
- int err = 1;
- size_t n = strlen (part);
-
- while (n >= 1 && c_isdigit (part[n-1])) {
- err = 0;
- n--;
- }
-
- if (err) {
- reply_with_error ("device name is not a partition");
- return -1;
- }
-
- int r;
- if (sscanf (&part[n], "%d", &r) != 1) {
- reply_with_error ("could not parse number");
- return -1;
- }
-
- return r;
-}
-
-int
-do_is_whole_device (const char *device)
-{
- /* A 'whole' block device will have a symlink to the device in its
- * /sys/block directory */
- CLEANUP_FREE char *devpath = NULL;
- if (asprintf (&devpath, "/sys/block/%s/device",
- device + strlen ("/dev/")) == -1) {
- reply_with_perror ("asprintf");
- return -1;
- }
-
- struct stat statbuf;
- if (stat (devpath, &statbuf) == -1) {
- if (errno == ENOENT || errno == ENOTDIR) return 0;
-
- reply_with_perror ("stat");
- return -1;
- }
-
- return 1;
-}
-
int
do_device_index (const char *device)
{
diff --git a/daemon/devsparts.ml b/daemon/devsparts.ml
new file mode 100644
index 000000000..95dc006ca
--- /dev/null
+++ b/daemon/devsparts.ml
@@ -0,0 +1,109 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Printf
+open Unix
+
+open Common_utils
+
+open Utils
+
+let map_block_devices ~return_md f + let devs = Sys.readdir
"/sys/block" in
+ let devs = Array.to_list devs in
+ let devs = List.filter (
+ fun dev ->
+ String.is_prefix dev "sd" ||
+ String.is_prefix dev "hd" ||
+ String.is_prefix dev "ubd" ||
+ String.is_prefix dev "vd" ||
+ String.is_prefix dev "sr" ||
+ (return_md && String.is_prefix dev "md" &&
+ String.length dev >= 3 && Char.isdigit dev.[2])
+ ) devs in
+
+ (* Ignore the root device. *)
+ let devs + List.filter (fun dev -> not (is_root_device
("/dev/" ^ dev))) devs in
+
+ (* RHBZ#514505: Some versions of qemu <= 0.10 add a
+ * CD-ROM device even though we didn't request it. Try to
+ * detect this by seeing if the device contains media.
+ *)
+ let devs + List.filter (
+ fun dev ->
+ try close (openfile ("/dev/" ^ dev) [O_RDONLY; O_CLOEXEC] 0);
true
+ with _ -> false
+ ) devs in
+
+ (* Call the map function for the devices left in the list. *)
+ List.map f devs
+
+let list_devices () + (* For backwards compatibility, don't return MD
devices in the list
+ * returned by guestfs_list_devices. This is because most API users
+ * expect that this list is effectively the same as the list of
+ * devices added by guestfs_add_drive.
+ *
+ * Also, MD devices are special devices - unlike the devices exposed
+ * by QEMU, and there is a special API for them,
+ * guestfs_list_md_devices.
+ *)
+ let devices + map_block_devices ~return_md:false (fun dev ->
"/dev/" ^ dev) in
+ sort_device_names devices
+
+let rec list_partitions () + let partitions = map_block_devices
~return_md:true add_partitions in
+ let partitions = List.flatten partitions in
+ sort_device_names partitions
+
+and add_partitions dev + (* Open the device's directory under /sys/block
*)
+ let parts = Sys.readdir ("/sys/block/" ^ dev) in
+ let parts = Array.to_list parts in
+
+ (* Look in /sys/block/<device>/ for entries starting with
+ * <device>, eg. /sys/block/sda/sda1.
+ *)
+ let parts = List.filter (fun part -> String.is_prefix part dev) parts in
+ List.map (fun part -> "/dev/" ^ part) parts
+
+let part_to_dev part + let dev, part = split_device_partition part in
+ if part = 0 then
+ failwithf "device name is not a partition";
+ "/dev/" ^ dev
+
+let part_to_partnum part + let _, part = split_device_partition part in
+ if part = 0 then
+ failwithf "device name is not a partition";
+ part
+
+let is_whole_device device + (* A 'whole' block device will have a
symlink to the device in its
+ * /sys/block directory
+ *)
+ assert (String.is_prefix device "/dev/");
+ let device = String.sub device 5 (String.length device - 5) in
+ let devpath = sprintf "/sys/block/%s/device" device in
+
+ try ignore (stat devpath); true
+ with Unix_error ((ENOENT|ENOTDIR), _, _) -> false
diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli
new file mode 100644
index 000000000..4dfaa86e6
--- /dev/null
+++ b/daemon/devsparts.mli
@@ -0,0 +1,25 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val list_devices : unit -> string list
+val list_partitions : unit -> string list
+
+val part_to_dev : string -> string
+val part_to_partnum : string -> int
+
+val is_whole_device : string -> bool
diff --git a/daemon/guestfsd.c b/daemon/guestfsd.c
index 9b6ae02b1..a54df03c5 100644
--- a/daemon/guestfsd.c
+++ b/daemon/guestfsd.c
@@ -652,81 +652,6 @@ free_stringslen (char **argv, size_t len)
free (argv);
}
-/**
- * Compare device names (including partition numbers if present).
- *
- *
L<https://rwmj.wordpress.com/2011/01/09/how-are-linux-drives-named-beyond-drive-26-devsdz/>
- */
-int
-compare_device_names (const char *a, const char *b)
-{
- size_t alen, blen;
- int r;
- int a_partnum, b_partnum;
-
- /* Skip /dev/ prefix if present. */
- if (STRPREFIX (a, "/dev/"))
- a += 5;
- if (STRPREFIX (b, "/dev/"))
- b += 5;
-
- /* Skip sd/hd/ubd/vd. */
- alen = strcspn (a, "d");
- blen = strcspn (b, "d");
- assert (alen > 0 && alen <= 2);
- assert (blen > 0 && blen <= 2);
- a += alen + 1;
- b += blen + 1;
-
- /* Get device name part, that is, just 'a', 'ab' etc. */
- alen = strcspn (a, "0123456789");
- blen = strcspn (b, "0123456789");
-
- /* If device name part is longer, it is always greater, eg.
- * "/dev/sdz" < "/dev/sdaa".
- */
- if (alen != blen)
- return alen - blen;
-
- /* Device name parts are the same length, so do a regular compare. */
- r = strncmp (a, b, alen);
- if (r != 0)
- return r;
-
- /* Compare partitions numbers. */
- a += alen;
- b += alen;
-
- /* If no partition numbers, bail -- the devices are the same. This
- * can happen in one peculiar case: where you have a mix of devices
- * with different interfaces (eg. /dev/sda and /dev/vda).
- * (RHBZ#858128).
- */
- if (!*a && !*b)
- return 0;
-
- r = sscanf (a, "%d", &a_partnum);
- assert (r == 1);
- r = sscanf (b, "%d", &b_partnum);
- assert (r == 1);
-
- return a_partnum - b_partnum;
-}
-
-static int
-compare_device_names_vp (const void *vp1, const void *vp2)
-{
- char * const *p1 = (char * const *) vp1;
- char * const *p2 = (char * const *) vp2;
- return compare_device_names (*p1, *p2);
-}
-
-void
-sort_device_names (char **argv, size_t len)
-{
- qsort (argv, len, sizeof (char *), compare_device_names_vp);
-}
-
char *
concat_strings (char *const *argv)
{
diff --git a/daemon/utils.ml b/daemon/utils.ml
index a97892d99..496ce2f81 100644
--- a/daemon/utils.ml
+++ b/daemon/utils.ml
@@ -129,6 +129,90 @@ let is_root_device device device func arg
(error_message err);
false
+(* XXX This function is copied from C, but is misconceived. It
+ * cannot by design work for devices like /dev/md0. It would be
+ * better if it checked for the existence of devices and partitions
+ * in /sys/block so we know what the kernel thinks is a device or
+ * partition. The same applies to APIs such as part_to_partnum
+ * and part_to_dev which rely on this function.
+ *)
+let split_device_partition dev + (* Skip /dev/ prefix if present. *)
+ let dev + if String.is_prefix dev "/dev/" then
+ String.sub dev 5 (String.length dev - 5)
+ else dev in
+
+ (* Find the partition number (if present). *)
+ let dev, part + let n = String.length dev in
+ let i = ref n in
+ while !i >= 1 && Char.isdigit dev.[!i-1] do
+ decr i
+ done;
+ let i = !i in
+ if i = n then
+ dev, 0 (* no partition number, whole device *)
+ else
+ String.sub dev 0 i, int_of_string (String.sub dev i (n-i)) in
+
+ (* Deal with device names like /dev/md0p1. *)
+ (* XXX This function is buggy (as was the old C function) when
+ * presented with a whole device like /dev/md0.
+ *)
+ let dev + let n = String.length dev in
+ if n < 2 || dev.[n-1] <> 'p' || not (Char.isdigit
dev.[n-2]) then
+ dev
+ else (
+ let i = ref (n-1) in
+ while !i >= 0 && Char.isdigit dev.[!i] do
+ decr i;
+ done;
+ let i = !i in
+ String.sub dev 0 i
+ ) in
+
+ dev, part
+
+let rec sort_device_names devs + List.sort compare_device_names devs
+
+and compare_device_names a b + (* This takes the device name like
"/dev/sda1" and returns ("sda", 1). *)
+ let dev_a, part_a = split_device_partition a
+ and dev_b, part_b = split_device_partition b in
+
+ (* Skip "sd|hd|ubd..." so that /dev/sda and /dev/vda sort together.
+ * (This is what the old C function did, but it's not clear if it
+ * is still relevant. XXX)
+ *)
+ let skip_prefix dev + let n = String.length dev in
+ if n >= 2 && dev.[1] = 'd' then
+ String.sub dev 2 (String.length dev - 2)
+ else if n >= 3 && dev.[2] = 'd' then
+ String.sub dev 3 (String.length dev - 3)
+ else
+ dev in
+ let dev_a = skip_prefix dev_a
+ and dev_b = skip_prefix dev_b in
+
+ (* If device name part is longer, it is always greater, eg.
+ * "/dev/sdz" < "/dev/sdaa".
+ *)
+ let r = compare (String.length dev_a) (String.length dev_b) in
+ if r <> 0 then r
+ else (
+ (* Device name parts are the same length, so do a regular compare. *)
+ let r = compare dev_a dev_b in
+ if r <> 0 then r
+ else (
+ (* Device names are identical, so compare partition numbers. *)
+ compare part_a part_b
+ )
+ )
+
let proc_unmangle_path path let n = String.length path in
let b = Buffer.create n in
diff --git a/daemon/utils.mli b/daemon/utils.mli
index 57f703c6c..a1f956be3 100644
--- a/daemon/utils.mli
+++ b/daemon/utils.mli
@@ -41,6 +41,21 @@ val is_root_device_stat : Unix.stats -> bool
(** As for {!is_root_device} but operates on a statbuf instead of
a device name. *)
+val split_device_partition : string -> string * int
+(** Split a device name like [/dev/sda1] into a device name and
+ partition number, eg. ["sda", 1].
+
+ The [/dev/] prefix is skipped and removed, if present.
+
+ If the partition number is not present (a whole device), 0 is returned.
+
+ This function splits [/dev/md0p1] to ["md0", 1]. *)
+
+val sort_device_names : string list -> string list
+(** Sort device names correctly so that /dev/sdaa appears after /dev/sdz.
+ This also deals with partition numbers, and works whether or not
+ [/dev/] is present. *)
+
val proc_unmangle_path : string -> string
(** Reverse kernel path escaping done in fs/seq_file.c:mangle_path.
This is inconsistently used for /proc fields. *)
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index a6eb2c273..94391288f 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -1817,6 +1817,7 @@ is I<not> intended that you try to parse the output
string." };
{ defaults with
name = "list_devices"; added = (0, 0, 4);
style = RStringList (RDevice, "devices"), [], [];
+ impl = OCaml "Devsparts.list_devices";
tests = [
InitEmpty, Always, TestResult (
[["list_devices"]],
@@ -1833,6 +1834,7 @@ See also C<guestfs_list_filesystems>." };
{ defaults with
name = "list_partitions"; added = (0, 0, 4);
style = RStringList (RDevice, "partitions"), [], [];
+ impl = OCaml "Devsparts.list_partitions";
tests = [
InitBasicFS, Always, TestResult (
[["list_partitions"]],
@@ -6086,6 +6088,7 @@ See also C<guestfs_stat>." };
{ defaults with
name = "part_to_dev"; added = (1, 5, 15);
style = RString (RDevice, "device"), [String (Device,
"partition")], [];
+ impl = OCaml "Devsparts.part_to_dev";
tests = [
InitPartition, Always, TestResultDevice (
[["part_to_dev"; "/dev/sda1"]],
"/dev/sda"), [];
@@ -6533,6 +6536,7 @@ as in C<guestfs_compress_out>." };
{ defaults with
name = "part_to_partnum"; added = (1, 13, 25);
style = RInt "partnum", [String (Device, "partition")],
[];
+ impl = OCaml "Devsparts.part_to_partnum";
tests = [
InitPartition, Always, TestResult (
[["part_to_partnum"; "/dev/sda1"]], "ret ==
1"), [];
@@ -8480,6 +8484,7 @@ you are better to use C<guestfs_mv> instead."
};
{ defaults with
name = "is_whole_device"; added = (1, 21, 9);
style = RBool "flag", [String (Device, "device")], [];
+ impl = OCaml "Devsparts.is_whole_device";
tests = [
InitEmpty, Always, TestResultTrue (
[["is_whole_device"; "/dev/sda"]]), [];
diff --git a/generator/daemon.ml b/generator/daemon.ml
index ef388850f..c37ffdab0 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -549,6 +549,26 @@ copy_mountable (const mountable_t *mountable)
CAMLreturn (r);
}
+/* Implement RStringList. */
+static char **
+return_string_list (value retv)
+{
+ CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret);
+ value v;
+
+ while (retv != Val_int (0)) {
+ v = Field (retv, 0);
+ if (add_string (&ret, String_val (v)) == -1)
+ return NULL;
+ retv = Field (retv, 1);
+ }
+
+ if (end_stringsbuf (&ret) == -1)
+ return NULL;
+
+ return take_stringsbuf (&ret); /* caller frees */
+}
+
";
List.iter (
@@ -665,12 +685,14 @@ copy_mountable (const mountable_t *mountable)
(match ret with
| RErr -> assert false
- | RInt _ -> assert false
+ | RInt _ ->
+ pr " CAMLreturnT (int, Int_val (retv));\n"
| RInt64 _ -> assert false
- | RBool _ -> assert false
+ | RBool _ ->
+ pr " CAMLreturnT (int, Bool_val (retv));\n"
| RConstString _ -> assert false
| RConstOptString _ -> assert false
- | RString (RPlainString, _) ->
+ | RString ((RPlainString|RDevice), _) ->
pr " char *ret = strdup (String_val (retv));\n";
pr " if (ret == NULL) {\n";
pr " reply_with_perror (\"strdup\");\n";
@@ -678,7 +700,9 @@ copy_mountable (const mountable_t *mountable)
pr " }\n";
pr " CAMLreturnT (char *, ret); /* caller frees */\n"
| RString _ -> assert false
- | RStringList _ -> assert false
+ | RStringList _ ->
+ pr " char **ret = return_string_list (retv);\n";
+ pr " CAMLreturnT (char **, ret); /* caller frees */\n"
| RStruct _ -> assert false
| RStructList _ -> assert false
| RHashtable _ -> assert false
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 06/12] daemon: Add unit tests of the ‘Utils’ module.
---
.gitignore | 1 +
daemon/Makefile.am | 40 ++++++++++++++++++++++++++++++++++++
daemon/daemon_utils_tests.ml | 48 ++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 89 insertions(+)
create mode 100644 daemon/daemon_utils_tests.ml
diff --git a/.gitignore b/.gitignore
index 69b824a74..0577a1137 100644
--- a/.gitignore
+++ b/.gitignore
@@ -160,6 +160,7 @@ Makefile.in
/daemon/caml-stubs.c
/daemon/common_utils.ml
/daemon/common_utils.mli
+/daemon/daemon_utils_tests
/daemon/dispatch.c
/daemon/guestfs_config.ml
/daemon/guestfsd
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 6d189b368..716141af9 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -56,6 +56,7 @@ BUILT_SOURCES = \
EXTRA_DIST = \
$(generator_built) \
$(SOURCES_MLI) $(SOURCES_ML) \
+ daemon_utils_tests.ml \
guestfsd.pod
if INSTALL_DAEMON
@@ -319,6 +320,45 @@ unix_utils.ml: ../mllib/unix_utils.ml
unix_utils.mli: ../mllib/unix_utils.mli
cp $< $@
+# Unit tests.
+
+check_PROGRAMS = daemon_utils_tests
+TESTS = daemon_utils_tests
+
+daemon_utils_tests_SOURCES = unix_utils-c.c
+daemon_utils_tests_CPPFLAGS = \
+ -I. \
+ -I$(top_builddir) \
+ -I$(shell $(OCAMLC) -where) \
+ -I$(top_srcdir)/lib
+daemon_utils_tests_BOBJECTS = \
+ guestfs_config.cmo \
+ unix_utils.cmo \
+ common_utils.cmo \
+ utils.cmo \
+ daemon_utils_tests.cmo
+daemon_utils_tests_XOBJECTS = $(daemon_utils_tests_BOBJECTS:.cmo=.cmx)
+
+if !HAVE_OCAMLOPT
+daemon_utils_tests_THEOBJECTS = $(daemon_utils_tests_BOBJECTS)
+else
+daemon_utils_tests_THEOBJECTS = $(daemon_utils_tests_XOBJECTS)
+endif
+
+OCAMLLINKFLAGS = $(LINK_CUSTOM_OCAMLC_ONLY)
+
+daemon_utils_tests_DEPENDENCIES = \
+ $(daemon_utils_tests_THEOBJECTS) \
+ $(top_srcdir)/ocaml-link.sh
+daemon_utils_tests_LINK = \
+ $(top_srcdir)/ocaml-link.sh -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \
+ $(OCAMLPACKAGES) \
+ $(daemon_utils_tests_THEOBJECTS) -o $@
+
+check-valgrind:
+ $(MAKE) VG="@VG@" check
+
# OCaml dependencies.
depend: .depend
diff --git a/daemon/daemon_utils_tests.ml b/daemon/daemon_utils_tests.ml
new file mode 100644
index 000000000..892509d89
--- /dev/null
+++ b/daemon/daemon_utils_tests.ml
@@ -0,0 +1,48 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Unix
+open Printf
+
+open Utils
+
+(* Test prog_exists. *)
+let () + assert (prog_exists "ls");
+ assert (prog_exists "true")
+
+(* Test command, commandr. *)
+let () + ignore (command "true" []);
+
+ let r, _, _ = commandr "false" [] in
+ assert (r = 1)
+
+(* Test split_device_partition. *)
+let () + assert (split_device_partition "/dev/sda1" =
("sda", 1));
+ assert (split_device_partition "/dev/sdb" = ("sdb", 0));
+ assert (split_device_partition "/dev/ubda9" = ("ubda",
9));
+ assert (split_device_partition "/dev/md0p1" = ("md0", 1))
+ (* XXX The function is buggy:
+ assert (split_device_partition "/dev/md0" = ("md0", 0))
*)
+
+(* Test proc_unmangle_path. *)
+let () + assert (proc_unmangle_path "\\040" = " ");
+ assert (proc_unmangle_path "\\040\\040" = " ")
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 07/12] daemon: Reimplement ‘is_dir’, ‘is_file’ and ‘is_symlink’ APIs in OCaml.
This also demonstrates usage of optional arguments.
---
daemon/Makefile.am | 2 ++
daemon/is.c | 41 -----------------------------------------
daemon/is.ml | 44 ++++++++++++++++++++++++++++++++++++++++++++
daemon/is.mli | 21 +++++++++++++++++++++
generator/actions_core.ml | 3 +++
generator/daemon.ml | 7 ++++---
6 files changed, 74 insertions(+), 44 deletions(-)
create mode 100644 daemon/is.ml
create mode 100644 daemon/is.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 716141af9..a84057ba1 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -256,6 +256,7 @@ SOURCES_MLI = \
sysroot.mli \
devsparts.mli \
file.mli \
+ is.mli \
mountable.mli \
unix_utils.mli \
utils.mli
@@ -272,6 +273,7 @@ SOURCES_ML = \
blkid.ml \
devsparts.ml \
file.ml \
+ is.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/is.c b/daemon/is.c
index 4d5e911c2..a91dab32b 100644
--- a/daemon/is.c
+++ b/daemon/is.c
@@ -39,36 +39,6 @@ do_exists (const char *path)
/* Takes optional arguments, consult optargs_bitmask. */
int
-do_is_file (const char *path, int followsymlinks)
-{
- mode_t mode;
- int r;
-
- if (!(optargs_bitmask & GUESTFS_IS_FILE_FOLLOWSYMLINKS_BITMASK))
- followsymlinks = 0;
-
- r = get_mode (path, &mode, followsymlinks);
- if (r <= 0) return r;
- return S_ISREG (mode);
-}
-
-/* Takes optional arguments, consult optargs_bitmask. */
-int
-do_is_dir (const char *path, int followsymlinks)
-{
- mode_t mode;
- int r;
-
- if (!(optargs_bitmask & GUESTFS_IS_DIR_FOLLOWSYMLINKS_BITMASK))
- followsymlinks = 0;
-
- r = get_mode (path, &mode, followsymlinks);
- if (r <= 0) return r;
- return S_ISDIR (mode);
-}
-
-/* Takes optional arguments, consult optargs_bitmask. */
-int
do_is_chardev (const char *path, int followsymlinks)
{
mode_t mode;
@@ -112,17 +82,6 @@ do_is_fifo (const char *path, int followsymlinks)
return S_ISFIFO (mode);
}
-int
-do_is_symlink (const char *path)
-{
- mode_t mode;
- int r;
-
- r = get_mode (path, &mode, 0);
- if (r <= 0) return r;
- return S_ISLNK (mode);
-}
-
/* Takes optional arguments, consult optargs_bitmask. */
int
do_is_socket (const char *path, int followsymlinks)
diff --git a/daemon/is.ml b/daemon/is.ml
new file mode 100644
index 000000000..b99215737
--- /dev/null
+++ b/daemon/is.ml
@@ -0,0 +1,44 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Printf
+open Unix
+
+let rec is_file ?(followsymlinks = false) path + let sysroot = Sysroot.sysroot
() in
+ let chroot = Chroot.create sysroot ~name:(sprintf "is_file: %s"
path) in
+ Chroot.f chroot get_kind (path, followsymlinks) = Some S_REG
+
+and is_dir ?(followsymlinks = false) path + let sysroot = Sysroot.sysroot ()
in
+ let chroot = Chroot.create sysroot ~name:(sprintf "is_dir: %s"
path) in
+ Chroot.f chroot get_kind (path, followsymlinks) = Some S_DIR
+
+and is_symlink path + let sysroot = Sysroot.sysroot () in
+ let chroot = Chroot.create sysroot ~name:(sprintf "is_symlink: %s"
path) in
+ Chroot.f chroot get_kind (path, false) = Some S_LNK
+
+and get_kind (path, followsymlinks) + let statfun = if followsymlinks then
stat else lstat in
+ try
+ let statbuf = statfun path in
+ Some statbuf.st_kind
+ with
+ Unix_error ((ENOENT|ENOTDIR), _, _) ->
+ None (* File doesn't exist => return None *)
diff --git a/daemon/is.mli b/daemon/is.mli
new file mode 100644
index 000000000..20622c39f
--- /dev/null
+++ b/daemon/is.mli
@@ -0,0 +1,21 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val is_file : ?followsymlinks:bool -> string -> bool
+val is_dir : ?followsymlinks:bool -> string -> bool
+val is_symlink : string -> bool
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 94391288f..421f3ac6b 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -2114,6 +2114,7 @@ See also C<guestfs_is_file>,
C<guestfs_is_dir>, C<guestfs_stat>." };
{ defaults with
name = "is_file"; added = (0, 0, 8);
style = RBool "fileflag", [String (Pathname, "path")],
[OBool "followsymlinks"];
+ impl = OCaml "Is.is_file";
once_had_no_optargs = true;
tests = [
InitISOFS, Always, TestResultTrue (
@@ -2138,6 +2139,7 @@ See also C<guestfs_stat>." };
{ defaults with
name = "is_dir"; added = (0, 0, 8);
style = RBool "dirflag", [String (Pathname, "path")],
[OBool "followsymlinks"];
+ impl = OCaml "Is.is_dir";
once_had_no_optargs = true;
tests = [
InitISOFS, Always, TestResultFalse (
@@ -6052,6 +6054,7 @@ See also C<guestfs_stat>." };
{ defaults with
name = "is_symlink"; added = (1, 5, 10);
style = RBool "flag", [String (Pathname, "path")], [];
+ impl = OCaml "Is.is_symlink";
tests = [
InitISOFS, Always, TestResultFalse (
[["is_symlink"; "/directory"]]), [];
diff --git a/generator/daemon.ml b/generator/daemon.ml
index c37ffdab0..060ab547e 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -573,6 +573,7 @@ return_string_list (value retv)
List.iter (
fun ({ name = name; style = ret, args, optargs } as f) ->
+ let uc_name = String.uppercase_ascii name in
let ocaml_function match f.impl with
| OCaml f -> f
@@ -621,8 +622,8 @@ return_string_list (value retv)
let uc_n = String.uppercase_ascii n in
(* optargs are all passed as [None|Some _] *)
- pr " if ((optargs_bitmask & %s_%s_BITMASK) == 0)\n"
- f.c_optarg_prefix uc_n;
+ pr " if ((optargs_bitmask & GUESTFS_%s_%s_BITMASK) ==
0)\n"
+ uc_name uc_n;
pr " args[%d] = Val_int (0); /* None */\n" !i;
pr " else {\n";
pr " v = ";
@@ -647,7 +648,7 @@ return_string_list (value retv)
| Bool n -> pr "Val_bool (%s)" n
| Int n -> pr "Val_int (%s)" n
| Int64 n -> pr "caml_copy_int64 (%s)" n
- | String ((PlainString|Device|Dev_or_Path), n) ->
+ | String ((PlainString|Device|Pathname|Dev_or_Path), n) ->
pr "caml_copy_string (%s)" n
| String (Mountable, n) ->
pr "copy_mountable (%s)" n
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 08/12] daemon: Reimplement ‘readlink’ API in OCaml.
---
daemon/Makefile.am | 2 ++
daemon/link.c | 16 ----------------
daemon/link.ml | 25 +++++++++++++++++++++++++
daemon/link.mli | 19 +++++++++++++++++++
generator/actions_core.ml | 1 +
5 files changed, 47 insertions(+), 16 deletions(-)
create mode 100644 daemon/link.ml
create mode 100644 daemon/link.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index a84057ba1..215c7d694 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -257,6 +257,7 @@ SOURCES_MLI = \
devsparts.mli \
file.mli \
is.mli \
+ link.mli \
mountable.mli \
unix_utils.mli \
utils.mli
@@ -274,6 +275,7 @@ SOURCES_ML = \
devsparts.ml \
file.ml \
is.ml \
+ link.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/link.c b/daemon/link.c
index 3ce54fa37..dde61a1c2 100644
--- a/daemon/link.c
+++ b/daemon/link.c
@@ -32,22 +32,6 @@
GUESTFSD_EXT_CMD(str_ln, ln);
-char *
-do_readlink (const char *path)
-{
- char *link;
-
- CHROOT_IN;
- link = areadlink (path);
- CHROOT_OUT;
- if (link == NULL) {
- reply_with_perror ("%s", path);
- return NULL;
- }
-
- return link; /* caller frees */
-}
-
char **
do_internal_readlinklist (const char *path, char *const *names)
{
diff --git a/daemon/link.ml b/daemon/link.ml
new file mode 100644
index 000000000..ba53fd6b5
--- /dev/null
+++ b/daemon/link.ml
@@ -0,0 +1,25 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Printf
+open Unix
+
+let readlink path + let sysroot = Sysroot.sysroot () in
+ let chroot = Chroot.create sysroot ~name:(sprintf "readlink: %s"
path) in
+ Chroot.f chroot readlink path
diff --git a/daemon/link.mli b/daemon/link.mli
new file mode 100644
index 000000000..6ca0283b4
--- /dev/null
+++ b/daemon/link.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val readlink : string -> string
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 421f3ac6b..7d6755fdc 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -4489,6 +4489,7 @@ The I<-f> option removes the link
(C<linkname>) if it exists already." };
{ defaults with
name = "readlink"; added = (1, 0, 66);
style = RString (RPlainString, "link"), [String (Pathname,
"path")], [];
+ impl = OCaml "Link.readlink";
shortdesc = "read the target of a symbolic link";
longdesc = "\
This command reads the target of a symbolic link." };
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 09/12] daemon: Reimplement ‘mount’, ‘mount_ro’, ‘mount_options’, ‘mount_vfs’ APIs in OCaml.
Some of the oldest and most core APIs, reimplemented.
This also moves the strange ?mount_vfs_nochroot? function into
btrfs.c.
---
daemon/Makefile.am | 2 +
daemon/btrfs.c | 43 ++++++++++++++++++++
daemon/daemon.h | 6 ---
daemon/mount.c | 99 -----------------------------------------------
daemon/mount.ml | 62 +++++++++++++++++++++++++++++
daemon/mount.mli | 22 +++++++++++
generator/actions_core.ml | 4 ++
generator/daemon.ml | 3 +-
8 files changed, 135 insertions(+), 106 deletions(-)
create mode 100644 daemon/mount.ml
create mode 100644 daemon/mount.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 215c7d694..c8e58ea20 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -258,6 +258,7 @@ SOURCES_MLI = \
file.mli \
is.mli \
link.mli \
+ mount.mli \
mountable.mli \
unix_utils.mli \
utils.mli
@@ -276,6 +277,7 @@ SOURCES_ML = \
file.ml \
is.ml \
link.ml \
+ mount.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/btrfs.c b/daemon/btrfs.c
index ae2310b53..f8c200112 100644
--- a/daemon/btrfs.c
+++ b/daemon/btrfs.c
@@ -37,6 +37,7 @@ GUESTFSD_EXT_CMD(str_btrfs, btrfs);
GUESTFSD_EXT_CMD(str_btrfstune, btrfstune);
GUESTFSD_EXT_CMD(str_btrfsck, btrfsck);
GUESTFSD_EXT_CMD(str_mkfs_btrfs, mkfs.btrfs);
+GUESTFSD_EXT_CMD(str_mount, mount);
GUESTFSD_EXT_CMD(str_umount, umount);
GUESTFSD_EXT_CMD(str_btrfsimage, btrfs-image);
@@ -387,6 +388,48 @@ do_btrfs_subvolume_create (const char *dest, const char
*qgroupid)
return 0;
}
+static int
+mount_vfs_nochroot (const char *options, const char *vfstype,
+ const mountable_t *mountable,
+ const char *mp, const char *user_mp)
+{
+ CLEANUP_FREE char *options_plus = NULL;
+ const char *device = mountable->device;
+ if (mountable->type == MOUNTABLE_BTRFSVOL) {
+ if (options && strlen (options) > 0) {
+ if (asprintf (&options_plus, "subvol=%s,%s",
+ mountable->volume, options) == -1) {
+ reply_with_perror ("asprintf");
+ return -1;
+ }
+ }
+ else {
+ if (asprintf (&options_plus, "subvol=%s",
mountable->volume) == -1) {
+ reply_with_perror ("asprintf");
+ return -1;
+ }
+ }
+ }
+
+ CLEANUP_FREE char *error = NULL;
+ int r;
+ if (vfstype)
+ r = command (NULL, &error,
+ str_mount, "-o", options_plus ? options_plus :
options,
+ "-t", vfstype, device, mp, NULL);
+ else
+ r = command (NULL, &error,
+ str_mount, "-o", options_plus ? options_plus :
options,
+ device, mp, NULL);
+ if (r == -1) {
+ reply_with_error ("%s on %s (options: '%s'): %s",
+ device, user_mp, options, error);
+ return -1;
+ }
+
+ return 0;
+}
+
static char *
mount (const mountable_t *fs)
{
diff --git a/daemon/daemon.h b/daemon/daemon.h
index 42b77f0ca..151909a82 100644
--- a/daemon/daemon.h
+++ b/daemon/daemon.h
@@ -76,12 +76,6 @@ extern int xread (int sock, void *buf, size_t len)
extern char *mountable_to_string (const mountable_t *mountable);
-/*-- in mount.c --*/
-
-extern int mount_vfs_nochroot (const char *options, const char *vfstype,
- const mountable_t *mountable,
- const char *mp, const char *user_mp);
-
/* Growable strings buffer. */
struct stringsbuf {
char **argv;
diff --git a/daemon/mount.c b/daemon/mount.c
index 0ad9626a7..962b86079 100644
--- a/daemon/mount.c
+++ b/daemon/mount.c
@@ -111,105 +111,6 @@ is_device_mounted (const char *device)
return 0;
}
-/* The "simple mount" call offers no complex options, you can just
- * mount a device on a mountpoint. The variations like mount_ro,
- * mount_options and mount_vfs let you set progressively more things.
- *
- * It's tempting to try a direct mount(2) syscall, but that doesn't
- * do any autodetection, so we are better off calling out to
- * /bin/mount.
- */
-
-int
-do_mount_vfs (const char *options, const char *vfstype,
- const mountable_t *mountable, const char *mountpoint)
-{
- CLEANUP_FREE char *mp = NULL;
- struct stat statbuf;
-
- ABS_PATH (mountpoint, 0, return -1);
-
- mp = sysroot_path (mountpoint);
- if (!mp) {
- reply_with_perror ("malloc");
- return -1;
- }
-
- /* Check the mountpoint exists and is a directory. */
- if (stat (mp, &statbuf) == -1) {
- reply_with_perror ("mount: %s", mountpoint);
- return -1;
- }
- if (!S_ISDIR (statbuf.st_mode)) {
- reply_with_perror ("mount: %s: mount point is not a directory",
mountpoint);
- return -1;
- }
-
- return mount_vfs_nochroot (options, vfstype, mountable, mp, mountpoint);
-}
-
-int
-mount_vfs_nochroot (const char *options, const char *vfstype,
- const mountable_t *mountable,
- const char *mp, const char *user_mp)
-{
- CLEANUP_FREE char *options_plus = NULL;
- const char *device = mountable->device;
- if (mountable->type == MOUNTABLE_BTRFSVOL) {
- if (options && strlen (options) > 0) {
- if (asprintf (&options_plus, "subvol=%s,%s",
- mountable->volume, options) == -1) {
- reply_with_perror ("asprintf");
- return -1;
- }
- }
-
- else {
- if (asprintf (&options_plus, "subvol=%s",
mountable->volume) == -1) {
- reply_with_perror ("asprintf");
- return -1;
- }
- }
- }
-
- CLEANUP_FREE char *error = NULL;
- int r;
- if (vfstype)
- r = command (NULL, &error,
- str_mount, "-o", options_plus ? options_plus :
options,
- "-t", vfstype, device, mp, NULL);
- else
- r = command (NULL, &error,
- str_mount, "-o", options_plus ? options_plus :
options,
- device, mp, NULL);
- if (r == -1) {
- reply_with_error ("%s on %s (options: '%s'): %s",
- device, user_mp, options, error);
- return -1;
- }
-
- return 0;
-}
-
-int
-do_mount (const mountable_t *mountable, const char *mountpoint)
-{
- return do_mount_vfs ("", NULL, mountable, mountpoint);
-}
-
-int
-do_mount_ro (const mountable_t *mountable, const char *mountpoint)
-{
- return do_mount_vfs ("ro", NULL, mountable, mountpoint);
-}
-
-int
-do_mount_options (const char *options, const mountable_t *mountable,
- const char *mountpoint)
-{
- return do_mount_vfs (options, NULL, mountable, mountpoint);
-}
-
/* Takes optional arguments, consult optargs_bitmask. */
int
do_umount (const char *pathordevice,
diff --git a/daemon/mount.ml b/daemon/mount.ml
new file mode 100644
index 000000000..665e79ae5
--- /dev/null
+++ b/daemon/mount.ml
@@ -0,0 +1,62 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Common_utils
+
+open Mountable
+open Utils
+
+let mount_vfs options vfs mountable mountpoint + let mp = Sysroot.sysroot ()
// mountpoint in
+
+ (* Check the mountpoint exists and is a directory. *)
+ if not (is_directory mp) then
+ failwithf "mount: %s: mount point is not a directory" mountpoint;
+
+ let args = ref [] in
+
+ (* -o options *)
+ (match options, mountable.m_type with
+ | (None | Some ""), (MountableDevice | MountablePath) -> ()
+ | Some options, (MountableDevice | MountablePath) ->
+ push_back args "-o";
+ push_back args options
+ | (None | Some ""), MountableBtrfsVol subvol ->
+ push_back args "-o";
+ push_back args ("subvol=" ^ subvol)
+ | Some options, MountableBtrfsVol subvol ->
+ push_back args "-o";
+ push_back args ("subvol=" ^ subvol ^ "," ^ options)
+ );
+
+ (* -t vfs *)
+ (match vfs with
+ | None | Some "" -> ()
+ | Some t ->
+ push_back args "-t";
+ push_back args t
+ );
+
+ push_back args mountable.m_device;
+ push_back args mp;
+
+ ignore (command "mount" !args)
+
+let mount = mount_vfs None None
+let mount_ro = mount_vfs (Some "ro") None
+let mount_options options = mount_vfs (Some options) None
diff --git a/daemon/mount.mli b/daemon/mount.mli
new file mode 100644
index 000000000..e43d97c42
--- /dev/null
+++ b/daemon/mount.mli
@@ -0,0 +1,22 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val mount : Mountable.t -> string -> unit
+val mount_ro : Mountable.t -> string -> unit
+val mount_options : string -> Mountable.t -> string -> unit
+val mount_vfs : string option -> string option -> Mountable.t ->
string -> unit
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 7d6755fdc..f33bc5320 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -1739,6 +1739,7 @@ let daemon_functions = [
{ defaults with
name = "mount"; added = (0, 0, 3);
style = RErr, [String (Mountable, "mountable"); String
(PlainString, "mountpoint")], [];
+ impl = OCaml "Mount.mount";
tests = [
InitEmpty, Always, TestResultString (
[["part_disk"; "/dev/sda"; "mbr"];
@@ -2922,6 +2923,7 @@ If set to true, POSIX ACLs are saved in the output tar.
{ defaults with
name = "mount_ro"; added = (1, 0, 10);
style = RErr, [String (Mountable, "mountable"); String
(PlainString, "mountpoint")], [];
+ impl = OCaml "Mount.mount_ro";
tests = [
InitBasicFS, Always, TestLastFail (
[["umount"; "/"; "false";
"false"];
@@ -2941,6 +2943,7 @@ mounts the filesystem with the read-only (I<-o ro>)
flag." };
{ defaults with
name = "mount_options"; added = (1, 0, 10);
style = RErr, [String (PlainString, "options"); String
(Mountable, "mountable"); String (PlainString,
"mountpoint")], [];
+ impl = OCaml "Mount.mount_options";
shortdesc = "mount a guest disk with mount options";
longdesc = "\
This is the same as the C<guestfs_mount> command, but it
@@ -2954,6 +2957,7 @@ the filesystem uses)." };
{ defaults with
name = "mount_vfs"; added = (1, 0, 10);
style = RErr, [String (PlainString, "options"); String
(PlainString, "vfstype"); String (Mountable, "mountable");
String (PlainString, "mountpoint")], [];
+ impl = OCaml "Mount.mount_vfs";
shortdesc = "mount a guest disk with mount options and vfstype";
longdesc = "\
This is the same as the C<guestfs_mount> command, but it
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 060ab547e..65e49a9a1 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -685,7 +685,8 @@ return_string_list (value retv)
pr "\n";
(match ret with
- | RErr -> assert false
+ | RErr ->
+ pr " CAMLreturnT (int, 0);\n"
| RInt _ ->
pr " CAMLreturnT (int, Int_val (retv));\n"
| RInt64 _ -> assert false
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 10/12] daemon: Reimplement ‘part_get_mbr_id’ API in OCaml.
---
daemon/Makefile.am | 2 ++
daemon/parted.c | 42 ------------------------------------
daemon/parted.ml | 55 +++++++++++++++++++++++++++++++++++++++++++++++
daemon/parted.mli | 19 ++++++++++++++++
generator/actions_core.ml | 1 +
5 files changed, 77 insertions(+), 42 deletions(-)
create mode 100644 daemon/parted.ml
create mode 100644 daemon/parted.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index c8e58ea20..7d9311ebb 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -260,6 +260,7 @@ SOURCES_MLI = \
link.mli \
mount.mli \
mountable.mli \
+ parted.mli \
unix_utils.mli \
utils.mli
@@ -278,6 +279,7 @@ SOURCES_ML = \
is.ml \
link.ml \
mount.ml \
+ parted.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/parted.c b/daemon/parted.c
index 03e83cb32..a1e5c81cf 100644
--- a/daemon/parted.c
+++ b/daemon/parted.c
@@ -521,48 +521,6 @@ test_sfdisk_has_part_type (void)
return tested;
}
-/* Currently we use sfdisk for getting and setting the ID byte. In
- * future, extend parted to provide this functionality. As a result
- * of using sfdisk, this won't work for non-MBR-style partitions, but
- * that limitation is noted in the documentation and we can extend it
- * later without breaking the ABI.
- */
-int
-do_part_get_mbr_id (const char *device, int partnum)
-{
- if (partnum <= 0) {
- reply_with_error ("partition number must be >= 1");
- return -1;
- }
-
- const char *param = test_sfdisk_has_part_type () ? "--part-type" :
"--print-id";
-
- char partnum_str[16];
- snprintf (partnum_str, sizeof partnum_str, "%d", partnum);
-
- CLEANUP_FREE char *out = NULL, *err = NULL;
- int r;
-
- udev_settle ();
-
- r = command (&out, &err, str_sfdisk, param, device, partnum_str,
NULL);
- if (r == -1) {
- reply_with_error ("sfdisk %s: %s", param, err);
- return -1;
- }
-
- udev_settle ();
-
- /* It's printed in hex ... */
- unsigned id;
- if (sscanf (out, "%x", &id) != 1) {
- reply_with_error ("sfdisk --print-id: cannot parse output: %s",
out);
- return -1;
- }
-
- return id;
-}
-
int
do_part_set_mbr_id (const char *device, int partnum, int idbyte)
{
diff --git a/daemon/parted.ml b/daemon/parted.ml
new file mode 100644
index 000000000..6da6de990
--- /dev/null
+++ b/daemon/parted.ml
@@ -0,0 +1,55 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Scanf
+
+open Common_utils
+
+open Utils
+
+(* Test if [sfdisk] is recent enough to have [--part-type], to be used
+ * instead of [--print-id] and [--change-id].
+ *)
+let test_sfdisk_has_part_type = lazy (
+ let out = command "sfdisk" ["--help"] in
+ String.find out "--part-type" >= 0
+)
+
+(* Currently we use sfdisk for getting and setting the ID byte. In
+ * future, extend parted to provide this functionality. As a result
+ * of using sfdisk, this won't work for non-MBR-style partitions, but
+ * that limitation is noted in the documentation and we can extend it
+ * later without breaking the ABI.
+ *)
+let part_get_mbr_id device partnum + if partnum <= 0 then
+ failwith "partition number must be >= 1";
+
+ let param + if Lazy.force test_sfdisk_has_part_type then
+ "--part-type"
+ else
+ "--print-id" in
+
+ udev_settle ();
+ let out + command "sfdisk" [param; device; string_of_int
partnum] in
+ udev_settle ();
+
+ (* It's printed in hex, possibly with a leading space. *)
+ sscanf out " %x" identity
diff --git a/daemon/parted.mli b/daemon/parted.mli
new file mode 100644
index 000000000..33eb6d30d
--- /dev/null
+++ b/daemon/parted.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val part_get_mbr_id : string -> int -> int
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index f33bc5320..4bf0c7b70 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -5513,6 +5513,7 @@ See also C<guestfs_part_set_bootable>." };
{ defaults with
name = "part_get_mbr_id"; added = (1, 3, 2);
style = RInt "idbyte", [String (Device, "device"); Int
"partnum"], [];
+ impl = OCaml "Parted.part_get_mbr_id";
fish_output = Some FishOutputHexadecimal;
tests = [
InitEmpty, Always, TestResult (
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 11/12] daemon: Reimplement ‘case_sensitive_path’ API in OCaml.
---
daemon/Makefile.am | 2 +
daemon/realpath.c | 187 ----------------------------------------------
daemon/realpath.ml | 83 ++++++++++++++++++++
daemon/realpath.mli | 19 +++++
generator/actions_core.ml | 1 +
5 files changed, 105 insertions(+), 187 deletions(-)
create mode 100644 daemon/realpath.ml
create mode 100644 daemon/realpath.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 7d9311ebb..357683bac 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -261,6 +261,7 @@ SOURCES_MLI = \
mount.mli \
mountable.mli \
parted.mli \
+ realpath.mli \
unix_utils.mli \
utils.mli
@@ -280,6 +281,7 @@ SOURCES_ML = \
link.ml \
mount.ml \
parted.ml \
+ realpath.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/realpath.c b/daemon/realpath.c
index 24ab133e2..f9d22d28d 100644
--- a/daemon/realpath.c
+++ b/daemon/realpath.c
@@ -48,190 +48,3 @@ do_realpath (const char *path)
return ret; /* caller frees */
}
-
-static int find_path_element (int fd_cwd, int is_end, const char *name, char
**name_ret);
-
-char *
-do_case_sensitive_path (const char *path)
-{
- size_t next;
- int fd_cwd, fd2, err, is_end;
- char *ret;
-
- ret = strdup ("/");
- if (ret == NULL) {
- reply_with_perror ("strdup");
- return NULL;
- }
- next = 1; /* next position in 'ret' buffer */
-
- /* 'fd_cwd' here is a surrogate for the current working directory, so
- * that we don't have to actually call chdir(2).
- */
- fd_cwd = open (sysroot, O_RDONLY|O_DIRECTORY|O_CLOEXEC);
- if (fd_cwd == -1) {
- reply_with_perror ("%s", sysroot);
- goto error;
- }
-
- /* First character is a '/'. Take each subsequent path element
- * and follow it.
- */
- while (*path) {
- char *t;
- size_t i, len;
- CLEANUP_FREE char *name_in = NULL, *name_out = NULL;
-
- i = strcspn (path, "/");
- if (i == 0) {
- path++;
- continue;
- }
-
- if ((i == 1 && path[0] == '.') ||
- (i == 2 && path[0] == '.' && path[1] ==
'.')) {
- reply_with_error ("path contained . or .. elements");
- goto error;
- }
-
- name_in = strndup (path, i);
- if (name_in == NULL) {
- reply_with_perror ("strdup");
- goto error;
- }
-
- /* Skip to next element in path (for the next loop iteration). */
- path += i;
- is_end = *path == 0;
-
- /* Read the current directory looking (case insensitively) for
- * this element of the path. This replaces 'name' with the
- * correct case version.
- */
- if (find_path_element (fd_cwd, is_end, name_in, &name_out) == -1)
- goto error;
- len = strlen (name_out);
-
- /* Add the real name of this path element to the return value. */
- if (next > 1)
- ret[next++] = '/';
-
- t = realloc (ret, next+len+1);
- if (t == NULL) {
- reply_with_perror ("realloc");
- goto error;
- }
- ret = t;
-
- strcpy (&ret[next], name_out);
- next += len;
-
- /* Is it a directory? Try going into it. */
- fd2 = openat (fd_cwd, name_out, O_RDONLY|O_DIRECTORY|O_CLOEXEC);
- err = errno;
- close (fd_cwd);
- fd_cwd = fd2;
- errno = err;
- if (fd_cwd == -1) {
- /* Some errors are OK provided we've reached the end of the path. */
- if (is_end && (errno == ENOTDIR || errno == ENOENT))
- break;
-
- reply_with_perror ("openat: %s", name_out);
- goto error;
- }
- }
-
- if (fd_cwd >= 0)
- close (fd_cwd);
-
- return ret; /* caller frees */
-
- error:
- if (fd_cwd >= 0)
- close (fd_cwd);
- free (ret);
-
- return NULL;
-}
-
-/* 'fd_cwd' is a file descriptor pointing to an open directory.
- * 'name' is the path element to search for. 'is_end' is a
flag
- * indicating if this is the last path element.
- *
- * We search the directory looking for a path element that case
- * insensitively matches 'name', returning the actual name in
'*name_ret'.
- *
- * If this is successful, return 0. If it fails, reply with an error
- * and return -1.
- */
-static int
-find_path_element (int fd_cwd, int is_end, const char *name, char **name_ret)
-{
- int fd2;
- DIR *dir;
- struct dirent *d;
-
- fd2 = dup_cloexec (fd_cwd); /* because closedir will close it */
- if (fd2 == -1) {
- reply_with_perror ("dup");
- return -1;
- }
- dir = fdopendir (fd2);
- if (dir == NULL) {
- reply_with_perror ("opendir");
- close (fd2);
- return -1;
- }
-
- for (;;) {
- errno = 0;
- d = readdir (dir);
- if (d == NULL)
- break;
- if (STRCASEEQ (d->d_name, name))
- break;
- }
-
- if (d == NULL && errno != 0) {
- reply_with_perror ("readdir");
- closedir (dir);
- return -1;
- }
-
- if (d == NULL && is_end) {
- /* Last path element: return it as-is, assuming that the user will
- * create a new file or directory (RHBZ#840115).
- */
- closedir (dir);
- *name_ret = strdup (name);
- if (*name_ret == NULL) {
- reply_with_perror ("strdup");
- return -1;
- }
- return 0;
- }
-
- if (d == NULL) {
- reply_with_error ("%s: no file or directory found with this
name", name);
- closedir (dir);
- return -1;
- }
-
- *name_ret = strdup (d->d_name);
- if (*name_ret == NULL) {
- reply_with_perror ("strdup");
- closedir (dir);
- return -1;
- }
-
- /* NB: closedir frees the structure associated with 'd', so we must
- * do this last.
- */
- if (closedir (dir) == -1) {
- reply_with_perror ("closedir");
- return -1;
- }
-
- return 0;
-}
diff --git a/daemon/realpath.ml b/daemon/realpath.ml
new file mode 100644
index 000000000..1027d47b5
--- /dev/null
+++ b/daemon/realpath.ml
@@ -0,0 +1,83 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Printf
+
+open Common_utils
+
+(* The infamous case_sensitive_path function, which works around
+ * the bug in ntfs-3g that all paths are case sensitive even though
+ * the underlying filesystem is case insensitive.
+ *)
+let rec case_sensitive_path path + let elems = String.nsplit "/"
path in
+
+ (* The caller ensures that the first element of [path] is [/],
+ * and therefore the first element of the split list must be
+ * empty.
+ *)
+ assert (List.length elems > 0);
+ assert (List.hd elems = "");
+ let elems = List.tl elems in
+
+ let sysroot = Sysroot.sysroot () in
+ let chroot = Chroot.create sysroot
+ ~name:(sprintf "case_sensitive_path: %s"
path) in
+
+ (* Now we iterate down the tree starting at the sysroot. *)
+ let elems + Chroot.f chroot (
+ fun () ->
+ let rec loop = function
+ | [] -> []
+ | [ "."|".." ] ->
+ failwithf "path contains \"//\" or \".\"
or \"..\" elements"
+ | "" :: elems ->
+ (* For compatibility with C implementation, we ignore
+ * "//" in the middle of the path.
+ *)
+ loop elems
+ | [ file ] ->
+ (* If it's the final element, it's allowed to be missing.
*)
+ (match find_path_element file with
+ | None -> [ file ] (* return the original *)
+ | Some file -> [ file ]
+ );
+ | elem :: elems ->
+ (match find_path_element elem with
+ | None ->
+ failwithf "%s: not found" elem
+ | Some elem ->
+ (* This will fail intentionally if not a directory. *)
+ Unix.chdir elem;
+ elem :: loop elems
+ )
+ in
+ loop elems
+ ) () in
+
+ (* Reconstruct the case sensitive path. *)
+ "/" ^ String.concat "/" elems
+
+and find_path_element name + let dir = Sys.readdir "." in
+ let dir = Array.to_list dir in
+ let lc_name = String.lowercase_ascii name in
+ let cmp n = String.lowercase_ascii n = lc_name in
+ try Some (List.find cmp dir)
+ with Not_found -> None
diff --git a/daemon/realpath.mli b/daemon/realpath.mli
new file mode 100644
index 000000000..371e619fc
--- /dev/null
+++ b/daemon/realpath.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val case_sensitive_path : string -> string
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 4bf0c7b70..54d0a6ca8 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -4797,6 +4797,7 @@ The result list is not sorted.
{ defaults with
name = "case_sensitive_path"; added = (1, 0, 75);
style = RString (RPlainString, "rpath"), [String (Pathname,
"path")], [];
+ impl = OCaml "Realpath.case_sensitive_path";
tests = [
InitISOFS, Always, TestResultString (
[["case_sensitive_path"; "/DIRECTORY"]],
"/directory"), [];
--
2.13.0
Richard W.M. Jones
2017-Jun-03 17:40 UTC
[Libguestfs] [PATCH v2 12/12] daemon: Reimplement ‘file_architecture’ API in OCaml.
The previously library-side ?file_architecture? API is reimplemented
in the daemon, in OCaml.
There are some significant differences compared to the C
implementation:
- The C code used libmagic. That is replaced by calling the ?file?
command (because that is simpler than using the library).
- The C code had extra cases to deal with compressed files. This is
not necessary since the ?file? command supports the ?-z? option
which transparently looks inside compressed content (this is a
consequence of the change above).
This commit demonstrates a number of techniques which will be useful
for moving inspection code to the daemon:
- Moving an API from the C library to the OCaml daemon.
- Calling from one OCaml API inside the daemon to another (from
?Filearch.file_architecture? to ?File.file?). This can be done and
is done with C daemon APIs but correct reply_with_error handling is
more difficult in C.
- Use of Str for regular expression matching within the appliance.
---
daemon/Makefile.am | 2 +
daemon/filearch.ml | 137 +++++++++++++++++
daemon/filearch.mli | 19 +++
docs/C_SOURCE_FILES | 5 +-
generator/actions_core.ml | 377 +++++++++++++++++++++++-----------------------
generator/proc_nr.ml | 1 +
lib/MAX_PROC_NR | 2 +-
lib/Makefile.am | 3 +-
lib/filearch.c | 362 --------------------------------------------
po/POTFILES | 1 -
10 files changed, 354 insertions(+), 555 deletions(-)
create mode 100644 daemon/filearch.ml
create mode 100644 daemon/filearch.mli
delete mode 100644 lib/filearch.c
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 357683bac..f03b0c54f 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -256,6 +256,7 @@ SOURCES_MLI = \
sysroot.mli \
devsparts.mli \
file.mli \
+ filearch.mli \
is.mli \
link.mli \
mount.mli \
@@ -277,6 +278,7 @@ SOURCES_ML = \
blkid.ml \
devsparts.ml \
file.ml \
+ filearch.ml \
is.ml \
link.ml \
mount.ml \
diff --git a/daemon/filearch.ml b/daemon/filearch.ml
new file mode 100644
index 000000000..79b5aea6c
--- /dev/null
+++ b/daemon/filearch.ml
@@ -0,0 +1,137 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+open Unix
+open Printf
+
+open Common_utils
+
+open Utils
+
+let re_file_elf + Str.regexp "ELF \\([0-9]+\\)-bit
\\(MSB\\|LSB\\).*\\(executable\\|shared object\\|relocatable\\),
\\([^,]+\\),"
+
+let re_file_elf_ppc64 = Str.regexp ".*64.*PowerPC"
+
+let initrd_binaries = [
+ "bin/ls";
+ "bin/rm";
+ "bin/modprobe";
+ "sbin/modprobe";
+ "bin/sh";
+ "bin/bash";
+ "bin/dash";
+ "bin/nash";
+]
+
+let rec file_architecture orig_path + (* Get the output of the
"file" command. Note that because this
+ * is running in the daemon, LANG=C so it's in English.
+ *)
+ let magic = File.file orig_path in
+ file_architecture_of_magic magic orig_path orig_path
+
+and file_architecture_of_magic magic orig_path path + if Str.string_match
re_file_elf magic 0 then (
+ let bits = Str.matched_group 1 magic in
+ let endianness = Str.matched_group 2 magic in
+ let elf_arch = Str.matched_group 4 magic in
+ canonical_elf_arch bits endianness elf_arch
+ )
+ else if String.find magic "PE32 executable" >= 0 then
+ "i386"
+ else if String.find magic "PE32+ executable" >= 0 then
+ "x86_64"
+ else if String.find magic "cpio archive" >= 0 then
+ cpio_arch magic orig_path path
+ else
+ failwithf "unknown architecture: %s" path
+
+(* Convert output from 'file' command on ELF files to the canonical
+ * architecture string. Caller must free the result.
+ *)
+and canonical_elf_arch bits endianness elf_arch + let substr s = String.find
elf_arch s >= 0 in
+ if substr "Intel 80386" || substr "Intel 80486" then
+ "i386"
+ else if substr "x86-64" || substr "AMD x86-64" then
+ "x86_64"
+ else if substr "SPARC32" then
+ "sparc"
+ else if substr "SPARC V9" then
+ "sparc64"
+ else if substr "IA-64" then
+ "ia64"
+ else if Str.string_match re_file_elf_ppc64 elf_arch 0 then (
+ match endianness with
+ | "MSB" -> "ppc64"
+ | "LSB" -> "ppc64le"
+ | _ -> failwithf "unknown endianness '%s'" endianness
+ )
+ else if substr "PowerPC" then
+ "ppc"
+ else if substr "ARM aarch64" then
+ "aarch64"
+ else if substr "ARM" then
+ "arm"
+ else if substr "UCB RISC-V" then
+ sprintf "riscv%s" bits
+ else if substr "IBM S/390" then (
+ match bits with
+ | "32" -> "s390"
+ | "64" -> "s390x"
+ | _ -> failwithf "unknown S/390 bit size: %s" bits
+ )
+ else
+ elf_arch
+
+and cpio_arch magic orig_path path + let sysroot = Sysroot.sysroot () in
+
+ let zcat + if String.find magic "gzip" >= 0 then
"zcat"
+ else if String.find magic "bzip2" >= 0 then "bzcat"
+ else if String.find magic "XZ compressed" >= 0 then
"xzcat"
+ else "cat" in
+
+ let tmpdir = sprintf "/tmp/%s" (String.random8 ()) in
+ mkdir tmpdir 0o700;
+
+ (* Construct a command to extract named binaries from the initrd file. *)
+ let cmd + sprintf "cd %s && %s %s | cpio --quiet -id %s"
+ tmpdir zcat (quote (sysroot // path))
+ (String.concat " " (List.map quote initrd_binaries)) in
+ if verbose () then eprintf "%s\n%!" cmd;
+ if Sys.command cmd <> 0 then
+ failwith "cpio command failed";
+
+ (* See if any of the binaries were present in the output. *)
+ let rec loop = function
+ | bin :: bins ->
+ let bin_path = tmpdir // bin in
+ if is_regular_file bin_path then (
+ let out = command "file" ["-zb"; bin_path] in
+ file_architecture_of_magic out orig_path bin_path
+ )
+ else
+ loop bins
+ | [] ->
+ failwithf "could not determine architecture of cpio archive:
%s" path
+ in
+ loop initrd_binaries
diff --git a/daemon/filearch.mli b/daemon/filearch.mli
new file mode 100644
index 000000000..c4630225b
--- /dev/null
+++ b/daemon/filearch.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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.
+ *)
+
+val file_architecture : string -> string
diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index 15abec124..6e923e725 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -62,6 +62,7 @@ daemon/blkdiscard.c
daemon/blkid.c
daemon/blockdev.c
daemon/btrfs.c
+daemon/caml-stubs.c
daemon/cap.c
daemon/checksum.c
daemon/cleanups.c
@@ -73,6 +74,7 @@ daemon/compress.c
daemon/copy.c
daemon/cpio.c
daemon/cpmv.c
+daemon/daemon-c.c
daemon/daemon.h
daemon/dd.c
daemon/debug-bmap.c
@@ -163,10 +165,12 @@ daemon/stubs.h
daemon/swap.c
daemon/sync.c
daemon/syslinux.c
+daemon/sysroot-c.c
daemon/tar.c
daemon/truncate.c
daemon/tsk.c
daemon/umask.c
+daemon/unix_utils-c.c
daemon/upload.c
daemon/utimens.c
daemon/utsname.c
@@ -286,7 +290,6 @@ lib/errors.c
lib/event-string.c
lib/events.c
lib/file.c
-lib/filearch.c
lib/fuse.c
lib/guestfs-internal-actions.h
lib/guestfs-internal-all.h
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 54d0a6ca8..bfd96589e 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -183,194 +183,6 @@ making this an unreliable way to test for features.
Use C<guestfs_available> or C<guestfs_feature_available>
instead." };
{ defaults with
- name = "file_architecture"; added = (1, 5, 3);
- style = RString (RPlainString, "arch"), [String (Pathname,
"filename")], [];
- tests = [
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-aarch64-dynamic"]],
"aarch64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-armv7-dynamic"]],
"arm"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-i586-dynamic"]],
"i386"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-ppc64-dynamic"]],
"ppc64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-ppc64le-dynamic"]],
"ppc64le"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-riscv64-dynamic"]],
"riscv64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-s390x-dynamic"]],
"s390x"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-sparc-dynamic"]],
"sparc"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-win32.exe"]],
"i386"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-win64.exe"]],
"x86_64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-x86_64-dynamic"]],
"x86_64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-aarch64.so"]],
"aarch64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-armv7.so"]],
"arm"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-i586.so"]],
"i386"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-ppc64.so"]],
"ppc64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-ppc64le.so"]],
"ppc64le"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-riscv64.so"]],
"riscv64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-s390x.so"]],
"s390x"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-sparc.so"]],
"sparc"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-win32.dll"]],
"i386"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-win64.dll"]],
"x86_64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-x86_64.so"]],
"x86_64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/initrd-x86_64.img"]],
"x86_64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/initrd-x86_64.img.gz"]],
"x86_64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/bin-x86_64-dynamic.gz"]],
"x86_64"), [];
- InitISOFS, Always, TestResultString (
- [["file_architecture"; "/lib-i586.so.xz"]],
"i386"), [];
- ];
- shortdesc = "detect the architecture of a binary file";
- longdesc = "\
-This detects the architecture of the binary F<filename>,
-and returns it if known.
-
-Currently defined architectures are:
-
-=over 4
-
-=item \"aarch64\"
-
-64 bit ARM.
-
-=item \"arm\"
-
-32 bit ARM.
-
-=item \"i386\"
-
-This string is returned for all 32 bit i386, i486, i586, i686 binaries
-irrespective of the precise processor requirements of the binary.
-
-=item \"ia64\"
-
-Intel Itanium.
-
-=item \"ppc\"
-
-32 bit Power PC.
-
-=item \"ppc64\"
-
-64 bit Power PC (big endian).
-
-=item \"ppc64le\"
-
-64 bit Power PC (little endian).
-
-=item \"riscv32\"
-
-=item \"riscv64\"
-
-=item \"riscv128\"
-
-RISC-V 32-, 64- or 128-bit variants.
-
-=item \"s390\"
-
-31 bit IBM S/390.
-
-=item \"s390x\"
-
-64 bit IBM S/390.
-
-=item \"sparc\"
-
-32 bit SPARC.
-
-=item \"sparc64\"
-
-64 bit SPARC V9 and above.
-
-=item \"x86_64\"
-
-64 bit x86-64.
-
-=back
-
-Libguestfs may return other architecture strings in future.
-
-The function works on at least the following types of files:
-
-=over 4
-
-=item *
-
-many types of Un*x and Linux binary
-
-=item *
-
-many types of Un*x and Linux shared library
-
-=item *
-
-Windows Win32 and Win64 binaries
-
-=item *
-
-Windows Win32 and Win64 DLLs
-
-Win32 binaries and DLLs return C<i386>.
-
-Win64 binaries and DLLs return C<x86_64>.
-
-=item *
-
-Linux kernel modules
-
-=item *
-
-Linux new-style initrd images
-
-=item *
-
-some non-x86 Linux vmlinuz kernels
-
-=back
-
-What it can't do currently:
-
-=over 4
-
-=item *
-
-static libraries (libfoo.a)
-
-=item *
-
-Linux old-style initrd as compressed ext2 filesystem (RHEL 3)
-
-=item *
-
-x86 Linux vmlinuz kernels
-
-x86 vmlinuz images (bzImage format) consist of a mix of 16-, 32- and
-compressed code, and are horribly hard to unpack. If you want to find
-the architecture of a kernel, use the architecture of the associated
-initrd or kernel module(s) instead.
-
-=back" };
-
- { defaults with
name = "mountable_device"; added = (1, 33, 15);
style = RString (RDevice, "device"), [String (Mountable,
"mountable")], [];
shortdesc = "extract the device part of a mountable";
@@ -9628,4 +9440,193 @@ wildcards.
Please note that this API may fail when used to compress directories
with large files, such as the resulting squashfs will be over 3GB big." };
+ { defaults with
+ name = "file_architecture"; added = (1, 5, 3);
+ style = RString (RPlainString, "arch"), [String (Pathname,
"filename")], [];
+ impl = OCaml "Filearch.file_architecture";
+ tests = [
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-aarch64-dynamic"]],
"aarch64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-armv7-dynamic"]],
"arm"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-i586-dynamic"]],
"i386"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-ppc64-dynamic"]],
"ppc64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-ppc64le-dynamic"]],
"ppc64le"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-riscv64-dynamic"]],
"riscv64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-s390x-dynamic"]],
"s390x"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-sparc-dynamic"]],
"sparc"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-win32.exe"]],
"i386"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-win64.exe"]],
"x86_64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-x86_64-dynamic"]],
"x86_64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-aarch64.so"]],
"aarch64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-armv7.so"]],
"arm"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-i586.so"]],
"i386"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-ppc64.so"]],
"ppc64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-ppc64le.so"]],
"ppc64le"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-riscv64.so"]],
"riscv64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-s390x.so"]],
"s390x"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-sparc.so"]],
"sparc"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-win32.dll"]],
"i386"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-win64.dll"]],
"x86_64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-x86_64.so"]],
"x86_64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/initrd-x86_64.img"]],
"x86_64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/initrd-x86_64.img.gz"]],
"x86_64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/bin-x86_64-dynamic.gz"]],
"x86_64"), [];
+ InitISOFS, Always, TestResultString (
+ [["file_architecture"; "/lib-i586.so.xz"]],
"i386"), [];
+ ];
+ shortdesc = "detect the architecture of a binary file";
+ longdesc = "\
+This detects the architecture of the binary F<filename>,
+and returns it if known.
+
+Currently defined architectures are:
+
+=over 4
+
+=item \"aarch64\"
+
+64 bit ARM.
+
+=item \"arm\"
+
+32 bit ARM.
+
+=item \"i386\"
+
+This string is returned for all 32 bit i386, i486, i586, i686 binaries
+irrespective of the precise processor requirements of the binary.
+
+=item \"ia64\"
+
+Intel Itanium.
+
+=item \"ppc\"
+
+32 bit Power PC.
+
+=item \"ppc64\"
+
+64 bit Power PC (big endian).
+
+=item \"ppc64le\"
+
+64 bit Power PC (little endian).
+
+=item \"riscv32\"
+
+=item \"riscv64\"
+
+=item \"riscv128\"
+
+RISC-V 32-, 64- or 128-bit variants.
+
+=item \"s390\"
+
+31 bit IBM S/390.
+
+=item \"s390x\"
+
+64 bit IBM S/390.
+
+=item \"sparc\"
+
+32 bit SPARC.
+
+=item \"sparc64\"
+
+64 bit SPARC V9 and above.
+
+=item \"x86_64\"
+
+64 bit x86-64.
+
+=back
+
+Libguestfs may return other architecture strings in future.
+
+The function works on at least the following types of files:
+
+=over 4
+
+=item *
+
+many types of Un*x and Linux binary
+
+=item *
+
+many types of Un*x and Linux shared library
+
+=item *
+
+Windows Win32 and Win64 binaries
+
+=item *
+
+Windows Win32 and Win64 DLLs
+
+Win32 binaries and DLLs return C<i386>.
+
+Win64 binaries and DLLs return C<x86_64>.
+
+=item *
+
+Linux kernel modules
+
+=item *
+
+Linux new-style initrd images
+
+=item *
+
+some non-x86 Linux vmlinuz kernels
+
+=back
+
+What it can't do currently:
+
+=over 4
+
+=item *
+
+static libraries (libfoo.a)
+
+=item *
+
+Linux old-style initrd as compressed ext2 filesystem (RHEL 3)
+
+=item *
+
+x86 Linux vmlinuz kernels
+
+x86 vmlinuz images (bzImage format) consist of a mix of 16-, 32- and
+compressed code, and are horribly hard to unpack. If you want to find
+the architecture of a kernel, use the architecture of the associated
+initrd or kernel module(s) instead.
+
+=back" };
+
]
diff --git a/generator/proc_nr.ml b/generator/proc_nr.ml
index c7619638a..1b0feae87 100644
--- a/generator/proc_nr.ml
+++ b/generator/proc_nr.ml
@@ -482,6 +482,7 @@ let proc_nr = [
472, "yara_load";
473, "yara_destroy";
474, "internal_yara_scan";
+475, "file_architecture";
]
(* End of list. If adding a new entry, add it at the end of the list
diff --git a/lib/MAX_PROC_NR b/lib/MAX_PROC_NR
index 5f3bb9813..7573eff88 100644
--- a/lib/MAX_PROC_NR
+++ b/lib/MAX_PROC_NR
@@ -1 +1 @@
-474
+475
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 360ce9c92..518ecf64b 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -89,7 +89,6 @@ libguestfs_la_SOURCES = \
event-string.c \
events.c \
file.c \
- filearch.c \
fuse.c \
guid.c \
handle.c \
@@ -155,7 +154,7 @@ libguestfs_la_LIBADD = \
../common/protocol/libprotocol.la \
../common/qemuopts/libqemuopts.la \
../common/utils/libutils.la \
- $(PCRE_LIBS) $(MAGIC_LIBS) \
+ $(PCRE_LIBS) \
$(LIBVIRT_LIBS) $(LIBXML2_LIBS) \
$(SELINUX_LIBS) \
$(YAJL_LIBS) \
diff --git a/lib/filearch.c b/lib/filearch.c
deleted file mode 100644
index e1d3daeef..000000000
--- a/lib/filearch.c
+++ /dev/null
@@ -1,362 +0,0 @@
-/* libguestfs
- * Copyright (C) 2010 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 <config.h>
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <inttypes.h>
-#include <unistd.h>
-#include <string.h>
-#include <sys/stat.h>
-#include <sys/wait.h>
-#include <libintl.h>
-
-#include <magic.h>
-
-#include "ignore-value.h"
-
-#include "guestfs.h"
-#include "guestfs-internal.h"
-#include "guestfs-internal-actions.h"
-
-# ifdef HAVE_ATTRIBUTE_CLEANUP
-# define CLEANUP_MAGIC_T_FREE __attribute__((cleanup(cleanup_magic_t_free)))
-
-static void
-cleanup_magic_t_free (void *ptr)
-{
- magic_t m = *(magic_t *) ptr;
-
- if (m)
- magic_close (m);
-}
-
-# else
-# define CLEANUP_MAGIC_T_FREE
-# endif
-
-COMPILE_REGEXP (re_file_elf,
- "ELF (\\d+)-bit (MSB|LSB).*(?:executable|shared
object|relocatable), (.+?),", 0)
-COMPILE_REGEXP (re_elf_ppc64, ".*64.*PowerPC", 0)
-
-/* Convert output from 'file' command on ELF files to the canonical
- * architecture string. Caller must free the result.
- */
-static char *
-canonical_elf_arch (guestfs_h *g,
- const char *bits, const char *endianness,
- const char *elf_arch)
-{
- const char *r;
- char *ret;
-
- if (strstr (elf_arch, "Intel 80386") ||
- strstr (elf_arch, "Intel 80486"))
- r = "i386";
- else if (strstr (elf_arch, "x86-64") ||
- strstr (elf_arch, "AMD x86-64"))
- r = "x86_64";
- else if (strstr (elf_arch, "SPARC32"))
- r = "sparc";
- else if (strstr (elf_arch, "SPARC V9"))
- r = "sparc64";
- else if (strstr (elf_arch, "IA-64"))
- r = "ia64";
- else if (match (g, elf_arch, re_elf_ppc64)) {
- if (strstr (endianness, "MSB"))
- r = "ppc64";
- else if (strstr (endianness, "LSB"))
- r = "ppc64le";
- else {
- error (g, "file_architecture: unknown endianness '%s'",
endianness);
- return NULL;
- }
- }
- else if (strstr (elf_arch, "PowerPC"))
- r = "ppc";
- else if (strstr (elf_arch, "ARM aarch64"))
- r = "aarch64";
- else if (strstr (elf_arch, "ARM"))
- r = "arm";
- else if (strstr (elf_arch, "UCB RISC-V")) {
- ret = safe_asprintf (g, "riscv%s", bits);
- goto no_strdup;
- }
- else if (strstr (elf_arch, "IBM S/390")) {
- if (STREQ (bits, "32"))
- r = "s390";
- else if (STREQ (bits, "64"))
- r = "s390x";
- else {
- error (g, "file_architecture: unknown S/390 bit size: %s",
bits);
- return NULL;
- }
- }
- else
- r = elf_arch;
-
- ret = safe_strdup (g, r);
- no_strdup:
- return ret;
-}
-
-static int
-is_regular_file (const char *filename)
-{
- struct stat statbuf;
-
- return lstat (filename, &statbuf) == 0 && S_ISREG
(statbuf.st_mode);
-}
-
-static char *
-magic_for_file (guestfs_h *g, const char *filename, bool *loading_ok,
- bool *matched)
-{
- int flags;
- CLEANUP_MAGIC_T_FREE magic_t m = NULL;
- const char *line;
- CLEANUP_FREE char *bits = NULL;
- CLEANUP_FREE char *elf_arch = NULL;
- CLEANUP_FREE char *endianness = NULL;
-
- flags = g->verbose ? MAGIC_DEBUG : 0;
- flags |= MAGIC_ERROR | MAGIC_RAW;
-
- if (loading_ok)
- *loading_ok = false;
- if (matched)
- *matched = false;
-
- m = magic_open (flags);
- if (m == NULL) {
- perrorf (g, "magic_open");
- return NULL;
- }
-
- if (magic_load (m, NULL) == -1) {
- perrorf (g, "magic_load: default magic database file");
- return NULL;
- }
-
- line = magic_file (m, filename);
- if (line == NULL) {
- perrorf (g, "magic_file: %s", filename);
- return NULL;
- }
-
- if (loading_ok)
- *loading_ok = true;
-
- if (!match3 (g, line, re_file_elf, &bits, &endianness,
&elf_arch)) {
- error (g, "no re_file_elf match in '%s'", line);
- return NULL;
- }
-
- if (matched)
- *matched = true;
-
- return canonical_elf_arch (g, bits, endianness, elf_arch);
-}
-
-/* Download and uncompress the cpio file to find binaries within. */
-static const char *initrd_binaries[] = {
- "bin/ls",
- "bin/rm",
- "bin/modprobe",
- "sbin/modprobe",
- "bin/sh",
- "bin/bash",
- "bin/dash",
- "bin/nash",
- NULL
-};
-
-static char *
-cpio_arch (guestfs_h *g, const char *file, const char *path)
-{
- CLEANUP_FREE char *tmpdir = guestfs_get_tmpdir (g), *dir = NULL;
- CLEANUP_FREE char *initrd = NULL;
- CLEANUP_CMD_CLOSE struct command *cmd = guestfs_int_new_command (g);
- char *ret = NULL;
- const char *method;
- int64_t size;
- int r;
- size_t i;
-
- if (asprintf (&dir, "%s/libguestfsXXXXXX", tmpdir) == -1) {
- perrorf (g, "asprintf");
- return NULL;
- }
-
- if (strstr (file, "gzip"))
- method = "zcat";
- else if (strstr (file, "bzip2"))
- method = "bzcat";
- else
- method = "cat";
-
- /* Security: Refuse to download initrd if it is huge. */
- size = guestfs_filesize (g, path);
- if (size == -1 || size > 100000000) {
- error (g, _("size of %s unreasonable (%" PRIi64 "
bytes)"),
- path, size);
- goto out;
- }
-
- if (mkdtemp (dir) == NULL) {
- perrorf (g, "mkdtemp");
- goto out;
- }
-
- initrd = safe_asprintf (g, "%s/initrd", dir);
- if (guestfs_download (g, path, initrd) == -1)
- goto out;
-
- /* Construct a command to extract named binaries from the initrd file. */
- guestfs_int_cmd_add_string_unquoted (cmd, "cd ");
- guestfs_int_cmd_add_string_quoted (cmd, dir);
- guestfs_int_cmd_add_string_unquoted (cmd, " && ");
- guestfs_int_cmd_add_string_unquoted (cmd, method);
- guestfs_int_cmd_add_string_unquoted (cmd, " initrd | cpio --quiet
-id");
- for (i = 0; initrd_binaries[i] != NULL; ++i) {
- guestfs_int_cmd_add_string_unquoted (cmd, " ");
- guestfs_int_cmd_add_string_quoted (cmd, initrd_binaries[i]);
- }
-
- r = guestfs_int_cmd_run (cmd);
- if (r == -1)
- goto out;
- if (!WIFEXITED (r) || WEXITSTATUS (r) != 0) {
- guestfs_int_external_command_failed (g, r, "cpio", path);
- goto out;
- }
-
- for (i = 0; initrd_binaries[i] != NULL; ++i) {
- CLEANUP_FREE char *bin - safe_asprintf (g, "%s/%s", dir,
initrd_binaries[i]);
-
- if (is_regular_file (bin)) {
- bool loading_ok, matched;
-
- ret = magic_for_file (g, bin, &loading_ok, &matched);
- if (!loading_ok || matched)
- goto out;
- }
- }
- error (g, "file_architecture: could not determine architecture of cpio
archive");
-
- out:
- guestfs_int_recursive_remove_dir (g, dir);
-
- return ret;
-}
-
-static char *
-compressed_file_arch (guestfs_h *g, const char *path, const char *method)
-{
- CLEANUP_FREE char *tmpdir = guestfs_get_tmpdir (g), *dir = NULL;
- CLEANUP_FREE char *tempfile = NULL, *tempfile_extracted = NULL;
- CLEANUP_CMD_CLOSE struct command *cmd = guestfs_int_new_command (g);
- char *ret = NULL;
- int64_t size;
- int r;
- bool matched;
-
- if (asprintf (&dir, "%s/libguestfsXXXXXX", tmpdir) == -1) {
- perrorf (g, "asprintf");
- return NULL;
- }
-
- /* Security: Refuse to download file if it is huge. */
- size = guestfs_filesize (g, path);
- if (size == -1 || size > 10000000) {
- error (g, _("size of %s unreasonable (%" PRIi64 "
bytes)"),
- path, size);
- goto out;
- }
-
- if (mkdtemp (dir) == NULL) {
- perrorf (g, "mkdtemp");
- goto out;
- }
-
- tempfile = safe_asprintf (g, "%s/file", dir);
- if (guestfs_download (g, path, tempfile) == -1)
- goto out;
-
- tempfile_extracted = safe_asprintf (g, "%s/file_extracted", dir);
-
- /* Construct a command to extract named binaries from the initrd file. */
- guestfs_int_cmd_add_string_unquoted (cmd, method);
- guestfs_int_cmd_add_string_unquoted (cmd, " ");
- guestfs_int_cmd_add_string_quoted (cmd, tempfile);
- guestfs_int_cmd_add_string_unquoted (cmd, " > ");
- guestfs_int_cmd_add_string_quoted (cmd, tempfile_extracted);
-
- r = guestfs_int_cmd_run (cmd);
- if (r == -1)
- goto out;
- if (!WIFEXITED (r) || WEXITSTATUS (r) != 0) {
- guestfs_int_external_command_failed (g, r, method, path);
- goto out;
- }
-
- ret = magic_for_file (g, tempfile_extracted, NULL, &matched);
- if (!matched)
- error (g, "file_architecture: could not determine architecture of
compressed file");
-
- out:
- guestfs_int_recursive_remove_dir (g, dir);
-
- return ret;
-}
-
-char *
-guestfs_impl_file_architecture (guestfs_h *g, const char *path)
-{
- CLEANUP_FREE char *file = NULL;
- CLEANUP_FREE char *bits = NULL;
- CLEANUP_FREE char *elf_arch = NULL;
- CLEANUP_FREE char *endianness = NULL;
- char *ret = NULL;
-
- /* Get the output of the "file" command. Note that because this
- * runs in the daemon, LANG=C so it's in English.
- */
- file = guestfs_file (g, path);
- if (file == NULL)
- return NULL;
-
- if ((match3 (g, file, re_file_elf, &bits, &endianness,
&elf_arch)) != 0)
- ret = canonical_elf_arch (g, bits, endianness, elf_arch);
- else if (strstr (file, "PE32 executable"))
- ret = safe_strdup (g, "i386");
- else if (strstr (file, "PE32+ executable"))
- ret = safe_strdup (g, "x86_64");
- else if (strstr (file, "cpio archive"))
- ret = cpio_arch (g, file, path);
- else if (strstr (file, "gzip compressed data"))
- ret = compressed_file_arch (g, path, "zcat");
- else if (strstr (file, "XZ compressed data"))
- ret = compressed_file_arch (g, path, "xzcat");
- else
- error (g, "file_architecture: unknown architecture: %s", path);
-
- return ret; /* caller frees */
-}
diff --git a/po/POTFILES b/po/POTFILES
index 0d8a924b6..1a38e8ed4 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -354,7 +354,6 @@ lib/errors.c
lib/event-string.c
lib/events.c
lib/file.c
-lib/filearch.c
lib/fuse.c
lib/guid.c
lib/handle.c
--
2.13.0
Reasonably Related Threads
- [PATCH v3 00/19] Allow APIs to be implemented in OCaml.
- [PATCH v3 00/23] Reimplement many daemon APIs in OCaml.
- [PATCH v2 00/23] Reimplement many daemon APIs in OCaml.
- [PATCH 00/27] Reimplement many daemon APIs in OCaml.
- [PATCH v5 00/32] Refactor utilities, implement some APIs in OCaml.