common: Bundle the ocaml-augeas library for use by the daemon.

This commit bundles the ocaml-augeas library (upstream here:
http://git.annexia.org/?p=ocaml-augeas.git;a=summary).  It's identical
to the upstream version and should remain so.

We can work towards using system ocaml-augeas, when it's more widely
available.

.gitignore

@@ -123,6 +123,7 @@ Makefile.in
 /common/errnostring/errnostring-gperf.gperf
 /common/errnostring/errnostring.h
 /common/miniexpect/miniexpect.3
+/common/mlaugeas/.depend
 /common/mlpcre/.depend
 /common/mlpcre/pcre_tests
 /common/mlprogress/.depend

Makefile.am

@@ -45,6 +45,7 @@ SUBDIRS += lib docs examples po
 
 # The daemon and the appliance.
 SUBDIRS += common/mlutils
+SUBDIRS += common/mlaugeas
 SUBDIRS += common/mlpcre
 if ENABLE_DAEMON
 SUBDIRS += daemon

common/mlaugeas/Makefile.am

@@ -0,0 +1,91 @@
+# libguestfs OCaml tools common code
+# Copyright (C) 2011-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 $(top_srcdir)/subdir-rules.mk
+
+EXTRA_DIST = \
+	$(SOURCES_MLI) \
+	$(SOURCES_ML) \
+	$(SOURCES_C)
+
+SOURCES_MLI = \
+	augeas.mli
+
+SOURCES_ML = \
+	augeas.ml
+
+SOURCES_C = \
+	augeas-c.c
+
+# 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.
+# This C library is never used.
+
+noinst_LIBRARIES = libmlaugeas.a
+
+if !HAVE_OCAMLOPT
+MLAUGEAS_CMA = mlaugeas.cma
+else
+MLAUGEAS_CMA = mlaugeas.cmxa
+endif
+
+noinst_DATA = $(MLAUGEAS_CMA)
+
+libmlaugeas_a_SOURCES = $(SOURCES_C)
+libmlaugeas_a_CPPFLAGS = \
+	-I. \
+	-I$(top_builddir) \
+	-I$(shell $(OCAMLC) -where)
+libmlaugeas_a_CFLAGS = \
+	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
+	$(LIBVIRT_CFLAGS) $(LIBXML2_CFLAGS) \
+	-fPIC
+
+BOBJECTS = $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+OCAMLPACKAGES =
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+else
+OBJECTS = $(XOBJECTS)
+endif
+
+libmlaugeas_a_DEPENDENCIES = $(OBJECTS)
+
+$(MLAUGEAS_CMA): $(OBJECTS) libmlaugeas.a
+	$(OCAMLFIND) mklib $(OCAMLPACKAGES) \
+	    $(OBJECTS) $(libmlaugeas_a_OBJECTS) -cclib -laugeas -o mlaugeas
+
+# Dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+	rm -f $@ $@-t
+	$(OCAMLFIND) ocamldep -I ../../ocaml -I $(abs_srcdir) $^ | \
+	  $(SED) 's/ *$$//' | \
+	  $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+	  $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+	  sort > $@-t
+	mv $@-t $@
+
+-include .depend
+
+.PHONY: depend docs

common/mlaugeas/augeas-c.c

@@ -0,0 +1,288 @@
+/* Augeas OCaml bindings
+ * Copyright (C) 2008-2012 Red Hat Inc., Richard W.M. Jones
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *
+ * $Id: augeas_c.c,v 1.1 2008/05/06 10:48:20 rjones Exp $
+ */
+
+#include "config.h"
+
+#include <augeas.h>
+
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+#include <caml/custom.h>
+
+typedef augeas *augeas_t;
+
+/* Raise an Augeas.Error exception. */
+static void
+raise_error (const char *msg)
+{
+  caml_raise_with_string (*caml_named_value ("Augeas.Error"), msg);
+}
+
+/* Map OCaml flags to C flags. */
+static int flag_map[] = {
+  /* AugSaveBackup */  AUG_SAVE_BACKUP,
+  /* AugSaveNewFile */ AUG_SAVE_NEWFILE,
+  /* AugTypeCheck */   AUG_TYPE_CHECK,
+  /* AugNoStdinc */    AUG_NO_STDINC,
+  /* AugSaveNoop */    AUG_SAVE_NOOP,
+  /* AugNoLoad */      AUG_NO_LOAD,
+};
+
+/* Wrap and unwrap augeas_t handles, with a finalizer. */
+#define Augeas_t_val(rv) (*(augeas_t *)Data_custom_val(rv))
+
+static void
+augeas_t_finalize (value tv)
+{
+  augeas_t t = Augeas_t_val (tv);
+  if (t) aug_close (t);
+}
+
+static struct custom_operations custom_operations = {
+  (char *) "augeas_t_custom_operations",
+  augeas_t_finalize,
+  custom_compare_default,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default
+};
+
+static value Val_augeas_t (augeas_t t)
+{
+  CAMLparam0 ();
+  CAMLlocal1 (rv);
+  /* We could choose these so that the GC can make better decisions.
+   * See 18.9.2 of the OCaml manual.
+   */
+  const int used = 0;
+  const int max = 1;
+
+  rv = caml_alloc_custom (&custom_operations,
+			  sizeof (augeas_t), used, max);
+  Augeas_t_val(rv) = t;
+
+  CAMLreturn (rv);
+}
+
+#pragma GCC diagnostic ignored "-Wmissing-prototypes"
+
+/* val create : string -> string option -> flag list -> t */
+CAMLprim value
+ocaml_augeas_create (value rootv, value loadpathv, value flagsv)
+{
+  CAMLparam1 (rootv);
+  char *root = String_val (rootv);
+  char *loadpath;
+  int flags = 0, i;
+  augeas_t t;
+
+  /* Optional loadpath. */
+  loadpath =
+    loadpathv == Val_int (0)
+    ? NULL
+    : String_val (Field (loadpathv, 0));
+
+  /* Convert list of flags to C. */
+  for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
+    i = Int_val (Field (flagsv, 0));
+    flags |= flag_map[i];
+  }
+
+  t = aug_init (root, loadpath, flags);
+
+  if (t == NULL)
+    raise_error ("Augeas.create");
+
+  CAMLreturn (Val_augeas_t (t));
+}
+
+/* val close : t -> unit */
+CAMLprim value
+ocaml_augeas_close (value tv)
+{
+  CAMLparam1 (tv);
+  augeas_t t = Augeas_t_val (tv);
+
+  if (t) {
+    aug_close (t);
+    Augeas_t_val(tv) = NULL;	/* So the finalizer doesn't double-free. */
+  }
+
+  CAMLreturn (Val_unit);
+}
+
+/* val get : t -> path -> value option */
+CAMLprim value
+ocaml_augeas_get (value tv, value pathv)
+{
+  CAMLparam2 (tv, pathv);
+  CAMLlocal2 (optv, v);
+  augeas_t t = Augeas_t_val (tv);
+  char *path = String_val (pathv);
+  const char *val;
+  int r;
+
+  r = aug_get (t, path, &val);
+  if (r == 1) {			/* Return Some val */
+    v = caml_copy_string (val);
+    optv = caml_alloc (1, 0);
+    Field (optv, 0) = v;
+  } else if (r == 0)		/* Return None */
+    optv = Val_int (0);
+  else if (r == -1)		/* Error or multiple matches */
+    raise_error ("Augeas.get");
+  else
+    failwith ("Augeas.get: bad return value");
+
+  CAMLreturn (optv);
+}
+
+/* val exists : t -> path -> bool */
+CAMLprim value
+ocaml_augeas_exists (value tv, value pathv)
+{
+  CAMLparam2 (tv, pathv);
+  CAMLlocal1 (v);
+  augeas_t t = Augeas_t_val (tv);
+  char *path = String_val (pathv);
+  int r;
+
+  r = aug_get (t, path, NULL);
+  if (r == 1)			/* Return true. */
+    v = Val_int (1);
+  else if (r == 0)		/* Return false */
+    v = Val_int (0);
+  else if (r == -1)		/* Error or multiple matches */
+    raise_error ("Augeas.exists");
+  else
+    failwith ("Augeas.exists: bad return value");
+
+  CAMLreturn (v);
+}
+
+/* val insert : t -> ?before:bool -> path -> string -> unit */
+CAMLprim value
+ocaml_augeas_insert (value tv, value beforev, value pathv, value labelv)
+{
+  CAMLparam4 (tv, beforev, pathv, labelv);
+  augeas_t t = Augeas_t_val (tv);
+  char *path = String_val (pathv);
+  char *label = String_val (labelv);
+  int before;
+
+  before = beforev == Val_int (0) ? 0 : Int_val (Field (beforev, 0));
+
+  if (aug_insert (t, path, label, before) == -1)
+    raise_error ("Augeas.insert");
+
+  CAMLreturn (Val_unit);
+}
+
+/* val rm : t -> path -> int */
+CAMLprim value
+ocaml_augeas_rm (value tv, value pathv)
+{
+  CAMLparam2 (tv, pathv);
+  augeas_t t = Augeas_t_val (tv);
+  char *path = String_val (pathv);
+  int r;
+
+  r = aug_rm (t, path);
+  if (r == -1)
+    raise_error ("Augeas.rm");
+
+  CAMLreturn (Val_int (r));
+}
+
+/* val matches : t -> path -> path list */
+CAMLprim value
+ocaml_augeas_match (value tv, value pathv)
+{
+  CAMLparam2 (tv, pathv);
+  CAMLlocal3 (rv, v, cons);
+  augeas_t t = Augeas_t_val (tv);
+  char *path = String_val (pathv);
+  char **matches;
+  int r, i;
+
+  r = aug_match (t, path, &matches);
+  if (r == -1)
+    raise_error ("Augeas.matches");
+
+  /* Copy the paths to a list. */
+  rv = Val_int (0);
+  for (i = 0; i < r; ++i) {
+    v = caml_copy_string (matches[i]);
+    free (matches[i]);
+    cons = caml_alloc (2, 0);
+    Field (cons, 1) = rv;
+    Field (cons, 0) = v;
+    rv = cons;
+  }
+
+  free (matches);
+
+  CAMLreturn (rv);
+}
+
+/* val count_matches : t -> path -> int */
+CAMLprim value
+ocaml_augeas_count_matches (value tv, value pathv)
+{
+  CAMLparam2 (tv, pathv);
+  augeas_t t = Augeas_t_val (tv);
+  char *path = String_val (pathv);
+  int r;
+
+  r = aug_match (t, path, NULL);
+  if (r == -1)
+    raise_error ("Augeas.count_matches");
+
+  CAMLreturn (Val_int (r));
+}
+
+/* val save : t -> unit */
+CAMLprim value
+ocaml_augeas_save (value tv)
+{
+  CAMLparam1 (tv);
+  augeas_t t = Augeas_t_val (tv);
+
+  if (aug_save (t) == -1)
+    raise_error ("Augeas.save");
+
+  CAMLreturn (Val_unit);
+}
+
+/* val load : t -> unit */
+CAMLprim value
+ocaml_augeas_load (value tv)
+{
+  CAMLparam1 (tv);
+  augeas_t t = Augeas_t_val (tv);
+
+  if (aug_load (t) == -1)
+    raise_error ("Augeas.load");
+
+  CAMLreturn (Val_unit);
+}

