[Libguestfs] [PATCH v2 1/4] mllib: Add a binding for visit function in cat/visit.c.

--- .gitignore | 1 + mllib/Makefile.am | 32 ++++++- mllib/visit-c.c | 253 +++++++++++++++++++++++++++++++++++++++++++++++++++ mllib/visit.ml | 36 ++++++++ mllib/visit.mli | 71 +++++++++++++++ mllib/visit_tests.ml | 150 ++++++++++++++++++++++++++++++ 6 files changed, 541 insertions(+), 2 deletions(-) create mode 100644 mllib/visit-c.c create mode 100644 mllib/visit.ml create mode 100644 mllib/visit.mli create mode 100644 mllib/visit_tests.ml diff --git a/.gitignore b/.gitignore index da59e44..76a16c5 100644 --- a/.gitignore +++ b/.gitignore @@ -332,6 +332,7 @@ Makefile.in /mllib/JSON_tests /mllib/libdir.ml /mllib/oUnit-* +/mllib/visit_tests /ocaml/bindtests.bc /ocaml/bindtests.opt /ocaml/bindtests.ml diff --git a/mllib/Makefile.am b/mllib/Makefile.am index 001b5e3..3949b1e 100644 --- a/mllib/Makefile.am +++ b/mllib/Makefile.am @@ -24,6 +24,7 @@ EXTRA_DIST = \ common_utils_tests.ml \ getopt_tests.ml \ JSON_tests.ml \ + visit_tests.ml \ test-getopt.sh SOURCES_MLI = \ @@ -41,7 +42,8 @@ SOURCES_MLI = \ regedit.mli \ StatVFS.mli \ stringMap.mli \ - URI.mli + URI.mli \ + visit.mli SOURCES_ML = \ guestfs_config.ml \ @@ -56,6 +58,7 @@ SOURCES_ML = \ progress.ml \ URI.ml \ mkdtemp.ml \ + visit.ml \ planner.ml \ regedit.ml \ StatVFS.ml \ @@ -65,6 +68,7 @@ SOURCES_ML = \ checksums.ml SOURCES_C = \ + ../cat/visit.c \ ../fish/decrypt.c \ ../fish/keys.c \ ../fish/progress.c \ @@ -77,7 +81,8 @@ SOURCES_C = \ mkdtemp-c.c \ progress-c.c \ statvfs-c.c \ - uri-c.c + uri-c.c \ + visit-c.c if HAVE_OCAML @@ -103,6 +108,7 @@ libmllib_a_CPPFLAGS = \ -I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \ -I$(shell $(OCAMLC) -where) \ -I$(top_srcdir)/src \ + -I$(top_srcdir)/cat \ -I$(top_srcdir)/fish libmllib_a_CFLAGS = \ $(WARN_CFLAGS) $(WERROR_CFLAGS) \ @@ -183,6 +189,10 @@ JSON_tests_SOURCES = dummy.c JSON_tests_BOBJECTS = JSON_tests.cmo JSON_tests_XOBJECTS = $(JSON_tests_BOBJECTS:.cmo=.cmx) +visit_tests_SOURCES = dummy.c +visit_tests_BOBJECTS = visit_tests.cmo +visit_tests_XOBJECTS = $(visit_tests_BOBJECTS:.cmo=.cmx) + # Can't call the following as <test>_OBJECTS because automake gets confused. if !HAVE_OCAMLOPT common_utils_tests_THEOBJECTS = $(common_utils_tests_BOBJECTS) @@ -202,6 +212,9 @@ getopt_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS) JSON_tests_THEOBJECTS = $(JSON_tests_XOBJECTS) JSON_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS) + +visit_tests_THEOBJECTS = $(visit_tests_XOBJECTS) +visit_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS) endif OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) $(LINK_CUSTOM_OCAMLC_ONLY) @@ -236,6 +249,16 @@ JSON_tests_LINK = \ $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \ $(JSON_tests_THEOBJECTS) -o $@ +visit_tests_DEPENDENCIES = \ + $(visit_tests_THEOBJECTS) \ + $(MLLIB_CMA) \ + $(top_srcdir)/ocaml-link.sh +visit_tests_LINK = \ + $(top_srcdir)/ocaml-link.sh -cclib '-lutils $(LIBXML2_LIBS) -lgnu' -- \ + $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \ + $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \ + $(visit_tests_THEOBJECTS) -o $@ + TESTS_ENVIRONMENT = $(top_builddir)/run --test TESTS = \ @@ -248,6 +271,11 @@ check_PROGRAMS += common_utils_tests JSON_tests TESTS += common_utils_tests JSON_tests endif +if ENABLE_APPLIANCE +check_PROGRAMS += visit_tests +TESTS += visit_tests +endif + check-valgrind: $(MAKE) VG="@VG@" check diff --git a/mllib/visit-c.c b/mllib/visit-c.c new file mode 100644 index 0000000..00a622e --- /dev/null +++ b/mllib/visit-c.c @@ -0,0 +1,253 @@ +/* Bindings for visitor function. + * Copyright (C) 2016 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 <errno.h> +#include <assert.h> + +#include <caml/alloc.h> +#include <caml/callback.h> +#include <caml/fail.h> +#include <caml/memory.h> +#include <caml/mlvalues.h> + +#include "guestfs.h" +#include "guestfs-internal.h" +#include "visit.h" + +#pragma GCC diagnostic ignored "-Wmissing-prototypes" + +struct visitor_function_wrapper_args { + /* In both case we are pointing to local roots, hence why these are + * value* not value. + */ + value *exnp; /* Safe place to store any exception + raised by visitor_function. */ + value *fvp; /* visitor_function. */ +}; + +static int visitor_function_wrapper (const char *dir, const char *name, const struct guestfs_statns *stat, const struct guestfs_xattr_list *xattrs, void *opaque); +static value copy_statns (const struct guestfs_statns *statns); +static value copy_xattr (const struct guestfs_xattr *xattr); +static value copy_xattr_list (const struct guestfs_xattr_list *xattrs); + +value +guestfs_int_mllib_visit (value gv, value dirv, value fv) +{ + CAMLparam3 (gv, dirv, fv); + guestfs_h *g = (guestfs_h *) Int64_val (gv); + struct visitor_function_wrapper_args args; + /* The dir string could move around when we call the + * visitor_function, so we have to take a full copy of it. + */ + CLEANUP_FREE char *dir = strdup (String_val (dirv)); + /* This stack address is used to point to the exception, if one is + * raised in the visitor_function. Note that the macro initializes + * this to Val_unit, which is how we know if an exception was set. + */ + CAMLlocal1 (exn); + + args.exnp = &exn; + args.fvp = &fv; + + if (visit (g, dir, visitor_function_wrapper, &args) == -1) { + if (exn != Val_unit) { + /* The failure was caused by visitor_function raising an + * exception. Re-raise it here. + */ + caml_raise (exn); + } + + /* Otherwise it's some other failure. The visit function has + * already printed the error to stderr (XXX - fix), so we raise a + * generic Failure. + */ + caml_failwith ("visit"); + } + + CAMLreturn (Val_unit); +} + +static int +visitor_function_wrapper (const char *dir, + const char *filename, + const struct guestfs_statns *stat, + const struct guestfs_xattr_list *xattrs, + void *opaque) +{ + CAMLparam0 (); + CAMLlocal5 (dirv, filenamev, statv, xattrsv, v); + struct visitor_function_wrapper_args *args = opaque; + + assert (dir != NULL); + assert (stat != NULL); + assert (xattrs != NULL); + assert (args != NULL); + + dirv = caml_copy_string (dir); + if (filename == NULL) + filenamev = Val_int (0); /* None */ + else { + filenamev = caml_alloc (1, 0); + v = caml_copy_string (filename); + Store_field (filenamev, 0, v); + } + statv = copy_statns (stat); + xattrsv = copy_xattr_list (xattrs); + + /* Call the visitor_function. */ + value argsv[4] = { dirv, filenamev, statv, xattrsv }; + v = caml_callbackN_exn (*args->fvp, 4, argsv); + if (Is_exception_result (v)) { + /* The visitor_function raised an exception. Store the exception + * in the 'exn' field on the stack of guestfs_int_mllib_visit, and + * return an error. + */ + *args->exnp = Extract_exception (v); + return -1; + } + + /* No error, return normally. */ + CAMLreturnT (int, 0); +} + +value +guestfs_int_mllib_full_path (value dirv, value namev) +{ + CAMLparam2 (dirv, namev); + CAMLlocal1 (rv); + const char *name = NULL; + char *ret; + + if (namev != Val_int (0)) + name = String_val (Field (namev, 0)); + + ret = full_path (String_val (dirv), name); + rv = caml_copy_string (ret); + free (ret); + + CAMLreturn (rv); +} + +#define is(t) \ + value \ + guestfs_int_mllib_is_##t (value iv) \ + { \ + return Val_bool (is_##t (Int64_val (iv))); \ + } +is(reg) +is(dir) +is(chr) +is(blk) +is(fifo) +is(lnk) +is(sock) + +/* The functions below are copied from ocaml/guestfs-c-actions.c. */ + +static value +copy_statns (const struct guestfs_statns *statns) +{ + CAMLparam0 (); + CAMLlocal2 (rv, v); + + rv = caml_alloc (22, 0); + v = caml_copy_int64 (statns->st_dev); + Store_field (rv, 0, v); + v = caml_copy_int64 (statns->st_ino); + Store_field (rv, 1, v); + v = caml_copy_int64 (statns->st_mode); + Store_field (rv, 2, v); + v = caml_copy_int64 (statns->st_nlink); + Store_field (rv, 3, v); + v = caml_copy_int64 (statns->st_uid); + Store_field (rv, 4, v); + v = caml_copy_int64 (statns->st_gid); + Store_field (rv, 5, v); + v = caml_copy_int64 (statns->st_rdev); + Store_field (rv, 6, v); + v = caml_copy_int64 (statns->st_size); + Store_field (rv, 7, v); + v = caml_copy_int64 (statns->st_blksize); + Store_field (rv, 8, v); + v = caml_copy_int64 (statns->st_blocks); + Store_field (rv, 9, v); + v = caml_copy_int64 (statns->st_atime_sec); + Store_field (rv, 10, v); + v = caml_copy_int64 (statns->st_atime_nsec); + Store_field (rv, 11, v); + v = caml_copy_int64 (statns->st_mtime_sec); + Store_field (rv, 12, v); + v = caml_copy_int64 (statns->st_mtime_nsec); + Store_field (rv, 13, v); + v = caml_copy_int64 (statns->st_ctime_sec); + Store_field (rv, 14, v); + v = caml_copy_int64 (statns->st_ctime_nsec); + Store_field (rv, 15, v); + v = caml_copy_int64 (statns->st_spare1); + Store_field (rv, 16, v); + v = caml_copy_int64 (statns->st_spare2); + Store_field (rv, 17, v); + v = caml_copy_int64 (statns->st_spare3); + Store_field (rv, 18, v); + v = caml_copy_int64 (statns->st_spare4); + Store_field (rv, 19, v); + v = caml_copy_int64 (statns->st_spare5); + Store_field (rv, 20, v); + v = caml_copy_int64 (statns->st_spare6); + Store_field (rv, 21, v); + CAMLreturn (rv); +} + +static value +copy_xattr (const struct guestfs_xattr *xattr) +{ + CAMLparam0 (); + CAMLlocal2 (rv, v); + + rv = caml_alloc (2, 0); + v = caml_copy_string (xattr->attrname); + Store_field (rv, 0, v); + v = caml_alloc_string (xattr->attrval_len); + memcpy (String_val (v), xattr->attrval, xattr->attrval_len); + Store_field (rv, 1, v); + CAMLreturn (rv); +} + +static value +copy_xattr_list (const struct guestfs_xattr_list *xattrs) +{ + CAMLparam0 (); + CAMLlocal2 (rv, v); + unsigned int i; + + if (xattrs->len == 0) + CAMLreturn (Atom (0)); + else { + rv = caml_alloc (xattrs->len, 0); + for (i = 0; i < xattrs->len; ++i) { + v = copy_xattr (&xattrs->val[i]); + Store_field (rv, i, v); + } + CAMLreturn (rv); + } +} diff --git a/mllib/visit.ml b/mllib/visit.ml new file mode 100644 index 0000000..c979e3e --- /dev/null +++ b/mllib/visit.ml @@ -0,0 +1,36 @@ +(* Bindings for visitor function. + * Copyright (C) 2016 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +type visitor_function = string -> string option -> Guestfs.statns -> Guestfs.xattr array -> unit + +external c_visit : int64 -> string -> visitor_function -> unit = + "guestfs_int_mllib_visit" + +let visit g dir f = + c_visit (Guestfs.c_pointer g) dir f + +external full_path : string -> string option -> string = + "guestfs_int_mllib_full_path" + +external is_reg : int64 -> bool = "guestfs_int_mllib_is_reg" "noalloc" +external is_dir : int64 -> bool = "guestfs_int_mllib_is_dir" "noalloc" +external is_chr : int64 -> bool = "guestfs_int_mllib_is_chr" "noalloc" +external is_blk : int64 -> bool = "guestfs_int_mllib_is_blk" "noalloc" +external is_fifo : int64 -> bool = "guestfs_int_mllib_is_fifo" "noalloc" +external is_lnk : int64 -> bool = "guestfs_int_mllib_is_lnk" "noalloc" +external is_sock : int64 -> bool = "guestfs_int_mllib_is_sock" "noalloc" diff --git a/mllib/visit.mli b/mllib/visit.mli new file mode 100644 index 0000000..57ff85f --- /dev/null +++ b/mllib/visit.mli @@ -0,0 +1,71 @@ +(* Bindings for visitor function. + * Copyright (C) 2016 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. + *) + +(** Bindings for the virt-ls visitor function used to recursively + visit every file and directory in a filesystem. *) + +type visitor_function = string -> string option -> Guestfs.statns -> Guestfs.xattr array -> unit +(** The visitor function is a callback called once for every directory + and every file. + + For the root directory, [visitor_function dir None statns xattrs] is + called. [statns] is the stat of the root directory and the + array [xattrs] contains extended attributes. + + For all other directories and files, + [visitor_function dir (Some name) statns xattrs] is called, where + [dir] is the parent directory path and [name] is the filename + (which might also be a directory). [statns] is the stat of [name] + and the array [xattrs] contains extended attributes. + + The visitor callback may raise an exception, which will cause + the whole visit to fail with an error (raising the same exception). *) + +val visit : Guestfs.t -> string -> visitor_function -> unit +(** [visit g dir f] calls the [visitor_function f] once for + every directory and every file. + + If the visitor function raises an exception, then the whole visit + stops and raises the same exception. + + Also other errors can happen, and those will cause a [Failure + "visit"] exception to be raised. (Because of the implementation + of the underlying function, the real error is printed + unconditionally to stderr). + + If the visit function returns normally you can assume there + was no error. *) + +val full_path : string -> string option -> string +(** This can be called with the [dir] and [name] parameters from + [visitor_function] to return the full canonical path. *) + +val is_reg : int64 -> bool +(** Returns true if [G.statns.st_mode] represents a regular file. *) +val is_dir : int64 -> bool +(** Returns true if [G.statns.st_mode] represents a directory. *) +val is_chr : int64 -> bool +(** Returns true if [G.statns.st_mode] represents a character device. *) +val is_blk : int64 -> bool +(** Returns true if [G.statns.st_mode] represents a block device. *) +val is_fifo : int64 -> bool +(** Returns true if [G.statns.st_mode] represents a FIFO. *) +val is_lnk : int64 -> bool +(** Returns true if [G.statns.st_mode] represents a symbolic link. *) +val is_sock : int64 -> bool +(** Returns true if [G.statns.st_mode] represents a Unix domain socket. *) diff --git a/mllib/visit_tests.ml b/mllib/visit_tests.ml new file mode 100644 index 0000000..f5d2b57 --- /dev/null +++ b/mllib/visit_tests.ml @@ -0,0 +1,150 @@ +(* Bindings for visitor function. + * Copyright (C) 2016 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 tests the [Visit] module. *) + +open Printf + +open Visit + +module G = Guestfs + +let rec main () = + let g = new G.guestfs () in + g#add_drive_scratch (Int64.mul 1024L (Int64.mul 1024L 1024L)); + g#launch (); + + g#mkfs "ext4" "/dev/sda"; + g#mount_options "user_xattr" "/dev/sda" "/"; + + (* Create some files and directories. *) + g#mkdir "/dir1"; + g#touch "/dir1/file1"; + g#touch "/dir1/file2"; + g#mkdir "/dir2"; + g#mkdir "/dir3"; + g#mkdir "/dir3/dir4"; + g#touch "/dir3/dir4/file6"; + g#setxattr "user.name" "data" 4 "/dir3/dir4/file6"; + g#mkfifo 0o444 "/dir3/dir4/pipe"; + g#touch "/dir3/file3"; + g#touch "/dir3/file4"; + g#mknod_b 0o444 1 2 "/dir3/block"; + g#mknod_c 0o444 1 2 "/dir3/char"; + + (* Recurse over them using the visitor function, and check the + * results. + *) + let visited = ref [] in + visit g#ocaml_handle "/" ( + fun dir filename stat xattrs -> + if filename <> Some "lost+found" then + visited := (dir, filename, stat, xattrs) :: !visited + ); + let visited = List.sort compare !visited in + let str = string_of_visited visited in + let expected = "\ +/: directory +/dir1: directory +/dir2: directory +/dir3: directory +/dir1/file1: file +/dir1/file2: file +/dir3/block: block device +/dir3/char: char device +/dir3/dir4: directory +/dir3/file3: file +/dir3/file4: file +/dir3/dir4/file6: file user.name=data +/dir3/dir4/pipe: fifo +" in + if str <> expected then ( + printf "'visit' read these files:\n%s\nexpected these files:\n%s\n" + str expected; + exit 1 + ); + + (* Recurse over a subdirectory. *) + let visited = ref [] in + visit g#ocaml_handle "/dir3" ( + fun dir filename stat xattrs -> + if filename <> Some "lost+found" then + visited := (dir, filename, stat, xattrs) :: !visited + ); + let visited = List.sort compare !visited in + let str = string_of_visited visited in + let expected = "\ +/dir3: directory +/dir3/block: block device +/dir3/char: char device +/dir3/dir4: directory +/dir3/file3: file +/dir3/file4: file +/dir3/dir4/file6: file user.name=data +/dir3/dir4/pipe: fifo +" in + if str <> expected then ( + printf "'visit' read these files:\n%s\nexpected these files:\n%s\n" + str expected; + exit 1 + ); + + (* Raise an exception in the visitor_function. *) + printf "testing exception in visitor function\n%!"; + (try visit g#ocaml_handle "/" (fun _ _ _ _ -> invalid_arg "test"); + assert false + with Invalid_argument "test" -> () + (* any other exception escapes and kills the test *) + ); + + (* Force an error and check [Failure "visit"] is raised. *) + printf "testing general error in visit\n%!"; + (try visit g#ocaml_handle "/nosuchdir" (fun _ _ _ _ -> ()); + assert false + with Failure "visit" -> () + (* any other exception escapes and kills the test *) + ); + + Gc.compact () + +and string_of_visited visited = + let buf = Buffer.create 1024 in + List.iter (_string_of_visited buf) visited; + Buffer.contents buf + +and _string_of_visited buf (dir, name, stat, xattrs) = + let path = full_path dir name in + bprintf buf "%s: %s%s\n" path (string_of_stat stat) (string_of_xattrs xattrs) + +and string_of_stat { G.st_mode = mode } = + if is_reg mode then "file" + else if is_dir mode then "directory" + else if is_chr mode then "char device" + else if is_blk mode then "block device" + else if is_fifo mode then "fifo" + else if is_lnk mode then "link" + else if is_sock mode then "socket" + else sprintf "unknown mode 0%Lo" mode + +and string_of_xattrs xattrs = + String.concat "" (List.map string_of_xattr (Array.to_list xattrs)) + +and string_of_xattr { G.attrname = name; G.attrval = v } = + sprintf " %s=%s" name v + +let () = main () -- 2.10.2