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 Furthermore, 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 | 8 +- Makefile.am | 2 +- common/mlutils/Makefile.am | 4 - daemon/Makefile.am | 122 +++++++++++++--- daemon/chroot.ml | 85 +++++++++++ daemon/chroot.mli | 38 +++++ daemon/daemon-c.c | 203 ++++++++++++++++++++++++++ daemon/daemon-c.h | 38 +++++ daemon/daemon.ml | 41 ++++++ daemon/guestfsd.c | 8 ++ daemon/sysroot-c.c | 37 +++++ daemon/sysroot.ml | 23 +++ daemon/sysroot.mli | 25 ++++ daemon/utils.ml | 158 ++++++++++++++++++++ daemon/utils.mli | 72 ++++++++++ docs/C_SOURCE_FILES | 4 + docs/guestfs-hacking.pod | 7 + generator/OCaml.ml | 8 ++ generator/OCaml.mli | 1 + generator/actions.ml | 5 + generator/actions.mli | 4 + generator/daemon.ml | 351 ++++++++++++++++++++++++++++++++++++++++++++- generator/daemon.mli | 4 + generator/main.ml | 10 ++ generator/types.ml | 7 +- 25 files changed, 1235 insertions(+), 30 deletions(-) diff --git a/.gitignore b/.gitignore index bbd9284c6..de50f7381 100644 --- a/.gitignore +++ b/.gitignore @@ -165,20 +165,26 @@ Makefile.in /customize/test-settings-*.sh /customize/virt-customize /customize/virt-customize.1 +/daemon/.depend /daemon/actions.h +/daemon/callbacks.ml +/daemon/caml-stubs.c /daemon/dispatch.c /daemon/guestfsd /daemon/guestfsd.8 /daemon/guestfsd.exe +/daemon/lvm-tokenization.c /daemon/names.c /daemon/optgroups.c /daemon/optgroups.h -/daemon/lvm-tokenization.c +/daemon/optgroups.ml /daemon/stamp-guestfsd.pod /daemon/structs-cleanups.c /daemon/structs-cleanups.h +/daemon/structs.ml /daemon/stubs-?.c /daemon/stubs.h +/daemon/types.ml /depcomp /df/stamp-virt-df.pod /df/virt-df diff --git a/Makefile.am b/Makefile.am index a411b0b7b..84b00393d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -44,6 +44,7 @@ SUBDIRS += common/structs SUBDIRS += lib docs examples po # The daemon and the appliance. +SUBDIRS += common/mlutils if ENABLE_DAEMON SUBDIRS += daemon SUBDIRS += tests/daemon @@ -155,7 +156,6 @@ SUBDIRS += csharp # OCaml tools. Note 'common/ml*', 'mllib' and 'customize' contain # shared code used by other OCaml tools, so these must come first. if HAVE_OCAML -SUBDIRS += common/mlutils SUBDIRS += common/mlprogress SUBDIRS += common/mlvisit SUBDIRS += common/mlxml diff --git a/common/mlutils/Makefile.am b/common/mlutils/Makefile.am index 94b2187eb..f29ffc062 100644 --- a/common/mlutils/Makefile.am +++ b/common/mlutils/Makefile.am @@ -35,8 +35,6 @@ SOURCES_C = \ c_utils-c.c \ unix_utils-c.c -if HAVE_OCAML - # We pretend that we're building a C library. automake handles the # compilation of the C sources for us. At the end we take the C # objects and OCaml objects and link them into the OCaml library. @@ -150,6 +148,4 @@ depend: .depend -include .depend -endif - .PHONY: depend docs diff --git a/daemon/Makefile.am b/daemon/Makefile.am index eedf09d52..e5a4986e3 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -17,27 +17,31 @@ include $(top_srcdir)/subdir-rules.mk -generator_built = \ - actions.h \ - 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 - 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 = \ +generator_built = \ $(BUILT_SOURCES) \ + callbacks.ml \ + types.ml + +EXTRA_DIST = \ + $(generator_built) \ + $(SOURCES_MLI) $(SOURCES_ML) \ guestfsd.pod if INSTALL_DAEMON @@ -61,6 +65,7 @@ guestfsd_SOURCES = \ blkid.c \ blockdev.c \ btrfs.c \ + caml-stubs.c \ cap.c \ checksum.c \ cleanups.c \ @@ -71,6 +76,8 @@ guestfsd_SOURCES = \ copy.c \ cpio.c \ cpmv.c \ + daemon-c.c \ + daemon-c.h \ daemon.h \ dd.c \ debug.c \ @@ -161,6 +168,7 @@ guestfsd_SOURCES = \ swap.c \ sync.c \ syslinux.c \ + sysroot-c.c \ tar.c \ tsk.c \ truncate.c \ @@ -176,10 +184,16 @@ guestfsd_SOURCES = \ zero.c \ zerofree.c +guestfsd_LDFLAGS = \ + -L$(shell $(OCAMLC) -where) \ + -L$(shell $(OCAMLC) -where)/hivex \ + -L../common/mlutils \ + -L../common/mlstdutils guestfsd_LDADD = \ ../common/errnostring/liberrnostring.la \ ../common/protocol/libprotocol.la \ ../common/utils/libutils.la \ + camldaemon.o \ $(ACL_LIBS) \ $(CAP_LIBS) \ $(YAJL_LIBS) \ @@ -198,9 +212,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 \ @@ -220,6 +237,71 @@ 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 = \ + chroot.mli \ + sysroot.mli \ + utils.mli + +SOURCES_ML = \ + types.ml \ + utils.ml \ + structs.ml \ + optgroups.ml \ + sysroot.ml \ + chroot.ml \ + callbacks.ml \ + daemon.ml + +BOBJECTS = $(SOURCES_ML:.ml=.cmo) +XOBJECTS = $(BOBJECTS:.cmo=.cmx) + +OCAMLPACKAGES = \ + -package str,unix,hivex \ + -I $(top_srcdir)/common/mlstdutils \ + -I $(top_srcdir)/common/mlutils + +OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_FLAGS) + +if !HAVE_OCAMLOPT +OBJECTS = $(BOBJECTS) +CAMLRUN = camlrun +else +OBJECTS = $(XOBJECTS) +CAMLRUN = asmrun +endif +OCAML_LIBS = \ + -lmlcutils \ + -lmlstdutils \ + -lmlhivex \ + -lcamlstr \ + -lunix \ + -l$(CAMLRUN) -ldl -lm + +CLEANFILES += camldaemon.o + +camldaemon.o: $(OBJECTS) + $(OCAMLFIND) $(BEST) -output-obj -o $@ \ + $(OCAMLFLAGS) $(OCAMLPACKAGES) \ + -linkpkg mlcutils.$(MLARCHIVE) mlstdutils.$(MLARCHIVE) \ + $(OBJECTS) + +# OCaml dependencies. +depend: .depend + +.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) + rm -f $@ $@-t + $(OCAMLFIND) ocamldep -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlstdutils -I $(abs_top_builddir)/common/mlutils $^ | \ + $(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 @@ -241,4 +323,4 @@ stamp-guestfsd.pod: guestfsd.pod $< touch $@ -.PHONY: force +.PHONY: depend force diff --git a/daemon/chroot.ml b/daemon/chroot.ml new file mode 100644 index 000000000..3364cd20b --- /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 Std_utils +open Unix_utils + +type t = { + name : string; + chroot : string; +} + +let create ?(name = "<unnamed>") ?(chroot = Sysroot.sysroot ()) () = + { 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..33f53ba18 --- /dev/null +++ b/daemon/chroot.mli @@ -0,0 +1,38 @@ +(* 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 parameter, forking, running the + function and marshalling the result or any exceptions. *) + +type t + +val create : ?name:string -> ?chroot:string -> unit -> t +(** Create a chroot handle. + + [?name] is an optional name used in debugging and error messages. + + [?chroot] is the optional chroot directory. This parameter + defaults to [Sysroot.sysroot ()]. *) + +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..cbb3d8918 --- /dev/null +++ b/daemon/daemon-c.c @@ -0,0 +1,203 @@ +/* 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/mlvalues.h> +#include <caml/memory.h> +#include <caml/unixsupport.h> + +#include "daemon.h" +#include "daemon-c.h" + +/* Convert an OCaml exception to a reply_with_error_errno call + * as best we can. + */ +void +guestfs_int_daemon_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/097f63cfb39a80418f... + * http://caml.inria.fr/pub/ml-archives/caml-list/2009/06/797e2f797f57b8ea2a... + */ + if (Tag_val (Field (exn, 0)) == String_tag) + /* For End_of_file and a few other constant exceptions. */ + exn_name = String_val (Field (exn, 0)); + else + /* For most exceptions. */ + 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: unhandled exception thrown: %s", + func, exn_name); +} + +/* NB: This is a "noalloc" call. */ +value +guestfs_int_daemon_get_verbose_flag (value unitv) +{ + return Val_bool (verbose); +} + +/* Implement String (Mountable, _) parameter. */ +value +guestfs_int_daemon_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); +} + +/* Implement RStringList. */ +char ** +guestfs_int_daemon_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 */ +} + +/* Implement RString (RMountable, _). */ +char * +guestfs_int_daemon_return_string_mountable (value retv) +{ + value typev = Field (retv, 0); + value devicev = Field (retv, 1); + value subvolv; + char *ret; + + if (Is_long (typev)) { /* MountableDevice or MountablePath */ + ret = strdup (String_val (devicev)); + if (ret == NULL) + reply_with_perror ("strdup"); + return ret; + } + else { /* MountableBtrfsVol of subvol */ + subvolv = Field (typev, 0); + if (asprintf (&ret, "btrfsvol:%s/%s", + String_val (devicev), String_val (subvolv)) == -1) + reply_with_perror ("asprintf"); + return ret; + } +} + +/* Implement RHashtable (RPlainString, RPlainString, _). */ +char ** +guestfs_int_daemon_return_hashtable_string_string (value retv) +{ + CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret); + value v, sv; + + while (retv != Val_int (0)) { + v = Field (retv, 0); /* (string, string) */ + sv = Field (v, 0); /* string */ + if (add_string (&ret, String_val (sv)) == -1) + return NULL; + sv = Field (v, 1); /* string */ + if (add_string (&ret, String_val (sv)) == -1) + return NULL; + retv = Field (retv, 1); + } + + if (end_stringsbuf (&ret) == -1) + return NULL; + + return take_stringsbuf (&ret); /* caller frees */ +} + +/* Implement RHashtable (RMountable, RPlainString, _). */ +char ** +guestfs_int_daemon_return_hashtable_mountable_string (value retv) +{ + CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret); + value v, mv, sv; + char *m; + + while (retv != Val_int (0)) { + v = Field (retv, 0); /* (Mountable.t, string) */ + mv = Field (v, 0); /* Mountable.t */ + m = guestfs_int_daemon_return_string_mountable (mv); + if (m == NULL) + return NULL; + if (add_string_nodup (&ret, m) == -1) + return NULL; + sv = Field (v, 1); /* string */ + if (add_string (&ret, String_val (sv)) == -1) + return NULL; + retv = Field (retv, 1); + } + + if (end_stringsbuf (&ret) == -1) + return NULL; + + return take_stringsbuf (&ret); /* caller frees */ +} diff --git a/daemon/daemon-c.h b/daemon/daemon-c.h new file mode 100644 index 000000000..1b9f102ff --- /dev/null +++ b/daemon/daemon-c.h @@ -0,0 +1,38 @@ +/* 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. + */ + +/* This file is separate from <daemon.h> because we don't want to + * include the OCaml headers (to get 'value') for the whole daemon. + */ + +#ifndef GUESTFSD_DAEMON_C_H +#define GUESTFSD_DAEMON_C_H + +#include "daemon.h" + +#include <caml/mlvalues.h> + +extern value guestfs_int_daemon_get_verbose_flag (value unitv); +extern void guestfs_int_daemon_exn_to_reply_with_error (const char *func, value exn); +extern value guestfs_int_daemon_copy_mountable (const mountable_t *mountable); +extern char **guestfs_int_daemon_return_string_list (value retv); +extern char *guestfs_int_daemon_return_string_mountable (value retv); +extern char **guestfs_int_daemon_return_hashtable_string_string (value retv); +extern char **guestfs_int_daemon_return_hashtable_mountable_string (value retv); + +#endif /* GUESTFSD_DAEMON_C_H */ diff --git a/daemon/daemon.ml b/daemon/daemon.ml new file mode 100644 index 000000000..bf486344f --- /dev/null +++ b/daemon/daemon.ml @@ -0,0 +1,41 @@ +(* 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 + +external get_verbose_flag : unit -> bool = + "guestfs_int_daemon_get_verbose_flag" "noalloc" + +(* When guestfsd starts up, early on (after parsing the command line + * but not much else), 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 ( + Std_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 8489500c6..90fc1058a 100644 --- a/daemon/guestfsd.c +++ b/daemon/guestfsd.c @@ -56,6 +56,8 @@ #include <augeas.h> +#include <caml/callback.h> /* for caml_startup */ + #include "sockets.h" #include "c-ctype.h" #include "ignore-value.h" @@ -231,6 +233,12 @@ main (int argc, char *argv[]) exit (EXIT_FAILURE); } + /* Initialize the OCaml stubs. This must be done after the + * ‘verbose’ flag is set from the command line since the OCaml + * initialization code depends on that. + */ + caml_startup (argv); + #ifndef WIN32 /* Make sure SIGPIPE doesn't kill us. */ struct sigaction sa; 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..262890952 --- /dev/null +++ b/daemon/sysroot.ml @@ -0,0 +1,23 @@ +(* 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 Std_utils + +external sysroot : unit -> string = "guestfs_int_daemon_sysroot" + +let sysroot_path path = sysroot () // path diff --git a/daemon/sysroot.mli b/daemon/sysroot.mli new file mode 100644 index 000000000..f99ab0d54 --- /dev/null +++ b/daemon/sysroot.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 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. *) + +val sysroot_path : string -> string +(** Equivalent to calling [sysroot () // path] *) diff --git a/daemon/utils.ml b/daemon/utils.ml new file mode 100644 index 000000000..f2c1ea328 --- /dev/null +++ b/daemon/utils.ml @@ -0,0 +1,158 @@ +(* 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 Std_utils + +let prog_exists prog = + try ignore (which prog); true + with Executable_not_found _ -> false + +let commandr ?(fold_stdout_on_stderr = false) prog args = + if verbose () then + eprintf "command: %s %s\n%!" + (if fold_stdout_on_stderr then " fold-stdout-on-stderr" else "") + (stringify_args (prog :: 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; + if not fold_stdout_on_stderr then + dup2 stdout_fd stdout + else + dup2 stderr_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 + + (try unlink stdout_file with _ -> ()); + (try unlink stderr_file with _ -> ()); + + 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 = String.chomp stderr in + + (r, stdout, stderr) + +let command ?fold_stdout_on_stderr prog args = + let r, stdout, stderr = commandr ?fold_stdout_on_stderr 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..b475ae3b8 --- /dev/null +++ b/daemon/utils.mli @@ -0,0 +1,72 @@ +(* 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 : ?fold_stdout_on_stderr:bool -> 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. + + [?fold_stdout_on_stderr] (default: false) + + For broken external commands that send error messages to stdout + (hello, parted) but that don't have any useful stdout information, + use this flag to capture the error messages in the [stderr] + buffer. Nothing will be captured on stdout if you use this flag. *) + +val commandr : ?fold_stdout_on_stderr:bool -> 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/C_SOURCE_FILES b/docs/C_SOURCE_FILES index a3ac13b7c..7bb6d5143 100644 --- a/docs/C_SOURCE_FILES +++ b/docs/C_SOURCE_FILES @@ -72,6 +72,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 @@ -82,6 +83,8 @@ daemon/compress.c daemon/copy.c daemon/cpio.c daemon/cpmv.c +daemon/daemon-c.c +daemon/daemon-c.h daemon/daemon.h daemon/dd.c daemon/debug-bmap.c @@ -172,6 +175,7 @@ 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 diff --git a/docs/guestfs-hacking.pod b/docs/guestfs-hacking.pod index bfbe4526d..61a49e872 100644 --- a/docs/guestfs-hacking.pod +++ b/docs/guestfs-hacking.pod @@ -416,6 +416,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.38, 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/OCaml.ml b/generator/OCaml.ml index 53f105198..853b41bb3 100644 --- a/generator/OCaml.ml +++ b/generator/OCaml.ml @@ -888,3 +888,11 @@ and generate_ocaml_function_type ?(extra_unit = false) (ret, args, optargs) = | RStructList (_, typ) -> pr "%s array" typ | RHashtable _ -> pr "(string * string) list" ) + +(* Structure definitions (again). These are used in the daemon, + * but it's convenient to generate them here. + *) +and generate_ocaml_daemon_structs () = + generate_header OCamlStyle GPLv2plus; + + generate_ocaml_structure_decls () diff --git a/generator/OCaml.mli b/generator/OCaml.mli index 4e79a5b5a..a36fbe02f 100644 --- a/generator/OCaml.mli +++ b/generator/OCaml.mli @@ -20,3 +20,4 @@ val generate_ocaml_c : unit -> unit val generate_ocaml_c_errnos : unit -> unit val generate_ocaml_ml : unit -> unit val generate_ocaml_mli : unit -> unit +val generate_ocaml_daemon_structs : unit -> unit diff --git a/generator/actions.ml b/generator/actions.ml index a9b3b5906..75742397a 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 2ae462864..b4d4cfe8e 100644 --- a/generator/daemon.ml +++ b/generator/daemon.ml @@ -471,6 +471,324 @@ 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; + + if actions |> impl_ocaml_functions <> [] then ( + 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) + ) + else + pr "let init_callbacks () = ()\n" + +(* 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\" +#include \"daemon-c.h\" + +"; + + (* Implement code for returning structs and struct lists. *) + let emit_return_struct typ = + let struc = Structs.lookup_struct typ in + pr "/* Implement RStruct (%S, _). */\n" typ; + pr "static guestfs_int_%s *\n" typ; + pr "return_%s (value retv)\n" typ; + pr "{\n"; + pr " guestfs_int_%s *ret;\n" typ; + pr " value v;\n"; + pr "\n"; + pr " ret = malloc (sizeof (*ret));\n"; + pr " if (ret == NULL) {\n"; + pr " reply_with_perror (\"malloc\");\n"; + pr " return NULL;\n"; + pr " }\n"; + pr "\n"; + iteri ( + fun i -> + pr " v = Field (retv, %d);\n" i; + function + | n, (FString|FUUID) -> + pr " ret->%s = strdup (String_val (v));\n" n; + pr " if (ret->%s == NULL) return NULL;\n" n + | n, FBuffer -> + pr " ret->%s_len = caml_string_length (v);\n" n; + pr " ret->%s = strdup (String_val (v));\n" n; + pr " if (ret->%s == NULL) return NULL;\n" n + | n, (FBytes|FInt64|FUInt64) -> + pr " ret->%s = Int64_val (v);\n" n + | n, (FInt32|FUInt32) -> + pr " ret->%s = Int32_val (v);\n" n + | n, FOptPercent -> + pr " if (v == Val_int (0)) /* None */\n"; + pr " ret->%s = -1;\n" n; + pr " else {\n"; + pr " v = Field (v, 0);\n"; + pr " ret->%s = Double_val (v);\n" n; + pr " }\n" + | n, FChar -> + pr " ret->%s = Int_val (v);\n" n + ) struc.s_cols; + pr "\n"; + pr " return ret;\n"; + pr "}\n"; + pr "\n" + + and emit_return_struct_list typ = + pr "/* Implement RStructList (%S, _). */\n" typ; + pr "static guestfs_int_%s_list *\n" typ; + pr "return_%s_list (value retv)\n" typ; + pr "{\n"; + pr " guestfs_int_%s_list *ret;\n" typ; + pr " guestfs_int_%s *r;\n" typ; + pr " size_t i, len;\n"; + pr " value v, rv;\n"; + pr "\n"; + pr " /* Count the number of elements in the list. */\n"; + pr " rv = retv;\n"; + pr " len = 0;\n"; + pr " while (rv != Val_int (0)) {\n"; + pr " len++;\n"; + pr " rv = Field (rv, 1);\n"; + pr " }\n"; + pr "\n"; + pr " ret = malloc (sizeof *ret);\n"; + pr " if (ret == NULL) {\n"; + pr " reply_with_perror (\"malloc\");\n"; + pr " return NULL;\n"; + pr " }\n"; + pr " ret->guestfs_int_%s_list_len = len;\n" typ; + pr " ret->guestfs_int_%s_list_val =\n" typ; + pr " calloc (len, sizeof (guestfs_int_%s));\n" typ; + pr " if (ret->guestfs_int_%s_list_val == NULL) {\n" typ; + pr " reply_with_perror (\"calloc\");\n"; + pr " free (ret);\n"; + pr " return NULL;\n"; + pr " }\n"; + pr "\n"; + pr " rv = retv;\n"; + pr " for (i = 0; i < len; ++i) {\n"; + pr " v = Field (rv, 0);\n"; + pr " r = return_%s (v);\n" typ; + pr " if (r == NULL)\n"; + pr " return NULL; /* XXX leaks memory along this error path */\n"; + pr " memcpy (&ret->guestfs_int_%s_list_val[i], r, sizeof (*r));\n" typ; + pr " free (r);\n"; + pr " rv = Field (rv, 1);\n"; + pr " }\n"; + pr "\n"; + pr " return ret;\n"; + pr "}\n"; + pr "\n"; + in + + List.iter ( + function + | typ, RStructOnly -> + emit_return_struct typ + | typ, (RStructListOnly | RStructAndList) -> + emit_return_struct typ; + emit_return_struct_list typ + ) (rstructs_used_by (actions |> impl_ocaml_functions)); + + (* Implement the wrapper functions. *) + 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 + | 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 & GUESTFS_%s_%s_BITMASK) == 0)\n" + uc_name 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 ((PlainString|Device|Pathname|Dev_or_Path), n) -> + pr "caml_copy_string (%s)" n + | String ((Mountable|Mountable_or_Path), n) -> + pr "guestfs_int_daemon_copy_mountable (%s)" n + | String _ -> assert false + | 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 " guestfs_int_daemon_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 -> + pr " CAMLreturnT (int, 0);\n" + | RInt _ -> + pr " CAMLreturnT (int, Int_val (retv));\n" + | RInt64 _ -> + pr " CAMLreturnT (int, Int64_val (retv));\n" + | RBool _ -> + pr " CAMLreturnT (int, Bool_val (retv));\n" + | RConstString _ -> assert false + | RConstOptString _ -> assert false + | RString ((RPlainString|RDevice), _) -> + 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 (RMountable, _) -> + pr " char *ret =\n"; + pr " guestfs_int_daemon_return_string_mountable (retv);\n"; + pr " CAMLreturnT (char *, ret); /* caller frees */\n" + | RStringList _ -> + pr " char **ret = guestfs_int_daemon_return_string_list (retv);\n"; + pr " CAMLreturnT (char **, ret); /* caller frees */\n" + | RStruct (_, typ) -> + pr " guestfs_int_%s *ret =\n" typ; + pr " return_%s (retv);\n" typ; + pr " /* caller frees */\n"; + pr " CAMLreturnT (guestfs_int_%s *, ret);\n" typ + | RStructList (_, typ) -> + pr " guestfs_int_%s_list *ret =\n" typ; + pr " return_%s_list (retv);\n" typ; + pr " /* caller frees */\n"; + pr " CAMLreturnT (guestfs_int_%s_list *, ret);\n" typ + | RHashtable (RPlainString, RPlainString, _) -> + pr " char **ret =\n"; + pr " guestfs_int_daemon_return_hashtable_string_string (retv);\n"; + pr " CAMLreturnT (char **, ret); /* caller frees */\n" + | RHashtable (RMountable, RPlainString, _) -> + pr " char **ret =\n"; + pr " guestfs_int_daemon_return_hashtable_mountable_string (retv);\n"; + pr " CAMLreturnT (char **, ret); /* caller frees */\n" + | RHashtable _ -> assert false + | RBufferOut _ -> assert false + ); + pr "}\n"; + pr "\n" + ) (actions |> impl_ocaml_functions |> sort) + let generate_daemon_dispatch () = generate_header CStyle GPLv2plus; @@ -730,6 +1048,8 @@ let generate_daemon_optgroups_c () = pr "#include <config.h>\n"; pr "\n"; + pr "#include <caml/mlvalues.h>\n"; + pr "\n"; pr "#include \"daemon.h\"\n"; pr "#include \"optgroups.h\"\n"; pr "\n"; @@ -752,7 +1072,22 @@ let generate_daemon_optgroups_c () = pr " { \"%s\", optgroup_%s_available },\n" group group ) optgroups_names_all; pr " { NULL, NULL }\n"; - pr "};\n" + pr "};\n"; + pr "\n"; + pr "/* Wrappers so these functions can be called from OCaml code. */\n"; + List.iter ( + fun group -> + pr "extern value guestfs_int_daemon_optgroup_%s_available (value);\n" + group; + pr "\n"; + pr "/* NB: This is a \"noalloc\" call. */\n"; + pr "value\n"; + pr "guestfs_int_daemon_optgroup_%s_available (value unitv)\n" group; + pr "{\n"; + pr " return Val_bool (optgroup_%s_available ());\n" group; + pr "}\n"; + pr "\n" + ) optgroups_names let generate_daemon_optgroups_h () = generate_header CStyle GPLv2plus; @@ -801,8 +1136,18 @@ let generate_daemon_optgroups_h () = pr "#endif /* GUESTFSD_OPTGROUPS_H */\n" +(* Generate optgroup available functions in OCaml. *) +let generate_daemon_optgroups_ml () = + generate_header OCamlStyle GPLv2plus; + + List.iter ( + fun group -> + pr "external %s_available : unit -> bool =\n" group; + pr " \"guestfs_int_daemon_optgroup_%s_available\" \"noalloc\"\n" group + ) optgroups_names + (* Generate structs-cleanups.c file. *) -and generate_daemon_structs_cleanups_c () = +let generate_daemon_structs_cleanups_c () = generate_header CStyle GPLv2plus; pr "\ @@ -852,7 +1197,7 @@ and generate_daemon_structs_cleanups_c () = ) structs (* Generate structs-cleanups.h file. *) -and generate_daemon_structs_cleanups_h () = +let generate_daemon_structs_cleanups_h () = generate_header CStyle GPLv2plus; pr "\ diff --git a/generator/daemon.mli b/generator/daemon.mli index ff008bf85..602f36a86 100644 --- a/generator/daemon.mli +++ b/generator/daemon.mli @@ -19,10 +19,14 @@ 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 val generate_daemon_optgroups_c : unit -> unit val generate_daemon_optgroups_h : unit -> unit +val generate_daemon_optgroups_ml : unit -> unit val generate_daemon_structs_cleanups_c : unit -> unit val generate_daemon_structs_cleanups_h : unit -> unit diff --git a/generator/main.ml b/generator/main.ml index c8890de6a..9d795b15a 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" @@ -141,6 +147,8 @@ Run it from the top source directory using the command Daemon.generate_daemon_optgroups_c; output_to "daemon/optgroups.h" Daemon.generate_daemon_optgroups_h; + output_to "daemon/optgroups.ml" + Daemon.generate_daemon_optgroups_ml; output_to "daemon/lvm-tokenization.c" Daemon.generate_daemon_lvm_tokenization; output_to "daemon/structs-cleanups.c" @@ -185,6 +193,8 @@ Run it from the top source directory using the command OCaml.generate_ocaml_c; output_to "ocaml/guestfs-c-errnos.c" OCaml.generate_ocaml_c_errnos; + output_to "daemon/structs.ml" + OCaml.generate_ocaml_daemon_structs; output_to "ocaml/bindtests.ml" Bindtests.generate_ocaml_bindtests; 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.2

