[Libguestfs] [PATCH v12 02/11] 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 | 1 + Makefile.am | 1 + common/mlaugeas/Makefile.am | 91 +++++++++++++ common/mlaugeas/augeas-c.c | 288 ++++++++++++++++++++++++++++++++++++++++++ common/mlaugeas/augeas.README | 8 ++ common/mlaugeas/augeas.ml | 59 +++++++++ common/mlaugeas/augeas.mli | 95 ++++++++++++++ configure.ac | 1 + daemon/Makefile.am | 7 +- daemon/daemon-c.c | 2 + docs/C_SOURCE_FILES | 1 + docs/guestfs-hacking.pod | 5 + ocaml-dep.sh.in | 1 + 13 files changed, 559 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 4d738d10f..8446d3af5 100644 --- a/.gitignore +++ b/.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 diff --git a/Makefile.am b/Makefile.am index e71328a58..e62f2678e 100644 --- a/Makefile.am +++ b/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 diff --git a/common/mlaugeas/Makefile.am b/common/mlaugeas/Makefile.am new file mode 100644 index 000000000..ed1abe7ec --- /dev/null +++ b/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 diff --git a/common/mlaugeas/augeas-c.c b/common/mlaugeas/augeas-c.c new file mode 100644 index 000000000..c06bf92da --- /dev/null +++ b/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); +} diff --git a/common/mlaugeas/augeas.README b/common/mlaugeas/augeas.README new file mode 100644 index 000000000..938dfd255 --- /dev/null +++ b/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. \ No newline at end of file diff --git a/common/mlaugeas/augeas.ml b/common/mlaugeas/augeas.ml new file mode 100644 index 000000000..f556df0f1 --- /dev/null +++ b/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 "") diff --git a/common/mlaugeas/augeas.mli b/common/mlaugeas/augeas.mli new file mode 100644 index 000000000..64e824014 --- /dev/null +++ b/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. *) diff --git a/configure.ac b/configure.ac index de247a36d..66d54c107 100644 --- a/configure.ac +++ b/configure.ac @@ -244,6 +244,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 diff --git a/daemon/Makefile.am b/daemon/Makefile.am index b26c43ed2..3e8bdb44f 100644 --- a/daemon/Makefile.am +++ b/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 = \ diff --git a/daemon/daemon-c.c b/daemon/daemon-c.c index 3bfa06393..4d04dc0dc 100644 --- a/daemon/daemon-c.c +++ b/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)", diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES index 91226415c..65e62f643 100644 --- a/docs/C_SOURCE_FILES +++ b/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 diff --git a/docs/guestfs-hacking.pod b/docs/guestfs-hacking.pod index c71e659c4..d0a28b094 100644 --- a/docs/guestfs-hacking.pod +++ b/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 diff --git a/ocaml-dep.sh.in b/ocaml-dep.sh.in index 61acaf209..2cf6e1c8f 100755 --- a/ocaml-dep.sh.in +++ b/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 -- 2.13.2