Libguestfs - Dec 2016 - Re: [PATCH v2 3/4] sysprep: Add a new operation to remove editor backup files (RHBZ#1401320).

In v2:

- The backup-files operation now operates on a conservative whitelist
  of filesystems, so it won't touch anything in /usr.  Consequently
  it also runs much more quickly, about 4 seconds on the barebones
  virt-builder fedora-25 image.

- Call Gc.compact () in visit_tests.

- Added documentation to fnmatch.mli.

---
 .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

This is taken from supermin.
---
 mllib/Makefile.am |  3 +++
 mllib/fnmatch-c.c | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 mllib/fnmatch.ml  | 29 ++++++++++++++++++++++++
 mllib/fnmatch.mli | 37 +++++++++++++++++++++++++++++++
 4 files changed, 135 insertions(+)
 create mode 100644 mllib/fnmatch-c.c
 create mode 100644 mllib/fnmatch.ml
 create mode 100644 mllib/fnmatch.mli

diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index 3949b1e..4cf4955 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -33,6 +33,7 @@ SOURCES_MLI = \
 	curl.mli \
 	dev_t.mli \
 	exit.mli \
+	fnmatch.mli \
 	fsync.mli \
 	getopt.mli \
 	JSON.mli \
@@ -59,6 +60,7 @@ SOURCES_ML = \
 	URI.ml \
 	mkdtemp.ml \
 	visit.ml \
+	fnmatch.ml \
 	planner.ml \
 	regedit.ml \
 	StatVFS.ml \
@@ -76,6 +78,7 @@ SOURCES_C = \
 	common_utils-c.c \
 	dev_t-c.c \
 	exit-c.c \
+	fnmatch-c.c \
 	fsync-c.c \
 	getopt-c.c \
 	mkdtemp-c.c \
diff --git a/mllib/fnmatch-c.c b/mllib/fnmatch-c.c
new file mode 100644
index 0000000..dc2984e
--- /dev/null
+++ b/mllib/fnmatch-c.c
@@ -0,0 +1,66 @@
+/* Binding for fnmatch.
+ * Copyright (C) 2009-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 <stdlib.h>
+#include <fnmatch.h>
+#include <errno.h>
+
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/unixsupport.h>
+
+#pragma GCC diagnostic ignored "-Wmissing-prototypes"
+
+/* NB: These flags must appear in the same order as fnmatch.ml */
+static int flags[] = {
+  FNM_NOESCAPE,
+  FNM_PATHNAME,
+  FNM_PERIOD,
+  FNM_FILE_NAME,
+  FNM_LEADING_DIR,
+  FNM_CASEFOLD,
+};
+
+value
+guestfs_int_mllib_fnmatch (value patternv, value strv, value flagsv)
+{
+  CAMLparam3 (patternv, strv, flagsv);
+  int f = 0, r;
+
+  /* Convert flags to bitmask. */
+  while (flagsv != Val_int (0)) {
+    f |= flags[Int_val (Field (flagsv, 0))];
+    flagsv = Field (flagsv, 1);
+  }
+
+  r = fnmatch (String_val (patternv), String_val (strv), f);
+
+  if (r == 0)
+    CAMLreturn (Val_true);
+  else if (r == FNM_NOMATCH)
+    CAMLreturn (Val_false);
+  else {
+    /* XXX The fnmatch specification doesn't mention what errors can
+     * be returned by fnmatch.  Assume they are errnos for now.
+     */
+    unix_error (errno, (char *) "fnmatch", patternv);
+  }
+}
diff --git a/mllib/fnmatch.ml b/mllib/fnmatch.ml
new file mode 100644
index 0000000..7ea844f
--- /dev/null
+++ b/mllib/fnmatch.ml
@@ -0,0 +1,29 @@
+(* Binding for fnmatch.
+ * Copyright (C) 2009-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
+ *)
+
+(* NB: These flags must appear in the same order as fnmatch-c.c *)
+type flag +| FNM_NOESCAPE
+| FNM_PATHNAME
+| FNM_PERIOD
+| FNM_FILE_NAME
+| FNM_LEADING_DIR
+| FNM_CASEFOLD
+
+external fnmatch : string -> string -> flag list -> bool + 
"guestfs_int_mllib_fnmatch"
diff --git a/mllib/fnmatch.mli b/mllib/fnmatch.mli
new file mode 100644
index 0000000..105e398
--- /dev/null
+++ b/mllib/fnmatch.mli
@@ -0,0 +1,37 @@
+(* Binding for fnmatch.
+ * Copyright (C) 2009-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
+ *)
+
+(** Binding for the fnmatch(3) function in glibc or gnulib. *)
+
+type flag +| FNM_NOESCAPE
+| FNM_PATHNAME
+| FNM_PERIOD
+| FNM_FILE_NAME
+| FNM_LEADING_DIR
+| FNM_CASEFOLD
+(** Flags passed to the fnmatch function. *)
+
+val fnmatch : string -> string -> flag list -> bool
+(** The [fnmatch pattern filename flags] function checks whether
+    the [filename] argument matches the wildcard in the [pattern]
+    argument.  The [flags] is a list of flags.  Consult the
+    fnmatch(3) man page for details of the flags.
+
+    The [filename] might be a filename element or a full path
+    (depending on the pattern and flags). *)
-- 
2.10.2

Remove editor backup files such as *~ and *.bak wherever
they occur within the guest filesystem.

This also includes a test.
---
 sysprep/Makefile.am                       |  2 +
 sysprep/sysprep_operation_backup_files.ml | 98 +++++++++++++++++++++++++++++++
 sysprep/test-virt-sysprep-backup-files.sh | 64 ++++++++++++++++++++
 3 files changed, 164 insertions(+)
 create mode 100644 sysprep/sysprep_operation_backup_files.ml
 create mode 100755 sysprep/test-virt-sysprep-backup-files.sh

diff --git a/sysprep/Makefile.am b/sysprep/Makefile.am
index e52f0d3..c9ce3b0 100644
--- a/sysprep/Makefile.am
+++ b/sysprep/Makefile.am
@@ -29,6 +29,7 @@ EXTRA_DIST = \
 # Filenames sysprep_operation_<name>.ml in alphabetical order.
 operations = \
 	abrt_data \
+	backup_files \
 	bash_history \
 	blkid_tab \
 	ca_certificates \
@@ -179,6 +180,7 @@ TESTS = \
 if ENABLE_APPLIANCE
 TESTS += \
 	test-virt-sysprep.sh \
+	test-virt-sysprep-backup-files.sh \
 	test-virt-sysprep-passwords.sh
 
 if HAVE_FUSE
diff --git a/sysprep/sysprep_operation_backup_files.ml
b/sysprep/sysprep_operation_backup_files.ml
new file mode 100644
index 0000000..4c002c8
--- /dev/null
+++ b/sysprep/sysprep_operation_backup_files.ml
@@ -0,0 +1,98 @@
+(* virt-sysprep
+ * Copyright (C) 2012-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.
+ *)
+
+open Printf
+
+open Sysprep_operation
+open Common_gettext.Gettext
+open Common_utils
+open Visit
+open Fnmatch
+
+module G = Guestfs
+
+let unix_whitelist = List.sort compare [
+  "/etc";
+  "/root";
+  "/srv";
+  "/tmp";
+  "/var";
+]
+let unix_whitelist_as_pod +  String.concat "\n" (List.map ((^) "
") unix_whitelist)
+
+let globs = List.sort compare [
+  "*.bak";
+  "*~";
+]
+let globs_as_pod = String.concat "\n" (List.map ((^) " ")
globs)
+
+let backup_files_perform (g : Guestfs.guestfs) root side_effects +  (*
Unix-like?  If so that only operate on the unix_whitelist
+   * filesystems, else operate on everything.
+   *)
+  let fses +    match g#inspect_get_type root with
+    | "hurd"
+    | "linux"
+    | "minix" -> unix_whitelist
+    | f when String.is_suffix f "bsd" -> unix_whitelist
+    | _ -> ["/"] in
+
+  List.iter (
+    fun fs ->
+      if g#is_dir ~followsymlinks:false fs then (
+        visit g#ocaml_handle fs (
+          fun dir filename { G.st_mode = mode } _ ->
+            match dir, filename, mode with
+            (* Ignore root directory and non-regular files. *)
+            | _, None, _ -> ()
+            | _, Some _, mode when not (is_reg mode) -> ()
+            | dir, Some filename, _ ->
+               (* Check the filename against all of the globs, and if it
+                * matches any then delete it.
+                *)
+               let matching glob = fnmatch glob filename [FNM_NOESCAPE] in
+               if List.exists matching globs then (
+                 let path = full_path dir (Some filename) in
+                 g#rm_f path
+               )
+        )
+      )
+  ) fses
+
+let op = {
+  defaults with
+    name = "backup-files";
+    enabled_by_default = true;
+    heading = s_"Remove editor backup files from the guest";
+    pod_description = Some (
+      sprintf (f_"\
+The following files are removed from anywhere in the guest
+filesystem:
+
+%s
+
+On Linux and Unix operating systems, only the following filesystems
+will be examined:
+
+%s") globs_as_pod unix_whitelist_as_pod);
+    perform_on_filesystems = Some backup_files_perform;
+}
+
+let () = register_operation op
diff --git a/sysprep/test-virt-sysprep-backup-files.sh
b/sysprep/test-virt-sysprep-backup-files.sh
new file mode 100755
index 0000000..bd9a36c
--- /dev/null
+++ b/sysprep/test-virt-sysprep-backup-files.sh
@@ -0,0 +1,64 @@
+#!/bin/bash -
+# libguestfs virt-sysprep test script
+# 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.
+
+export LANG=C
+set -e
+
+# Test removal of editor backup files.
+
+if [ "$(guestfish get-backend)" = "uml" ]; then
+    echo "$0: skipping test because uml backend does not support
qcow2"
+    exit 77
+fi
+
+if [ ! -s ../test-data/phony-guests/fedora.img ]; then
+    echo "$0: skipping test because there is no phony Fedora test
image"
+    exit 77
+fi
+
+rm -f test-backup-files.qcow2
+rm -f test-backup-files-before
+rm -f test-backup-files-after
+
+# Add some backup files to the Fedora image.
+guestfish -- \
+          disk-create test-backup-files.qcow2 qcow2 -1 \
+            backingfile:../test-data/phony-guests/fedora.img \
+            backingformat:raw
+guestfish -a test-backup-files.qcow2 -i <<'EOF'
+# /bin and /usr are not on the whitelist, so these file shouldn't be
deleted.
+touch /bin/test~
+touch /usr/share/test~
+find / | cat > test-backup-files-before
+touch /etc/fstab.bak
+touch /etc/resolv.conf~
+EOF
+
+# Run virt-sysprep backup-files operation only.
+
+virt-sysprep -x --format qcow2 -a test-backup-files.qcow2 \
+    --enable backup-files
+
+# Check the file list is the same as above.
+guestfish -a test-backup-files.qcow2 -i find / > test-backup-files-after
+
+diff -u test-backup-files-before test-backup-files-after
+
+rm test-backup-files.qcow2
+rm test-backup-files-before
+rm test-backup-files-after
-- 
2.10.2

---
 sysprep/Makefile.am                         |  1 +
 sysprep/sysprep_operation_passwd_backups.ml | 54 +++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+)
 create mode 100644 sysprep/sysprep_operation_passwd_backups.ml

diff --git a/sysprep/Makefile.am b/sysprep/Makefile.am
index c9ce3b0..4722568 100644
--- a/sysprep/Makefile.am
+++ b/sysprep/Makefile.am
@@ -52,6 +52,7 @@ operations = \
 	pacct_log \
 	package_manager_cache \
 	pam_data \
+	passwd_backups \
 	puppet_data_log \
 	rh_subscription_manager \
 	rhn_systemid \
diff --git a/sysprep/sysprep_operation_passwd_backups.ml
b/sysprep/sysprep_operation_passwd_backups.ml
new file mode 100644
index 0000000..d1995a4
--- /dev/null
+++ b/sysprep/sysprep_operation_passwd_backups.ml
@@ -0,0 +1,54 @@
+(* virt-sysprep
+ * 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.
+ *)
+
+open Printf
+
+open Sysprep_operation
+open Common_gettext.Gettext
+
+module G = Guestfs
+
+let files = List.sort compare [
+  "/etc/group-";
+  "/etc/gshadow-";
+  "/etc/passwd-";
+  "/etc/shadow-";
+  "/etc/subuid-";
+  "/etc/subgid-";
+]
+let files_as_pod = String.concat "\n" (List.map ((^) " ")
files)
+
+let passwd_backups_perform (g : Guestfs.guestfs) root side_effects +  let typ =
g#inspect_get_type root in
+  if typ = "linux" then
+    List.iter g#rm_f files
+
+let op = {
+  defaults with
+    name = "passwd-backups";
+    enabled_by_default = true;
+    heading = s_"Remove /etc/passwd- and similar backup files";
+    pod_description = Some (
+      sprintf (f_"\
+On Linux the following files are removed:
+
+%s") files_as_pod);
+    perform_on_filesystems = Some passwd_backups_perform;
+}
+
+let () = register_operation op
-- 
2.10.2

On Wednesday, 14 December 2016 13:12:01 CET Richard W.M. Jones
wrote:
> Remove editor backup files such as *~ and *.bak wherever
> they occur within the guest filesystem.
> 
> This also includes a test.
> ---
Looks nice -- I have few notes below.

Also, should this operation include also the swap files that editors
can leave while editing?
> +  let fses > +    match g#inspect_get_type root with
> +    | "hurd"
> +    | "linux"
> +    | "minix" -> unix_whitelist
> +    | f when String.is_suffix f "bsd" -> unix_whitelist
> +    | _ -> ["/"] in
There's a similar list also in customize/customize_run.ml for the
`SSHInject operation -- I guess an helper function could be added to
Common_utils.
> +  List.iter (
> +    fun fs ->
> +      if g#is_dir ~followsymlinks:false fs then (
> +        visit g#ocaml_handle fs (
> +          fun dir filename { G.st_mode = mode } _ ->
> +            match dir, filename, mode with
> +            (* Ignore root directory and non-regular files. *)
> +            | _, None, _ -> ()
> +            | _, Some _, mode when not (is_reg mode) -> ()
> +            | dir, Some filename, _ ->
> +               (* Check the filename against all of the globs, and if it
> +                * matches any then delete it.
> +                *)
> +               let matching glob = fnmatch glob filename [FNM_NOESCAPE] in
> +               if List.exists matching globs then (
Considering the current globs are basically filename suffixes, wouldn't
it be easier (and possibly faster too) to just check for them?

  let suffixes = [ ".bak"; "~" ] in
  ...
    if List.exists (String.is_suffix filename) suffixes then (
      ...

This would be easier to extend also for filename prefixes, in case we
need them, so for now the fnmatch usage can be avoided.
> +                 let path = full_path dir (Some filename) in
> +                 g#rm_f path
> +               )
> +        )
> +      )
> +  ) fses
> +
> +let op = {
> +  defaults with
> +    name = "backup-files";
> +    enabled_by_default = true;
> +    heading = s_"Remove editor backup files from the guest";
> +    pod_description = Some (
> +      sprintf (f_"\
> +The following files are removed from anywhere in the guest
> +filesystem:
> +
> +%s
> +
> +On Linux and Unix operating systems, only the following filesystems
> +will be examined:
> +
> +%s") globs_as_pod unix_whitelist_as_pod);
> +    perform_on_filesystems = Some backup_files_perform;
> +}
> +
> +let () = register_operation op
> diff --git a/sysprep/test-virt-sysprep-backup-files.sh
b/sysprep/test-virt-sysprep-backup-files.sh
> new file mode 100755
> index 0000000..bd9a36c
> --- /dev/null
> +++ b/sysprep/test-virt-sysprep-backup-files.sh
> @@ -0,0 +1,64 @@
> [...]
> +guestfish -a test-backup-files.qcow2 -i <<'EOF'
Can you please specify --format qcow2 explicitly?
> +# Check the file list is the same as above.
> +guestfish -a test-backup-files.qcow2 -i find / >
test-backup-files-after
Ditto.

Thanks,
-- 
Pino Toscano

On Wednesday, 14 December 2016 13:12:02 CET Richard W.M. Jones
wrote:
> ---
LGTM -- just one note below.
> +let files_as_pod = String.concat "\n" (List.map ((^) "
") files)
Other in this and the previously added operation (patch #3), I see this
function also in the logfiles operation -- can you please move it
shared in Sysprep_operation?

Thanks,
-- 
Pino Toscano