--- 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 + 7 files changed, 141 insertions(+), 6 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 8cf5d77ce..cf0e2c503 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -241,9 +241,11 @@ 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 \ sysroot.mli \ file.mli \ + mountable.mli \ utils.mli SOURCES_ML = \ @@ -252,7 +254,9 @@ SOURCES_ML = \ structs.ml \ optgroups.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 d9858d5c8..fea322f5e 100644 --- a/daemon/blkid.c +++ b/daemon/blkid.c @@ -67,12 +67,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..69baa8e8d --- /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 Std_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.chomp out + + | 2 -> (* means tag not found, we return "" *) + "" + + | _ -> + failwithf "blkid: %s: %s: %s" device 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"), [] -- 2.13.2

--- .gitignore | 1 + daemon/Makefile.am | 45 ++++++++++++++++++++++++++++++++++++++++- daemon/daemon_utils_tests.ml | 48 ++++++++++++++++++++++++++++++++++++++++++++ daemon/dummy.c | 2 ++ docs/C_SOURCE_FILES | 1 + 5 files changed, 96 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index de50f7381..4699933d3 100644 --- a/.gitignore +++ b/.gitignore @@ -169,6 +169,7 @@ Makefile.in /daemon/actions.h /daemon/callbacks.ml /daemon/caml-stubs.c +/daemon/daemon_utils_tests /daemon/dispatch.c /daemon/guestfsd /daemon/guestfsd.8 diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 2cdf20c07..f1b395725 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -42,6 +42,7 @@ generator_built = \ EXTRA_DIST = \ $(generator_built) \ $(SOURCES_MLI) $(SOURCES_ML) \ + daemon_utils_tests.ml \ guestfsd.pod if INSTALL_DAEMON @@ -269,7 +270,8 @@ XOBJECTS = $(BOBJECTS:.cmo=.cmx) OCAMLPACKAGES = \ -package str,unix,hivex \ -I $(top_srcdir)/common/mlstdutils \ - -I $(top_srcdir)/common/mlutils + -I $(top_srcdir)/common/mlutils \ + -I $(top_builddir)/common/utils/.libs OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_FLAGS) @@ -310,6 +312,47 @@ depend: .depend -include .depend +# Tests. + +check_PROGRAMS = daemon_utils_tests +TESTS_ENVIRONMENT = $(top_builddir)/run --test +TESTS = \ + daemon_utils_tests + +check-valgrind: + $(MAKE) VG="@VG@" check + +daemon_utils_tests_SOURCES = dummy.c +daemon_utils_tests_CPPFLAGS = \ + -I. \ + -I$(top_builddir) \ + -I$(shell $(OCAMLC) -where) \ + -I$(top_srcdir)/lib +daemon_utils_tests_BOBJECTS = \ + 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 = \ + mlcutils.$(MLARCHIVE) \ + mlstdutils.$(MLARCHIVE) \ + $(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 $@ + # Manual pages and HTML files for the website. if INSTALL_DAEMON man_MANS = guestfsd.8 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" = " ") diff --git a/daemon/dummy.c b/daemon/dummy.c new file mode 100644 index 000000000..ebab6198c --- /dev/null +++ b/daemon/dummy.c @@ -0,0 +1,2 @@ +/* Dummy source, to be used for OCaml-based tools with no C sources. */ +enum { foo = 1 }; diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES index 7bb6d5143..5f76499f7 100644 --- a/docs/C_SOURCE_FILES +++ b/docs/C_SOURCE_FILES @@ -97,6 +97,7 @@ daemon/dispatch.c daemon/dmesg.c daemon/dropcaches.c daemon/du.c +daemon/dummy.c daemon/echo-daemon.c daemon/ext2.c daemon/fallocate.c -- 2.13.2