common/mlaugeas/augeas.README

@@ -0,0 +1,8 @@
+The files augeas-c.c, augeas.ml and augeas.mli come from the
+ocaml-augeas library:
+
+  http://git.annexia.org/?p=ocaml-augeas.git
+
+which is released under a compatible license.  We try to keep them
+identical, so if you make changes to these files then you must also
+submit the changes to ocaml-augeas, and vice versa.

common/mlaugeas/augeas.ml

@@ -0,0 +1,59 @@
+(* Augeas OCaml bindings
+ * Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *
+ * $Id: augeas.ml,v 1.2 2008/05/06 10:48:20 rjones Exp $
+ *)
+
+type t
+
+exception Error of string
+
+type flag =
+  | AugSaveBackup
+  | AugSaveNewFile
+  | AugTypeCheck
+  | AugNoStdinc
+  | AugSaveNoop
+  | AugNoLoad
+
+type path = string
+
+type value = string
+
+external create : string -> string option -> flag list -> t
+  = "ocaml_augeas_create"
+external close : t -> unit
+  = "ocaml_augeas_close"
+external get : t -> path -> value option
+  = "ocaml_augeas_get"
+external exists : t -> path -> bool
+  = "ocaml_augeas_exists"
+external insert : t -> ?before:bool -> path -> string -> unit
+  = "ocaml_augeas_insert"
+external rm : t -> path -> int
+  = "ocaml_augeas_rm"
+external matches : t -> path -> path list
+  = "ocaml_augeas_match"
+external count_matches : t -> path -> int
+  = "ocaml_augeas_count_matches"
+external save : t -> unit
+  = "ocaml_augeas_save"
+external load : t -> unit
+  = "ocaml_augeas_load"
+
+let () =
+  Callback.register_exception "Augeas.Error" (Error "")

