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 | 7 +- Makefile.am | 2 +- common/mlutils/Makefile.am | 4 - daemon/Makefile.am | 121 +++++++++++++--- daemon/chroot.ml | 85 ++++++++++++ daemon/chroot.mli | 38 +++++ daemon/daemon-c.c | 203 +++++++++++++++++++++++++++ daemon/daemon-c.h | 38 +++++ daemon/daemon.ml | 39 ++++++ daemon/guestfsd.c | 5 + daemon/sysroot-c.c | 37 +++++ daemon/sysroot.ml | 23 ++++ daemon/sysroot.mli | 25 ++++ daemon/utils.ml | 160 +++++++++++++++++++++ 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 | 337 ++++++++++++++++++++++++++++++++++++++++++++- generator/daemon.mli | 3 + generator/main.ml | 8 ++ generator/types.ml | 7 +- 25 files changed, 1215 insertions(+), 28 deletions(-) diff --git a/.gitignore b/.gitignore index bbd9284c6..4f10327c4 100644 --- a/.gitignore +++ b/.gitignore @@ -165,20 +165,25 @@ 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/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..67a26de06 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,70 @@ 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 \ + 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 +322,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..45bac029a --- /dev/null +++ b/daemon/daemon.ml @@ -0,0 +1,39 @@ +(* 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, after initialization but before accepting + * messages, it calls 'caml_startup' which runs all initialization code + * in the OCaml modules, including this one. Therefore this is where + * we can place OCaml initialization code for the daemon. + *) +let () = + (* Connect the guestfsd [-v] (verbose) flag into 'verbose ()' + * used in OCaml code to print debugging messages. + *) + if get_verbose_flag () then ( + 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 b3f40628b..ddc49ed44 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" @@ -348,6 +350,9 @@ main (int argc, char *argv[]) */ udev_settle (); + /* Initialize the OCaml stubs. */ + caml_startup (argv); + /* Send the magic length message which indicates that * userspace is up inside the guest. */ diff --git a/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..347ed613b --- /dev/null +++ b/daemon/utils.ml @@ -0,0 +1,160 @@ +(* 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 + +type command_flag = + CommandFlagFoldStdoutOnStderr + +let commandr ?(flags = []) prog args = + let fold_stdout_on_stderr = List.mem CommandFlagFoldStdoutOnStderr flags in + + 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 + + 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 ?flags prog args = + let r, stdout, stderr = commandr ?flags 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..b399bfc00 --- /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. *) + +type command_flag = + CommandFlagFoldStdoutOnStderr + (** 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 command : ?flags:command_flag list -> string -> string list -> string +(** Run an external command without using the shell, and collect + stdout and stderr separately. Returns stdout if the command + runs successfully. + + On failure of the command, this throws an exception containing + the stderr from the command. *) + +val commandr : ?flags:command_flag list -> 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..5004509e6 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; diff --git a/generator/daemon.mli b/generator/daemon.mli index ff008bf85..314a6da8f 100644 --- a/generator/daemon.mli +++ b/generator/daemon.mli @@ -19,6 +19,9 @@ val generate_daemon_actions_h : unit -> unit val generate_daemon_stubs_h : unit -> unit val generate_daemon_stubs : Types.action list -> unit -> unit +val generate_daemon_caml_stubs : unit -> unit +val generate_daemon_caml_callbacks_ml : unit -> unit +val generate_daemon_caml_types_ml : unit -> unit val generate_daemon_dispatch : unit -> unit val generate_daemon_lvm_tokenization : unit -> unit val generate_daemon_names : unit -> unit diff --git a/generator/main.ml b/generator/main.ml index c8890de6a..c61326b61 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" @@ -185,6 +191,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

‘file’ is a small, self-contained API which runs a single command, so it's a good test case for reimplementing APIs. --- daemon/Makefile.am | 2 ++ daemon/file.c | 80 ----------------------------------------------- daemon/file.ml | 59 ++++++++++++++++++++++++++++++++++ daemon/file.mli | 19 +++++++++++ generator/actions_core.ml | 1 + 5 files changed, 81 insertions(+), 80 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 67a26de06..7d8e84aeb 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -243,6 +243,7 @@ guestfsd_CFLAGS = \ SOURCES_MLI = \ chroot.mli \ sysroot.mli \ + file.mli \ utils.mli SOURCES_ML = \ @@ -251,6 +252,7 @@ SOURCES_ML = \ structs.ml \ sysroot.ml \ chroot.ml \ + file.ml \ callbacks.ml \ daemon.ml diff --git a/daemon/file.c b/daemon/file.c index 84874dc6f..ee79eb507 100644 --- a/daemon/file.c +++ b/daemon/file.c @@ -30,7 +30,6 @@ #include "actions.h" #include "optgroups.h" -GUESTFSD_EXT_CMD(str_file, file); GUESTFSD_EXT_CMD(str_zcat, zcat); GUESTFSD_EXT_CMD(str_bzcat, bzcat); @@ -449,85 +448,6 @@ do_pwrite_device (const char *device, const char *content, size_t size, return pwrite_fd (fd, content, size, offset, device, 1); } -/* This runs the 'file' command. */ -char * -do_file (const char *path) -{ - CLEANUP_FREE char *buf = NULL; - const char *display_path = path; - const int is_dev = STRPREFIX (path, "/dev/"); - struct stat statbuf; - - if (!is_dev) { - buf = sysroot_path (path); - if (!buf) { - reply_with_perror ("malloc"); - return NULL; - } - path = buf; - - /* For non-dev, check this is a regular file, else just return the - * file type as a string (RHBZ#582484). - */ - if (lstat (path, &statbuf) == -1) { - reply_with_perror ("lstat: %s", display_path); - return NULL; - } - - if (! S_ISREG (statbuf.st_mode)) { - char *ret; - - if (S_ISDIR (statbuf.st_mode)) - ret = strdup ("directory"); - else if (S_ISCHR (statbuf.st_mode)) - ret = strdup ("character device"); - else if (S_ISBLK (statbuf.st_mode)) - ret = strdup ("block device"); - else if (S_ISFIFO (statbuf.st_mode)) - ret = strdup ("FIFO"); - else if (S_ISLNK (statbuf.st_mode)) - ret = strdup ("symbolic link"); - else if (S_ISSOCK (statbuf.st_mode)) - ret = strdup ("socket"); - else - ret = strdup ("unknown, not regular file"); - - if (ret == NULL) - reply_with_perror ("strdup"); - return ret; - } - } - - /* Which flags to use? For /dev paths, follow links because - * /dev/VG/LV is a symbolic link. - */ - const char *flags = is_dev ? "-zbsL" : "-zb"; - - char *out; - CLEANUP_FREE char *err = NULL; - int r = command (&out, &err, str_file, flags, path, NULL); - - if (r == -1) { - free (out); - reply_with_error ("%s: %s", display_path, err); - return NULL; - } - - /* We need to remove the trailing \n from output of file(1). */ - size_t len = strlen (out); - if (len > 0 && out[len-1] == '\n') - out[--len] = '\0'; - - /* Some upstream versions of file add a space at the end of the - * output. This is fixed in the Fedora version, but we might as - * well fix it here too. (RHBZ#928995). - */ - if (len > 0 && out[len-1] == ' ') - out[--len] = '\0'; - - return out; /* caller frees */ -} - /* zcat | file */ char * do_zfile (const char *method, const char *path) diff --git a/daemon/file.ml b/daemon/file.ml new file mode 100644 index 000000000..b45bd9019 --- /dev/null +++ b/daemon/file.ml @@ -0,0 +1,59 @@ +(* 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 Utils + +(* This runs the [file] command. *) +let file path = + let is_dev = String.is_prefix path "/dev/" in + + (* For non-dev, check this is a regular file, else just return the + * file type as a string (RHBZ#582484). + *) + if not is_dev then ( + let chroot = Chroot.create ~name:(sprintf "file: %s" path) () in + + let statbuf = Chroot.f chroot lstat path in + match statbuf.st_kind with + | S_DIR -> "directory" + | S_CHR -> "character device" + | S_BLK -> "block device" + | S_FIFO -> "FIFO" + | S_LNK -> "symbolic link" + | S_SOCK -> "socket" + | S_REG -> + (* Regular file, so now run [file] on it. *) + let out = command "file" ["-zb"; Sysroot.sysroot_path path] in + + (* We need to remove the trailing \n from output of file(1). + * + * Some upstream versions of file add a space at the end of the + * output. This is fixed in the Fedora version, but we might as + * well fix it here too. (RHBZ#928995). + *) + String.trimr out + ) + else (* it's a device *) ( + let out = command "file" ["-zbsL"; path] in + String.trimr out + ) diff --git a/daemon/file.mli b/daemon/file.mli new file mode 100644 index 000000000..bd49bad0b --- /dev/null +++ b/daemon/file.mli @@ -0,0 +1,19 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val file : string -> string diff --git a/generator/actions_core.ml b/generator/actions_core.ml index 0e667eff1..26ed1274e 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -2321,6 +2321,7 @@ and physical volumes." }; { defaults with name = "file"; added = (1, 9, 1); style = RString (RPlainString, "description"), [String (Dev_or_Path, "path")], []; + impl = OCaml "File.file"; tests = [ InitISOFS, Always, TestResultString ( [["file"; "/empty"]], "empty"), []; -- 2.13.2

