[Libguestfs] [PATCH v3 1/5] mllib: Add a binding for visit function in cat/visit.c.
Richard W.M. Jones
rjones at redhat.com
Wed Dec 14 16:55:41 UTC 2016
---
.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
More information about the Libguestfs
mailing list