common/mlaugeas/augeas.mli

@@ -0,0 +1,95 @@
+(** Augeas OCaml bindings *)
+(* Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *
+ * $Id: augeas.mli,v 1.2 2008/05/06 10:48:20 rjones Exp $
+ *)
+
+type t
+  (** Augeas library handle. *)
+
+exception Error of string
+  (** This exception is thrown when the underlying Augeas library
+      returns an error. *)
+
+type flag =
+  | AugSaveBackup			(** Rename original with .augsave *)
+  | AugSaveNewFile			(** Save changes to .augnew *)
+  | AugTypeCheck			(** Type-check lenses *)
+  | AugNoStdinc
+  | AugSaveNoop
+  | AugNoLoad
+  (** Flags passed to the {!create} function. *)
+
+type path = string
+  (** A path expression.
+
+      Note in future we may replace this with a type-safe path constructor. *)
+
+type value = string
+  (** A value. *)
+
+val create : string -> string option -> flag list -> t
+  (** [create root loadpath flags] creates an Augeas handle.
+
+      [root] is a file system path describing the location
+      of the configuration files.
+
+      [loadpath] is an optional colon-separated list of directories
+      which are searched for schema definitions.
+
+      [flags] is a list of flags. *)
+
+val close : t -> unit
+  (** [close handle] closes the handle.
+
+      You don't need to close handles explicitly with this function:
+      they will be finalized eventually by the garbage collector.
+      However calling this function frees up any resources used by the
+      underlying Augeas library immediately.
+
+      Do not use the handle after closing it. *)
+
+val get : t -> path -> value option
+  (** [get t path] returns the value at [path], or [None] if there
+      is no value. *)
+
+val exists : t -> path -> bool
+  (** [exists t path] returns true iff there is a value at [path]. *)
+
+val insert : t -> ?before:bool -> path -> string -> unit
+  (** [insert t ?before path label] inserts [label] as a sibling
+      of [path].  By default it is inserted after [path], unless
+      [~before:true] is specified. *)
+
+val rm : t -> path -> int
+  (** [rm t path] removes all nodes matching [path].
+
+      Returns the number of nodes removed (which may be 0). *)
+
+val matches : t -> path -> path list
+  (** [matches t path] returns a list of path expressions
+      of all nodes matching [path]. *)
+
+val count_matches : t -> path -> int
+  (** [count_matches t path] counts the number of nodes matching
+      [path] but does not return them (see {!matches}). *)
+
+val save : t -> unit
+  (** [save t] saves all pending changes to disk. *)
+
+val load : t -> unit
+  (** [load t] loads files into the tree. *)