The reimplemented APIs are: * list_devices * list_partitions * part_to_dev * part_to_partnum * is_whole_device --- daemon/Makefile.am | 2 + daemon/daemon.h | 3 - daemon/devsparts.c | 257 ---------------------------------------------- daemon/devsparts.ml | 113 ++++++++++++++++++++ daemon/devsparts.mli | 25 +++++ daemon/guestfsd.c | 75 -------------- daemon/utils.ml | 84 +++++++++++++++ daemon/utils.mli | 15 +++ generator/actions_core.ml | 5 + 9 files changed, 244 insertions(+), 335 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 3c3ad5c97..d75413e66 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -244,6 +244,7 @@ SOURCES_MLI = \ blkid.mli \ chroot.mli \ sysroot.mli \ + devsparts.mli \ file.mli \ mountable.mli \ utils.mli @@ -256,6 +257,7 @@ SOURCES_ML = \ mountable.ml \ chroot.ml \ blkid.ml \ + devsparts.ml \ file.ml \ callbacks.ml \ daemon.ml diff --git a/daemon/daemon.h b/daemon/daemon.h index be7a3bedc..0a92e6cee 100644 --- a/daemon/daemon.h +++ b/daemon/daemon.h @@ -130,9 +130,6 @@ extern void free_stringsbuf (struct stringsbuf *sb); extern void sort_strings (char **argv, size_t len); extern void free_stringslen (char **argv, size_t len); -extern void sort_device_names (char **argv, size_t len); -extern int compare_device_names (const char *a, const char *b); - extern struct stringsbuf split_lines_sb (char *str); extern char **split_lines (char *str); diff --git a/daemon/devsparts.c b/daemon/devsparts.c index 82467b92f..1aacb8e16 100644 --- a/daemon/devsparts.c +++ b/daemon/devsparts.c @@ -33,263 +33,6 @@ #include "daemon.h" #include "actions.h" -typedef int (*block_dev_func_t) (const char *dev, struct stringsbuf *r); - -/* Execute a given function for each discovered block device */ -static char ** -foreach_block_device (block_dev_func_t func, bool return_md) -{ - CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (r); - DIR *dir; - int err = 0; - struct dirent *d; - int fd; - - dir = opendir ("/sys/block"); - if (!dir) { - reply_with_perror ("opendir: /sys/block"); - return NULL; - } - - for (;;) { - errno = 0; - d = readdir (dir); - if (!d) break; - - if (STREQLEN (d->d_name, "sd", 2) || - STREQLEN (d->d_name, "hd", 2) || - STREQLEN (d->d_name, "ubd", 3) || - STREQLEN (d->d_name, "vd", 2) || - STREQLEN (d->d_name, "sr", 2) || - (return_md && - STREQLEN (d->d_name, "md", 2) && c_isdigit (d->d_name[2]))) { - CLEANUP_FREE char *dev_path = NULL; - if (asprintf (&dev_path, "/dev/%s", d->d_name) == -1) { - reply_with_perror ("asprintf"); - closedir (dir); - return NULL; - } - - /* Ignore the root device. */ - if (is_root_device (dev_path)) - continue; - - /* RHBZ#514505: Some versions of qemu <= 0.10 add a - * CD-ROM device even though we didn't request it. Try to - * detect this by seeing if the device contains media. - */ - fd = open (dev_path, O_RDONLY|O_CLOEXEC); - if (fd == -1) { - perror (dev_path); - continue; - } - close (fd); - - /* Call the map function for this device */ - if ((*func)(d->d_name, &r) != 0) { - err = 1; - break; - } - } - } - - /* Check readdir didn't fail */ - if (errno != 0) { - reply_with_perror ("readdir: /sys/block"); - closedir (dir); - return NULL; - } - - /* Close the directory handle */ - if (closedir (dir) == -1) { - reply_with_perror ("closedir: /sys/block"); - return NULL; - } - - if (err) - return NULL; - - /* Sort the devices. */ - if (r.size > 0) - sort_device_names (r.argv, r.size); - - /* NULL terminate the list */ - if (end_stringsbuf (&r) == -1) { - return NULL; - } - - return take_stringsbuf (&r); -} - -/* Add a device to the list of devices */ -static int -add_device (const char *device, struct stringsbuf *r) -{ - char *dev_path; - - if (asprintf (&dev_path, "/dev/%s", device) == -1) { - reply_with_perror ("asprintf"); - return -1; - } - - if (add_string_nodup (r, dev_path) == -1) - return -1; - - return 0; -} - -char ** -do_list_devices (void) -{ - /* For backwards compatibility, don't return MD devices in the list - * returned by guestfs_list_devices. This is because most API users - * expect that this list is effectively the same as the list of - * devices added by guestfs_add_drive. - * - * Also, MD devices are special devices - unlike the devices exposed - * by QEMU, and there is a special API for them, - * guestfs_list_md_devices. - */ - return foreach_block_device (add_device, false); -} - -static int -add_partitions (const char *device, struct stringsbuf *r) -{ - CLEANUP_FREE char *devdir = NULL; - - /* Open the device's directory under /sys/block */ - if (asprintf (&devdir, "/sys/block/%s", device) == -1) { - reply_with_perror ("asprintf"); - return -1; - } - - DIR *dir = opendir (devdir); - if (!dir) { - reply_with_perror ("opendir: %s", devdir); - return -1; - } - - /* Look in /sys/block/<device>/ for entries starting with <device> - * e.g. /sys/block/sda/sda1 - */ - errno = 0; - struct dirent *d; - while ((d = readdir (dir)) != NULL) { - if (STREQLEN (d->d_name, device, strlen (device))) { - CLEANUP_FREE char *part = NULL; - if (asprintf (&part, "/dev/%s", d->d_name) == -1) { - perror ("asprintf"); - closedir (dir); - return -1; - } - - if (add_string (r, part) == -1) { - closedir (dir); - return -1; - } - } - } - - /* Check if readdir failed */ - if (0 != errno) { - reply_with_perror ("readdir: %s", devdir); - closedir (dir); - return -1; - } - - /* Close the directory handle */ - if (closedir (dir) == -1) { - reply_with_perror ("closedir: /sys/block/%s", device); - return -1; - } - - return 0; -} - -char ** -do_list_partitions (void) -{ - return foreach_block_device (add_partitions, true); -} - -char * -do_part_to_dev (const char *part) -{ - int err = 1; - size_t n = strlen (part); - - while (n >= 1 && c_isdigit (part[n-1])) { - err = 0; - n--; - } - - if (err) { - reply_with_error ("device name is not a partition"); - return NULL; - } - - /* Deal with <device>p<N> partition names such as /dev/md0p1. */ - if (part[n-1] == 'p') - n--; - - char *r = strndup (part, n); - if (r == NULL) { - reply_with_perror ("strdup"); - return NULL; - } - - return r; -} - -int -do_part_to_partnum (const char *part) -{ - int err = 1; - size_t n = strlen (part); - - while (n >= 1 && c_isdigit (part[n-1])) { - err = 0; - n--; - } - - if (err) { - reply_with_error ("device name is not a partition"); - return -1; - } - - int r; - if (sscanf (&part[n], "%d", &r) != 1) { - reply_with_error ("could not parse number"); - return -1; - } - - return r; -} - -int -do_is_whole_device (const char *device) -{ - /* A 'whole' block device will have a symlink to the device in its - * /sys/block directory */ - CLEANUP_FREE char *devpath = NULL; - if (asprintf (&devpath, "/sys/block/%s/device", - device + strlen ("/dev/")) == -1) { - reply_with_perror ("asprintf"); - return -1; - } - - struct stat statbuf; - if (stat (devpath, &statbuf) == -1) { - if (errno == ENOENT || errno == ENOTDIR) return 0; - - reply_with_perror ("stat"); - return -1; - } - - return 1; -} - int do_device_index (const char *device) { diff --git a/daemon/devsparts.ml b/daemon/devsparts.ml new file mode 100644 index 000000000..43093aba8 --- /dev/null +++ b/daemon/devsparts.ml @@ -0,0 +1,113 @@ +(* 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 Utils + +let map_block_devices ~return_md f = + let devs = Sys.readdir "/sys/block" in + let devs = Array.to_list devs in + let devs = List.filter ( + fun dev -> + String.is_prefix dev "sd" || + String.is_prefix dev "hd" || + String.is_prefix dev "ubd" || + String.is_prefix dev "vd" || + String.is_prefix dev "sr" || + (return_md && String.is_prefix dev "md" && + String.length dev >= 3 && Char.isdigit dev.[2]) + ) devs in + + (* Ignore the root device. *) + let devs = + List.filter (fun dev -> not (is_root_device ("/dev/" ^ dev))) devs in + + (* RHBZ#514505: Some versions of qemu <= 0.10 add a + * CD-ROM device even though we didn't request it. Try to + * detect this by seeing if the device contains media. + *) + let devs = + List.filter ( + fun dev -> + try + let fd = openfile ("/dev/" ^ dev) [O_RDONLY] 0 in + Unix.set_close_on_exec fd; (* XXX *) + close fd; + true + with _ -> false + ) devs in + + (* Call the map function for the devices left in the list. *) + List.map f devs + +let list_devices () = + (* For backwards compatibility, don't return MD devices in the list + * returned by guestfs_list_devices. This is because most API users + * expect that this list is effectively the same as the list of + * devices added by guestfs_add_drive. + * + * Also, MD devices are special devices - unlike the devices exposed + * by QEMU, and there is a special API for them, + * guestfs_list_md_devices. + *) + let devices = + map_block_devices ~return_md:false ((^) "/dev/") in + sort_device_names devices + +let rec list_partitions () = + let partitions = map_block_devices ~return_md:true add_partitions in + let partitions = List.flatten partitions in + sort_device_names partitions + +and add_partitions dev = + (* Open the device's directory under /sys/block *) + let parts = Sys.readdir ("/sys/block/" ^ dev) in + let parts = Array.to_list parts in + + (* Look in /sys/block/<device>/ for entries starting with + * <device>, eg. /sys/block/sda/sda1. + *) + let parts = List.filter (fun part -> String.is_prefix part dev) parts in + List.map ((^) "/dev/") parts + +let part_to_dev part = + let dev, part = split_device_partition part in + if part = 0 then + failwithf "device name is not a partition"; + "/dev/" ^ dev + +let part_to_partnum part = + let _, part = split_device_partition part in + if part = 0 then + failwithf "device name is not a partition"; + part + +let is_whole_device device = + (* A 'whole' block device will have a symlink to the device in its + * /sys/block directory + *) + assert (String.is_prefix device "/dev/"); + let device = String.sub device 5 (String.length device - 5) in + let devpath = sprintf "/sys/block/%s/device" device in + + try ignore (stat devpath); true + with Unix_error ((ENOENT|ENOTDIR), _, _) -> false diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli new file mode 100644 index 000000000..4dfaa86e6 --- /dev/null +++ b/daemon/devsparts.mli @@ -0,0 +1,25 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val list_devices : unit -> string list +val list_partitions : unit -> string list + +val part_to_dev : string -> string +val part_to_partnum : string -> int + +val is_whole_device : string -> bool diff --git a/daemon/guestfsd.c b/daemon/guestfsd.c index ddc49ed44..a302c3d5c 100644 --- a/daemon/guestfsd.c +++ b/daemon/guestfsd.c @@ -628,81 +628,6 @@ free_stringslen (char **argv, size_t len) } /** - * Compare device names (including partition numbers if present). - * - * L<https://rwmj.wordpress.com/2011/01/09/how-are-linux-drives-named-bey... - */ -int -compare_device_names (const char *a, const char *b) -{ - size_t alen, blen; - int r; - int a_partnum, b_partnum; - - /* Skip /dev/ prefix if present. */ - if (STRPREFIX (a, "/dev/")) - a += 5; - if (STRPREFIX (b, "/dev/")) - b += 5; - - /* Skip sd/hd/ubd/vd. */ - alen = strcspn (a, "d"); - blen = strcspn (b, "d"); - assert (alen > 0 && alen <= 2); - assert (blen > 0 && blen <= 2); - a += alen + 1; - b += blen + 1; - - /* Get device name part, that is, just 'a', 'ab' etc. */ - alen = strcspn (a, "0123456789"); - blen = strcspn (b, "0123456789"); - - /* If device name part is longer, it is always greater, eg. - * "/dev/sdz" < "/dev/sdaa". - */ - if (alen != blen) - return alen - blen; - - /* Device name parts are the same length, so do a regular compare. */ - r = strncmp (a, b, alen); - if (r != 0) - return r; - - /* Compare partitions numbers. */ - a += alen; - b += alen; - - /* If no partition numbers, bail -- the devices are the same. This - * can happen in one peculiar case: where you have a mix of devices - * with different interfaces (eg. /dev/sda and /dev/vda). - * (RHBZ#858128). - */ - if (!*a && !*b) - return 0; - - r = sscanf (a, "%d", &a_partnum); - assert (r == 1); - r = sscanf (b, "%d", &b_partnum); - assert (r == 1); - - return a_partnum - b_partnum; -} - -static int -compare_device_names_vp (const void *vp1, const void *vp2) -{ - char * const *p1 = (char * const *) vp1; - char * const *p2 = (char * const *) vp2; - return compare_device_names (*p1, *p2); -} - -void -sort_device_names (char **argv, size_t len) -{ - qsort (argv, len, sizeof (char *), compare_device_names_vp); -} - -/** * Split an output string into a NULL-terminated list of lines, * wrapped into a stringsbuf. * diff --git a/daemon/utils.ml b/daemon/utils.ml index 347ed613b..ecbf924d5 100644 --- a/daemon/utils.ml +++ b/daemon/utils.ml @@ -133,6 +133,90 @@ let is_root_device device = device func arg (error_message err); false +(* XXX This function is copied from C, but is misconceived. It + * cannot by design work for devices like /dev/md0. It would be + * better if it checked for the existence of devices and partitions + * in /sys/block so we know what the kernel thinks is a device or + * partition. The same applies to APIs such as part_to_partnum + * and part_to_dev which rely on this function. + *) +let split_device_partition dev = + (* Skip /dev/ prefix if present. *) + let dev = + if String.is_prefix dev "/dev/" then + String.sub dev 5 (String.length dev - 5) + else dev in + + (* Find the partition number (if present). *) + let dev, part = + let n = String.length dev in + let i = ref n in + while !i >= 1 && Char.isdigit dev.[!i-1] do + decr i + done; + let i = !i in + if i = n then + dev, 0 (* no partition number, whole device *) + else + String.sub dev 0 i, int_of_string (String.sub dev i (n-i)) in + + (* Deal with device names like /dev/md0p1. *) + (* XXX This function is buggy (as was the old C function) when + * presented with a whole device like /dev/md0. + *) + let dev = + let n = String.length dev in + if n < 2 || dev.[n-1] <> 'p' || not (Char.isdigit dev.[n-2]) then + dev + else ( + let i = ref (n-1) in + while !i >= 0 && Char.isdigit dev.[!i] do + decr i; + done; + let i = !i in + String.sub dev 0 i + ) in + + dev, part + +let rec sort_device_names devs = + List.sort compare_device_names devs + +and compare_device_names a b = + (* This takes the device name like "/dev/sda1" and returns ("sda", 1). *) + let dev_a, part_a = split_device_partition a + and dev_b, part_b = split_device_partition b in + + (* Skip "sd|hd|ubd..." so that /dev/sda and /dev/vda sort together. + * (This is what the old C function did, but it's not clear if it + * is still relevant. XXX) + *) + let skip_prefix dev = + let n = String.length dev in + if n >= 2 && dev.[1] = 'd' then + String.sub dev 2 (String.length dev - 2) + else if n >= 3 && dev.[2] = 'd' then + String.sub dev 3 (String.length dev - 3) + else + dev in + let dev_a = skip_prefix dev_a + and dev_b = skip_prefix dev_b in + + (* If device name part is longer, it is always greater, eg. + * "/dev/sdz" < "/dev/sdaa". + *) + let r = compare (String.length dev_a) (String.length dev_b) in + if r <> 0 then r + else ( + (* Device name parts are the same length, so do a regular compare. *) + let r = compare dev_a dev_b in + if r <> 0 then r + else ( + (* Device names are identical, so compare partition numbers. *) + compare part_a part_b + ) + ) + let proc_unmangle_path path = let n = String.length path in let b = Buffer.create n in diff --git a/daemon/utils.mli b/daemon/utils.mli index b399bfc00..d3c8bdf4d 100644 --- a/daemon/utils.mli +++ b/daemon/utils.mli @@ -41,6 +41,21 @@ val is_root_device_stat : Unix.stats -> bool (** As for {!is_root_device} but operates on a statbuf instead of a device name. *) +val split_device_partition : string -> string * int +(** Split a device name like [/dev/sda1] into a device name and + partition number, eg. ["sda", 1]. + + The [/dev/] prefix is skipped and removed, if present. + + If the partition number is not present (a whole device), 0 is returned. + + This function splits [/dev/md0p1] to ["md0", 1]. *) + +val sort_device_names : string list -> string list +(** Sort device names correctly so that /dev/sdaa appears after /dev/sdz. + This also deals with partition numbers, and works whether or not + [/dev/] is present. *) + val proc_unmangle_path : string -> string (** Reverse kernel path escaping done in fs/seq_file.c:mangle_path. This is inconsistently used for /proc fields. *) diff --git a/generator/actions_core.ml b/generator/actions_core.ml index a6eb2c273..94391288f 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -1817,6 +1817,7 @@ is I<not> intended that you try to parse the output string." }; { defaults with name = "list_devices"; added = (0, 0, 4); style = RStringList (RDevice, "devices"), [], []; + impl = OCaml "Devsparts.list_devices"; tests = [ InitEmpty, Always, TestResult ( [["list_devices"]], @@ -1833,6 +1834,7 @@ See also C<guestfs_list_filesystems>." }; { defaults with name = "list_partitions"; added = (0, 0, 4); style = RStringList (RDevice, "partitions"), [], []; + impl = OCaml "Devsparts.list_partitions"; tests = [ InitBasicFS, Always, TestResult ( [["list_partitions"]], @@ -6086,6 +6088,7 @@ See also C<guestfs_stat>." }; { defaults with name = "part_to_dev"; added = (1, 5, 15); style = RString (RDevice, "device"), [String (Device, "partition")], []; + impl = OCaml "Devsparts.part_to_dev"; tests = [ InitPartition, Always, TestResultDevice ( [["part_to_dev"; "/dev/sda1"]], "/dev/sda"), []; @@ -6533,6 +6536,7 @@ as in C<guestfs_compress_out>." }; { defaults with name = "part_to_partnum"; added = (1, 13, 25); style = RInt "partnum", [String (Device, "partition")], []; + impl = OCaml "Devsparts.part_to_partnum"; tests = [ InitPartition, Always, TestResult ( [["part_to_partnum"; "/dev/sda1"]], "ret == 1"), []; @@ -8480,6 +8484,7 @@ you are better to use C<guestfs_mv> instead." }; { defaults with name = "is_whole_device"; added = (1, 21, 9); style = RBool "flag", [String (Device, "device")], []; + impl = OCaml "Devsparts.is_whole_device"; tests = [ InitEmpty, Always, TestResultTrue ( [["is_whole_device"; "/dev/sda"]]), []; -- 2.13.2