--- daemon/Makefile.am | 2 ++ daemon/link.c | 16 ---------------- daemon/link.ml | 24 ++++++++++++++++++++++++ daemon/link.mli | 19 +++++++++++++++++++ generator/actions_core.ml | 1 + 5 files changed, 46 insertions(+), 16 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 090a80329..ea9a5fc8f 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -248,6 +248,7 @@ SOURCES_MLI = \ devsparts.mli \ file.mli \ is.mli \ + link.mli \ mountable.mli \ utils.mli @@ -263,6 +264,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 0878fd32b..53f4719ed 100644 --- a/daemon/link.c +++ b/daemon/link.c @@ -30,22 +30,6 @@ #include "daemon.h" #include "actions.h" -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..e80e24aa5 --- /dev/null +++ b/daemon/link.ml @@ -0,0 +1,24 @@ +(* 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 chroot = Chroot.create ~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.2

--- 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(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 3b527e10f..195b2e0a7 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -251,6 +251,7 @@ SOURCES_MLI = \ link.mli \ mount.mli \ mountable.mli \ + parted.mli \ utils.mli SOURCES_ML = \ @@ -267,6 +268,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 7446bc93e..b788ed72a 100644 --- a/daemon/parted.c +++ b/daemon/parted.c @@ -517,48 +517,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, "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..6be41cf66 --- /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 Std_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.2

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 | 140 +++++++++++++++++ daemon/filearch.mli | 19 +++ docs/C_SOURCE_FILES | 1 - 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, 353 insertions(+), 555 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 9927bb47c..31cb01b85 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -247,6 +247,7 @@ SOURCES_MLI = \ sysroot.mli \ devsparts.mli \ file.mli \ + filearch.mli \ is.mli \ link.mli \ mount.mli \ @@ -266,6 +267,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..505d8c78e --- /dev/null +++ b/daemon/filearch.ml @@ -0,0 +1,140 @@ +(* 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 Std_utils +open Unix_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. + *) +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 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 = Mkdtemp.temp_dir "filearch" in + let finally () = ignore (Sys.command (sprintf "rm -rf %s" (quote tmpdir))) in + + protect ~finally ~f:( + fun () -> + (* 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.sysroot_path 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 5f76499f7..7ac6716cd 100644 --- a/docs/C_SOURCE_FILES +++ b/docs/C_SOURCE_FILES @@ -300,7 +300,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 5a1443b62..fab8c4a45 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 \ @@ -159,7 +158,7 @@ libguestfs_la_LIBADD = \ ../common/qemuopts/libqemuopts.la \ ../common/structs/libstructs.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 429c63abf..456cbe73b 100644 --- a/po/POTFILES +++ b/po/POTFILES @@ -363,7 +363,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.2

--- daemon/Makefile.am | 2 + daemon/lvm.c | 151 ---------------------------------------------- daemon/lvm.ml | 98 ++++++++++++++++++++++++++++++ daemon/lvm.mli | 19 ++++++ generator/actions_core.ml | 1 + 5 files changed, 120 insertions(+), 151 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index f5049516b..2e723bfc8 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -251,6 +251,7 @@ SOURCES_MLI = \ is.mli \ ldm.mli \ link.mli \ + lvm.mli \ mount.mli \ mountable.mli \ parted.mli \ @@ -272,6 +273,7 @@ SOURCES_ML = \ is.ml \ ldm.ml \ link.ml \ + lvm.ml \ mount.ml \ parted.ml \ realpath.ml \ diff --git a/daemon/lvm.c b/daemon/lvm.c index af2582448..4026c4f92 100644 --- a/daemon/lvm.c +++ b/daemon/lvm.c @@ -101,89 +101,6 @@ convert_lvm_output (char *out, const char *prefix) return take_stringsbuf (&ret); } -/* Filter a colon-separated output of - * lvs -o lv_attr,vg_name,lv_name - * removing thin layouts, and building the device path as we expect it. - * - * This is used only when lvm has no -S. - */ -static char ** -filter_convert_old_lvs_output (char *out) -{ - char *p, *pend; - CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret); - - p = out; - while (p) { - size_t len; - char *saveptr; - char *lv_attr, *vg_name, *lv_name; - - pend = strchr (p, '\n'); /* Get the next line of output. */ - if (pend) { - *pend = '\0'; - pend++; - } - - while (*p && c_isspace (*p)) /* Skip any leading whitespace. */ - p++; - - /* Sigh, skip trailing whitespace too. "pvs", I'm looking at you. */ - len = strlen (p)-1; - while (*p && c_isspace (p[len])) - p[len--] = '\0'; - - if (!*p) { /* Empty line? Skip it. */ - skip_line: - p = pend; - continue; - } - - lv_attr = strtok_r (p, ":", &saveptr); - if (!lv_attr) - goto skip_line; - - vg_name = strtok_r (NULL, ":", &saveptr); - if (!vg_name) - goto skip_line; - - lv_name = strtok_r (NULL, ":", &saveptr); - if (!lv_name) - goto skip_line; - - /* Ignore thin layouts (RHBZ#1278878). */ - if (lv_attr[0] == 't') - goto skip_line; - - /* Ignore activationskip (RHBZ#1306666). */ - if (strlen (lv_attr) >= 10 && lv_attr[9] == 'k') - goto skip_line; - - /* Ignore "unknown device" message (RHBZ#1054761). */ - if (STRNEQ (p, "unknown device")) { - char buf[256]; - - snprintf (buf, sizeof buf, "/dev/%s/%s", vg_name, lv_name); - if (add_string (&ret, buf) == -1) { - free (out); - return NULL; - } - } - - p = pend; - } - - free (out); - - if (ret.size > 0) - sort_strings (ret.argv, ret.size); - - if (end_stringsbuf (&ret) == -1) - return NULL; - - return take_stringsbuf (&ret); -} - char ** do_pvs (void) { @@ -220,74 +137,6 @@ do_vgs (void) return convert_lvm_output (out, NULL); } -/* Check whether lvs has -S to filter its output. - * It is available only in lvm2 >= 2.02.107. - */ -static int -test_lvs_has_S_opt (void) -{ - static int result = -1; - if (result != -1) - return result; - - CLEANUP_FREE char *out = NULL; - CLEANUP_FREE char *err = NULL; - - int r = command (&out, &err, "lvm", "lvs", "--help", NULL); - if (r == -1) { - reply_with_error ("lvm lvs --help: %s", err); - return -1; - } - - if (strstr (out, "-S") == NULL) - result = 0; - else - result = 1; - - return result; -} - -char ** -do_lvs (void) -{ - char *out; - CLEANUP_FREE char *err = NULL; - int r; - const int has_S = test_lvs_has_S_opt (); - - if (has_S < 0) - return NULL; - - if (has_S > 0) { - r = command (&out, &err, - "lvm", "lvs", - "-o", "vg_name,lv_name", - "-S", "lv_role=public && lv_skip_activation!=yes", - "--noheadings", - "--separator", "/", NULL); - if (r == -1) { - reply_with_error ("%s", err); - free (out); - return NULL; - } - - return convert_lvm_output (out, "/dev/"); - } else { - r = command (&out, &err, - "lvm", "lvs", - "-o", "lv_attr,vg_name,lv_name", - "--noheadings", - "--separator", ":", NULL); - if (r == -1) { - reply_with_error ("%s", err); - free (out); - return NULL; - } - - return filter_convert_old_lvs_output (out); - } -} - /* These were so complex to implement that I ended up auto-generating * the code. That code is in stubs.c, and it is generated as usual * by generator.ml. diff --git a/daemon/lvm.ml b/daemon/lvm.ml new file mode 100644 index 000000000..4a9156dad --- /dev/null +++ b/daemon/lvm.ml @@ -0,0 +1,98 @@ +(* 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 Std_utils + +open Utils + +(* Check whether lvs has -S to filter its output. + * It is available only in lvm2 >= 2.02.107. + *) +let lvs_has_S_opt = lazy ( + let out = command "lvm" ["lvs"; "--help"] in + String.find out "-S" >= 0 +) + +let rec lvs () = + let has_S = Lazy.force lvs_has_S_opt in + if has_S then ( + let out = command "lvm" ["lvs"; + "-o"; "vg_name,lv_name"; + "-S"; "lv_role=public && lv_skip_activation!=yes"; + "--noheadings"; + "--separator"; "/"] in + convert_lvm_output ~prefix:"/dev/" out + ) + else ( + let out = command "lvm" ["lvs"; + "-o"; "lv_attr,vg_name,lv_name"; + "--noheadings"; + "--separator"; ":"] in + filter_convert_old_lvs_output out + ) + +and convert_lvm_output ?prefix out = + let lines = String.nsplit "\n" out in + + (* Skip leading and trailing ("pvs", I'm looking at you) whitespace. *) + let lines = List.map String.trim lines in + + (* Skip empty lines. *) + let lines = List.filter ((<>) "") lines in + + (* Ignore "unknown device" message (RHBZ#1054761). *) + let lines = List.filter ((<>) "unknown device") lines in + + (* Add a prefix? *) + let lines = + match prefix with + | None -> lines + | Some prefix -> List.map ((^) prefix) lines in + + (* Sort and return. *) + List.sort compare lines + +(* Filter a colon-separated output of + * lvs -o lv_attr,vg_name,lv_name + * removing thin layouts, and building the device path as we expect it. + * + * This is used only when lvm has no -S. + *) +and filter_convert_old_lvs_output out = + let lines = String.nsplit "\n" out in + let lines = List.map String.trim lines in + let lines = List.filter ((<>) "") lines in + let lines = List.filter ((<>) "unknown device") lines in + + let lines = filter_map ( + fun line -> + match String.nsplit ":" line with + | [ lv_attr; vg_name; lv_name ] -> + (* Ignore thin layouts (RHBZ#1278878). *) + if String.length lv_attr > 0 && lv_attr.[0] = 't' then None + (* Ignore activationskip (RHBZ#1306666). *) + else if String.length lv_attr > 9 && lv_attr.[9] = 'k' then None + else + Some (sprintf "/dev/%s/%s" vg_name lv_name) + | _ -> + None + ) lines in + + List.sort compare lines diff --git a/daemon/lvm.mli b/daemon/lvm.mli new file mode 100644 index 000000000..f254728cb --- /dev/null +++ b/daemon/lvm.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 lvs : unit -> string list diff --git a/generator/actions_core.ml b/generator/actions_core.ml index 331a5feb1..f6f006eee 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -1732,6 +1732,7 @@ See also C<guestfs_vgs_full>." }; { defaults with name = "lvs"; added = (0, 0, 4); style = RStringList (RDevice, "logvols"), [], []; + impl = OCaml "Lvm.lvs"; optional = Some "lvm2"; tests = [ InitBasicFSonLVM, Always, TestResult ( -- 2.13.2

--- daemon/Makefile.am | 2 + daemon/btrfs.c | 175 ---------------------------------------------- daemon/btrfs.ml | 127 +++++++++++++++++++++++++++++++++ daemon/btrfs.mli | 26 +++++++ generator/actions_core.ml | 2 + 5 files changed, 157 insertions(+), 175 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 873f6b394..9971a45a7 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -243,6 +243,7 @@ guestfsd_CFLAGS = \ # https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html SOURCES_MLI = \ blkid.mli \ + btrfs.mli \ chroot.mli \ sysroot.mli \ devsparts.mli \ @@ -268,6 +269,7 @@ SOURCES_ML = \ mountable.ml \ chroot.ml \ blkid.ml \ + btrfs.ml \ devsparts.ml \ file.ml \ filearch.ml \ diff --git a/daemon/btrfs.c b/daemon/btrfs.c index 00c9b3c75..f11902b21 100644 --- a/daemon/btrfs.c +++ b/daemon/btrfs.c @@ -33,11 +33,6 @@ #include "c-ctype.h" #include "ignore-value.h" -COMPILE_REGEXP (re_btrfs_subvolume_list, - "ID\\s+(\\d+).*\\s" - "top level\\s+(\\d+).*\\s" - "path\\s(.*)", - 0) COMPILE_REGEXP (re_btrfs_balance_status, "Balance on '.*' is (.*)", 0) int @@ -475,137 +470,6 @@ umount (char *fs_buf, const mountable_t *fs) return 0; } -guestfs_int_btrfssubvolume_list * -do_btrfs_subvolume_list (const mountable_t *fs) -{ - CLEANUP_FREE_STRING_LIST char **lines = NULL; - size_t i = 0; - const size_t MAX_ARGS = 64; - const char *argv[MAX_ARGS]; - - /* Execute 'btrfs subvolume list <fs>', and split the output into lines */ - { - char *fs_buf = mount (fs); - - if (!fs_buf) - return NULL; - - ADD_ARG (argv, i, "btrfs"); - ADD_ARG (argv, i, "subvolume"); - ADD_ARG (argv, i, "list"); - ADD_ARG (argv, i, fs_buf); - ADD_ARG (argv, i, NULL); - - CLEANUP_FREE char *out = NULL, *errout = NULL; - int r = commandv (&out, &errout, argv); - - if (umount (fs_buf, fs) != 0) - return NULL; - - if (r == -1) { - CLEANUP_FREE char *fs_desc = mountable_to_string (fs); - if (fs_desc == NULL) { - fprintf (stderr, "malloc: %m"); - } - reply_with_error ("%s: %s", fs_desc ? fs_desc : "malloc", errout); - return NULL; - } - - lines = split_lines (out); - if (!lines) return NULL; - } - - /* Output is: - * - * ID 256 gen 30 top level 5 path test1 - * ID 257 gen 30 top level 5 path dir/test2 - * ID 258 gen 30 top level 5 path test3 - * - * "ID <n>" is the subvolume ID. - * "gen <n>" is the generation when the root was created or last - * updated. - * "top level <n>" is the top level subvolume ID. - * "path <str>" is the subvolume path, relative to the top of the - * filesystem. - * - * Note that the order that each of the above is fixed, but - * different versions of btrfs may display different sets of data. - * Specifically, older versions of btrfs do not display gen. - */ - - guestfs_int_btrfssubvolume_list *ret = NULL; - - const size_t nr_subvolumes = guestfs_int_count_strings (lines); - - ret = malloc (sizeof *ret); - if (!ret) { - reply_with_perror ("malloc"); - return NULL; - } - - ret->guestfs_int_btrfssubvolume_list_len = nr_subvolumes; - ret->guestfs_int_btrfssubvolume_list_val = - calloc (nr_subvolumes, sizeof (struct guestfs_int_btrfssubvolume)); - if (ret->guestfs_int_btrfssubvolume_list_val == NULL) { - reply_with_perror ("calloc"); - goto error; - } - - for (i = 0; i < nr_subvolumes; ++i) { - /* To avoid allocations, reuse the 'line' buffer to store the - * path. Thus we don't need to free 'line', since it will be - * freed by the calling (XDR) code. - */ - char *line = lines[i]; -#define N_MATCHES 4 - int ovector[N_MATCHES * 3]; - - if (pcre_exec (re_btrfs_subvolume_list, NULL, line, strlen (line), 0, 0, - ovector, N_MATCHES * 3) < 0) -#undef N_MATCHES - { - unexpected_output: - reply_with_error ("unexpected output from 'btrfs subvolume list' command: %s", line); - goto error; - } - - struct guestfs_int_btrfssubvolume *this = - &ret->guestfs_int_btrfssubvolume_list_val[i]; - -#if __WORDSIZE == 64 -#define XSTRTOU64 xstrtoul -#else -#define XSTRTOU64 xstrtoull -#endif - - if (XSTRTOU64 (line + ovector[2], NULL, 10, - &this->btrfssubvolume_id, NULL) != LONGINT_OK) - goto unexpected_output; - if (XSTRTOU64 (line + ovector[4], NULL, 10, - &this->btrfssubvolume_top_level_id, NULL) != LONGINT_OK) - goto unexpected_output; - -#undef XSTRTOU64 - - this->btrfssubvolume_path = - strndup (line + ovector[6], ovector[7] - ovector[6]); - if (this->btrfssubvolume_path == NULL) - goto error; - } - - return ret; - - error: - if (ret->guestfs_int_btrfssubvolume_list_val) { - for (i = 0; i < nr_subvolumes; ++i) - free (ret->guestfs_int_btrfssubvolume_list_val[i].btrfssubvolume_path); - free (ret->guestfs_int_btrfssubvolume_list_val); - } - free (ret); - - return NULL; -} - int do_btrfs_subvolume_set_default (int64_t id, const char *fs) { @@ -641,45 +505,6 @@ do_btrfs_subvolume_set_default (int64_t id, const char *fs) return 0; } -int64_t -do_btrfs_subvolume_get_default (const mountable_t *fs) -{ - const size_t MAX_ARGS = 64; - const char *argv[MAX_ARGS]; - size_t i = 0; - char *fs_buf = NULL; - CLEANUP_FREE char *err = NULL; - CLEANUP_FREE char *out = NULL; - int r; - int64_t ret = -1; - - fs_buf = mount (fs); - if (fs_buf == NULL) - goto error; - - ADD_ARG (argv, i, "btrfs"); - ADD_ARG (argv, i, "subvolume"); - ADD_ARG (argv, i, "get-default"); - ADD_ARG (argv, i, fs_buf); - ADD_ARG (argv, i, NULL); - - r = commandv (&out, &err, argv); - if (r == -1) { - reply_with_error ("%s: %s", fs_buf, err); - goto error; - } - if (sscanf (out, "ID %" SCNi64, &ret) != 1) { - reply_with_error ("%s: could not parse subvolume id: %s", argv[0], out); - ret = -1; - goto error; - } - - error: - if (fs_buf && umount (fs_buf, fs) != 0) - return -1; - return ret; -} - int do_btrfs_filesystem_sync (const char *fs) { diff --git a/daemon/btrfs.ml b/daemon/btrfs.ml new file mode 100644 index 000000000..fc02abefa --- /dev/null +++ b/daemon/btrfs.ml @@ -0,0 +1,127 @@ +(* 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 Scanf +open Unix + +open Std_utils +open Unix_utils + +open Mountable +open Utils + +include Structs + +(* In order to examine subvolumes, quota and other things, the btrfs + * filesystem has to be mounted. However we're passed a mountable + * in these cases, so we must mount the filesystem. But we cannot + * mount it under the sysroot, as something else might be mounted + * there so this function mounts the filesystem on a temporary + * directory and ensures it is always unmounted afterwards. + *) +let rec with_mounted mountable f = + let _with_mounted mount_cmd f = + let tmpdir = Mkdtemp.temp_dir "btrfs" in + + (* This is the cleanup function which is called to unmount and + * remove the temporary directory. This is called on error and + * ordinary exit paths. + *) + let finally () = + ignore (Sys.command (sprintf "umount %s" (quote tmpdir))); + rmdir tmpdir + in + + protect ~finally ~f:(fun () -> mount_cmd tmpdir; f tmpdir) + in + + match mountable.m_type with + | MountablePath -> + (* This corner-case happens for Mountable_or_Path parameters, where + * a path was supplied by the caller. The path (the m_device + * field) is relative to the sysroot. + *) + f (Sysroot.sysroot_path mountable.m_device) + + | MountableDevice -> + let cmd tmpdir = + ignore (command "mount" [mountable.m_device; tmpdir]) in + _with_mounted cmd f + + | MountableBtrfsVol subvol -> + let cmd tmpdir = + ignore (command "mount" ["-o"; "subvol=" ^ subvol (* XXX quoting? *); + mountable.m_device; tmpdir]) in + _with_mounted cmd f + +let re_btrfs_subvolume_list = + Str.regexp ("ID[ \t]+\\([0-9]+\\).*[ \t]" ^ + "top level[ \t]+\\([0-9]+\\).*[ \t]" ^ + "path[ \t]+\\(.*\\)") + +let btrfs_subvolume_list mountable = + (* Execute 'btrfs subvolume list <fs>', and split the output into lines *) + let lines = + with_mounted mountable ( + fun mp -> command "btrfs" ["subvolume"; "list"; mp] + ) in + let lines = String.nsplit "\n" lines in + let lines = List.filter ((<>) "") lines in + + (* Output is: + * + * ID 256 gen 30 top level 5 path test1 + * ID 257 gen 30 top level 5 path dir/test2 + * ID 258 gen 30 top level 5 path test3 + * + * "ID <n>" is the subvolume ID. + * "gen <n>" is the generation when the root was created or last + * updated. + * "top level <n>" is the top level subvolume ID. + * "path <str>" is the subvolume path, relative to the top of the + * filesystem. + * + * Note that the order that each of the above is fixed, but + * different versions of btrfs may display different sets of data. + * Specifically, older versions of btrfs do not display gen. + *) + List.map ( + fun line -> + if Str.string_match re_btrfs_subvolume_list line 0 then ( + let id = Int64.of_string (Str.matched_group 1 line) + and top_level_id = Int64.of_string (Str.matched_group 2 line) + and path = Str.matched_group 3 line in + + { + btrfssubvolume_id = id; + btrfssubvolume_top_level_id = top_level_id; + btrfssubvolume_path = path + } + ) + else + failwithf "unexpected output from 'btrfs subvolume list' command: %s" + line + ) lines + +let btrfs_subvolume_get_default mountable = + let out = + with_mounted mountable ( + fun mp -> command "btrfs" ["subvolume"; "get-default"; mp] + ) in + sscanf out "ID %Ld" identity diff --git a/daemon/btrfs.mli b/daemon/btrfs.mli new file mode 100644 index 000000000..55a38e42d --- /dev/null +++ b/daemon/btrfs.mli @@ -0,0 +1,26 @@ +(* 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 btrfssubvolume = { + btrfssubvolume_id : int64; + btrfssubvolume_top_level_id : int64; + btrfssubvolume_path : string; +} + +val btrfs_subvolume_list : Mountable.t -> btrfssubvolume list +val btrfs_subvolume_get_default : Mountable.t -> int64 diff --git a/generator/actions_core.ml b/generator/actions_core.ml index 140ba6c1b..bd3c21d3b 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -7304,6 +7304,7 @@ created subvolume will be added to." }; { defaults with name = "btrfs_subvolume_list"; added = (1, 17, 35); style = RStructList ("subvolumes", "btrfssubvolume"), [String (Mountable_or_Path, "fs")], []; + impl = OCaml "Btrfs.btrfs_subvolume_list"; optional = Some "btrfs"; camel_name = "BTRFSSubvolumeList"; test_excuse = "tested in tests/btrfs"; shortdesc = "list btrfs snapshots and subvolumes"; @@ -8783,6 +8784,7 @@ This uses the L<blockdev(8)> command." }; { defaults with name = "btrfs_subvolume_get_default"; added = (1, 29, 17); style = RInt64 "id", [String (Mountable_or_Path, "fs")], []; + impl = OCaml "Btrfs.btrfs_subvolume_get_default"; optional = Some "btrfs"; camel_name = "BTRFSSubvolumeGetDefault"; tests = [ InitPartition, Always, TestResult ( -- 2.13.2

--- daemon/parted.c | 56 ----------------------------------------------- daemon/parted.ml | 56 +++++++++++++++++++++++++++++++++++++++++++++++ daemon/parted.mli | 8 +++++++ generator/actions_core.ml | 1 + 4 files changed, 65 insertions(+), 56 deletions(-) diff --git a/daemon/parted.c b/daemon/parted.c index b788ed72a..3ad1ba147 100644 --- a/daemon/parted.c +++ b/daemon/parted.c @@ -383,62 +383,6 @@ do_part_get_parttype (const char *device) return r; } -guestfs_int_partition_list * -do_part_list (const char *device) -{ - CLEANUP_FREE char *out = print_partition_table (device, true); - if (!out) - return NULL; - - CLEANUP_FREE_STRING_LIST char **lines = split_lines (out); - - if (!lines) - return NULL; - - guestfs_int_partition_list *r; - - /* lines[0] is "BYT;", lines[1] is the device line which we ignore, - * lines[2..] are the partitions themselves. Count how many. - */ - size_t nr_rows = 0, row; - for (row = 2; lines[row] != NULL; ++row) - ++nr_rows; - - r = malloc (sizeof *r); - if (r == NULL) { - reply_with_perror ("malloc"); - return NULL; - } - r->guestfs_int_partition_list_len = nr_rows; - r->guestfs_int_partition_list_val = - malloc (nr_rows * sizeof (guestfs_int_partition)); - if (r->guestfs_int_partition_list_val == NULL) { - reply_with_perror ("malloc"); - goto error2; - } - - /* Now parse the lines. */ - size_t i; - for (i = 0, row = 2; lines[row] != NULL; ++i, ++row) { - if (sscanf (lines[row], "%d:%" SCNi64 "B:%" SCNi64 "B:%" SCNi64 "B", - &r->guestfs_int_partition_list_val[i].part_num, - &r->guestfs_int_partition_list_val[i].part_start, - &r->guestfs_int_partition_list_val[i].part_end, - &r->guestfs_int_partition_list_val[i].part_size) != 4) { - reply_with_error ("could not parse row from output of parted print command: %s", lines[row]); - goto error3; - } - } - - return r; - - error3: - free (r->guestfs_int_partition_list_val); - error2: - free (r); - return NULL; -} - int do_part_get_bootable (const char *device, int partnum) { diff --git a/daemon/parted.ml b/daemon/parted.ml index 6be41cf66..da31ab5c6 100644 --- a/daemon/parted.ml +++ b/daemon/parted.ml @@ -22,6 +22,8 @@ open Std_utils open Utils +include Structs + (* Test if [sfdisk] is recent enough to have [--part-type], to be used * instead of [--print-id] and [--change-id]. *) @@ -53,3 +55,57 @@ let part_get_mbr_id device partnum = (* It's printed in hex, possibly with a leading space. *) sscanf out " %x" identity + +(* This is not equivalent to print_partition_table in the C code, as + * it only deals with the ‘-m’ option output, and it partially parses + * that. If we convert other functions that don't use the ‘-m’ version + * we'll have to refactor this. XXX + *) +let print_partition_table_machine_readable device = + udev_settle (); + + let args = ref [] in + push_back args "-m"; + push_back args "-s"; + push_back args "--"; + push_back args device; + push_back args "unit"; + push_back args "b"; + push_back args "print"; + + let out = + try command "parted" !args + with + (* Translate "unrecognised disk label" into an errno code. *) + Failure str when String.find str "unrecognised disk label" >= 0 -> + raise (Unix.Unix_error (Unix.EINVAL, "parted", device ^ ": " ^ str)) in + + udev_settle (); + + (* Split the output into lines. *) + let out = String.trim out in + let lines = String.nsplit "\n" out in + + (* lines[0] is "BYT;", lines[1] is the device line which we ignore, + * lines[2..] are the partitions themselves. + *) + match lines with + | "BYT;" :: _ :: lines -> lines + | [] | [_] -> + failwith "too few rows of output from 'parted print' command" + | _ -> + failwith "did not see 'BYT;' magic value in 'parted print' command" + +let part_list device = + let lines = print_partition_table_machine_readable device in + + List.map ( + fun line -> + try sscanf line "%d:%LdB:%LdB:%LdB" + (fun num start end_ size -> + { part_num = Int32.of_int num; + part_start = start; part_end = end_; part_size = size }) + with Scan_failure err -> + failwithf "could not parse row from output of 'parted print' command: %s: %s" + line err + ) lines diff --git a/daemon/parted.mli b/daemon/parted.mli index 33eb6d30d..057d7e8c7 100644 --- a/daemon/parted.mli +++ b/daemon/parted.mli @@ -16,4 +16,12 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +type partition = { + part_num : int32; + part_start : int64; + part_end : int64; + part_size : int64; +} + val part_get_mbr_id : string -> int -> int +val part_list : string -> partition list diff --git a/generator/actions_core.ml b/generator/actions_core.ml index d5946b3f5..b1e2559e0 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -5039,6 +5039,7 @@ table. This works on C<gpt> but not on C<mbr> partitions." }; { defaults with name = "part_list"; added = (1, 0, 78); style = RStructList ("partitions", "partition"), [String (Device, "device")], []; + impl = OCaml "Parted.part_list"; tests = [] (* XXX Add a regression test for this. *); shortdesc = "list partitions on a device"; longdesc = "\ -- 2.13.2

--- daemon/devsparts.c | 15 --------------- daemon/devsparts.ml | 2 ++ daemon/devsparts.mli | 2 ++ generator/actions_core.ml | 1 + 4 files changed, 5 insertions(+), 15 deletions(-) diff --git a/daemon/devsparts.c b/daemon/devsparts.c index 1aacb8e16..12e779326 100644 --- a/daemon/devsparts.c +++ b/daemon/devsparts.c @@ -54,21 +54,6 @@ do_device_index (const char *device) return ret; } -int -do_nr_devices (void) -{ - size_t i; - CLEANUP_FREE_STRING_LIST char **devices = do_list_devices (); - - if (devices == NULL) - return -1; - - for (i = 0; devices[i] != NULL; ++i) - ; - - return (int) i; -} - #define GUESTFSDIR "/dev/disk/guestfs" char ** diff --git a/daemon/devsparts.ml b/daemon/devsparts.ml index 43093aba8..86963899f 100644 --- a/daemon/devsparts.ml +++ b/daemon/devsparts.ml @@ -89,6 +89,8 @@ and add_partitions dev = let parts = List.filter (fun part -> String.is_prefix part dev) parts in List.map ((^) "/dev/") parts +let nr_devices () = List.length (list_devices ()) + let part_to_dev part = let dev, part = split_device_partition part in if part = 0 then diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli index 4dfaa86e6..8be47e752 100644 --- a/daemon/devsparts.mli +++ b/daemon/devsparts.mli @@ -19,6 +19,8 @@ val list_devices : unit -> string list val list_partitions : unit -> string list +val nr_devices : unit -> int + val part_to_dev : string -> string val part_to_partnum : string -> int diff --git a/generator/actions_core.ml b/generator/actions_core.ml index 0a967f76d..db1411ff8 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -7432,6 +7432,7 @@ See also C<guestfs_list_devices>, C<guestfs_part_to_dev>." }; { defaults with name = "nr_devices"; added = (1, 19, 15); + impl = OCaml "Devsparts.nr_devices"; style = RInt "nrdisks", [], []; tests = [ InitEmpty, Always, TestResult ( -- 2.13.2

--- daemon/Makefile.am | 1 - daemon/realpath.c | 50 ----------------------------------------------- daemon/realpath.ml | 4 ++++ daemon/realpath.mli | 1 + docs/C_SOURCE_FILES | 1 - generator/actions_core.ml | 1 + 6 files changed, 6 insertions(+), 52 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index eb8bbb152..1f7cb2277 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -140,7 +140,6 @@ guestfsd_SOURCES = \ pingdaemon.c \ proto.c \ readdir.c \ - realpath.c \ rename.c \ rsync.c \ scrub.c \ diff --git a/daemon/realpath.c b/daemon/realpath.c deleted file mode 100644 index f9d22d28d..000000000 --- a/daemon/realpath.c +++ /dev/null @@ -1,50 +0,0 @@ -/* libguestfs - the guestfsd daemon - * 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. - */ - -#include <config.h> - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <unistd.h> -#include <fcntl.h> -#include <limits.h> -#include <sys/types.h> -#include <dirent.h> - -#include "cloexec.h" - -#include "daemon.h" -#include "optgroups.h" -#include "actions.h" - -char * -do_realpath (const char *path) -{ - char *ret; - - CHROOT_IN; - ret = realpath (path, NULL); - CHROOT_OUT; - if (ret == NULL) { - reply_with_perror ("%s", path); - return NULL; - } - - return ret; /* caller frees */ -} diff --git a/daemon/realpath.ml b/daemon/realpath.ml index e499786a1..8f83a7ad9 100644 --- a/daemon/realpath.ml +++ b/daemon/realpath.ml @@ -20,6 +20,10 @@ open Printf open Std_utils +let realpath path = + let chroot = Chroot.create ~name:(sprintf "realpath: %s" path) () in + Chroot.f chroot Unix_utils.Realpath.realpath path + (* 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. diff --git a/daemon/realpath.mli b/daemon/realpath.mli index 371e619fc..3da53c461 100644 --- a/daemon/realpath.mli +++ b/daemon/realpath.mli @@ -16,4 +16,5 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +val realpath : string -> string val case_sensitive_path : string -> string diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES index d720f43ff..e47469a6a 100644 --- a/docs/C_SOURCE_FILES +++ b/docs/C_SOURCE_FILES @@ -147,7 +147,6 @@ daemon/parted.c daemon/pingdaemon.c daemon/proto.c daemon/readdir.c -daemon/realpath.c daemon/rename.c daemon/rsync.c daemon/scrub.c diff --git a/generator/actions_core.ml b/generator/actions_core.ml index 070a1c641..4ec83d22d 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -4197,6 +4197,7 @@ compress- or gzip-compressed. { defaults with name = "realpath"; added = (1, 0, 66); style = RString (RPlainString, "rpath"), [String (Pathname, "path")], []; + impl = OCaml "Realpath.realpath"; tests = [ InitISOFS, Always, TestResultString ( [["realpath"; "/../directory"]], "/directory"), [] -- 2.13.2

--- daemon/devsparts.c | 21 --------------------- daemon/devsparts.ml | 11 +++++++++++ daemon/devsparts.mli | 6 ++---- generator/actions_core.ml | 1 + 4 files changed, 14 insertions(+), 25 deletions(-) diff --git a/daemon/devsparts.c b/daemon/devsparts.c index 12e779326..7c65be1dc 100644 --- a/daemon/devsparts.c +++ b/daemon/devsparts.c @@ -33,27 +33,6 @@ #include "daemon.h" #include "actions.h" -int -do_device_index (const char *device) -{ - size_t i; - int ret = -1; - CLEANUP_FREE_STRING_LIST char **devices = do_list_devices (); - - if (devices == NULL) - return -1; - - for (i = 0; devices[i] != NULL; ++i) { - if (STREQ (device, devices[i])) - ret = (int) i; - } - - if (ret == -1) - reply_with_error ("device not found"); - - return ret; -} - #define GUESTFSDIR "/dev/disk/guestfs" char ** diff --git a/daemon/devsparts.ml b/daemon/devsparts.ml index 86963899f..9f9751b40 100644 --- a/daemon/devsparts.ml +++ b/daemon/devsparts.ml @@ -113,3 +113,14 @@ let is_whole_device device = try ignore (stat devpath); true with Unix_error ((ENOENT|ENOTDIR), _, _) -> false + +let device_index device = + (* This is the algorithm which was used by the C version. Why + * can't we use drive_index from C_utils? XXX + *) + let rec loop i = function + | [] -> failwithf "%s: device not found" device + | dev :: devices when dev = device -> i + | _ :: devices -> loop (i+1) devices + in + loop 0 (list_devices ()) diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli index 8be47e752..4afb36bec 100644 --- a/daemon/devsparts.mli +++ b/daemon/devsparts.mli @@ -18,10 +18,8 @@ val list_devices : unit -> string list val list_partitions : unit -> string list - -val nr_devices : unit -> int - val part_to_dev : string -> string val part_to_partnum : string -> int - val is_whole_device : string -> bool +val nr_devices : unit -> int +val device_index : string -> int diff --git a/generator/actions_core.ml b/generator/actions_core.ml index c3421133e..ea0735676 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -7419,6 +7419,7 @@ instead of, or after calling C<guestfs_zero_free_space>." }; { defaults with name = "device_index"; added = (1, 19, 7); style = RInt "index", [String (Device, "device")], []; + impl = OCaml "Devsparts.device_index"; tests = [ InitEmpty, Always, TestResult ( [["device_index"; "/dev/sda"]], "ret == 0"), [] -- 2.13.2