configure.ac

@@ -226,6 +226,7 @@ AC_CONFIG_FILES([Makefile
                  common/errnostring/Makefile
                  common/edit/Makefile
                  common/miniexpect/Makefile
+                 common/mlaugeas/Makefile
                  common/mlpcre/Makefile
                  common/mlprogress/Makefile
                  common/mlstdutils/Makefile

daemon/Makefile.am

@@ -190,6 +190,7 @@ guestfsd_LDFLAGS = \
 	-L$(shell $(OCAMLC) -where)/hivex \
 	-L../common/mlutils \
 	-L../common/mlstdutils \
+	-L../common/mlaugeas \
 	-L../common/mlpcre
 guestfsd_LDADD = \
 	../common/errnostring/liberrnostring.la \
@@ -294,6 +295,7 @@ XOBJECTS = $(BOBJECTS:.cmo=.cmx)
 
 OCAMLPACKAGES = \
 	-package str,unix,hivex \
+	-I $(top_srcdir)/common/mlaugeas \
 	-I $(top_srcdir)/common/mlstdutils \
 	-I $(top_srcdir)/common/mlutils \
 	-I $(top_builddir)/common/utils/.libs \
@@ -314,6 +316,7 @@ OCAML_LIBS = \
 	-lmlpcre \
 	-lmlcutils \
 	-lmlstdutils \
+	-lmlaugeas \
 	-lmlhivex \
 	-lcamlstr \
 	-lunix \
@@ -325,7 +328,8 @@ camldaemon.o: $(OBJECTS)
 	$(OCAMLFIND) $(BEST) -output-obj -o $@ \
 	    $(OCAMLFLAGS) $(OCAMLPACKAGES) \
 	    -linkpkg \
-	    mlpcre.$(MLARCHIVE) mlcutils.$(MLARCHIVE) mlstdutils.$(MLARCHIVE) \
+	    mlaugeas.$(MLARCHIVE) mlpcre.$(MLARCHIVE) \
+	    mlcutils.$(MLARCHIVE) mlstdutils.$(MLARCHIVE) \
 	    $(OBJECTS)
 
 # OCaml dependencies.
@@ -377,6 +381,7 @@ OCAMLLINKFLAGS = \
 	mlpcre.$(MLARCHIVE) \
 	mlcutils.$(MLARCHIVE) \
 	mlstdutils.$(MLARCHIVE) \
+	mlaugeas.$(MLARCHIVE) \
 	$(LINK_CUSTOM_OCAMLC_ONLY)
 
 daemon_utils_tests_DEPENDENCIES = \

daemon/daemon-c.c

@@ -65,6 +65,8 @@ guestfs_int_daemon_exn_to_reply_with_error (const char *func, value exn)
     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 if (STREQ (exn_name, "Augeas.Error"))
+    reply_with_error ("augeas error: %s", String_val (Field (exn, 1)));
   else if (STREQ (exn_name, "PCRE.Error")) {
     value pair = Field (exn, 1);
     reply_with_error ("PCRE error: %s (PCRE error code: %d)",

docs/C_SOURCE_FILES

@@ -15,6 +15,7 @@ common/edit/file-edit.c
 common/edit/file-edit.h
 common/miniexpect/miniexpect.c
 common/miniexpect/miniexpect.h
+common/mlaugeas/augeas-c.c
 common/mlpcre/dummy.c
 common/mlpcre/pcre-c.c
 common/mlprogress/progress-c.c

docs/guestfs-hacking.pod

@@ -100,6 +100,11 @@ A copy of the miniexpect library from
 L<http://git.annexia.org/?p=miniexpect.git;a=summary>.  This is used
 in virt-p2v.
 
+=item F<common/mlaugeas>
+
+Bindings for the Augeas library.  These come from the ocaml-augeas
+library L<http://git.annexia.org/?p=ocaml-augeas.git>
+
 =item F<common/mlpcre>
 
 Lightweight OCaml bindings for Perl Compatible Regular Expressions

ocaml-dep.sh.in

@@ -33,6 +33,7 @@ set -e
 # directories must have unique names (eg. not ‘Utils’) else
 # dependencies don't get built right.
 include_dirs="
+common/mlaugeas
 common/mlpcre
 common/mlprogress
 common/mlstdutils