This also demonstrates usage of optional arguments. --- daemon/Makefile.am | 2 ++ daemon/is.c | 41 ----------------------------------------- daemon/is.ml | 42 ++++++++++++++++++++++++++++++++++++++++++ daemon/is.mli | 21 +++++++++++++++++++++ generator/actions_core.ml | 3 +++ 5 files changed, 68 insertions(+), 41 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 8ffa35ec5..3c9cc1c71 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -247,6 +247,7 @@ SOURCES_MLI = \ sysroot.mli \ devsparts.mli \ file.mli \ + is.mli \ mountable.mli \ utils.mli @@ -260,6 +261,7 @@ SOURCES_ML = \ blkid.ml \ devsparts.ml \ file.ml \ + is.ml \ callbacks.ml \ daemon.ml diff --git a/daemon/is.c b/daemon/is.c index 4d5e911c2..a91dab32b 100644 --- a/daemon/is.c +++ b/daemon/is.c @@ -39,36 +39,6 @@ do_exists (const char *path) /* Takes optional arguments, consult optargs_bitmask. */ int -do_is_file (const char *path, int followsymlinks) -{ - mode_t mode; - int r; - - if (!(optargs_bitmask & GUESTFS_IS_FILE_FOLLOWSYMLINKS_BITMASK)) - followsymlinks = 0; - - r = get_mode (path, &mode, followsymlinks); - if (r <= 0) return r; - return S_ISREG (mode); -} - -/* Takes optional arguments, consult optargs_bitmask. */ -int -do_is_dir (const char *path, int followsymlinks) -{ - mode_t mode; - int r; - - if (!(optargs_bitmask & GUESTFS_IS_DIR_FOLLOWSYMLINKS_BITMASK)) - followsymlinks = 0; - - r = get_mode (path, &mode, followsymlinks); - if (r <= 0) return r; - return S_ISDIR (mode); -} - -/* Takes optional arguments, consult optargs_bitmask. */ -int do_is_chardev (const char *path, int followsymlinks) { mode_t mode; @@ -112,17 +82,6 @@ do_is_fifo (const char *path, int followsymlinks) return S_ISFIFO (mode); } -int -do_is_symlink (const char *path) -{ - mode_t mode; - int r; - - r = get_mode (path, &mode, 0); - if (r <= 0) return r; - return S_ISLNK (mode); -} - /* Takes optional arguments, consult optargs_bitmask. */ int do_is_socket (const char *path, int followsymlinks) diff --git a/daemon/is.ml b/daemon/is.ml new file mode 100644 index 000000000..4929f48b3 --- /dev/null +++ b/daemon/is.ml @@ -0,0 +1,42 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Printf +open Unix + +let rec is_file ?(followsymlinks = false) path = + is "is_file" S_REG followsymlinks path +and is_dir ?(followsymlinks = false) path = + is "is_dir" S_DIR followsymlinks path +and is_symlink path = + is "is_symlink" S_LNK false path + +and is func expected_kind followsymlinks path = + let chroot = Chroot.create ~name:(sprintf "%s: %s" func path) () in + let kind = + Chroot.f chroot ( + fun () -> + let statfun = if followsymlinks then stat else lstat in + try + let statbuf = statfun path in + Some statbuf.st_kind + with + Unix_error ((ENOENT|ENOTDIR), _, _) -> + None (* File doesn't exist => return None *) + ) () in + kind = Some expected_kind diff --git a/daemon/is.mli b/daemon/is.mli new file mode 100644 index 000000000..20622c39f --- /dev/null +++ b/daemon/is.mli @@ -0,0 +1,21 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val is_file : ?followsymlinks:bool -> string -> bool +val is_dir : ?followsymlinks:bool -> string -> bool +val is_symlink : string -> bool diff --git a/generator/actions_core.ml b/generator/actions_core.ml index 94391288f..421f3ac6b 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -2114,6 +2114,7 @@ See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>." }; { defaults with name = "is_file"; added = (0, 0, 8); style = RBool "fileflag", [String (Pathname, "path")], [OBool "followsymlinks"]; + impl = OCaml "Is.is_file"; once_had_no_optargs = true; tests = [ InitISOFS, Always, TestResultTrue ( @@ -2138,6 +2139,7 @@ See also C<guestfs_stat>." }; { defaults with name = "is_dir"; added = (0, 0, 8); style = RBool "dirflag", [String (Pathname, "path")], [OBool "followsymlinks"]; + impl = OCaml "Is.is_dir"; once_had_no_optargs = true; tests = [ InitISOFS, Always, TestResultFalse ( @@ -6052,6 +6054,7 @@ See also C<guestfs_stat>." }; { defaults with name = "is_symlink"; added = (1, 5, 10); style = RBool "flag", [String (Pathname, "path")], []; + impl = OCaml "Is.is_symlink"; tests = [ InitISOFS, Always, TestResultFalse ( [["is_symlink"; "/directory"]]), []; -- 2.13.2

Some of the oldest and most core APIs, reimplemented. This also moves the strange ‘mount_vfs_nochroot’ function into btrfs.c. --- daemon/Makefile.am | 2 + daemon/btrfs.c | 43 ++++++++++++++++++++ daemon/daemon.h | 6 --- daemon/mount.c | 99 ----------------------------------------------- daemon/mount.ml | 62 +++++++++++++++++++++++++++++ daemon/mount.mli | 22 +++++++++++ generator/actions_core.ml | 4 ++ 7 files changed, 133 insertions(+), 105 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 74ccc4c6f..1ac48f751 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -249,6 +249,7 @@ SOURCES_MLI = \ file.mli \ is.mli \ link.mli \ + mount.mli \ mountable.mli \ utils.mli @@ -264,6 +265,7 @@ SOURCES_ML = \ file.ml \ is.ml \ link.ml \ + mount.ml \ callbacks.ml \ daemon.ml diff --git a/daemon/btrfs.c b/daemon/btrfs.c index 5f1e5d1d0..4f52b71e8 100644 --- a/daemon/btrfs.c +++ b/daemon/btrfs.c @@ -37,6 +37,7 @@ GUESTFSD_EXT_CMD(str_btrfs, btrfs); GUESTFSD_EXT_CMD(str_btrfstune, btrfstune); GUESTFSD_EXT_CMD(str_btrfsck, btrfsck); GUESTFSD_EXT_CMD(str_mkfs_btrfs, mkfs.btrfs); +GUESTFSD_EXT_CMD(str_mount, mount); GUESTFSD_EXT_CMD(str_umount, umount); GUESTFSD_EXT_CMD(str_btrfsimage, btrfs-image); @@ -387,6 +388,48 @@ do_btrfs_subvolume_create (const char *dest, const char *qgroupid) return 0; } +static int +mount_vfs_nochroot (const char *options, const char *vfstype, + const mountable_t *mountable, + const char *mp, const char *user_mp) +{ + CLEANUP_FREE char *options_plus = NULL; + const char *device = mountable->device; + if (mountable->type == MOUNTABLE_BTRFSVOL) { + if (options && strlen (options) > 0) { + if (asprintf (&options_plus, "subvol=%s,%s", + mountable->volume, options) == -1) { + reply_with_perror ("asprintf"); + return -1; + } + } + else { + if (asprintf (&options_plus, "subvol=%s", mountable->volume) == -1) { + reply_with_perror ("asprintf"); + return -1; + } + } + } + + CLEANUP_FREE char *error = NULL; + int r; + if (vfstype) + r = command (NULL, &error, + str_mount, "-o", options_plus ? options_plus : options, + "-t", vfstype, device, mp, NULL); + else + r = command (NULL, &error, + str_mount, "-o", options_plus ? options_plus : options, + device, mp, NULL); + if (r == -1) { + reply_with_error ("%s on %s (options: '%s'): %s", + device, user_mp, options, error); + return -1; + } + + return 0; +} + static char * mount (const mountable_t *fs) { diff --git a/daemon/daemon.h b/daemon/daemon.h index 0a92e6cee..62e1211c8 100644 --- a/daemon/daemon.h +++ b/daemon/daemon.h @@ -94,12 +94,6 @@ extern void cleanup_free_stringsbuf (void *ptr); #define CLEANUP_FREE_STRINGSBUF #endif -/*-- in mount.c --*/ - -extern int mount_vfs_nochroot (const char *options, const char *vfstype, - const mountable_t *mountable, - const char *mp, const char *user_mp); - /* Growable strings buffer. */ struct stringsbuf { char **argv; diff --git a/daemon/mount.c b/daemon/mount.c index 0ad9626a7..962b86079 100644 --- a/daemon/mount.c +++ b/daemon/mount.c @@ -111,105 +111,6 @@ is_device_mounted (const char *device) return 0; } -/* The "simple mount" call offers no complex options, you can just - * mount a device on a mountpoint. The variations like mount_ro, - * mount_options and mount_vfs let you set progressively more things. - * - * It's tempting to try a direct mount(2) syscall, but that doesn't - * do any autodetection, so we are better off calling out to - * /bin/mount. - */ - -int -do_mount_vfs (const char *options, const char *vfstype, - const mountable_t *mountable, const char *mountpoint) -{ - CLEANUP_FREE char *mp = NULL; - struct stat statbuf; - - ABS_PATH (mountpoint, 0, return -1); - - mp = sysroot_path (mountpoint); - if (!mp) { - reply_with_perror ("malloc"); - return -1; - } - - /* Check the mountpoint exists and is a directory. */ - if (stat (mp, &statbuf) == -1) { - reply_with_perror ("mount: %s", mountpoint); - return -1; - } - if (!S_ISDIR (statbuf.st_mode)) { - reply_with_perror ("mount: %s: mount point is not a directory", mountpoint); - return -1; - } - - return mount_vfs_nochroot (options, vfstype, mountable, mp, mountpoint); -} - -int -mount_vfs_nochroot (const char *options, const char *vfstype, - const mountable_t *mountable, - const char *mp, const char *user_mp) -{ - CLEANUP_FREE char *options_plus = NULL; - const char *device = mountable->device; - if (mountable->type == MOUNTABLE_BTRFSVOL) { - if (options && strlen (options) > 0) { - if (asprintf (&options_plus, "subvol=%s,%s", - mountable->volume, options) == -1) { - reply_with_perror ("asprintf"); - return -1; - } - } - - else { - if (asprintf (&options_plus, "subvol=%s", mountable->volume) == -1) { - reply_with_perror ("asprintf"); - return -1; - } - } - } - - CLEANUP_FREE char *error = NULL; - int r; - if (vfstype) - r = command (NULL, &error, - str_mount, "-o", options_plus ? options_plus : options, - "-t", vfstype, device, mp, NULL); - else - r = command (NULL, &error, - str_mount, "-o", options_plus ? options_plus : options, - device, mp, NULL); - if (r == -1) { - reply_with_error ("%s on %s (options: '%s'): %s", - device, user_mp, options, error); - return -1; - } - - return 0; -} - -int -do_mount (const mountable_t *mountable, const char *mountpoint) -{ - return do_mount_vfs ("", NULL, mountable, mountpoint); -} - -int -do_mount_ro (const mountable_t *mountable, const char *mountpoint) -{ - return do_mount_vfs ("ro", NULL, mountable, mountpoint); -} - -int -do_mount_options (const char *options, const mountable_t *mountable, - const char *mountpoint) -{ - return do_mount_vfs (options, NULL, mountable, mountpoint); -} - /* Takes optional arguments, consult optargs_bitmask. */ int do_umount (const char *pathordevice, diff --git a/daemon/mount.ml b/daemon/mount.ml new file mode 100644 index 000000000..3391ffc11 --- /dev/null +++ b/daemon/mount.ml @@ -0,0 +1,62 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Std_utils + +open Mountable +open Utils + +let mount_vfs options vfs mountable mountpoint = + let mp = Sysroot.sysroot_path mountpoint in + + (* Check the mountpoint exists and is a directory. *) + if not (is_directory mp) then + failwithf "mount: %s: mount point is not a directory" mountpoint; + + let args = ref [] in + + (* -o options *) + (match options, mountable.m_type with + | (None | Some ""), (MountableDevice | MountablePath) -> () + | Some options, (MountableDevice | MountablePath) -> + push_back args "-o"; + push_back args options + | (None | Some ""), MountableBtrfsVol subvol -> + push_back args "-o"; + push_back args ("subvol=" ^ subvol) + | Some options, MountableBtrfsVol subvol -> + push_back args "-o"; + push_back args ("subvol=" ^ subvol ^ "," ^ options) + ); + + (* -t vfs *) + (match vfs with + | None | Some "" -> () + | Some t -> + push_back args "-t"; + push_back args t + ); + + push_back args mountable.m_device; + push_back args mp; + + ignore (command "mount" !args) + +let mount = mount_vfs None None +let mount_ro = mount_vfs (Some "ro") None +let mount_options options = mount_vfs (Some options) None diff --git a/daemon/mount.mli b/daemon/mount.mli new file mode 100644 index 000000000..e43d97c42 --- /dev/null +++ b/daemon/mount.mli @@ -0,0 +1,22 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val mount : Mountable.t -> string -> unit +val mount_ro : Mountable.t -> string -> unit +val mount_options : string -> Mountable.t -> string -> unit +val mount_vfs : string option -> string option -> Mountable.t -> string -> unit diff --git a/generator/actions_core.ml b/generator/actions_core.ml index 7d6755fdc..f33bc5320 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -1739,6 +1739,7 @@ let daemon_functions = [ { defaults with name = "mount"; added = (0, 0, 3); style = RErr, [String (Mountable, "mountable"); String (PlainString, "mountpoint")], []; + impl = OCaml "Mount.mount"; tests = [ InitEmpty, Always, TestResultString ( [["part_disk"; "/dev/sda"; "mbr"]; @@ -2922,6 +2923,7 @@ If set to true, POSIX ACLs are saved in the output tar. { defaults with name = "mount_ro"; added = (1, 0, 10); style = RErr, [String (Mountable, "mountable"); String (PlainString, "mountpoint")], []; + impl = OCaml "Mount.mount_ro"; tests = [ InitBasicFS, Always, TestLastFail ( [["umount"; "/"; "false"; "false"]; @@ -2941,6 +2943,7 @@ mounts the filesystem with the read-only (I<-o ro>) flag." }; { defaults with name = "mount_options"; added = (1, 0, 10); style = RErr, [String (PlainString, "options"); String (Mountable, "mountable"); String (PlainString, "mountpoint")], []; + impl = OCaml "Mount.mount_options"; shortdesc = "mount a guest disk with mount options"; longdesc = "\ This is the same as the C<guestfs_mount> command, but it @@ -2954,6 +2957,7 @@ the filesystem uses)." }; { defaults with name = "mount_vfs"; added = (1, 0, 10); style = RErr, [String (PlainString, "options"); String (PlainString, "vfstype"); String (Mountable, "mountable"); String (PlainString, "mountpoint")], []; + impl = OCaml "Mount.mount_vfs"; shortdesc = "mount a guest disk with mount options and vfstype"; longdesc = "\ This is the same as the C<guestfs_mount> command, but it -- 2.13.2

--- daemon/Makefile.am | 2 + daemon/realpath.c | 187 ---------------------------------------------- daemon/realpath.ml | 82 ++++++++++++++++++++ daemon/realpath.mli | 19 +++++ generator/actions_core.ml | 1 + 5 files changed, 104 insertions(+), 187 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index b69fc8c5b..cf622a705 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -252,6 +252,7 @@ SOURCES_MLI = \ mount.mli \ mountable.mli \ parted.mli \ + realpath.mli \ utils.mli SOURCES_ML = \ @@ -268,6 +269,7 @@ SOURCES_ML = \ link.ml \ mount.ml \ parted.ml \ + realpath.ml \ callbacks.ml \ daemon.ml diff --git a/daemon/realpath.c b/daemon/realpath.c index 24ab133e2..f9d22d28d 100644 --- a/daemon/realpath.c +++ b/daemon/realpath.c @@ -48,190 +48,3 @@ do_realpath (const char *path) return ret; /* caller frees */ } - -static int find_path_element (int fd_cwd, int is_end, const char *name, char **name_ret); - -char * -do_case_sensitive_path (const char *path) -{ - size_t next; - int fd_cwd, fd2, err, is_end; - char *ret; - - ret = strdup ("/"); - if (ret == NULL) { - reply_with_perror ("strdup"); - return NULL; - } - next = 1; /* next position in 'ret' buffer */ - - /* 'fd_cwd' here is a surrogate for the current working directory, so - * that we don't have to actually call chdir(2). - */ - fd_cwd = open (sysroot, O_RDONLY|O_DIRECTORY|O_CLOEXEC); - if (fd_cwd == -1) { - reply_with_perror ("%s", sysroot); - goto error; - } - - /* First character is a '/'. Take each subsequent path element - * and follow it. - */ - while (*path) { - char *t; - size_t i, len; - CLEANUP_FREE char *name_in = NULL, *name_out = NULL; - - i = strcspn (path, "/"); - if (i == 0) { - path++; - continue; - } - - if ((i == 1 && path[0] == '.') || - (i == 2 && path[0] == '.' && path[1] == '.')) { - reply_with_error ("path contained . or .. elements"); - goto error; - } - - name_in = strndup (path, i); - if (name_in == NULL) { - reply_with_perror ("strdup"); - goto error; - } - - /* Skip to next element in path (for the next loop iteration). */ - path += i; - is_end = *path == 0; - - /* Read the current directory looking (case insensitively) for - * this element of the path. This replaces 'name' with the - * correct case version. - */ - if (find_path_element (fd_cwd, is_end, name_in, &name_out) == -1) - goto error; - len = strlen (name_out); - - /* Add the real name of this path element to the return value. */ - if (next > 1) - ret[next++] = '/'; - - t = realloc (ret, next+len+1); - if (t == NULL) { - reply_with_perror ("realloc"); - goto error; - } - ret = t; - - strcpy (&ret[next], name_out); - next += len; - - /* Is it a directory? Try going into it. */ - fd2 = openat (fd_cwd, name_out, O_RDONLY|O_DIRECTORY|O_CLOEXEC); - err = errno; - close (fd_cwd); - fd_cwd = fd2; - errno = err; - if (fd_cwd == -1) { - /* Some errors are OK provided we've reached the end of the path. */ - if (is_end && (errno == ENOTDIR || errno == ENOENT)) - break; - - reply_with_perror ("openat: %s", name_out); - goto error; - } - } - - if (fd_cwd >= 0) - close (fd_cwd); - - return ret; /* caller frees */ - - error: - if (fd_cwd >= 0) - close (fd_cwd); - free (ret); - - return NULL; -} - -/* 'fd_cwd' is a file descriptor pointing to an open directory. - * 'name' is the path element to search for. 'is_end' is a flag - * indicating if this is the last path element. - * - * We search the directory looking for a path element that case - * insensitively matches 'name', returning the actual name in '*name_ret'. - * - * If this is successful, return 0. If it fails, reply with an error - * and return -1. - */ -static int -find_path_element (int fd_cwd, int is_end, const char *name, char **name_ret) -{ - int fd2; - DIR *dir; - struct dirent *d; - - fd2 = dup_cloexec (fd_cwd); /* because closedir will close it */ - if (fd2 == -1) { - reply_with_perror ("dup"); - return -1; - } - dir = fdopendir (fd2); - if (dir == NULL) { - reply_with_perror ("opendir"); - close (fd2); - return -1; - } - - for (;;) { - errno = 0; - d = readdir (dir); - if (d == NULL) - break; - if (STRCASEEQ (d->d_name, name)) - break; - } - - if (d == NULL && errno != 0) { - reply_with_perror ("readdir"); - closedir (dir); - return -1; - } - - if (d == NULL && is_end) { - /* Last path element: return it as-is, assuming that the user will - * create a new file or directory (RHBZ#840115). - */ - closedir (dir); - *name_ret = strdup (name); - if (*name_ret == NULL) { - reply_with_perror ("strdup"); - return -1; - } - return 0; - } - - if (d == NULL) { - reply_with_error ("%s: no file or directory found with this name", name); - closedir (dir); - return -1; - } - - *name_ret = strdup (d->d_name); - if (*name_ret == NULL) { - reply_with_perror ("strdup"); - closedir (dir); - return -1; - } - - /* NB: closedir frees the structure associated with 'd', so we must - * do this last. - */ - if (closedir (dir) == -1) { - reply_with_perror ("closedir"); - return -1; - } - - return 0; -} diff --git a/daemon/realpath.ml b/daemon/realpath.ml new file mode 100644 index 000000000..e499786a1 --- /dev/null +++ b/daemon/realpath.ml @@ -0,0 +1,82 @@ +(* 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 + +(* The infamous case_sensitive_path function, which works around + * the bug in ntfs-3g that all paths are case sensitive even though + * the underlying filesystem is case insensitive. + *) +let rec case_sensitive_path path = + let elems = String.nsplit "/" path in + + (* The caller ensures that the first element of [path] is [/], + * and therefore the first element of the split list must be + * empty. + *) + assert (List.length elems > 0); + assert (List.hd elems = ""); + let elems = List.tl elems in + + let chroot = + Chroot.create ~name:(sprintf "case_sensitive_path: %s" path) () in + + (* Now we iterate down the tree starting at the sysroot. *) + let elems = + Chroot.f chroot ( + fun () -> + let rec loop = function + | [] -> [] + | [ "."|".." ] -> + failwithf "path contains \".\" or \"..\" elements" + | "" :: elems -> + (* For compatibility with C implementation, we ignore + * "//" in the middle of the path. + *) + loop elems + | [ file ] -> + (* If it's the final element, it's allowed to be missing. *) + (match find_path_element file with + | None -> [ file ] (* return the original *) + | Some file -> [ file ] + ); + | elem :: elems -> + (match find_path_element elem with + | None -> + failwithf "%s: not found" elem + | Some elem -> + (* This will fail intentionally if not a directory. *) + Unix.chdir elem; + elem :: loop elems + ) + in + loop elems + ) () in + + (* Reconstruct the case sensitive path. *) + "/" ^ String.concat "/" elems + +and find_path_element name = + let dir = Sys.readdir "." in + let dir = Array.to_list dir in + let lc_name = String.lowercase_ascii name in + let cmp n = String.lowercase_ascii n = lc_name in + try Some (List.find cmp dir) + with Not_found -> None diff --git a/daemon/realpath.mli b/daemon/realpath.mli new file mode 100644 index 000000000..371e619fc --- /dev/null +++ b/daemon/realpath.mli @@ -0,0 +1,19 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val case_sensitive_path : string -> string diff --git a/generator/actions_core.ml b/generator/actions_core.ml index 4bf0c7b70..54d0a6ca8 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -4797,6 +4797,7 @@ The result list is not sorted. { defaults with name = "case_sensitive_path"; added = (1, 0, 75); style = RString (RPlainString, "rpath"), [String (Pathname, "path")], []; + impl = OCaml "Realpath.case_sensitive_path"; tests = [ InitISOFS, Always, TestResultString ( [["case_sensitive_path"; "/DIRECTORY"]], "/directory"), []; -- 2.13.2

--- daemon/Makefile.am | 2 ++ daemon/ldm.c | 82 ----------------------------------------------- daemon/ldm.ml | 44 +++++++++++++++++++++++++ daemon/ldm.mli | 20 ++++++++++++ generator/actions_core.ml | 2 ++ 5 files changed, 68 insertions(+), 82 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 6d6e1b962..f1ab10c6e 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -249,6 +249,7 @@ SOURCES_MLI = \ file.mli \ filearch.mli \ is.mli \ + ldm.mli \ link.mli \ mount.mli \ mountable.mli \ @@ -268,6 +269,7 @@ SOURCES_ML = \ file.ml \ filearch.ml \ is.ml \ + ldm.ml \ link.ml \ mount.ml \ parted.ml \ diff --git a/daemon/ldm.c b/daemon/ldm.c index 75418e8d3..5106e65f9 100644 --- a/daemon/ldm.c +++ b/daemon/ldm.c @@ -23,7 +23,6 @@ #include <unistd.h> #include <sys/types.h> #include <sys/stat.h> -#include <glob.h> #include <string.h> #include <yajl/yajl_tree.h> @@ -47,87 +46,6 @@ optgroup_ldm_available (void) return prog_exists (str_ldmtool); } -static int -glob_errfunc (const char *epath, int eerrno) -{ - fprintf (stderr, "glob: failure reading %s: %s\n", epath, strerror (eerrno)); - return 1; -} - -static char ** -get_devices (const char *pattern) -{ - CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret); - glob_t devs; - int err; - size_t i; - - memset (&devs, 0, sizeof devs); - - err = glob (pattern, GLOB_ERR, glob_errfunc, &devs); - if (err == GLOB_NOSPACE) { - reply_with_error ("glob: returned GLOB_NOSPACE: " - "rerun with LIBGUESTFS_DEBUG=1"); - goto error; - } else if (err == GLOB_ABORTED) { - reply_with_error ("glob: returned GLOB_ABORTED: " - "rerun with LIBGUESTFS_DEBUG=1"); - goto error; - } - - for (i = 0; i < devs.gl_pathc; ++i) { - if (add_string (&ret, devs.gl_pathv[i]) == -1) - goto error; - } - - if (end_stringsbuf (&ret) == -1) goto error; - - globfree (&devs); - return take_stringsbuf (&ret); - - error: - globfree (&devs); - - return NULL; -} - -/* All device mapper devices called /dev/mapper/ldm_vol_*. XXX We - * could tighten this up in future if ldmtool had a way to read these - * names back after they have been created. - */ -char ** -do_list_ldm_volumes (void) -{ - struct stat buf; - - /* If /dev/mapper doesn't exist at all, don't give an error. */ - if (stat ("/dev/mapper", &buf) == -1) { - if (errno == ENOENT) - return empty_list (); - reply_with_perror ("/dev/mapper"); - return NULL; - } - - return get_devices ("/dev/mapper/ldm_vol_*"); -} - -/* Same as above but /dev/mapper/ldm_part_*. See comment above. */ -char ** -do_list_ldm_partitions (void) -{ - struct stat buf; - - /* If /dev/mapper doesn't exist at all, don't give an error. */ - if (stat ("/dev/mapper", &buf) == -1) { - if (errno == ENOENT) - return empty_list (); - reply_with_perror ("/dev/mapper"); - return NULL; - } - - return get_devices ("/dev/mapper/ldm_part_*"); -} - int do_ldmtool_create_all (void) { diff --git a/daemon/ldm.ml b/daemon/ldm.ml new file mode 100644 index 000000000..f943e3cfd --- /dev/null +++ b/daemon/ldm.ml @@ -0,0 +1,44 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Std_utils + +open Utils + +(* All device mapper devices are called /dev/mapper/ldm_vol_* + * or /dev/mapper/ldm_part_*. + * + * XXX We could tighten this up in future if ldmtool had a way + * to read these names back after they have been created. + *) +let rec list_ldm_volumes () = list "ldm_vol_" + +and list_ldm_partitions () = list "ldm_part_" + +and list prefix = + (* If /dev/mapper doesn't exist at all, don't give an error. *) + if not (is_directory "/dev/mapper") then + [] + else ( + let dir = Sys.readdir "/dev/mapper" in + let dir = Array.to_list dir in + let dir = + List.filter (fun d -> String.is_prefix d prefix) dir in + let dir = List.map ((^) "/dev/mapper/") dir in + List.sort compare dir + ) diff --git a/daemon/ldm.mli b/daemon/ldm.mli new file mode 100644 index 000000000..789abb0b3 --- /dev/null +++ b/daemon/ldm.mli @@ -0,0 +1,20 @@ +(* guestfs-inspection + * Copyright (C) 2009-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val list_ldm_volumes : unit -> string list +val list_ldm_partitions : unit -> string list diff --git a/generator/actions_core.ml b/generator/actions_core.ml index bfd96589e..331a5feb1 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -8114,6 +8114,7 @@ The capabilities set C<cap> should be passed in text form { defaults with name = "list_ldm_volumes"; added = (1, 20, 0); style = RStringList (RDevice, "devices"), [], []; + impl = OCaml "Ldm.list_ldm_volumes"; optional = Some "ldm"; shortdesc = "list all Windows dynamic disk volumes"; longdesc = "\ @@ -8124,6 +8125,7 @@ device names." }; { defaults with name = "list_ldm_partitions"; added = (1, 20, 0); style = RStringList (RDevice, "devices"), [], []; + impl = OCaml "Ldm.list_ldm_partitions"; optional = Some "ldm"; shortdesc = "list all Windows dynamic disk partitions"; longdesc = "\ -- 2.13.2

--- daemon/Makefile.am | 2 + daemon/md.c | 125 ++++++++++++---------------------------------- daemon/md.ml | 48 ++++++++++++++++++ daemon/md.mli | 19 +++++++ generator/actions_core.ml | 1 + 5 files changed, 101 insertions(+), 94 deletions(-) diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 2a8e5876a..d017f73eb 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -252,6 +252,7 @@ SOURCES_MLI = \ ldm.mli \ link.mli \ lvm.mli \ + md.mli \ mount.mli \ mountable.mli \ parted.mli \ @@ -273,6 +274,7 @@ SOURCES_ML = \ ldm.ml \ link.ml \ lvm.ml \ + md.ml \ mount.ml \ parted.ml \ realpath.ml \ diff --git a/daemon/md.c b/daemon/md.c index 64d98fae5..5c9ecd136 100644 --- a/daemon/md.c +++ b/daemon/md.c @@ -24,7 +24,6 @@ #include <inttypes.h> #include <unistd.h> #include <fcntl.h> -#include <glob.h> #ifdef HAVE_LINUX_RAID_MD_U_H #include <sys/ioctl.h> @@ -32,6 +31,8 @@ #include <linux/raid/md_u.h> #endif /* HAVE_LINUX_RAID_MD_U_H */ +#include <caml/mlvalues.h> + #include "daemon.h" #include "actions.h" #include "optgroups.h" @@ -45,6 +46,35 @@ optgroup_mdadm_available (void) return prog_exists (str_mdadm); } +/* Check if 'dev' is a real RAID device, because in the case where md + * is linked directly into the kernel (not a module), /dev/md0 is + * sometimes created. This is called from OCaml function + * Md.list_md_devices. + */ +extern value guestfs_int_daemon_is_raid_device (value devicev); + +/* NB: This is a "noalloc" call. */ +value +guestfs_int_daemon_is_raid_device (value devv) +{ + const char *dev = String_val (devv); + int ret = 1; + +#if defined(HAVE_LINUX_RAID_MD_U_H) && defined(GET_ARRAY_INFO) + int fd; + mdu_array_info_t array; + + fd = open (dev, O_RDONLY); + if (fd >= 0) { + if (ioctl (fd, GET_ARRAY_INFO, &array) == -1 && errno == ENODEV) + ret = 0; + close (fd); + } +#endif + + return Val_bool (ret); +} + static size_t count_bits (uint64_t bitmap) { @@ -188,99 +218,6 @@ do_md_create (const char *name, char *const *devices, #pragma GCC diagnostic pop #endif -static int -glob_errfunc (const char *epath, int eerrno) -{ - fprintf (stderr, "glob: failure reading %s: %s\n", epath, strerror (eerrno)); - return 1; -} - -/* Check if 'dev' is a real RAID device, because in the case where md - * is linked directly into the kernel (not a module), /dev/md0 is - * sometimes created. - */ -static int -is_raid_device (const char *dev) -{ - int ret = 1; - -#if defined(HAVE_LINUX_RAID_MD_U_H) && defined(GET_ARRAY_INFO) - int fd; - mdu_array_info_t array; - - fd = open (dev, O_RDONLY); - if (fd >= 0) { - if (ioctl (fd, GET_ARRAY_INFO, &array) == -1 && errno == ENODEV) - ret = 0; - close (fd); - } -#endif - - return ret; -} - -char ** -do_list_md_devices (void) -{ - CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret); - glob_t mds; - - memset (&mds, 0, sizeof mds); - -#define PREFIX "/sys/block/md" -#define SUFFIX "/md" - - /* Look for directories under /sys/block matching md[0-9]* - * As an additional check, we also make sure they have a md subdirectory. - */ - const int err = glob (PREFIX "[0-9]*" SUFFIX, GLOB_ERR, glob_errfunc, &mds); - if (err == GLOB_NOSPACE) { - reply_with_error ("glob: returned GLOB_NOSPACE: " - "rerun with LIBGUESTFS_DEBUG=1"); - goto error; - } else if (err == GLOB_ABORTED) { - reply_with_error ("glob: returned GLOB_ABORTED: " - "rerun with LIBGUESTFS_DEBUG=1"); - goto error; - } - - for (size_t i = 0; i < mds.gl_pathc; i++) { - size_t len; - char *dev, *n; - - len = strlen (mds.gl_pathv[i]) - strlen (PREFIX) - strlen (SUFFIX); - -#define DEV "/dev/md" - dev = malloc (strlen (DEV) + len + 1); - if (NULL == dev) { - reply_with_perror ("malloc"); - goto error; - } - - n = dev; - n = mempcpy (n, DEV, strlen (DEV)); - n = mempcpy (n, &mds.gl_pathv[i][strlen (PREFIX)], len); - *n = '\0'; - - if (!is_raid_device (dev)) { - free (dev); - continue; - } - - if (add_string_nodup (&ret, dev) == -1) goto error; - } - - if (end_stringsbuf (&ret) == -1) goto error; - globfree (&mds); - - return take_stringsbuf (&ret); - - error: - globfree (&mds); - - return NULL; -} - char ** do_md_detail (const char *md) { diff --git a/daemon/md.ml b/daemon/md.ml new file mode 100644 index 000000000..caf87cf8f --- /dev/null +++ b/daemon/md.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 Printf + +open Std_utils + +open Utils + +external is_raid_device : string -> bool = + "guestfs_int_daemon_is_raid_device" "noalloc" + +let re_md = Str.regexp "^md[0-9]+$" + +let list_md_devices () = + (* Look for directories under /sys/block matching md[0-9]+ + * As an additional check, we also make sure they have a md subdirectory. + *) + let devs = Sys.readdir "/sys/block" in + let devs = Array.to_list devs in + let devs = List.filter (fun d -> Str.string_match re_md d 0) devs in + let devs = List.filter ( + fun d -> is_directory (sprintf "/sys/block/%s/md" d) + ) devs in + + (* Construct the equivalent /dev/md[0-9]+ device names. *) + let devs = List.map ((^) "/dev/") devs in + + (* Check they are really RAID devices. *) + let devs = List.filter is_raid_device devs in + + (* Return the list sorted. *) + sort_device_names devs diff --git a/daemon/md.mli b/daemon/md.mli new file mode 100644 index 000000000..56b6ea65e --- /dev/null +++ b/daemon/md.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 list_md_devices : unit -> string list diff --git a/generator/actions_core.ml b/generator/actions_core.ml index f6f006eee..140ba6c1b 100644 --- a/generator/actions_core.ml +++ b/generator/actions_core.ml @@ -6632,6 +6632,7 @@ If not set, this defaults to C<raid1>. { defaults with name = "list_md_devices"; added = (1, 15, 4); style = RStringList (RDevice, "devices"), [], []; + impl = OCaml "Md.list_md_devices"; shortdesc = "list Linux md (RAID) devices"; longdesc = "\ List all Linux md devices." }; -- 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 a1e5c81cf..125aec60b 100644 --- a/daemon/parted.c +++ b/daemon/parted.c @@ -387,62 +387,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 91eb9c08e..5d6752c90 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