Re: [Libguestfs] [PATCH] inspection: Deprecate APIs and remove support for inspecting installer CDs.

[Pino Toscano]

On Friday, 16 June 2017 12:26:55 CEST Richard W.M. Jones wrote:
> This just duplicated libosinfo information, and because it was never
> tested it didn't work most of the time.
> ---

lib/osinfo.c is needed for the upcoming virt-builder-repository tool,
so in case we could just move it over there.

-- 
Pino Toscano

signature.asc
Description: This is a digitally signed message part.
___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v7 13/13] daemon: Link guestfsd with libutils.

[Pino Toscano]

On Monday, 19 June 2017 15:31:29 CEST Richard W.M. Jones wrote:
> After the previous refactoring, we are able to link the daemon to
> common/utils, and also remove some of the "duplicate" functions that
> the daemon carried ("duplicate" in quotes because they were often not
> exact duplicates).
> 
> Also this removes the duplicate reimplementation of (most) cleanup
> functions in the daemon, since those are provided by libutils now.
> 
> It also allows us in future (but not in this commit) to move utility
> functions from the daemon into libutils.
> ---
>  daemon/Makefile.am   |  8 +--
>  daemon/augeas.c  |  2 +-
>  daemon/btrfs.c   | 18 +++
>  daemon/cleanups.c| 49 +---
>  daemon/cleanups.h| 51 -
>  daemon/daemon.h  | 31 -
>  daemon/debug.c   |  4 ++--
>  daemon/echo-daemon.c |  2 +-
>  daemon/guestfsd.c| 64 
> 
>  daemon/ldm.c |  2 +-
>  daemon/lvm.c |  4 ++--
>  daemon/md.c  |  8 ---
>  daemon/stat.c|  2 +-
>  docs/C_SOURCE_FILES  |  1 -
>  generator/daemon.ml  |  8 +++
>  15 files changed, 53 insertions(+), 201 deletions(-)
> 
> diff --git a/daemon/Makefile.am b/daemon/Makefile.am
> index 0d3dde516..db19594b8 100644
> --- a/daemon/Makefile.am
> +++ b/daemon/Makefile.am
> @@ -49,6 +49,8 @@ endif
>  guestfsd_SOURCES = \
>   ../common/errnostring/errnostring.h \
>   ../common/protocol/guestfs_protocol.h \
> + ../common/utils/cleanups.h \
> + ../common/utils/utils.h \

Should this be guestfs-utils.h?

> diff --git a/daemon/cleanups.h b/daemon/cleanups.h
> deleted file mode 100644
> index a791244cb..0
> --- a/daemon/cleanups.h
> +++ /dev/null
> @@ -1,51 +0,0 @@
> -/* libguestfs - the guestfsd daemon
> - * Copyright (C) 2009-2015 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.
> - */
> -
> -#ifndef GUESTFSD_CLEANUPS_H
> -#define GUESTFSD_CLEANUPS_H
> -
> -/* These functions are used internally by the CLEANUP_* macros.
> - * Don't call them directly.
> - */
> -extern void cleanup_free (void *ptr);
> -extern void cleanup_free_string_list (void *ptr);
> -extern void cleanup_unlink_free (void *ptr);
> -extern void cleanup_close (void *ptr);
> -extern void cleanup_fclose (void *ptr);
> -extern void cleanup_aug_close (void *ptr);
> -extern void cleanup_free_stringsbuf (void *ptr);
> -
> -#ifdef HAVE_ATTRIBUTE_CLEANUP
> -#define CLEANUP_FREE __attribute__((cleanup(cleanup_free)))
> -#define CLEANUP_FREE_STRING_LIST\
> -__attribute__((cleanup(cleanup_free_string_list)))
> -#define CLEANUP_UNLINK_FREE __attribute__((cleanup(cleanup_unlink_free)))
> -#define CLEANUP_CLOSE __attribute__((cleanup(cleanup_close)))
> -#define CLEANUP_FCLOSE __attribute__((cleanup(cleanup_fclose)))
> -#define CLEANUP_AUG_CLOSE __attribute__((cleanup(cleanup_aug_close)))
> -#define CLEANUP_FREE_STRINGSBUF 
> __attribute__((cleanup(cleanup_free_stringsbuf)))
> -#else
> -#define CLEANUP_FREE
> -#define CLEANUP_FREE_STRING_LIST
> -#define CLEANUP_UNLINK_FREE
> -#define CLEANUP_CLOSE
> -#define CLEANUP_AUG_CLOSE
> -#define CLEANUP_FREE_STRINGSBUF
> -#endif
> -
> -#endif /* GUESTFSD_CLEANUPS_H */

Considering cleanups.c is still there, I'd leave this too, even if with
much smaller content.

-- 
Pino Toscano

signature.asc
Description: This is a digitally signed message part.
___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v7 10/13] utils: Split out structs cleanups and printing into common/structs.

[Pino Toscano]

On Monday, 19 June 2017 17:44:40 CEST Richard W.M. Jones wrote:
> On Mon, Jun 19, 2017 at 05:38:53PM +0200, Pino Toscano wrote:
> > On Monday, 19 June 2017 15:31:26 CEST Richard W.M. Jones wrote:
> > > These won't be used by the daemon, so interferes with us using
> > > common/utils in the daemon, so they are moved to a different library.
> > > ---
> > 
> > I checked it again, and the daemon does use structs cleanups:
> > 
> > $ cat generator/main.ml
> > [...]
> >   output_to "daemon/structs-cleanups.c"
> > Daemon.generate_daemon_structs_cleanups_c;
> >   output_to "daemon/structs-cleanups.h"
> > Daemon.generate_daemon_structs_cleanups_h;
> 
> Those are different from common/structs/structs-cleanups.[ch] though
> (hence why they use different generator functions to generate them).

Not that much though -- the differences basically are:
a) slightly different names for the cleanup functions (i.e. those
   associated with the __attribute__((cleanup(...)))
b) the _free and _list_free in the library are exported

I guess this can be a later cleanup (pun intended!).

-- 
Pino Toscano

signature.asc
Description: This is a digitally signed message part.
___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v7 12/13] utils: Rename ‘guestfs-internal-frontend.h’ to ‘guestfs-utils.h’.

[Richard W.M. Jones]

OK, fixed now.  Also the same mistake in daemon/Makefile.am in
the following commit.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines.  Supports shell scripting,
bindings from many languages.  http://libguestfs.org

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v7 12/13] utils: Rename ‘guestfs-internal-frontend.h’ to ‘guestfs-utils.h’.

[Pino Toscano]

On Monday, 19 June 2017 15:31:28 CEST Richard W.M. Jones wrote:
> The reason it's not just ‘utils.h’ is because Pino is worried that we
> might pick up /usr/include/utils.h from a rogue library.
> ---
> diff --git a/python/MANIFEST.in b/python/MANIFEST.in
> index 116367d16..69db7e5ce 100644
> --- a/python/MANIFEST.in
> +++ b/python/MANIFEST.in
> @@ -17,8 +17,8 @@
>  
>  include actions.h
>  include c-ctype.h
> +include cleanups.h
>  include config.h
>  include guestfs-internal-all.h
> -include guestfs-internal-frontend-cleanups.h
> -include guestfs-internal-frontend.h
> +include utils.h
>  include ignore-value.h

Not correct name here.

> diff --git a/python/Makefile.am b/python/Makefile.am
> index 7e91bbb7e..a357f36ff 100644
> --- a/python/Makefile.am
> +++ b/python/Makefile.am
> @@ -101,9 +101,9 @@ stamp-extra-files: \
> cleanups.h \
> config.h \
> guestfs-internal-all.h \
> -   guestfs-internal-frontend.h \
> ignore-value.h \
> -   utils.c
> +   utils.c \
> +   utils.h

Ditto.

> -guestfs-internal-frontend.h:
> - ln $(top_srcdir)/common/utils/guestfs-internal-frontend.h $@
> +utils.h:
> + ln $(top_srcdir)/common/utils/utils.h $@

Ditto.

> @@ -152,10 +152,10 @@ CLEANFILES += \
>   cleanups.c \
>   cleanups.h \
>   guestfs-internal-all.h \
> - guestfs-internal-frontend.h \
>   ignore-value.h \
>   stamp-extra-files \
> - utils.c
> + utils.c \
> + utils.h

Ditto.

-- 
Pino Toscano

signature.asc
Description: This is a digitally signed message part.
___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 28/29] daemon: Reimplement ‘device_index’ API in OCaml.

[Richard W.M. Jones]

---
 daemon/devsparts.c| 21 -
 daemon/devsparts.ml   | 11 +++
 daemon/devsparts.mli  |  6 ++
 generator/actions_core.ml |  1 +
 4 files changed, 14 insertions(+), 25 deletions(-)

diff --git a/daemon/devsparts.c b/daemon/devsparts.c
index 12e779326..7c65be1dc 100644
--- a/daemon/devsparts.c
+++ b/daemon/devsparts.c
@@ -33,27 +33,6 @@
 #include "daemon.h"
 #include "actions.h"
 
-int
-do_device_index (const char *device)
-{
-  size_t i;
-  int ret = -1;
-  CLEANUP_FREE_STRING_LIST char **devices = do_list_devices ();
-
-  if (devices == NULL)
-return -1;
-
-  for (i = 0; devices[i] != NULL; ++i) {
-if (STREQ (device, devices[i]))
-  ret = (int) i;
-  }
-
-  if (ret == -1)
-reply_with_error ("device not found");
-
-  return ret;
-}
-
 #define GUESTFSDIR "/dev/disk/guestfs"
 
 char **
diff --git a/daemon/devsparts.ml b/daemon/devsparts.ml
index 273612516..4d273f59e 100644
--- a/daemon/devsparts.ml
+++ b/daemon/devsparts.ml
@@ -109,3 +109,14 @@ let is_whole_device device =
 
   try ignore (stat devpath); true
   with Unix_error ((ENOENT|ENOTDIR), _, _) -> false
+
+let device_index device =
+  (* This is the algorithm which was used by the C version.  Why
+   * can't we use drive_index from C_utils?  XXX
+   *)
+  let rec loop i = function
+| [] -> failwithf "%s: device not found" device
+| dev :: devices when dev = device -> i
+| _ :: devices -> loop (i+1) devices
+  in
+  loop 0 (list_devices ())
diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli
index 8be47e752..4afb36bec 100644
--- a/daemon/devsparts.mli
+++ b/daemon/devsparts.mli
@@ -18,10 +18,8 @@
 
 val list_devices : unit -> string list
 val list_partitions : unit -> string list
-
-val nr_devices : unit -> int
-
 val part_to_dev : string -> string
 val part_to_partnum : string -> int
-
 val is_whole_device : string -> bool
+val nr_devices : unit -> int
+val device_index : string -> int
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index c3421133e..ea0735676 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -7419,6 +7419,7 @@ instead of, or after calling C." 
};
   { defaults with
 name = "device_index"; added = (1, 19, 7);
 style = RInt "index", [String (Device, "device")], [];
+impl = OCaml "Devsparts.device_index";
 tests = [
   InitEmpty, Always, TestResult (
 [["device_index"; "/dev/sda"]], "ret == 0"), []
-- 
2.13.0

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 27/29] lib: Move implementation of ‘hivex_value_utf8’ to new file ‘lib/hivex.c’.

[Richard W.M. Jones]

Just a code movement, no change.
---
 docs/C_SOURCE_FILES  |   1 +
 lib/Makefile.am  |   1 +
 lib/hivex.c  | 111 +++
 lib/inspect-fs-windows.c |  83 ---
 4 files changed, 113 insertions(+), 83 deletions(-)

diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index 0b55c122f..39dcf9035 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -303,6 +303,7 @@ lib/guestfs-internal.h
 lib/guestfs.h
 lib/guid.c
 lib/handle.c
+lib/hivex.c
 lib/info.c
 lib/inspect-apps.c
 lib/inspect-fs-unix.c
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 7eaff88ee..31568f933 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -92,6 +92,7 @@ libguestfs_la_SOURCES = \
fuse.c \
guid.c \
handle.c \
+   hivex.c \
info.c \
inspect.c \
inspect-apps.c \
diff --git a/lib/hivex.c b/lib/hivex.c
new file mode 100644
index 0..2d782e192
--- /dev/null
+++ b/lib/hivex.c
@@ -0,0 +1,111 @@
+/* libguestfs
+ * Copyright (C) 2010-2012 Red Hat Inc.
+ *
+ * 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
+ */
+
+#include 
+
+#include 
+#include 
+#include 
+#include 
+
+#include "guestfs.h"
+#include "guestfs-internal.h"
+#include "guestfs-internal-actions.h"
+
+/* Read the data from 'valueh', assume it is UTF16LE and convert it to
+ * UTF8.  This is copied from hivex_value_string which doesn't work in
+ * the appliance because it uses iconv_open which doesn't work because
+ * we delete all the i18n databases.
+ */
+static char *utf16_to_utf8 (/* const */ char *input, size_t len);
+
+char *
+guestfs_impl_hivex_value_utf8 (guestfs_h *g, int64_t valueh)
+{
+  char *ret;
+  size_t buflen;
+
+  CLEANUP_FREE char *buf = guestfs_hivex_value_value (g, valueh, );
+  if (buf == NULL)
+return NULL;
+
+  ret = utf16_to_utf8 (buf, buflen);
+  if (ret == NULL) {
+perrorf (g, "hivex: conversion of registry value to UTF8 failed");
+return NULL;
+  }
+
+  return ret;
+}
+
+static char *
+utf16_to_utf8 (/* const */ char *input, size_t len)
+{
+  iconv_t ic = iconv_open ("UTF-8", "UTF-16LE");
+  if (ic == (iconv_t) -1)
+return NULL;
+
+  /* iconv(3) has an insane interface ... */
+
+  /* Mostly UTF-8 will be smaller, so this is a good initial guess. */
+  size_t outalloc = len;
+
+ again:;
+  size_t inlen = len;
+  size_t outlen = outalloc;
+  char *out = malloc (outlen + 1);
+  if (out == NULL) {
+int err = errno;
+iconv_close (ic);
+errno = err;
+return NULL;
+  }
+  char *inp = input;
+  char *outp = out;
+
+  const size_t r =
+iconv (ic, (ICONV_CONST char **) , , , );
+  if (r == (size_t) -1) {
+if (errno == E2BIG) {
+  const int err = errno;
+  const size_t prev = outalloc;
+  /* Try again with a larger output buffer. */
+  free (out);
+  outalloc *= 2;
+  if (outalloc < prev) {
+iconv_close (ic);
+errno = err;
+return NULL;
+  }
+  goto again;
+}
+else {
+  /* Else some conversion failure, eg. EILSEQ, EINVAL. */
+  const int err = errno;
+  iconv_close (ic);
+  free (out);
+  errno = err;
+  return NULL;
+}
+  }
+
+  *outp = '\0';
+  iconv_close (ic);
+
+  return out;
+}
diff --git a/lib/inspect-fs-windows.c b/lib/inspect-fs-windows.c
index b14dc2e14..34f33c908 100644
--- a/lib/inspect-fs-windows.c
+++ b/lib/inspect-fs-windows.c
@@ -737,86 +737,3 @@ guestfs_int_case_sensitive_path_silently (guestfs_h *g, 
const char *path)
 
   return ret;
 }
-
-/* Read the data from 'valueh', assume it is UTF16LE and convert it to
- * UTF8.  This is copied from hivex_value_string which doesn't work in
- * the appliance because it uses iconv_open which doesn't work because
- * we delete all the i18n databases.
- */
-static char *utf16_to_utf8 (/* const */ char *input, size_t len);
-
-char *
-guestfs_impl_hivex_value_utf8 (guestfs_h *g, int64_t valueh)
-{
-  char *ret;
-  size_t buflen;
-
-  CLEANUP_FREE char *buf = guestfs_hivex_value_value (g, valueh, );
-  if (buf == NULL)
-return NULL;
-
-  ret = utf16_to_utf8 (buf, buflen);
-  if (ret == NULL) {
-perrorf (g, "hivex: conversion of registry value to UTF8 failed");
-return NULL;
-  }
-
-  return ret;
-}
-
-static char *

[Libguestfs] [PATCH v7 26/29] daemon: Reimplement ‘part_get_parttype’, ‘part_get_gpt_type’, ‘part_get_gpt_guid’ APIs in OCaml.

[Richard W.M. Jones]

---
 daemon/parted.c   | 176 +-
 daemon/parted.ml  |  74 ++-
 daemon/parted.mli |   5 ++
 generator/actions_core.ml |   3 +
 4 files changed, 96 insertions(+), 162 deletions(-)

diff --git a/daemon/parted.c b/daemon/parted.c
index 125aec60b..1c81cd968 100644
--- a/daemon/parted.c
+++ b/daemon/parted.c
@@ -348,45 +348,6 @@ print_partition_table (const char *device, bool 
add_m_option)
   return out;
 }
 
-char *
-do_part_get_parttype (const char *device)
-{
-  CLEANUP_FREE char *out = print_partition_table (device, true);
-  if (!out)
-return NULL;
-
-  CLEANUP_FREE_STRING_LIST char **lines = split_lines (out);
-  if (!lines)
-return NULL;
-
-  if (lines[0] == NULL || STRNEQ (lines[0], "BYT;")) {
-reply_with_error ("unknown signature, expected \"BYT;\" as first line of 
the output: %s",
-  lines[0] ? lines[0] : "(signature was null)");
-return NULL;
-  }
-
-  if (lines[1] == NULL) {
-reply_with_error ("parted didn't return a line describing the device");
-return NULL;
-  }
-
-  /* lines[1] is something like:
-   * "/dev/sda:1953525168s:scsi:512:512:msdos:ATA Hitachi HDT72101;"
-   */
-  char *r = get_table_field (lines[1], 5);
-  if (r == NULL)
-return NULL;
-
-  /* If "loop" return an error (RHBZ#634246). */
-  if (STREQ (r, "loop")) {
-free (r);
-reply_with_error ("not a partitioned device");
-return NULL;
-  }
-
-  return r;
-}
-
 int
 do_part_get_bootable (const char *device, int partnum)
 {
@@ -557,126 +518,6 @@ do_part_set_gpt_guid (const char *device, int partnum, 
const char *guid)
   return 0;
 }
 
-static char *
-sgdisk_info_extract_field (const char *device, int partnum, const char *field,
-   char *(*extract) (const char *path))
-{
-  if (partnum <= 0) {
-reply_with_error ("partition number must be >= 1");
-return NULL;
-  }
-
-  CLEANUP_FREE char *partnum_str = NULL;
-  if (asprintf (_str, "%i", partnum) == -1) {
-reply_with_perror ("asprintf");
-return NULL;
-  }
-
-  udev_settle ();
-
-  CLEANUP_FREE char *err = NULL;
-  int r = commandf (NULL, , COMMAND_FLAG_FOLD_STDOUT_ON_STDERR,
-str_sgdisk, device, "-i", partnum_str, NULL);
-
-  if (r == -1) {
-reply_with_error ("%s %s -i %s: %s", str_sgdisk, device, partnum_str, err);
-return NULL;
-  }
-
-  udev_settle ();
-
-  CLEANUP_FREE_STRING_LIST char **lines = split_lines (err);
-  if (lines == NULL) {
-reply_with_error ("'%s %s -i %i' returned no output",
-  str_sgdisk, device, partnum);
-return NULL;
-  }
-
-  const int fieldlen = strlen (field);
-
-  /* Parse the output of sgdisk -i:
-   * Partition GUID code: 21686148-6449-6E6F-744E-656564454649 (BIOS boot 
partition)
-   * Partition unique GUID: 19AEC5FE-D63A-4A15-9D37-6FCBFB873DC0
-   * First sector: 2048 (at 1024.0 KiB)
-   * Last sector: 411647 (at 201.0 MiB)
-   * Partition size: 409600 sectors (200.0 MiB)
-   * Attribute flags: 
-   * Partition name: 'EFI System Partition'
-   */
-  for (char **i = lines; *i != NULL; i++) {
-char *line = *i;
-
-/* Skip blank lines */
-if (line[0] == '\0') continue;
-
-/* Split the line in 2 at the colon */
-char *colon = strchr (line, ':');
-if (colon) {
-  if (colon - line == fieldlen &&
-  memcmp (line, field, fieldlen) == 0)
-  {
-/* The value starts after the colon */
-char *value = colon + 1;
-
-/* Skip any leading whitespace */
-value += strspn (value, " \t");
-
-/* Extract the actual information from the field. */
-char *ret = extract (value);
-if (ret == NULL) {
-  /* The extraction function already sends the error. */
-  return NULL;
-}
-
-return ret;
-  }
-} else {
-  /* Ignore lines with no colon. Log to stderr so it will show up in
-   * LIBGUESTFS_DEBUG. */
-  if (verbose) {
-fprintf (stderr, "get-gpt-type: unexpected sgdisk output ignored: 
%s\n",
- line);
-  }
-}
-  }
-
-  /* If we got here it means we didn't find the field */
-  reply_with_error ("sgdisk output did not contain '%s'. "
-"See LIBGUESTFS_DEBUG output for more details", field);
-  return NULL;
-}
-
-static char *
-extract_uuid (const char *value)
-{
-  /* The value contains only valid GUID characters */
-  const size_t value_len = strspn (value, "-0123456789ABCDEF");
-
-  char *ret = malloc (value_len + 1);
-  if (ret == NULL) {
-reply_with_perror ("malloc");
-return NULL;
-  }
-
-  memcpy (ret, value, value_len);
-  ret[value_len] = '\0';
-  return ret;
-}
-
-char *
-do_part_get_gpt_type (const char *device, int partnum)
-{
-  return sgdisk_info_extract_field (device, partnum,
-"Partition GUID code", extract_uuid);
-}
-
-char *
-do_part_get_gpt_guid (const char *device, int partnum)

[Libguestfs] [PATCH v7 23/29] daemon: Reimplement ‘md_detail’ API in OCaml.

[Richard W.M. Jones]

---
 daemon/md.c   | 66 ---
 daemon/md.ml  | 37 ++
 daemon/md.mli |  1 +
 generator/actions_core.ml |  1 +
 generator/daemon.ml   | 27 +++
 5 files changed, 66 insertions(+), 66 deletions(-)

diff --git a/daemon/md.c b/daemon/md.c
index 5c9ecd136..549dd89fa 100644
--- a/daemon/md.c
+++ b/daemon/md.c
@@ -218,72 +218,6 @@ do_md_create (const char *name, char *const *devices,
 #pragma GCC diagnostic pop
 #endif
 
-char **
-do_md_detail (const char *md)
-{
-  size_t i;
-  int r;
-
-  CLEANUP_FREE char *out = NULL, *err = NULL;
-  CLEANUP_FREE_STRING_LIST char **lines = NULL;
-
-  CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret);
-
-  const char *mdadm[] = { str_mdadm, "-D", "--export", md, NULL };
-  r = commandv (, , mdadm);
-  if (r == -1) {
-reply_with_error ("%s", err);
-return NULL;
-  }
-
-  /* Split the command output into lines */
-  lines = split_lines (out);
-  if (lines == NULL)
-return NULL;
-
-  /* Parse the output of mdadm -D --export:
-   * MD_LEVEL=raid1
-   * MD_DEVICES=2
-   * MD_METADATA=1.0
-   * MD_UUID=cfa81b59:b6cfbd53:3f02085b:58f4a2e1
-   * MD_NAME=localhost.localdomain:0
-   */
-  for (i = 0; lines[i] != NULL; ++i) {
-char *line = lines[i];
-
-/* Skip blank lines (shouldn't happen) */
-if (line[0] == '\0') continue;
-
-/* Split the line in 2 at the equals sign */
-char *eq = strchr (line, '=');
-if (eq) {
-  *eq = '\0'; eq++;
-
-  /* Remove the MD_ prefix from the key and translate the remainder to 
lower
-   * case */
-  if (STRPREFIX (line, "MD_")) {
-line += 3;
-for (char *j = line; *j != '\0'; j++) {
-  *j = c_tolower (*j);
-}
-  }
-
-  /* Add the key/value pair to the output */
-  if (add_string (, line) == -1 ||
-  add_string (, eq) == -1) return NULL;
-} else {
-  /* Ignore lines with no equals sign (shouldn't happen). Log to stderr so
-   * it will show up in LIBGUESTFS_DEBUG. */
-  fprintf (stderr, "md-detail: unexpected mdadm output ignored: %s", line);
-}
-  }
-
-  if (end_stringsbuf () == -1)
-return NULL;
-
-  return take_stringsbuf ();
-}
-
 int
 do_md_stop (const char *md)
 {
diff --git a/daemon/md.ml b/daemon/md.ml
index caf87cf8f..ba045b5f7 100644
--- a/daemon/md.ml
+++ b/daemon/md.ml
@@ -46,3 +46,40 @@ let list_md_devices () =
 
   (* Return the list sorted. *)
   sort_device_names devs
+
+let md_detail md =
+  let out = command "mdadm" ["-D"; "--export"; md] in
+
+  (* Split the command output into lines. *)
+  let out = String.trim out in
+  let lines = String.nsplit "\n" out in
+
+  (* Parse the output of mdadm -D --export:
+   * MD_LEVEL=raid1
+   * MD_DEVICES=2
+   * MD_METADATA=1.0
+   * MD_UUID=cfa81b59:b6cfbd53:3f02085b:58f4a2e1
+   * MD_NAME=localhost.localdomain:0
+   *)
+  filter_map (
+fun line ->
+  (* Skip blank lines (shouldn't happen). *)
+  if line = "" then None
+  else (
+(* Split the line at the equals sign. *)
+let key, value = String.split "=" line in
+
+(* Remove the MD_ prefix from the key and translate the
+ * remainder to lower case.
+ *)
+let key =
+  if String.is_prefix key "MD_" then
+String.sub key 3 (String.length key - 3)
+  else
+key in
+let key = String.lowercase_ascii key in
+
+(* Add the key/value pair to the output. *)
+Some (key, value)
+  )
+  ) lines
diff --git a/daemon/md.mli b/daemon/md.mli
index 56b6ea65e..8f0c79a7f 100644
--- a/daemon/md.mli
+++ b/daemon/md.mli
@@ -17,3 +17,4 @@
  *)
 
 val list_md_devices : unit -> string list
+val md_detail : string -> (string * string) list
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index db1411ff8..070a1c641 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -6606,6 +6606,7 @@ List all Linux md devices." };
   { defaults with
 name = "md_detail"; added = (1, 15, 6);
 style = RHashtable (RPlainString, RPlainString, "info"), [String (Device, 
"md")], [];
+impl = OCaml "Md.md_detail";
 optional = Some "mdadm";
 shortdesc = "obtain metadata for an MD device";
 longdesc = "\
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 66b625388..f20c87bea 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -597,6 +597,30 @@ return_string_mountable (value retv)
   }
 }
 
+/* Implement RHashtable (RPlainString, RPlainString, _). */
+static char **
+return_hashtable_string_string (value retv)
+{
+  CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret);
+  value v, sv;
+
+  while (retv != Val_int (0)) {
+v = Field (retv, 0);/* (string, string) */
+sv = Field (v, 0);  /* string */
+if (add_string (, String_val (sv)) == -1)
+  return NULL;
+sv = Field (v, 1);  /* string */
+if (add_string (, 

[Libguestfs] [PATCH v7 22/29] daemon: Reimplement ‘nr_devices’ API in OCaml.

[Richard W.M. Jones]

---
 daemon/devsparts.c| 15 ---
 daemon/devsparts.ml   |  2 ++
 daemon/devsparts.mli  |  2 ++
 generator/actions_core.ml |  1 +
 4 files changed, 5 insertions(+), 15 deletions(-)

diff --git a/daemon/devsparts.c b/daemon/devsparts.c
index 1aacb8e16..12e779326 100644
--- a/daemon/devsparts.c
+++ b/daemon/devsparts.c
@@ -54,21 +54,6 @@ do_device_index (const char *device)
   return ret;
 }
 
-int
-do_nr_devices (void)
-{
-  size_t i;
-  CLEANUP_FREE_STRING_LIST char **devices = do_list_devices ();
-
-  if (devices == NULL)
-return -1;
-
-  for (i = 0; devices[i] != NULL; ++i)
-;
-
-  return (int) i;
-}
-
 #define GUESTFSDIR "/dev/disk/guestfs"
 
 char **
diff --git a/daemon/devsparts.ml b/daemon/devsparts.ml
index e97ff1267..273612516 100644
--- a/daemon/devsparts.ml
+++ b/daemon/devsparts.ml
@@ -85,6 +85,8 @@ and add_partitions dev =
   let parts = List.filter (fun part -> String.is_prefix part dev) parts in
   List.map (fun part -> "/dev/" ^ part) parts
 
+let nr_devices () = List.length (list_devices ())
+
 let part_to_dev part =
   let dev, part = split_device_partition part in
   if part = 0 then
diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli
index 4dfaa86e6..8be47e752 100644
--- a/daemon/devsparts.mli
+++ b/daemon/devsparts.mli
@@ -19,6 +19,8 @@
 val list_devices : unit -> string list
 val list_partitions : unit -> string list
 
+val nr_devices : unit -> int
+
 val part_to_dev : string -> string
 val part_to_partnum : string -> int
 
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 0a967f76d..db1411ff8 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -7432,6 +7432,7 @@ See also C, 
C." };
 
   { defaults with
 name = "nr_devices"; added = (1, 19, 15);
+impl = OCaml "Devsparts.nr_devices";
 style = RInt "nrdisks", [], [];
 tests = [
   InitEmpty, Always, TestResult (
-- 
2.13.0

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v7 10/13] utils: Split out structs cleanups and printing into common/structs.

[Richard W.M. Jones]

On Mon, Jun 19, 2017 at 05:38:53PM +0200, Pino Toscano wrote:
> On Monday, 19 June 2017 15:31:26 CEST Richard W.M. Jones wrote:
> > These won't be used by the daemon, so interferes with us using
> > common/utils in the daemon, so they are moved to a different library.
> > ---
> 
> I checked it again, and the daemon does use structs cleanups:
> 
> $ cat generator/main.ml
> [...]
>   output_to "daemon/structs-cleanups.c"
> Daemon.generate_daemon_structs_cleanups_c;
>   output_to "daemon/structs-cleanups.h"
> Daemon.generate_daemon_structs_cleanups_h;

Those are different from common/structs/structs-cleanups.[ch] though
(hence why they use different generator functions to generate them).

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
Fedora Windows cross-compiler. Compile Windows programs, test, and
build Windows installers. Over 100 libraries supported.
http://fedoraproject.org/wiki/MinGW

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 19/29] daemon: Reimplement ‘list_filesystems’ API in the daemon, in OCaml.

[Richard W.M. Jones]

Move the list_filesystems API into the daemon, reimplementing it in
OCaml.  Since this API makes many other API calls, it runs a lot
faster in the daemon.
---
 daemon/Makefile.am|   2 +
 daemon/ldm.ml |   3 +
 daemon/ldm.mli|   2 +
 daemon/listfs.ml  | 156 +
 daemon/listfs.mli |  19 
 daemon/lvm.ml |   3 +
 daemon/lvm.mli|   2 +
 docs/C_SOURCE_FILES   |   1 -
 generator/actions_core.ml |  75 +++---
 generator/daemon.ml   |  59 ++-
 generator/proc_nr.ml  |   1 +
 lib/MAX_PROC_NR   |   2 +-
 lib/Makefile.am   |   1 -
 lib/listfs.c  | 246 --
 14 files changed, 285 insertions(+), 287 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 459b5d7cc..fbe4734cf 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -265,6 +265,7 @@ SOURCES_MLI = \
is.mli \
ldm.mli \
link.mli \
+   listfs.mli \
lvm.mli \
md.mli \
mount.mli \
@@ -292,6 +293,7 @@ SOURCES_ML = \
md.ml \
mount.ml \
parted.ml \
+   listfs.ml \
realpath.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/ldm.ml b/daemon/ldm.ml
index dc7b36f9c..19cd03e83 100644
--- a/daemon/ldm.ml
+++ b/daemon/ldm.ml
@@ -20,6 +20,9 @@ open Std_utils
 
 open Utils
 
+external available : unit -> bool =
+  "guestfs_int_daemon_optgroup_lvm2_available" "noalloc"
+
 (* All device mapper devices are called /dev/mapper/ldm_vol_*.  XXX We
  * could tighten this up in future if ldmtool had a way to read these
  * names back after they have been created.
diff --git a/daemon/ldm.mli b/daemon/ldm.mli
index 789abb0b3..e6edfabd8 100644
--- a/daemon/ldm.mli
+++ b/daemon/ldm.mli
@@ -16,5 +16,7 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
+val available : unit -> bool
+
 val list_ldm_volumes : unit -> string list
 val list_ldm_partitions : unit -> string list
diff --git a/daemon/listfs.ml b/daemon/listfs.ml
new file mode 100644
index 0..df5404f81
--- /dev/null
+++ b/daemon/listfs.ml
@@ -0,0 +1,156 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Printf
+
+open Std_utils
+
+let rec list_filesystems () =
+  let has_lvm2 = Lvm.available () in
+  let has_ldm = Ldm.available () in
+
+  let devices = Devsparts.list_devices () in
+  let partitions = Devsparts.list_partitions () in
+  let mds = Md.list_md_devices () in
+
+  (* Look to see if any devices directly contain filesystems
+   * (RHBZ#590167).  However vfs-type will fail to tell us anything
+   * useful about devices which just contain partitions, so we also
+   * get the list of partitions and exclude the corresponding devices
+   * by using part-to-dev.
+   *)
+  let devices = List.fold_left (
+fun devices part ->
+  let d = Devsparts.part_to_dev part in
+  List.filter ((<>) d) devices
+  ) devices partitions in
+
+  (* Use vfs-type to check for filesystems on devices. *)
+  let ret = filter_map check_with_vfs_type devices in
+
+  (* Use vfs-type to check for filesystems on partitions, but
+   * ignore MBR partition type 42 used by LDM.
+   *)
+  let ret =
+ret @
+  filter_map (
+fun part ->
+  if not has_ldm || not (is_mbr_partition_type_42 part) then
+check_with_vfs_type part
+  else
+None(* ignore type 42 *)
+  ) partitions in
+
+  (* Use vfs-type to check for filesystems on md devices. *)
+  let ret = ret @ filter_map check_with_vfs_type mds in
+
+  (* LVM. *)
+  let ret =
+if has_lvm2 then (
+  let lvs = Lvm.lvs () in
+  (* Use vfs-type to check for filesystems on LVs. *)
+  ret @ filter_map check_with_vfs_type lvs
+)
+else ret in
+
+  (* LDM. *)
+  let ret =
+if has_ldm then (
+  let ldmvols = Ldm.list_ldm_volumes () in
+  let ldmparts = Ldm.list_ldm_partitions () in
+  (* Use vfs-type to check for filesystems on Windows dynamic disks. *)
+  ret @
+filter_map check_with_vfs_type ldmvols @
+filter_map check_with_vfs_type ldmparts
+)
+else ret in
+
+  List.flatten ret

[Libguestfs] [PATCH v7 21/29] daemon: Reimplement ‘findfs_uuid’ and ‘findfs_label’ APIs in OCaml.

[Richard W.M. Jones]

This also reimplements the lv_canonical function in OCaml.  We cannot
call the original C function because it calls reply_with_perror which
would break the OCaml bindings.
---
 daemon/Makefile.am|  3 +-
 daemon/findfs.c   | 94 ---
 daemon/findfs.ml  | 56 
 daemon/findfs.mli | 20 ++
 daemon/lvm.ml | 28 ++
 daemon/lvm.mli| 10 +
 docs/C_SOURCE_FILES   |  1 -
 generator/actions_core.ml |  2 +
 8 files changed, 118 insertions(+), 96 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index fbe4734cf..087f67258 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -108,7 +108,6 @@ guestfsd_SOURCES = \
ext2.c \
fallocate.c \
file.c \
-   findfs.c \
fill.c \
find.c \
format.c \
@@ -262,6 +261,7 @@ SOURCES_MLI = \
devsparts.mli \
file.mli \
filearch.mli \
+   findfs.mli \
is.mli \
ldm.mli \
link.mli \
@@ -290,6 +290,7 @@ SOURCES_ML = \
ldm.ml \
link.ml \
lvm.ml \
+   findfs.ml \
md.ml \
mount.ml \
parted.ml \
diff --git a/daemon/findfs.c b/daemon/findfs.c
deleted file mode 100644
index f44137038..0
--- a/daemon/findfs.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/* libguestfs - the guestfsd daemon
- * Copyright (C) 2010 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 
-
-#include 
-#include 
-#include 
-#include 
-
-#include "daemon.h"
-#include "actions.h"
-
-GUESTFSD_EXT_CMD(str_findfs, findfs);
-
-static char *
-findfs (const char *tag, const char *label_or_uuid)
-{
-  char *out;
-  CLEANUP_FREE char *err = NULL;
-  CLEANUP_FREE char *arg = NULL;
-  int r;
-  size_t len;
-
-  /* Kill the cache file, forcing blkid to reread values from the
-   * original filesystems.  In blkid there is a '-p' option which is
-   * supposed to do this, but (a) it doesn't work and (b) that option
-   * is not supported in RHEL 5.
-   */
-  unlink ("/etc/blkid/blkid.tab");
-  unlink ("/run/blkid/blkid.tab");
-
-  if (asprintf (, "%s=%s", tag, label_or_uuid) == -1) {
-reply_with_perror ("asprintf");
-return NULL;
-  }
-
-  r = command (, , str_findfs, arg, NULL);
-  if (r == -1) {
-reply_with_error ("%s", err);
-free (out);
-return NULL;
-  }
-
-  /* Trim trailing \n if present. */
-  len = strlen (out);
-  if (len > 0 && out[len-1] == '\n')
-out[len-1] = '\0';
-
-  if (STRPREFIX (out, "/dev/mapper/") || STRPREFIX (out, "/dev/dm-")) {
-char *canonical;
-r = lv_canonical (out, );
-if (r == -1) {
-  free (out);
-  return NULL;
-}
-if (r == 1) {
-  free (out);
-  out = canonical;
-}
-/* Ignore the case where r == 0.  /dev/mapper does not correspond
- * to an LV, so the best we can do is just return it as-is.
- */
-  }
-
-  return out;   /* caller frees */
-}
-
-char *
-do_findfs_uuid (const char *uuid)
-{
-  return findfs ("UUID", uuid);
-}
-
-char *
-do_findfs_label (const char *label)
-{
-  return findfs ("LABEL", label);
-}
diff --git a/daemon/findfs.ml b/daemon/findfs.ml
new file mode 100644
index 0..8acb72928
--- /dev/null
+++ b/daemon/findfs.ml
@@ -0,0 +1,56 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Printf
+open Unix
+
+open Std_utils
+
+open Utils
+
+let rec findfs_uuid uuid =
+  findfs "UUID" uuid
+and findfs_label label =
+  findfs "LABEL"label

[Libguestfs] [PATCH v7 17/29] daemon: Enable RStruct, RStructList for OCaml-implemented APIs.

[Richard W.M. Jones]

---
 .gitignore  |   1 +
 daemon/Makefile.am  |   1 +
 generator/OCaml.ml  |   8 
 generator/OCaml.mli |   1 +
 generator/daemon.ml | 116 +++-
 generator/main.ml   |   2 +
 6 files changed, 127 insertions(+), 2 deletions(-)

diff --git a/.gitignore b/.gitignore
index 29596594a..8aea2cdb4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -180,6 +180,7 @@ Makefile.in
 /daemon/stamp-guestfsd.pod
 /daemon/structs-cleanups.c
 /daemon/structs-cleanups.h
+/daemon/structs.ml
 /daemon/stubs-?.c
 /daemon/stubs.h
 /daemon/types.ml
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 6ff71bb1f..4a818a7a9 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -275,6 +275,7 @@ SOURCES_MLI = \
 SOURCES_ML = \
types.ml \
utils.ml \
+   structs.ml \
sysroot.ml \
mountable.ml \
chroot.ml \
diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 53f105198..853b41bb3 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -888,3 +888,11 @@ and generate_ocaml_function_type ?(extra_unit = false) 
(ret, args, optargs) =
| RStructList (_, typ) -> pr "%s array" typ
| RHashtable _ -> pr "(string * string) list"
   )
+
+(* Structure definitions (again).  These are used in the daemon,
+ * but it's convenient to generate them here.
+ *)
+and generate_ocaml_daemon_structs () =
+  generate_header OCamlStyle GPLv2plus;
+
+  generate_ocaml_structure_decls ()
diff --git a/generator/OCaml.mli b/generator/OCaml.mli
index 4e79a5b5a..a36fbe02f 100644
--- a/generator/OCaml.mli
+++ b/generator/OCaml.mli
@@ -20,3 +20,4 @@ val generate_ocaml_c : unit -> unit
 val generate_ocaml_c_errnos : unit -> unit
 val generate_ocaml_ml : unit -> unit
 val generate_ocaml_mli : unit -> unit
+val generate_ocaml_daemon_structs : unit -> unit
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 1d7461f8c..8cac5ccb1 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -575,6 +575,110 @@ return_string_list (value retv)
 
 ";
 
+  (* Implement code for returning structs and struct lists. *)
+  let emit_return_struct typ =
+let struc = Structs.lookup_struct typ in
+pr "/* Implement RStruct (%S, _). */\n" typ;
+pr "static guestfs_int_%s *\n" typ;
+pr "return_%s (value retv)\n" typ;
+pr "{\n";
+pr "  guestfs_int_%s *ret;\n" typ;
+pr "  value v;\n";
+pr "\n";
+pr "  ret = malloc (sizeof (*ret));\n";
+pr "  if (ret == NULL) {\n";
+pr "reply_with_perror (\"malloc\");\n";
+pr "return NULL;\n";
+pr "  }\n";
+pr "\n";
+iteri (
+  fun i ->
+pr "  v = Field (retv, %d);\n" i;
+function
+| n, (FString|FUUID) ->
+   pr "  ret->%s = strdup (String_val (v));\n" n;
+   pr "  if (ret->%s == NULL) return NULL;\n" n
+| n, FBuffer ->
+   pr "  ret->%s_len = caml_string_length (v);\n" n;
+   pr "  ret->%s = strdup (String_val (v));\n" n;
+   pr "  if (ret->%s == NULL) return NULL;\n" n
+| n, (FBytes|FInt64|FUInt64) ->
+   pr "  ret->%s = Int64_val (v);\n" n
+| n, (FInt32|FUInt32) ->
+   pr "  ret->%s = Int32_val (v);\n" n
+| n, FOptPercent ->
+   pr "  if (v == Val_int (0)) /* None */\n";
+   pr "ret->%s = -1;\n" n;
+   pr "  else {\n";
+   pr "v = Field (v, 0);\n";
+   pr "ret->%s = Double_val (v);\n" n;
+   pr "  }\n"
+| n, FChar ->
+   pr "  ret->%s = Int_val (v);\n" n
+) struc.s_cols;
+pr "\n";
+pr "  return ret;\n";
+pr "}\n";
+pr "\n"
+
+  and emit_return_struct_list typ =
+pr "/* Implement RStructList (%S, _). */\n" typ;
+pr "static guestfs_int_%s_list *\n" typ;
+pr "return_%s_list (value retv)\n" typ;
+pr "{\n";
+pr "  guestfs_int_%s_list *ret;\n" typ;
+pr "  guestfs_int_%s *r;\n" typ;
+pr "  size_t i, len;\n";
+pr "  value v, rv;\n";
+pr "\n";
+pr "  /* Count the number of elements in the list. */\n";
+pr "  rv = retv;\n";
+pr "  len = 0;\n";
+pr "  while (rv != Val_int (0)) {\n";
+pr "len++;\n";
+pr "rv = Field (rv, 1);\n";
+pr "  }\n";
+pr "\n";
+pr "  ret = malloc (sizeof *ret);\n";
+pr "  if (ret == NULL) {\n";
+pr "reply_with_perror (\"malloc\");\n";
+pr "return NULL;\n";
+pr "  }\n";
+pr "  ret->guestfs_int_%s_list_len = len;\n" typ;
+pr "  ret->guestfs_int_%s_list_val =\n" typ;
+pr "calloc (len, sizeof (guestfs_int_%s));\n" typ;
+pr "  if (ret->guestfs_int_%s_list_val == NULL) {\n" typ;
+pr "reply_with_perror (\"calloc\");\n";
+pr "free (ret);\n";
+pr "return NULL;\n";
+pr "  }\n";
+pr "\n";
+pr "  rv = retv;\n";
+pr "  for (i = 0; i < len; ++i) {\n";
+pr "v = Field (rv, 0);\n";
+pr "r = return_%s (v);\n" typ;
+pr "if (r == NULL)\n";
+pr "  return NULL; /* XXX leaks 

[Libguestfs] [PATCH v7 25/29] daemon: Implement command flag CommandFlagFoldStdoutOnStderr.

[Richard W.M. Jones]

Used to handle broken commands like parted, sgdisk which print errors
on stdout.
---
 daemon/utils.ml  | 19 ++-
 daemon/utils.mli | 11 +--
 2 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/daemon/utils.ml b/daemon/utils.ml
index 48f6b9c5c..808e575fd 100644
--- a/daemon/utils.ml
+++ b/daemon/utils.ml
@@ -25,9 +25,15 @@ let prog_exists prog =
   try ignore (which prog); true
   with Executable_not_found _ -> false
 
-let commandr prog args =
+type command_flag =
+  CommandFlagFoldStdoutOnStderr
+
+let commandr ?(flags = []) prog args =
+  let fold_stdout_on_stderr = List.mem CommandFlagFoldStdoutOnStderr flags in
+
   if verbose () then
-eprintf "command: %s %s\n%!"
+eprintf "command:%s %s %s\n%!"
+(if fold_stdout_on_stderr then " fold-stdout-on-stderr" else "")
 prog (String.concat " " args);
 
   let argv = Array.of_list (prog :: args) in
@@ -43,7 +49,10 @@ let commandr prog args =
 (* Child process. *)
 dup2 stdin_fd stdin;
 close stdin_fd;
-dup2 stdout_fd stdout;
+if not fold_stdout_on_stderr then
+  dup2 stdout_fd stdout
+else
+  dup2 stderr_fd stdout;
 close stdout_fd;
 dup2 stderr_fd stderr;
 close stderr_fd;
@@ -91,8 +100,8 @@ let commandr prog args =
 
   (r, stdout, stderr)
 
-let command prog args =
-  let r, stdout, stderr = commandr prog args in
+let command ?flags prog args =
+  let r, stdout, stderr = commandr ?flags prog args in
   if r <> 0 then
 failwithf "%s exited with status %d: %s" prog r stderr;
   stdout
diff --git a/daemon/utils.mli b/daemon/utils.mli
index a1f956be3..d3c8bdf4d 100644
--- a/daemon/utils.mli
+++ b/daemon/utils.mli
@@ -60,7 +60,14 @@ val proc_unmangle_path : string -> string
 (** Reverse kernel path escaping done in fs/seq_file.c:mangle_path.
 This is inconsistently used for /proc fields. *)
 
-val command : string -> string list -> string
+type command_flag =
+  CommandFlagFoldStdoutOnStderr
+(** For broken external commands that send error messages to stdout
+(hello, parted) but that don't have any useful stdout information,
+use this flag to capture the error messages in the [stderr]
+buffer.  Nothing will be captured on stdout if you use this flag. *)
+
+val command : ?flags:command_flag list -> string -> string list -> string
 (** Run an external command without using the shell, and collect
 stdout and stderr separately.  Returns stdout if the command
 runs successfully.
@@ -68,7 +75,7 @@ val command : string -> string list -> string
 On failure of the command, this throws an exception containing
 the stderr from the command. *)
 
-val commandr : string -> string list -> (int * string * string)
+val commandr : ?flags:command_flag list -> string -> string list -> (int * 
string * string)
 (** Run an external command without using the shell, and collect
 stdout and stderr separately.
 
-- 
2.13.0

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 16/29] daemon: Generate OCaml wrappers for optgroup_*_available functions.

[Richard W.M. Jones]

It is sometimes useful to be able to call these from OCaml code.
---
 generator/daemon.ml | 23 ++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/generator/daemon.ml b/generator/daemon.ml
index fd01e5d8a..1d7461f8c 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -976,6 +976,10 @@ let generate_daemon_optgroups_c () =
   generate_header CStyle GPLv2plus;
 
   pr "#include \n";
+  pr "#include \n";
+  pr "#include \n";
+  pr "\n";
+  pr "#include \n";
   pr "\n";
   pr "#include \"daemon.h\"\n";
   pr "#include \"optgroups.h\"\n";
@@ -999,7 +1003,24 @@ let generate_daemon_optgroups_c () =
 pr "  { \"%s\", optgroup_%s_available },\n" group group
   ) optgroups_names_all;
   pr "  { NULL, NULL }\n";
-  pr "};\n"
+  pr "};\n";
+  pr "\n";
+  pr "/* Wrappers so these functions can be called from OCaml code. */\n";
+  List.iter (
+fun group ->
+  if not (List.mem group optgroups_retired) then (
+pr "extern value guestfs_int_daemon_optgroup_%s_available (value);\n"
+   group;
+pr "\n";
+pr "/* NB: This is a \"noalloc\" call. */\n";
+pr "value\n";
+pr "guestfs_int_daemon_optgroup_%s_available (value unitv)\n" group;
+pr "{\n";
+pr "  return Val_bool (optgroup_%s_available ());\n" group;
+pr "}\n";
+pr "\n"
+  )
+  ) optgroups_names_all
 
 let generate_daemon_optgroups_h () =
   generate_header CStyle GPLv2plus;
-- 
2.13.0

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 10/29] daemon: Reimplement ‘part_get_mbr_id’ API in OCaml.

[Richard W.M. Jones]

---
 daemon/Makefile.am|  2 ++
 daemon/parted.c   | 42 
 daemon/parted.ml  | 55 +++
 daemon/parted.mli | 19 
 generator/actions_core.ml |  1 +
 5 files changed, 77 insertions(+), 42 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index d5703b595..1035d7ea2 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -264,6 +264,7 @@ SOURCES_MLI = \
link.mli \
mount.mli \
mountable.mli \
+   parted.mli \
utils.mli
 
 SOURCES_ML = \
@@ -278,6 +279,7 @@ SOURCES_ML = \
is.ml \
link.ml \
mount.ml \
+   parted.ml \
callbacks.ml \
daemon.ml
 
diff --git a/daemon/parted.c b/daemon/parted.c
index 03e83cb32..a1e5c81cf 100644
--- a/daemon/parted.c
+++ b/daemon/parted.c
@@ -521,48 +521,6 @@ test_sfdisk_has_part_type (void)
   return tested;
 }
 
-/* Currently we use sfdisk for getting and setting the ID byte.  In
- * future, extend parted to provide this functionality.  As a result
- * of using sfdisk, this won't work for non-MBR-style partitions, but
- * that limitation is noted in the documentation and we can extend it
- * later without breaking the ABI.
- */
-int
-do_part_get_mbr_id (const char *device, int partnum)
-{
-  if (partnum <= 0) {
-reply_with_error ("partition number must be >= 1");
-return -1;
-  }
-
-  const char *param = test_sfdisk_has_part_type () ? "--part-type" : 
"--print-id";
-
-  char partnum_str[16];
-  snprintf (partnum_str, sizeof partnum_str, "%d", partnum);
-
-  CLEANUP_FREE char *out = NULL, *err = NULL;
-  int r;
-
-  udev_settle ();
-
-  r = command (, , str_sfdisk, param, device, partnum_str, NULL);
-  if (r == -1) {
-reply_with_error ("sfdisk %s: %s", param, err);
-return -1;
-  }
-
-  udev_settle ();
-
-  /* It's printed in hex ... */
-  unsigned id;
-  if (sscanf (out, "%x", ) != 1) {
-reply_with_error ("sfdisk --print-id: cannot parse output: %s", out);
-return -1;
-  }
-
-  return id;
-}
-
 int
 do_part_set_mbr_id (const char *device, int partnum, int idbyte)
 {
diff --git a/daemon/parted.ml b/daemon/parted.ml
new file mode 100644
index 0..6be41cf66
--- /dev/null
+++ b/daemon/parted.ml
@@ -0,0 +1,55 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Scanf
+
+open Std_utils
+
+open Utils
+
+(* Test if [sfdisk] is recent enough to have [--part-type], to be used
+ * instead of [--print-id] and [--change-id].
+ *)
+let test_sfdisk_has_part_type = lazy (
+  let out = command "sfdisk" ["--help"] in
+  String.find out "--part-type" >= 0
+)
+
+(* Currently we use sfdisk for getting and setting the ID byte.  In
+ * future, extend parted to provide this functionality.  As a result
+ * of using sfdisk, this won't work for non-MBR-style partitions, but
+ * that limitation is noted in the documentation and we can extend it
+ * later without breaking the ABI.
+ *)
+let part_get_mbr_id device partnum =
+  if partnum <= 0 then
+failwith "partition number must be >= 1";
+
+  let param =
+if Lazy.force test_sfdisk_has_part_type then
+  "--part-type"
+else
+  "--print-id" in
+
+  udev_settle ();
+  let out =
+command "sfdisk" [param; device; string_of_int partnum] in
+  udev_settle ();
+
+  (* It's printed in hex, possibly with a leading space. *)
+  sscanf out " %x" identity
diff --git a/daemon/parted.mli b/daemon/parted.mli
new file mode 100644
index 0..33eb6d30d
--- /dev/null
+++ b/daemon/parted.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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
+ 

[Libguestfs] [PATCH v7 15/29] daemon: Reimplement ‘list_md_devices’ API in OCaml.

[Richard W.M. Jones]

---
 daemon/Makefile.am|   2 +
 daemon/md.c   | 125 --
 daemon/md.ml  |  48 ++
 daemon/md.mli |  19 +++
 generator/actions_core.ml |   1 +
 5 files changed, 101 insertions(+), 94 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index abd45b744..6ff71bb1f 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -265,6 +265,7 @@ SOURCES_MLI = \
ldm.mli \
link.mli \
lvm.mli \
+   md.mli \
mount.mli \
mountable.mli \
parted.mli \
@@ -285,6 +286,7 @@ SOURCES_ML = \
ldm.ml \
link.ml \
lvm.ml \
+   md.ml \
mount.ml \
parted.ml \
realpath.ml \
diff --git a/daemon/md.c b/daemon/md.c
index 64d98fae5..5c9ecd136 100644
--- a/daemon/md.c
+++ b/daemon/md.c
@@ -24,7 +24,6 @@
 #include 
 #include 
 #include 
-#include 
 
 #ifdef HAVE_LINUX_RAID_MD_U_H
 #include 
@@ -32,6 +31,8 @@
 #include 
 #endif /* HAVE_LINUX_RAID_MD_U_H */
 
+#include 
+
 #include "daemon.h"
 #include "actions.h"
 #include "optgroups.h"
@@ -45,6 +46,35 @@ optgroup_mdadm_available (void)
   return prog_exists (str_mdadm);
 }
 
+/* Check if 'dev' is a real RAID device, because in the case where md
+ * is linked directly into the kernel (not a module), /dev/md0 is
+ * sometimes created.  This is called from OCaml function
+ * Md.list_md_devices.
+ */
+extern value guestfs_int_daemon_is_raid_device (value devicev);
+
+/* NB: This is a "noalloc" call. */
+value
+guestfs_int_daemon_is_raid_device (value devv)
+{
+  const char *dev = String_val (devv);
+  int ret = 1;
+
+#if defined(HAVE_LINUX_RAID_MD_U_H) && defined(GET_ARRAY_INFO)
+  int fd;
+  mdu_array_info_t array;
+
+  fd = open (dev, O_RDONLY);
+  if (fd >= 0) {
+if (ioctl (fd, GET_ARRAY_INFO, ) == -1 && errno == ENODEV)
+  ret = 0;
+close (fd);
+  }
+#endif
+
+  return Val_bool (ret);
+}
+
 static size_t
 count_bits (uint64_t bitmap)
 {
@@ -188,99 +218,6 @@ do_md_create (const char *name, char *const *devices,
 #pragma GCC diagnostic pop
 #endif
 
-static int
-glob_errfunc (const char *epath, int eerrno)
-{
-  fprintf (stderr, "glob: failure reading %s: %s\n", epath, strerror (eerrno));
-  return 1;
-}
-
-/* Check if 'dev' is a real RAID device, because in the case where md
- * is linked directly into the kernel (not a module), /dev/md0 is
- * sometimes created.
- */
-static int
-is_raid_device (const char *dev)
-{
-  int ret = 1;
-
-#if defined(HAVE_LINUX_RAID_MD_U_H) && defined(GET_ARRAY_INFO)
-  int fd;
-  mdu_array_info_t array;
-
-  fd = open (dev, O_RDONLY);
-  if (fd >= 0) {
-if (ioctl (fd, GET_ARRAY_INFO, ) == -1 && errno == ENODEV)
-  ret = 0;
-close (fd);
-  }
-#endif
-
-  return ret;
-}
-
-char **
-do_list_md_devices (void)
-{
-  CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret);
-  glob_t mds;
-
-  memset (, 0, sizeof mds);
-
-#define PREFIX "/sys/block/md"
-#define SUFFIX "/md"
-
-  /* Look for directories under /sys/block matching md[0-9]*
-   * As an additional check, we also make sure they have a md subdirectory.
-   */
-  const int err = glob (PREFIX "[0-9]*" SUFFIX, GLOB_ERR, glob_errfunc, );
-  if (err == GLOB_NOSPACE) {
-reply_with_error ("glob: returned GLOB_NOSPACE: "
-  "rerun with LIBGUESTFS_DEBUG=1");
-goto error;
-  } else if (err == GLOB_ABORTED) {
-reply_with_error ("glob: returned GLOB_ABORTED: "
-  "rerun with LIBGUESTFS_DEBUG=1");
-goto error;
-  }
-
-  for (size_t i = 0; i < mds.gl_pathc; i++) {
-size_t len;
-char *dev, *n;
-
-len = strlen (mds.gl_pathv[i]) - strlen (PREFIX) - strlen (SUFFIX);
-
-#define DEV "/dev/md"
-dev = malloc (strlen (DEV) + len + 1);
-if (NULL == dev) {
-  reply_with_perror ("malloc");
-  goto error;
-}
-
-n = dev;
-n = mempcpy (n, DEV, strlen (DEV));
-n = mempcpy (n, _pathv[i][strlen (PREFIX)], len);
-*n = '\0';
-
-if (!is_raid_device (dev)) {
-  free (dev);
-  continue;
-}
-
-if (add_string_nodup (, dev) == -1) goto error;
-  }
-
-  if (end_stringsbuf () == -1) goto error;
-  globfree ();
-
-  return take_stringsbuf ();
-
- error:
-  globfree ();
-
-  return NULL;
-}
-
 char **
 do_md_detail (const char *md)
 {
diff --git a/daemon/md.ml b/daemon/md.ml
new file mode 100644
index 0..caf87cf8f
--- /dev/null
+++ b/daemon/md.ml
@@ -0,0 +1,48 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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
+ * 

[Libguestfs] [PATCH v7 13/29] daemon: Reimplement ‘list_ldm_(volumes|partitions)’ APIs in OCaml.

[Richard W.M. Jones]

---
 daemon/Makefile.am|  2 ++
 daemon/ldm.c  | 82 ---
 daemon/ldm.ml | 52 ++
 daemon/ldm.mli| 20 
 generator/actions_core.ml |  2 ++
 5 files changed, 76 insertions(+), 82 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index e86435c4c..5d79dc830 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -262,6 +262,7 @@ SOURCES_MLI = \
file.mli \
filearch.mli \
is.mli \
+   ldm.mli \
link.mli \
mount.mli \
mountable.mli \
@@ -280,6 +281,7 @@ SOURCES_ML = \
file.ml \
filearch.ml \
is.ml \
+   ldm.ml \
link.ml \
mount.ml \
parted.ml \
diff --git a/daemon/ldm.c b/daemon/ldm.c
index 75418e8d3..5106e65f9 100644
--- a/daemon/ldm.c
+++ b/daemon/ldm.c
@@ -23,7 +23,6 @@
 #include 
 #include 
 #include 
-#include 
 #include 
 
 #include 
@@ -47,87 +46,6 @@ optgroup_ldm_available (void)
   return prog_exists (str_ldmtool);
 }
 
-static int
-glob_errfunc (const char *epath, int eerrno)
-{
-  fprintf (stderr, "glob: failure reading %s: %s\n", epath, strerror (eerrno));
-  return 1;
-}
-
-static char **
-get_devices (const char *pattern)
-{
-  CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret);
-  glob_t devs;
-  int err;
-  size_t i;
-
-  memset (, 0, sizeof devs);
-
-  err = glob (pattern, GLOB_ERR, glob_errfunc, );
-  if (err == GLOB_NOSPACE) {
-reply_with_error ("glob: returned GLOB_NOSPACE: "
-  "rerun with LIBGUESTFS_DEBUG=1");
-goto error;
-  } else if (err == GLOB_ABORTED) {
-reply_with_error ("glob: returned GLOB_ABORTED: "
-  "rerun with LIBGUESTFS_DEBUG=1");
-goto error;
-  }
-
-  for (i = 0; i < devs.gl_pathc; ++i) {
-if (add_string (, devs.gl_pathv[i]) == -1)
-  goto error;
-  }
-
-  if (end_stringsbuf () == -1) goto error;
-
-  globfree ();
-  return take_stringsbuf ();
-
- error:
-  globfree ();
-
-  return NULL;
-}
-
-/* All device mapper devices called /dev/mapper/ldm_vol_*.  XXX We
- * could tighten this up in future if ldmtool had a way to read these
- * names back after they have been created.
- */
-char **
-do_list_ldm_volumes (void)
-{
-  struct stat buf;
-
-  /* If /dev/mapper doesn't exist at all, don't give an error. */
-  if (stat ("/dev/mapper", ) == -1) {
-if (errno == ENOENT)
-  return empty_list ();
-reply_with_perror ("/dev/mapper");
-return NULL;
-  }
-
-  return get_devices ("/dev/mapper/ldm_vol_*");
-}
-
-/* Same as above but /dev/mapper/ldm_part_*.  See comment above. */
-char **
-do_list_ldm_partitions (void)
-{
-  struct stat buf;
-
-  /* If /dev/mapper doesn't exist at all, don't give an error. */
-  if (stat ("/dev/mapper", ) == -1) {
-if (errno == ENOENT)
-  return empty_list ();
-reply_with_perror ("/dev/mapper");
-return NULL;
-  }
-
-  return get_devices ("/dev/mapper/ldm_part_*");
-}
-
 int
 do_ldmtool_create_all (void)
 {
diff --git a/daemon/ldm.ml b/daemon/ldm.ml
new file mode 100644
index 0..dc7b36f9c
--- /dev/null
+++ b/daemon/ldm.ml
@@ -0,0 +1,52 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Std_utils
+
+open Utils
+
+(* All device mapper devices are called /dev/mapper/ldm_vol_*.  XXX We
+ * could tighten this up in future if ldmtool had a way to read these
+ * names back after they have been created.
+ *)
+let list_ldm_volumes () =
+  (* If /dev/mapper doesn't exist at all, don't give an error. *)
+  if not (is_directory "/dev/mapper") then
+[]
+  else (
+let dir = Sys.readdir "/dev/mapper" in
+let dir = Array.to_list dir in
+let dir =
+  List.filter (fun d -> String.is_prefix d "ldm_vol_") dir in
+let dir = List.map ((^) "/dev/mapper/") dir in
+List.sort compare dir
+  )
+
+(* Same as above but /dev/mapper/ldm_part_*. *)
+let list_ldm_partitions () =
+  (* If /dev/mapper doesn't exist at all, don't give an error. *)
+  if not (is_directory "/dev/mapper") then
+[]
+  else (
+let dir = Sys.readdir "/dev/mapper" in
+let dir = Array.to_list dir in
+let dir =
+  List.filter (fun d -> String.is_prefix d "ldm_part_") dir in
+  

[Libguestfs] [PATCH v7 09/29] daemon: Reimplement ‘mount’, ‘mount_ro’, ‘mount_options’, ‘mount_vfs’ APIs in OCaml.

[Richard W.M. Jones]

Some of the oldest and most core APIs, reimplemented.

This also moves the strange ‘mount_vfs_nochroot’ function into
btrfs.c.
---
 daemon/Makefile.am|  2 +
 daemon/btrfs.c| 43 
 daemon/daemon.h   |  6 ---
 daemon/mount.c| 99 ---
 daemon/mount.ml   | 62 +
 daemon/mount.mli  | 22 +++
 generator/actions_core.ml |  4 ++
 generator/daemon.ml   |  3 +-
 8 files changed, 135 insertions(+), 106 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 8171985b4..d5703b595 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -262,6 +262,7 @@ SOURCES_MLI = \
file.mli \
is.mli \
link.mli \
+   mount.mli \
mountable.mli \
utils.mli
 
@@ -276,6 +277,7 @@ SOURCES_ML = \
file.ml \
is.ml \
link.ml \
+   mount.ml \
callbacks.ml \
daemon.ml
 
diff --git a/daemon/btrfs.c b/daemon/btrfs.c
index 5f1e5d1d0..4f52b71e8 100644
--- a/daemon/btrfs.c
+++ b/daemon/btrfs.c
@@ -37,6 +37,7 @@ GUESTFSD_EXT_CMD(str_btrfs, btrfs);
 GUESTFSD_EXT_CMD(str_btrfstune, btrfstune);
 GUESTFSD_EXT_CMD(str_btrfsck, btrfsck);
 GUESTFSD_EXT_CMD(str_mkfs_btrfs, mkfs.btrfs);
+GUESTFSD_EXT_CMD(str_mount, mount);
 GUESTFSD_EXT_CMD(str_umount, umount);
 GUESTFSD_EXT_CMD(str_btrfsimage, btrfs-image);
 
@@ -387,6 +388,48 @@ do_btrfs_subvolume_create (const char *dest, const char 
*qgroupid)
   return 0;
 }
 
+static int
+mount_vfs_nochroot (const char *options, const char *vfstype,
+const mountable_t *mountable,
+const char *mp, const char *user_mp)
+{
+  CLEANUP_FREE char *options_plus = NULL;
+  const char *device = mountable->device;
+  if (mountable->type == MOUNTABLE_BTRFSVOL) {
+if (options && strlen (options) > 0) {
+  if (asprintf (_plus, "subvol=%s,%s",
+mountable->volume, options) == -1) {
+reply_with_perror ("asprintf");
+return -1;
+  }
+}
+else {
+  if (asprintf (_plus, "subvol=%s", mountable->volume) == -1) {
+reply_with_perror ("asprintf");
+return -1;
+  }
+}
+  }
+
+  CLEANUP_FREE char *error = NULL;
+  int r;
+  if (vfstype)
+r = command (NULL, ,
+ str_mount, "-o", options_plus ? options_plus : options,
+ "-t", vfstype, device, mp, NULL);
+  else
+r = command (NULL, ,
+ str_mount, "-o", options_plus ? options_plus : options,
+ device, mp, NULL);
+  if (r == -1) {
+reply_with_error ("%s on %s (options: '%s'): %s",
+  device, user_mp, options, error);
+return -1;
+  }
+
+  return 0;
+}
+
 static char *
 mount (const mountable_t *fs)
 {
diff --git a/daemon/daemon.h b/daemon/daemon.h
index 0a92e6cee..62e1211c8 100644
--- a/daemon/daemon.h
+++ b/daemon/daemon.h
@@ -94,12 +94,6 @@ extern void cleanup_free_stringsbuf (void *ptr);
 #define CLEANUP_FREE_STRINGSBUF
 #endif
 
-/*-- in mount.c --*/
-
-extern int mount_vfs_nochroot (const char *options, const char *vfstype,
-   const mountable_t *mountable,
-   const char *mp, const char *user_mp);
-
 /* Growable strings buffer. */
 struct stringsbuf {
   char **argv;
diff --git a/daemon/mount.c b/daemon/mount.c
index 0ad9626a7..962b86079 100644
--- a/daemon/mount.c
+++ b/daemon/mount.c
@@ -111,105 +111,6 @@ is_device_mounted (const char *device)
   return 0;
 }
 
-/* The "simple mount" call offers no complex options, you can just
- * mount a device on a mountpoint.  The variations like mount_ro,
- * mount_options and mount_vfs let you set progressively more things.
- *
- * It's tempting to try a direct mount(2) syscall, but that doesn't
- * do any autodetection, so we are better off calling out to
- * /bin/mount.
- */
-
-int
-do_mount_vfs (const char *options, const char *vfstype,
-  const mountable_t *mountable, const char *mountpoint)
-{
-  CLEANUP_FREE char *mp = NULL;
-  struct stat statbuf;
-
-  ABS_PATH (mountpoint, 0, return -1);
-
-  mp = sysroot_path (mountpoint);
-  if (!mp) {
-reply_with_perror ("malloc");
-return -1;
-  }
-
-  /* Check the mountpoint exists and is a directory. */
-  if (stat (mp, ) == -1) {
-reply_with_perror ("mount: %s", mountpoint);
-return -1;
-  }
-  if (!S_ISDIR (statbuf.st_mode)) {
-reply_with_perror ("mount: %s: mount point is not a directory", 
mountpoint);
-return -1;
-  }
-
-  return mount_vfs_nochroot (options, vfstype, mountable, mp, mountpoint);
-}
-
-int
-mount_vfs_nochroot (const char *options, const char *vfstype,
-const mountable_t *mountable,
-const char *mp, const char *user_mp)
-{
-  CLEANUP_FREE char *options_plus = NULL;
-  const char *device = mountable->device;
-  if (mountable->type == MOUNTABLE_BTRFSVOL) {
-if (options && strlen 

[Libguestfs] [PATCH v7 18/29] daemon: Reimplement ‘btrfs_subvolume_list’ and ‘btrfs_subvolume_get_default’ in OCaml.

[Richard W.M. Jones]

---
 daemon/Makefile.am|   2 +
 daemon/btrfs.c| 175 --
 daemon/btrfs.ml   | 127 +
 daemon/btrfs.mli  |  26 +++
 generator/actions_core.ml |   2 +
 generator/daemon.ml   |   5 +-
 6 files changed, 160 insertions(+), 177 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 4a818a7a9..459b5d7cc 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -256,6 +256,7 @@ guestfsd_CFLAGS = \
 # https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html
 SOURCES_MLI = \
blkid.mli \
+   btrfs.mli \
chroot.mli \
sysroot.mli \
devsparts.mli \
@@ -280,6 +281,7 @@ SOURCES_ML = \
mountable.ml \
chroot.ml \
blkid.ml \
+   btrfs.ml \
devsparts.ml \
file.ml \
filearch.ml \
diff --git a/daemon/btrfs.c b/daemon/btrfs.c
index 4f52b71e8..d9043d53c 100644
--- a/daemon/btrfs.c
+++ b/daemon/btrfs.c
@@ -41,11 +41,6 @@ GUESTFSD_EXT_CMD(str_mount, mount);
 GUESTFSD_EXT_CMD(str_umount, umount);
 GUESTFSD_EXT_CMD(str_btrfsimage, btrfs-image);
 
-COMPILE_REGEXP (re_btrfs_subvolume_list,
-"ID\\s+(\\d+).*\\s"
-"top level\\s+(\\d+).*\\s"
-"path\\s(.*)",
-0)
 COMPILE_REGEXP (re_btrfs_balance_status, "Balance on '.*' is (.*)", 0)
 
 int
@@ -483,137 +478,6 @@ umount (char *fs_buf, const mountable_t *fs)
   return 0;
 }
 
-guestfs_int_btrfssubvolume_list *
-do_btrfs_subvolume_list (const mountable_t *fs)
-{
-  CLEANUP_FREE_STRING_LIST char **lines = NULL;
-  size_t i = 0;
-  const size_t MAX_ARGS = 64;
-  const char *argv[MAX_ARGS];
-
-  /* Execute 'btrfs subvolume list ', and split the output into lines */
-  {
-char *fs_buf = mount (fs);
-
-if (!fs_buf)
-  return NULL;
-
-ADD_ARG (argv, i, str_btrfs);
-ADD_ARG (argv, i, "subvolume");
-ADD_ARG (argv, i, "list");
-ADD_ARG (argv, i, fs_buf);
-ADD_ARG (argv, i, NULL);
-
-CLEANUP_FREE char *out = NULL, *errout = NULL;
-int r = commandv (, , argv);
-
-if (umount (fs_buf, fs) != 0)
-  return NULL;
-
-if (r == -1) {
-  CLEANUP_FREE char *fs_desc = mountable_to_string (fs);
-  if (fs_desc == NULL) {
-fprintf (stderr, "malloc: %m");
-  }
-  reply_with_error ("%s: %s", fs_desc ? fs_desc : "malloc", errout);
-  return NULL;
-}
-
-lines = split_lines (out);
-if (!lines) return NULL;
-  }
-
-  /* Output is:
-   *
-   * ID 256 gen 30 top level 5 path test1
-   * ID 257 gen 30 top level 5 path dir/test2
-   * ID 258 gen 30 top level 5 path test3
-   *
-   * "ID " is the subvolume ID.
-   * "gen " is the generation when the root was created or last
-   * updated.
-   * "top level " is the top level subvolume ID.
-   * "path " is the subvolume path, relative to the top of the
-   * filesystem.
-   *
-   * Note that the order that each of the above is fixed, but
-   * different versions of btrfs may display different sets of data.
-   * Specifically, older versions of btrfs do not display gen.
-   */
-
-  guestfs_int_btrfssubvolume_list *ret = NULL;
-
-  const size_t nr_subvolumes = guestfs_int_count_strings (lines);
-
-  ret = malloc (sizeof *ret);
-  if (!ret) {
-reply_with_perror ("malloc");
-return NULL;
-  }
-
-  ret->guestfs_int_btrfssubvolume_list_len = nr_subvolumes;
-  ret->guestfs_int_btrfssubvolume_list_val =
-calloc (nr_subvolumes, sizeof (struct guestfs_int_btrfssubvolume));
-  if (ret->guestfs_int_btrfssubvolume_list_val == NULL) {
-reply_with_perror ("calloc");
-goto error;
-  }
-
-  for (i = 0; i < nr_subvolumes; ++i) {
-/* To avoid allocations, reuse the 'line' buffer to store the
- * path.  Thus we don't need to free 'line', since it will be
- * freed by the calling (XDR) code.
- */
-char *line = lines[i];
-#define N_MATCHES 4
-int ovector[N_MATCHES * 3];
-
-if (pcre_exec (re_btrfs_subvolume_list, NULL, line, strlen (line), 0, 0,
-   ovector, N_MATCHES * 3) < 0)
-#undef N_MATCHES
-  {
-  unexpected_output:
-   reply_with_error ("unexpected output from 'btrfs subvolume list' 
command: %s", line);
-   goto error;
-  }
-
-struct guestfs_int_btrfssubvolume *this =
-  >guestfs_int_btrfssubvolume_list_val[i];
-
-#if __WORDSIZE == 64
-#define XSTRTOU64 xstrtoul
-#else
-#define XSTRTOU64 xstrtoull
-#endif
-
-if (XSTRTOU64 (line + ovector[2], NULL, 10,
-   >btrfssubvolume_id, NULL) != LONGINT_OK)
-  goto unexpected_output;
-if (XSTRTOU64 (line + ovector[4], NULL, 10,
-   >btrfssubvolume_top_level_id, NULL) != LONGINT_OK)
-  goto unexpected_output;
-
-#undef XSTRTOU64
-
-this->btrfssubvolume_path =
-  strndup (line + ovector[6], ovector[7] - ovector[6]);
-if (this->btrfssubvolume_path == NULL)
-  goto error;
-  }
-
-  return ret;
-
- error:
-  if 

[Libguestfs] [PATCH v7 11/29] daemon: Reimplement ‘case_sensitive_path’ API in OCaml.

[Richard W.M. Jones]

---
 daemon/Makefile.am|   2 +
 daemon/realpath.c | 187 --
 daemon/realpath.ml|  83 
 daemon/realpath.mli   |  19 +
 generator/actions_core.ml |   1 +
 5 files changed, 105 insertions(+), 187 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 1035d7ea2..d56c99123 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -265,6 +265,7 @@ SOURCES_MLI = \
mount.mli \
mountable.mli \
parted.mli \
+   realpath.mli \
utils.mli
 
 SOURCES_ML = \
@@ -280,6 +281,7 @@ SOURCES_ML = \
link.ml \
mount.ml \
parted.ml \
+   realpath.ml \
callbacks.ml \
daemon.ml
 
diff --git a/daemon/realpath.c b/daemon/realpath.c
index 24ab133e2..f9d22d28d 100644
--- a/daemon/realpath.c
+++ b/daemon/realpath.c
@@ -48,190 +48,3 @@ do_realpath (const char *path)
 
   return ret;  /* caller frees */
 }
-
-static int find_path_element (int fd_cwd, int is_end, const char *name, char 
**name_ret);
-
-char *
-do_case_sensitive_path (const char *path)
-{
-  size_t next;
-  int fd_cwd, fd2, err, is_end;
-  char *ret;
-
-  ret = strdup ("/");
-  if (ret == NULL) {
-reply_with_perror ("strdup");
-return NULL;
-  }
-  next = 1; /* next position in 'ret' buffer */
-
-  /* 'fd_cwd' here is a surrogate for the current working directory, so
-   * that we don't have to actually call chdir(2).
-   */
-  fd_cwd = open (sysroot, O_RDONLY|O_DIRECTORY|O_CLOEXEC);
-  if (fd_cwd == -1) {
-reply_with_perror ("%s", sysroot);
-goto error;
-  }
-
-  /* First character is a '/'.  Take each subsequent path element
-   * and follow it.
-   */
-  while (*path) {
-char *t;
-size_t i, len;
-CLEANUP_FREE char *name_in = NULL, *name_out = NULL;
-
-i = strcspn (path, "/");
-if (i == 0) {
-  path++;
-  continue;
-}
-
-if ((i == 1 && path[0] == '.') ||
-(i == 2 && path[0] == '.' && path[1] == '.')) {
-  reply_with_error ("path contained . or .. elements");
-  goto error;
-}
-
-name_in = strndup (path, i);
-if (name_in == NULL) {
-  reply_with_perror ("strdup");
-  goto error;
-}
-
-/* Skip to next element in path (for the next loop iteration). */
-path += i;
-is_end = *path == 0;
-
-/* Read the current directory looking (case insensitively) for
- * this element of the path.  This replaces 'name' with the
- * correct case version.
- */
-if (find_path_element (fd_cwd, is_end, name_in, _out) == -1)
-  goto error;
-len = strlen (name_out);
-
-/* Add the real name of this path element to the return value. */
-if (next > 1)
-  ret[next++] = '/';
-
-t = realloc (ret, next+len+1);
-if (t == NULL) {
-  reply_with_perror ("realloc");
-  goto error;
-}
-ret = t;
-
-strcpy ([next], name_out);
-next += len;
-
-/* Is it a directory?  Try going into it. */
-fd2 = openat (fd_cwd, name_out, O_RDONLY|O_DIRECTORY|O_CLOEXEC);
-err = errno;
-close (fd_cwd);
-fd_cwd = fd2;
-errno = err;
-if (fd_cwd == -1) {
-  /* Some errors are OK provided we've reached the end of the path. */
-  if (is_end && (errno == ENOTDIR || errno == ENOENT))
-break;
-
-  reply_with_perror ("openat: %s", name_out);
-  goto error;
-}
-  }
-
-  if (fd_cwd >= 0)
-close (fd_cwd);
-
-  return ret;   /* caller frees */
-
- error:
-  if (fd_cwd >= 0)
-close (fd_cwd);
-  free (ret);
-
-  return NULL;
-}
-
-/* 'fd_cwd' is a file descriptor pointing to an open directory.
- * 'name' is the path element to search for.  'is_end' is a flag
- * indicating if this is the last path element.
- *
- * We search the directory looking for a path element that case
- * insensitively matches 'name', returning the actual name in '*name_ret'.
- *
- * If this is successful, return 0.  If it fails, reply with an error
- * and return -1.
- */
-static int
-find_path_element (int fd_cwd, int is_end, const char *name, char **name_ret)
-{
-  int fd2;
-  DIR *dir;
-  struct dirent *d;
-
-  fd2 = dup_cloexec (fd_cwd); /* because closedir will close it */
-  if (fd2 == -1) {
-reply_with_perror ("dup");
-return -1;
-  }
-  dir = fdopendir (fd2);
-  if (dir == NULL) {
-reply_with_perror ("opendir");
-close (fd2);
-return -1;
-  }
-
-  for (;;) {
-errno = 0;
-d = readdir (dir);
-if (d == NULL)
-  break;
-if (STRCASEEQ (d->d_name, name))
-  break;
-  }
-
-  if (d == NULL && errno != 0) {
-reply_with_perror ("readdir");
-closedir (dir);
-return -1;
-  }
-
-  if (d == NULL && is_end) {
-/* Last path element: return it as-is, assuming that the user will
- * create a new file or directory (RHBZ#840115).
- */
-closedir (dir);
-*name_ret = strdup (name);
-if (*name_ret == NULL) {
-  reply_with_perror ("strdup");
-  

[Libguestfs] [PATCH v7 14/29] daemon: Reimplement ‘lvs’ API in OCaml.

[Richard W.M. Jones]

---
 daemon/Makefile.am|   2 +
 daemon/lvm.c  | 151 --
 daemon/lvm.ml |  92 
 daemon/lvm.mli|  19 ++
 generator/actions_core.ml |   1 +
 5 files changed, 114 insertions(+), 151 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 5d79dc830..abd45b744 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -264,6 +264,7 @@ SOURCES_MLI = \
is.mli \
ldm.mli \
link.mli \
+   lvm.mli \
mount.mli \
mountable.mli \
parted.mli \
@@ -283,6 +284,7 @@ SOURCES_ML = \
is.ml \
ldm.ml \
link.ml \
+   lvm.ml \
mount.ml \
parted.ml \
realpath.ml \
diff --git a/daemon/lvm.c b/daemon/lvm.c
index 5d12b009f..072bf53b4 100644
--- a/daemon/lvm.c
+++ b/daemon/lvm.c
@@ -103,89 +103,6 @@ convert_lvm_output (char *out, const char *prefix)
   return take_stringsbuf ();
 }
 
-/* Filter a colon-separated output of
- *   lvs -o lv_attr,vg_name,lv_name
- * removing thin layouts, and building the device path as we expect it.
- *
- * This is used only when lvm has no -S.
- */
-static char **
-filter_convert_old_lvs_output (char *out)
-{
-  char *p, *pend;
-  CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret);
-
-  p = out;
-  while (p) {
-size_t len;
-char *saveptr;
-char *lv_attr, *vg_name, *lv_name;
-
-pend = strchr (p, '\n');   /* Get the next line of output. */
-if (pend) {
-  *pend = '\0';
-  pend++;
-}
-
-while (*p && c_isspace (*p))   /* Skip any leading whitespace. */
-  p++;
-
-/* Sigh, skip trailing whitespace too.  "pvs", I'm looking at you. */
-len = strlen (p)-1;
-while (*p && c_isspace (p[len]))
-  p[len--] = '\0';
-
-if (!*p) { /* Empty line?  Skip it. */
-skip_line:
-  p = pend;
-  continue;
-}
-
-lv_attr = strtok_r (p, ":", );
-if (!lv_attr)
-  goto skip_line;
-
-vg_name = strtok_r (NULL, ":", );
-if (!vg_name)
-  goto skip_line;
-
-lv_name = strtok_r (NULL, ":", );
-if (!lv_name)
-  goto skip_line;
-
-/* Ignore thin layouts (RHBZ#1278878). */
-if (lv_attr[0] == 't')
-  goto skip_line;
-
-/* Ignore activationskip (RHBZ#130). */
-if (strlen (lv_attr) >= 10 && lv_attr[9] == 'k')
-  goto skip_line;
-
-/* Ignore "unknown device" message (RHBZ#1054761). */
-if (STRNEQ (p, "unknown device")) {
-  char buf[256];
-
-  snprintf (buf, sizeof buf, "/dev/%s/%s", vg_name, lv_name);
-  if (add_string (, buf) == -1) {
-free (out);
-return NULL;
-  }
-}
-
-p = pend;
-  }
-
-  free (out);
-
-  if (ret.size > 0)
-sort_strings (ret.argv, ret.size);
-
-  if (end_stringsbuf () == -1)
-return NULL;
-
-  return take_stringsbuf ();
-}
-
 char **
 do_pvs (void)
 {
@@ -222,74 +139,6 @@ do_vgs (void)
   return convert_lvm_output (out, NULL);
 }
 
-/* Check whether lvs has -S to filter its output.
- * It is available only in lvm2 >= 2.02.107.
- */
-static int
-test_lvs_has_S_opt (void)
-{
-  static int result = -1;
-  if (result != -1)
-return result;
-
-  CLEANUP_FREE char *out = NULL;
-  CLEANUP_FREE char *err = NULL;
-
-  int r = command (, , str_lvm, "lvs", "--help", NULL);
-  if (r == -1) {
-reply_with_error ("lvm lvs --help: %s", err);
-return -1;
-  }
-
-  if (strstr (out, "-S") == NULL)
-result = 0;
-  else
-result = 1;
-
-  return result;
-}
-
-char **
-do_lvs (void)
-{
-  char *out;
-  CLEANUP_FREE char *err = NULL;
-  int r;
-  const int has_S = test_lvs_has_S_opt ();
-
-  if (has_S < 0)
-return NULL;
-
-  if (has_S > 0) {
-r = command (, ,
- str_lvm, "lvs",
- "-o", "vg_name,lv_name",
- "-S", "lv_role=public && lv_skip_activation!=yes",
- "--noheadings",
- "--separator", "/", NULL);
-if (r == -1) {
-  reply_with_error ("%s", err);
-  free (out);
-  return NULL;
-}
-
-return convert_lvm_output (out, "/dev/");
-  } else {
-r = command (, ,
- str_lvm, "lvs",
- "-o", "lv_attr,vg_name,lv_name",
- "--noheadings",
- "--separator", ":", NULL);
-if (r == -1) {
-  reply_with_error ("%s", err);
-  free (out);
-  return NULL;
-}
-
-return filter_convert_old_lvs_output (out);
-  }
-}
-
 /* These were so complex to implement that I ended up auto-generating
  * the code.  That code is in stubs.c, and it is generated as usual
  * by generator.ml.
diff --git a/daemon/lvm.ml b/daemon/lvm.ml
new file mode 100644
index 0..55421b628
--- /dev/null
+++ b/daemon/lvm.ml
@@ -0,0 +1,92 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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 

[Libguestfs] [PATCH v7 07/29] daemon: Reimplement ‘is_dir’, ‘is_file’ and ‘is_symlink’ APIs in OCaml.

[Richard W.M. Jones]

This also demonstrates usage of optional arguments.
---
 daemon/Makefile.am|  2 ++
 daemon/is.c   | 41 -
 daemon/is.ml  | 44 
 daemon/is.mli | 21 +
 generator/actions_core.ml |  3 +++
 generator/daemon.ml   |  7 ---
 6 files changed, 74 insertions(+), 44 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index a7cd5d5c6..2fffceffb 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -260,6 +260,7 @@ SOURCES_MLI = \
sysroot.mli \
devsparts.mli \
file.mli \
+   is.mli \
mountable.mli \
utils.mli
 
@@ -272,6 +273,7 @@ SOURCES_ML = \
blkid.ml \
devsparts.ml \
file.ml \
+   is.ml \
callbacks.ml \
daemon.ml
 
diff --git a/daemon/is.c b/daemon/is.c
index 4d5e911c2..a91dab32b 100644
--- a/daemon/is.c
+++ b/daemon/is.c
@@ -39,36 +39,6 @@ do_exists (const char *path)
 
 /* Takes optional arguments, consult optargs_bitmask. */
 int
-do_is_file (const char *path, int followsymlinks)
-{
-  mode_t mode;
-  int r;
-
-  if (!(optargs_bitmask & GUESTFS_IS_FILE_FOLLOWSYMLINKS_BITMASK))
-followsymlinks = 0;
-
-  r = get_mode (path, , followsymlinks);
-  if (r <= 0) return r;
-  return S_ISREG (mode);
-}
-
-/* Takes optional arguments, consult optargs_bitmask. */
-int
-do_is_dir (const char *path, int followsymlinks)
-{
-  mode_t mode;
-  int r;
-
-  if (!(optargs_bitmask & GUESTFS_IS_DIR_FOLLOWSYMLINKS_BITMASK))
-followsymlinks = 0;
-
-  r = get_mode (path, , followsymlinks);
-  if (r <= 0) return r;
-  return S_ISDIR (mode);
-}
-
-/* Takes optional arguments, consult optargs_bitmask. */
-int
 do_is_chardev (const char *path, int followsymlinks)
 {
   mode_t mode;
@@ -112,17 +82,6 @@ do_is_fifo (const char *path, int followsymlinks)
   return S_ISFIFO (mode);
 }
 
-int
-do_is_symlink (const char *path)
-{
-  mode_t mode;
-  int r;
-
-  r = get_mode (path, , 0);
-  if (r <= 0) return r;
-  return S_ISLNK (mode);
-}
-
 /* Takes optional arguments, consult optargs_bitmask. */
 int
 do_is_socket (const char *path, int followsymlinks)
diff --git a/daemon/is.ml b/daemon/is.ml
new file mode 100644
index 0..b99215737
--- /dev/null
+++ b/daemon/is.ml
@@ -0,0 +1,44 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Printf
+open Unix
+
+let rec is_file ?(followsymlinks = false) path =
+  let sysroot = Sysroot.sysroot () in
+  let chroot = Chroot.create sysroot ~name:(sprintf "is_file: %s" path) in
+  Chroot.f chroot get_kind (path, followsymlinks) = Some S_REG
+
+and is_dir ?(followsymlinks = false) path =
+  let sysroot = Sysroot.sysroot () in
+  let chroot = Chroot.create sysroot ~name:(sprintf "is_dir: %s" path) in
+  Chroot.f chroot get_kind (path, followsymlinks) = Some S_DIR
+
+and is_symlink path =
+  let sysroot = Sysroot.sysroot () in
+  let chroot = Chroot.create sysroot ~name:(sprintf "is_symlink: %s" path) in
+  Chroot.f chroot get_kind (path, false) = Some S_LNK
+
+and get_kind (path, followsymlinks) =
+  let statfun = if followsymlinks then stat else lstat in
+  try
+let statbuf = statfun path in
+Some statbuf.st_kind
+  with
+Unix_error ((ENOENT|ENOTDIR), _, _) ->
+  None  (* File doesn't exist => return None *)
diff --git a/daemon/is.mli b/daemon/is.mli
new file mode 100644
index 0..20622c39f
--- /dev/null
+++ b/daemon/is.mli
@@ -0,0 +1,21 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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 

[Libguestfs] [PATCH v7 08/29] daemon: Reimplement ‘readlink’ API in OCaml.

[Richard W.M. Jones]

---
 daemon/Makefile.am|  2 ++
 daemon/link.c | 16 
 daemon/link.ml| 25 +
 daemon/link.mli   | 19 +++
 generator/actions_core.ml |  1 +
 5 files changed, 47 insertions(+), 16 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 2fffceffb..8171985b4 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -261,6 +261,7 @@ SOURCES_MLI = \
devsparts.mli \
file.mli \
is.mli \
+   link.mli \
mountable.mli \
utils.mli
 
@@ -274,6 +275,7 @@ SOURCES_ML = \
devsparts.ml \
file.ml \
is.ml \
+   link.ml \
callbacks.ml \
daemon.ml
 
diff --git a/daemon/link.c b/daemon/link.c
index 3ce54fa37..dde61a1c2 100644
--- a/daemon/link.c
+++ b/daemon/link.c
@@ -32,22 +32,6 @@
 
 GUESTFSD_EXT_CMD(str_ln, ln);
 
-char *
-do_readlink (const char *path)
-{
-  char *link;
-
-  CHROOT_IN;
-  link = areadlink (path);
-  CHROOT_OUT;
-  if (link == NULL) {
-reply_with_perror ("%s", path);
-return NULL;
-  }
-
-  return link; /* caller frees */
-}
-
 char **
 do_internal_readlinklist (const char *path, char *const *names)
 {
diff --git a/daemon/link.ml b/daemon/link.ml
new file mode 100644
index 0..ba53fd6b5
--- /dev/null
+++ b/daemon/link.ml
@@ -0,0 +1,25 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Printf
+open Unix
+
+let readlink path =
+  let sysroot = Sysroot.sysroot () in
+  let chroot = Chroot.create sysroot ~name:(sprintf "readlink: %s" path) in
+  Chroot.f chroot readlink path
diff --git a/daemon/link.mli b/daemon/link.mli
new file mode 100644
index 0..6ca0283b4
--- /dev/null
+++ b/daemon/link.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+val readlink : string -> string
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 421f3ac6b..7d6755fdc 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -4489,6 +4489,7 @@ The I<-f> option removes the link (C) if it 
exists already." };
   { defaults with
 name = "readlink"; added = (1, 0, 66);
 style = RString (RPlainString, "link"), [String (Pathname, "path")], [];
+impl = OCaml "Link.readlink";
 shortdesc = "read the target of a symbolic link";
 longdesc = "\
 This command reads the target of a symbolic link." };
-- 
2.13.0

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 12/29] daemon: Reimplement ‘file_architecture’ API in OCaml.

[Richard W.M. Jones]

The previously library-side ‘file_architecture’ API is reimplemented
in the daemon, in OCaml.

There are some significant differences compared to the C
implementation:

 - The C code used libmagic.  That is replaced by calling the ‘file’
   command (because that is simpler than using the library).

 - The C code had extra cases to deal with compressed files.  This is
   not necessary since the ‘file’ command supports the ‘-z’ option
   which transparently looks inside compressed content (this is a
   consequence of the change above).

This commit demonstrates a number of techniques which will be useful
for moving inspection code to the daemon:

 - Moving an API from the C library to the OCaml daemon.

 - Calling from one OCaml API inside the daemon to another (from
   ‘Filearch.file_architecture’ to ‘File.file’).  This can be done and
   is done with C daemon APIs but correct reply_with_error handling is
   more difficult in C.

 - Use of Str for regular expression matching within the appliance.
---
 daemon/Makefile.am|   2 +
 daemon/filearch.ml| 137 +
 daemon/filearch.mli   |  19 +++
 docs/C_SOURCE_FILES   |   4 +-
 generator/actions_core.ml | 377 +++---
 generator/proc_nr.ml  |   1 +
 lib/MAX_PROC_NR   |   2 +-
 lib/Makefile.am   |   3 +-
 lib/filearch.c| 362 
 po/POTFILES   |   1 -
 10 files changed, 353 insertions(+), 555 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index d56c99123..e86435c4c 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -260,6 +260,7 @@ SOURCES_MLI = \
sysroot.mli \
devsparts.mli \
file.mli \
+   filearch.mli \
is.mli \
link.mli \
mount.mli \
@@ -277,6 +278,7 @@ SOURCES_ML = \
blkid.ml \
devsparts.ml \
file.ml \
+   filearch.ml \
is.ml \
link.ml \
mount.ml \
diff --git a/daemon/filearch.ml b/daemon/filearch.ml
new file mode 100644
index 0..68ddd61ea
--- /dev/null
+++ b/daemon/filearch.ml
@@ -0,0 +1,137 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Unix
+open Printf
+
+open Std_utils
+
+open Utils
+
+let re_file_elf =
+  Str.regexp "ELF \\([0-9]+\\)-bit \\(MSB\\|LSB\\).*\\(executable\\|shared 
object\\|relocatable\\), \\([^,]+\\),"
+
+let re_file_elf_ppc64 = Str.regexp ".*64.*PowerPC"
+
+let initrd_binaries = [
+  "bin/ls";
+  "bin/rm";
+  "bin/modprobe";
+  "sbin/modprobe";
+  "bin/sh";
+  "bin/bash";
+  "bin/dash";
+  "bin/nash";
+]
+
+let rec file_architecture orig_path =
+  (* Get the output of the "file" command.  Note that because this
+   * is running in the daemon, LANG=C so it's in English.
+   *)
+  let magic = File.file orig_path in
+  file_architecture_of_magic magic orig_path orig_path
+
+and file_architecture_of_magic magic orig_path path =
+  if Str.string_match re_file_elf magic 0 then (
+let bits = Str.matched_group 1 magic in
+let endianness = Str.matched_group 2 magic in
+let elf_arch = Str.matched_group 4 magic in
+canonical_elf_arch bits endianness elf_arch
+  )
+  else if String.find magic "PE32 executable" >= 0 then
+"i386"
+  else if String.find magic "PE32+ executable" >= 0 then
+"x86_64"
+  else if String.find magic "cpio archive" >= 0 then
+cpio_arch magic orig_path path
+  else
+failwithf "unknown architecture: %s" path
+
+(* Convert output from 'file' command on ELF files to the canonical
+ * architecture string.  Caller must free the result.
+ *)
+and canonical_elf_arch bits endianness elf_arch =
+  let substr s = String.find elf_arch s >= 0 in
+  if substr "Intel 80386" || substr "Intel 80486" then
+"i386"
+  else if substr "x86-64" || substr "AMD x86-64" then
+"x86_64"
+  else if substr "SPARC32" then
+"sparc"
+  else if substr "SPARC V9" then
+"sparc64"
+  else if substr "IA-64" then
+"ia64"
+  else if Str.string_match re_file_elf_ppc64 elf_arch 0 then (
+match endianness with
+| "MSB" -> "ppc64"
+| "LSB" -> "ppc64le"
+| _ -> failwithf "unknown endianness '%s'" endianness
+  )
+  else if substr "PowerPC" then
+"ppc"
+  

[Libguestfs] [PATCH v7 04/29] daemon: Reimplement ‘vfs_type’ API in OCaml.

[Richard W.M. Jones]

This also implements support for String (Mountable, _)
parameters.
---
 daemon/Makefile.am|  4 
 daemon/blkid.c|  6 --
 daemon/blkid.ml   | 40 
 daemon/blkid.mli  | 19 +++
 daemon/mountable.ml   | 43 +++
 daemon/mountable.mli  | 34 ++
 generator/actions_core.ml |  1 +
 generator/daemon.ml   | 38 --
 8 files changed, 177 insertions(+), 8 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index c11f51cef..a9d7fb9bd 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -254,16 +254,20 @@ guestfsd_CFLAGS = \
 # library and then linked to the daemon.  See
 # https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html
 SOURCES_MLI = \
+   blkid.mli \
chroot.mli \
sysroot.mli \
file.mli \
+   mountable.mli \
utils.mli
 
 SOURCES_ML = \
types.ml \
utils.ml \
sysroot.ml \
+   mountable.ml \
chroot.ml \
+   blkid.ml \
file.ml \
callbacks.ml \
daemon.ml
diff --git a/daemon/blkid.c b/daemon/blkid.c
index 1fe5ff93a..7757b5ad0 100644
--- a/daemon/blkid.c
+++ b/daemon/blkid.c
@@ -69,12 +69,6 @@ get_blkid_tag (const char *device, const char *tag)
 }
 
 char *
-do_vfs_type (const mountable_t *mountable)
-{
-  return get_blkid_tag (mountable->device, "TYPE");
-}
-
-char *
 do_vfs_label (const mountable_t *mountable)
 {
   CLEANUP_FREE char *type = do_vfs_type (mountable);
diff --git a/daemon/blkid.ml b/daemon/blkid.ml
new file mode 100644
index 0..3345f826e
--- /dev/null
+++ b/daemon/blkid.ml
@@ -0,0 +1,40 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Std_utils
+
+open Utils
+
+let rec vfs_type { Mountable.m_device = device } =
+  get_blkid_tag device "TYPE"
+
+and get_blkid_tag device tag =
+  let r, out, err =
+commandr "blkid"
+ [(* Adding -c option kills all caching, even on RHEL 5. *)
+   "-c"; "/dev/null";
+   "-o"; "value"; "-s"; tag; device] in
+  match r with
+  | 0 ->(* success *)
+ String.trimr out
+
+  | 2 ->(* means tag not found, we return "" *)
+ ""
+
+  | _ ->
+ failwithf "blkid: %s: %s" tag err
diff --git a/daemon/blkid.mli b/daemon/blkid.mli
new file mode 100644
index 0..59a86ac2c
--- /dev/null
+++ b/daemon/blkid.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+val vfs_type : Mountable.t -> string
diff --git a/daemon/mountable.ml b/daemon/mountable.ml
new file mode 100644
index 0..96dffb80b
--- /dev/null
+++ b/daemon/mountable.ml
@@ -0,0 +1,43 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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 

[Libguestfs] [PATCH v7 03/29] daemon: Reimplement ‘file’ API in OCaml.

[Richard W.M. Jones]

‘file’ is a small, self-contained API which runs a single command, so
it's a good test case for reimplementing APIs.
---
 daemon/Makefile.am|  2 ++
 daemon/file.c | 80 ---
 daemon/file.ml| 60 +++
 daemon/file.mli   | 19 +++
 generator/actions_core.ml |  1 +
 5 files changed, 82 insertions(+), 80 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index c7375fb87..c11f51cef 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -256,6 +256,7 @@ guestfsd_CFLAGS = \
 SOURCES_MLI = \
chroot.mli \
sysroot.mli \
+   file.mli \
utils.mli
 
 SOURCES_ML = \
@@ -263,6 +264,7 @@ SOURCES_ML = \
utils.ml \
sysroot.ml \
chroot.ml \
+   file.ml \
callbacks.ml \
daemon.ml
 
diff --git a/daemon/file.c b/daemon/file.c
index 84874dc6f..ee79eb507 100644
--- a/daemon/file.c
+++ b/daemon/file.c
@@ -30,7 +30,6 @@
 #include "actions.h"
 #include "optgroups.h"
 
-GUESTFSD_EXT_CMD(str_file, file);
 GUESTFSD_EXT_CMD(str_zcat, zcat);
 GUESTFSD_EXT_CMD(str_bzcat, bzcat);
 
@@ -449,85 +448,6 @@ do_pwrite_device (const char *device, const char *content, 
size_t size,
   return pwrite_fd (fd, content, size, offset, device, 1);
 }
 
-/* This runs the 'file' command. */
-char *
-do_file (const char *path)
-{
-  CLEANUP_FREE char *buf = NULL;
-  const char *display_path = path;
-  const int is_dev = STRPREFIX (path, "/dev/");
-  struct stat statbuf;
-
-  if (!is_dev) {
-buf = sysroot_path (path);
-if (!buf) {
-  reply_with_perror ("malloc");
-  return NULL;
-}
-path = buf;
-
-/* For non-dev, check this is a regular file, else just return the
- * file type as a string (RHBZ#582484).
- */
-if (lstat (path, ) == -1) {
-  reply_with_perror ("lstat: %s", display_path);
-  return NULL;
-}
-
-if (! S_ISREG (statbuf.st_mode)) {
-  char *ret;
-
-  if (S_ISDIR (statbuf.st_mode))
-ret = strdup ("directory");
-  else if (S_ISCHR (statbuf.st_mode))
-ret = strdup ("character device");
-  else if (S_ISBLK (statbuf.st_mode))
-ret = strdup ("block device");
-  else if (S_ISFIFO (statbuf.st_mode))
-ret = strdup ("FIFO");
-  else if (S_ISLNK (statbuf.st_mode))
-ret = strdup ("symbolic link");
-  else if (S_ISSOCK (statbuf.st_mode))
-ret = strdup ("socket");
-  else
-ret = strdup ("unknown, not regular file");
-
-  if (ret == NULL)
-reply_with_perror ("strdup");
-  return ret;
-}
-  }
-
-  /* Which flags to use?  For /dev paths, follow links because
-   * /dev/VG/LV is a symbolic link.
-   */
-  const char *flags = is_dev ? "-zbsL" : "-zb";
-
-  char *out;
-  CLEANUP_FREE char *err = NULL;
-  int r = command (, , str_file, flags, path, NULL);
-
-  if (r == -1) {
-free (out);
-reply_with_error ("%s: %s", display_path, err);
-return NULL;
-  }
-
-  /* We need to remove the trailing \n from output of file(1). */
-  size_t len = strlen (out);
-  if (len > 0 && out[len-1] == '\n')
-out[--len] = '\0';
-
-  /* Some upstream versions of file add a space at the end of the
-   * output.  This is fixed in the Fedora version, but we might as
-   * well fix it here too.  (RHBZ#928995).
-   */
-  if (len > 0 && out[len-1] == ' ')
-out[--len] = '\0';
-
-  return out;  /* caller frees */
-}
-
 /* zcat | file */
 char *
 do_zfile (const char *method, const char *path)
diff --git a/daemon/file.ml b/daemon/file.ml
new file mode 100644
index 0..557de764b
--- /dev/null
+++ b/daemon/file.ml
@@ -0,0 +1,60 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Unix
+open Printf
+
+open Std_utils
+
+open Utils
+
+(* This runs the [file] command. *)
+let file path =
+  let is_dev = String.is_prefix path "/dev/" in
+
+  (* For non-dev, check this is a regular file, else just return the
+   * file type as a string (RHBZ#582484).
+   *)
+  if not is_dev then (
+let sysroot = Sysroot.sysroot () in
+let chroot = Chroot.create sysroot ~name:(sprintf "file: %s" path) in
+
+let statbuf = Chroot.f chroot lstat path in
+   

[Libguestfs] [PATCH v7 06/29] daemon: Add unit tests of the ‘Utils’ module.

[Richard W.M. Jones]

---
 .gitignore   |  1 +
 daemon/Makefile.am   | 43 ++-
 daemon/daemon_utils_tests.ml | 48 
 daemon/dummy.c   |  2 ++
 docs/C_SOURCE_FILES  |  1 +
 5 files changed, 94 insertions(+), 1 deletion(-)

diff --git a/.gitignore b/.gitignore
index f37ca263a..29596594a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -168,6 +168,7 @@ Makefile.in
 /daemon/actions.h
 /daemon/callbacks.ml
 /daemon/caml-stubs.c
+/daemon/daemon_utils_tests
 /daemon/dispatch.c
 /daemon/guestfsd
 /daemon/guestfsd.8
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 9e53aef7a..a7cd5d5c6 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -56,6 +56,7 @@ BUILT_SOURCES = \
 EXTRA_DIST = \
$(generator_built) \
$(SOURCES_MLI) $(SOURCES_ML) \
+   daemon_utils_tests.ml \
guestfsd.pod
 
 if INSTALL_DAEMON
@@ -280,7 +281,8 @@ XOBJECTS = $(BOBJECTS:.cmo=.cmx)
 OCAMLPACKAGES = \
-package str,unix,hivex \
-I $(top_srcdir)/common/mlstdutils \
-   -I $(top_srcdir)/common/mlutils
+   -I $(top_srcdir)/common/mlutils \
+   -I $(top_builddir)/common/utils/.libs
 
 OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_FLAGS)
 
@@ -307,6 +309,45 @@ camldaemon.o: $(OBJECTS)
-linkpkg mlcutils.$(MLARCHIVE) mlstdutils.$(MLARCHIVE) \
$(OBJECTS)
 
+# Unit tests.
+
+check_PROGRAMS = daemon_utils_tests
+TESTS = daemon_utils_tests
+
+daemon_utils_tests_SOURCES = dummy.c
+daemon_utils_tests_CPPFLAGS = \
+   -I. \
+   -I$(top_builddir) \
+   -I$(shell $(OCAMLC) -where) \
+   -I$(top_srcdir)/lib
+daemon_utils_tests_BOBJECTS = \
+   utils.cmo \
+   daemon_utils_tests.cmo
+daemon_utils_tests_XOBJECTS = $(daemon_utils_tests_BOBJECTS:.cmo=.cmx)
+
+if !HAVE_OCAMLOPT
+daemon_utils_tests_THEOBJECTS = $(daemon_utils_tests_BOBJECTS)
+else
+daemon_utils_tests_THEOBJECTS = $(daemon_utils_tests_XOBJECTS)
+endif
+
+OCAMLLINKFLAGS = \
+   mlcutils.$(MLARCHIVE) \
+   mlstdutils.$(MLARCHIVE) \
+   $(LINK_CUSTOM_OCAMLC_ONLY)
+
+daemon_utils_tests_DEPENDENCIES = \
+   $(daemon_utils_tests_THEOBJECTS) \
+   $(top_srcdir)/ocaml-link.sh
+daemon_utils_tests_LINK = \
+   $(top_srcdir)/ocaml-link.sh -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \
+ $(OCAMLPACKAGES) \
+ $(daemon_utils_tests_THEOBJECTS) -o $@
+
+check-valgrind:
+   $(MAKE) VG="@VG@" check
+
 # OCaml dependencies.
 depend: .depend
 
diff --git a/daemon/daemon_utils_tests.ml b/daemon/daemon_utils_tests.ml
new file mode 100644
index 0..892509d89
--- /dev/null
+++ b/daemon/daemon_utils_tests.ml
@@ -0,0 +1,48 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
+
+open Unix
+open Printf
+
+open Utils
+
+(* Test prog_exists. *)
+let () =
+  assert (prog_exists "ls");
+  assert (prog_exists "true")
+
+(* Test command, commandr. *)
+let () =
+  ignore (command "true" []);
+
+  let r, _, _ = commandr "false" [] in
+  assert (r = 1)
+
+(* Test split_device_partition. *)
+let () =
+  assert (split_device_partition "/dev/sda1" = ("sda", 1));
+  assert (split_device_partition "/dev/sdb" = ("sdb", 0));
+  assert (split_device_partition "/dev/ubda9" = ("ubda", 9));
+  assert (split_device_partition "/dev/md0p1" = ("md0", 1))
+  (* XXX The function is buggy:
+  assert (split_device_partition "/dev/md0" = ("md0", 0)) *)
+
+(* Test proc_unmangle_path. *)
+let () =
+  assert (proc_unmangle_path "\\040" = " ");
+  assert (proc_unmangle_path "\\040\\040" = "  ")
diff --git a/daemon/dummy.c b/daemon/dummy.c
new file mode 100644
index 0..ebab6198c
--- /dev/null
+++ b/daemon/dummy.c
@@ -0,0 +1,2 @@
+/* Dummy source, to be used for OCaml-based tools with no C sources. */
+enum { foo = 1 };
diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index 61cdbea38..e7c457e92 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -93,6 +93,7 @@ daemon/dispatch.c
 daemon/dmesg.c
 daemon/dropcaches.c
 daemon/du.c
+daemon/dummy.c
 daemon/echo-daemon.c
 daemon/ext2.c
 daemon/fallocate.c
-- 
2.13.0

___
Libguestfs mailing list
Libguestfs@redhat.com

[Libguestfs] [PATCH v7 01/29] inspection: Deprecate APIs and remove support for inspecting installer CDs.

[Richard W.M. Jones]

This just duplicated libosinfo information, and because it was never
tested it didn't work most of the time.
---
 docs/C_SOURCE_FILES|   2 -
 generator/actions_inspection.ml|  67 ---
 generator/actions_inspection_deprecated.ml |  61 +++
 inspector/Makefile.am  |  11 +-
 inspector/example-debian-netinst-cd.xml|  23 -
 inspector/example-debian.xml   |   1 -
 inspector/example-fedora-dvd.xml   |  23 -
 inspector/example-fedora-netinst-cd.xml|  21 -
 inspector/example-fedora.xml   |   1 -
 inspector/example-rhel-6-dvd.xml   |  23 -
 inspector/example-rhel-6-netinst-cd.xml|  21 -
 inspector/example-rhel-6.xml   |   1 -
 inspector/example-ubuntu-live-cd.xml   |  23 -
 inspector/example-ubuntu.xml   |   1 -
 inspector/example-windows-2003-x64-cd.xml  |  24 --
 inspector/example-windows-2003-x86-cd.xml  |  24 --
 inspector/example-windows-xp-cd.xml|  24 --
 inspector/example-windows.xml  |   1 -
 inspector/expected-archlinux.img.xml   |   1 -
 inspector/expected-coreos.img.xml  |   1 -
 inspector/expected-debian.img.xml  |   1 -
 inspector/expected-fedora.img.xml  |   1 -
 inspector/expected-ubuntu.img.xml  |   1 -
 inspector/expected-windows.img.xml |   1 -
 inspector/inspector.c  |  31 +-
 inspector/virt-inspector.pod   |  22 -
 inspector/virt-inspector.rng   |  15 -
 lib/Makefile.am|   3 -
 lib/guestfs-internal.h |  31 --
 lib/guestfs.pod|   9 -
 lib/inspect-fs-cd.c| 606 --
 lib/inspect-fs.c   |  40 --
 lib/osinfo.c   | 655 -
 33 files changed, 63 insertions(+), 1707 deletions(-)

diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index 8ce6b5865..61cdbea38 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -304,7 +304,6 @@ lib/guid.c
 lib/handle.c
 lib/info.c
 lib/inspect-apps.c
-lib/inspect-fs-cd.c
 lib/inspect-fs-unix.c
 lib/inspect-fs-windows.c
 lib/inspect-fs.c
@@ -323,7 +322,6 @@ lib/listfs.c
 lib/lpj.c
 lib/match.c
 lib/mountable.c
-lib/osinfo.c
 lib/private-data.c
 lib/proto.c
 lib/qemu.c
diff --git a/generator/actions_inspection.ml b/generator/actions_inspection.ml
index b7ea5a4de..cd8b9da18 100644
--- a/generator/actions_inspection.ml
+++ b/generator/actions_inspection.ml
@@ -566,73 +566,6 @@ string C is returned.
 Please read L for more details." };
 
   { defaults with
-name = "inspect_get_format"; added = (1, 9, 4);
-style = RString (RPlainString, "format"), [String (Mountable, "root")], [];
-shortdesc = "get format of inspected operating system";
-longdesc = "\
-This returns the format of the inspected operating system.  You
-can use it to detect install images, live CDs and similar.
-
-Currently defined formats are:
-
-=over 4
-
-=item \"installed\"
-
-This is an installed operating system.
-
-=item \"installer\"
-
-The disk image being inspected is not an installed operating system,
-but a I install disk, live CD, or similar.
-
-=item \"unknown\"
-
-The format of this disk image is not known.
-
-=back
-
-Future versions of libguestfs may return other strings here.
-The caller should be prepared to handle any string.
-
-Please read L for more details." };
-
-  { defaults with
-name = "inspect_is_live"; added = (1, 9, 4);
-style = RBool "live", [String (Mountable, "root")], [];
-shortdesc = "get live flag for install disk";
-longdesc = "\
-If C returns C (this
-is an install disk), then this returns true if a live image
-was detected on the disk.
-
-Please read L for more details." };
-
-  { defaults with
-name = "inspect_is_netinst"; added = (1, 9, 4);
-style = RBool "netinst", [String (Mountable, "root")], [];
-shortdesc = "get netinst (network installer) flag for install disk";
-longdesc = "\
-If C returns C (this
-is an install disk), then this returns true if the disk is
-a network installer, ie. not a self-contained install CD but
-one which is likely to require network access to complete
-the install.
-
-Please read L for more details." };
-
-  { defaults with
-name = "inspect_is_multipart"; added = (1, 9, 4);
-style = RBool "multipart", [String (Mountable, "root")], [];
-shortdesc = "get multipart flag for install disk";
-longdesc = "\
-If C returns C (this
-is an install disk), then this returns true if the disk is
-part of a set.
-
-Please read L for more details." };
-
-  { defaults with
 name = "inspect_get_product_variant"; added = (1, 9, 13);
 style = RString (RPlainString, "variant"), [String (Mountable, "root")], 
[];
 shortdesc = "get 

[Libguestfs] [PATCH v7 02/29] daemon: Allow parts of the daemon and APIs to be written in OCaml.

[Richard W.M. Jones]

This change allows parts of the daemon to be written in the OCaml
programming language.  I am using the ‘Main Program in C’ method along
with ‘-output-obj’ to create an object file from the OCaml code /
runtime, as described here:
https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html

Furthermore, change the generator to allow individual APIs to be
implemented in OCaml.  This is picked by setting:

  impl = OCaml ;

The generator creates ‘do_function’ (the same one you would have to
write by hand in C), with the function calling the named
‘ocaml_function’ and dealing with marshalling/unmarshalling the OCaml
parameters.

Note that the OCaml compiler (either ocamlc or ocamlopt) is now
required even for building from tarballs.
---
 .gitignore|   6 +-
 Makefile.am   |   2 +-
 daemon/Makefile.am| 103 +++--
 daemon/chroot.ml  |  85 +
 daemon/chroot.mli |  35 +
 daemon/daemon-c.c |  35 +
 daemon/daemon.ml  |  39 ++
 daemon/guestfsd.c |  45 +++
 daemon/sysroot-c.c|  37 +
 daemon/sysroot.ml |  19 +
 daemon/sysroot.mli|  22 ++
 daemon/utils.ml   | 156 ++
 daemon/utils.mli  |  65 
 docs/guestfs-building.pod |  10 ++-
 docs/guestfs-hacking.pod  |   7 ++
 generator/actions.ml  |   5 ++
 generator/actions.mli |   4 +
 generator/daemon.ml   | 187 ++
 generator/daemon.mli  |   3 +
 generator/main.ml |   6 ++
 generator/types.ml|   7 +-
 21 files changed, 866 insertions(+), 12 deletions(-)

diff --git a/.gitignore b/.gitignore
index 8afd06d0e..f37ca263a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -164,20 +164,24 @@ Makefile.in
 /customize/test-settings-*.sh
 /customize/virt-customize
 /customize/virt-customize.1
+/daemon/.depend
 /daemon/actions.h
+/daemon/callbacks.ml
+/daemon/caml-stubs.c
 /daemon/dispatch.c
 /daemon/guestfsd
 /daemon/guestfsd.8
 /daemon/guestfsd.exe
+/daemon/lvm-tokenization.c
 /daemon/names.c
 /daemon/optgroups.c
 /daemon/optgroups.h
-/daemon/lvm-tokenization.c
 /daemon/stamp-guestfsd.pod
 /daemon/structs-cleanups.c
 /daemon/structs-cleanups.h
 /daemon/stubs-?.c
 /daemon/stubs.h
+/daemon/types.ml
 /depcomp
 /df/stamp-virt-df.pod
 /df/virt-df
diff --git a/Makefile.am b/Makefile.am
index 9122d44ac..1b091044a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -44,6 +44,7 @@ SUBDIRS += common/structs
 SUBDIRS += lib docs examples po
 
 # The daemon and the appliance.
+SUBDIRS += common/mlutils
 if ENABLE_DAEMON
 SUBDIRS += daemon
 SUBDIRS += tests/daemon
@@ -155,7 +156,6 @@ SUBDIRS += csharp
 # OCaml tools.  Note 'common/ml*', 'mllib' and 'customize' contain
 # shared code used by other OCaml tools, so these must come first.
 if HAVE_OCAML
-SUBDIRS += common/mlutils
 SUBDIRS += common/mlprogress
 SUBDIRS += common/mlvisit
 SUBDIRS += common/mlxml
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index db19594b8..c7375fb87 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -19,6 +19,7 @@ include $(top_srcdir)/subdir-rules.mk
 
 generator_built = \
actions.h \
+   caml-stubs.c \
dispatch.c \
names.c \
lvm-tokenization.c \
@@ -31,13 +32,30 @@ generator_built = \
stubs-4.c \
stubs-5.c \
stubs-6.c \
-   stubs.h
+   stubs.h \
+   callbacks.ml \
+   types.ml
 
 BUILT_SOURCES = \
-   $(generator_built)
+   actions.h \
+   caml-stubs.c \
+   dispatch.c \
+   names.c \
+   lvm-tokenization.c \
+   structs-cleanups.c \
+   structs-cleanups.h \
+   stubs-0.c \
+   stubs-1.c \
+   stubs-2.c \
+   stubs-3.c \
+   stubs-4.c \
+   stubs-5.c \
+   stubs-6.c \
+   stubs.h
 
 EXTRA_DIST = \
-   $(BUILT_SOURCES) \
+   $(generator_built) \
+   $(SOURCES_MLI) $(SOURCES_ML) \
guestfsd.pod
 
 if INSTALL_DAEMON
@@ -61,6 +79,7 @@ guestfsd_SOURCES = \
blkid.c \
blockdev.c \
btrfs.c \
+   caml-stubs.c \
cap.c \
checksum.c \
cleanups.c \
@@ -71,6 +90,7 @@ guestfsd_SOURCES = \
copy.c \
cpio.c \
cpmv.c \
+   daemon-c.c \
daemon.h \
dd.c \
debug.c \
@@ -161,6 +181,7 @@ guestfsd_SOURCES = \
swap.c \
sync.c \
syslinux.c \
+   sysroot-c.c \
tar.c \
tsk.c \
truncate.c \
@@ -176,10 +197,16 @@ guestfsd_SOURCES = \
zero.c \
zerofree.c
 
+guestfsd_LDFLAGS = \
+   -L$(shell $(OCAMLC) -where) \
+   -L$(shell $(OCAMLC) -where)/hivex \
+   -L../common/mlutils \
+   -L../common/mlstdutils
 guestfsd_LDADD = \
../common/errnostring/liberrnostring.la \
../common/protocol/libprotocol.la \
../common/utils/libutils.la \
+   camldaemon.o \

[Libguestfs] [PATCH v7 00/29] Reimplement inspection in the daemon.

[Richard W.M. Jones]

v6 was posted here:

  https://www.redhat.com/archives/libguestfs/2017-June/msg00103.html

and this requires the utilities refactoring posted here:

  https://www.redhat.com/archives/libguestfs/2017-June/msg00169.html

Inspection is now complete[*], although not very well tested.  I'm
intending to compare the output of many guests using old & new
virt-inspector to see if I can find any differences.

Rich.

[*] Except that "name" labels on disks are ignored.  This requires a
bit of complicated work to fix because the names are not actually
available inside the daemon.  So far this only affects a test, it was
not something that any of our tools used.

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v7 10/13] utils: Split out structs cleanups and printing into common/structs.

[Pino Toscano]

On Monday, 19 June 2017 15:31:26 CEST Richard W.M. Jones wrote:
> These won't be used by the daemon, so interferes with us using
> common/utils in the daemon, so they are moved to a different library.
> ---

I checked it again, and the daemon does use structs cleanups:

$ cat generator/main.ml
[...]
  output_to "daemon/structs-cleanups.c"
Daemon.generate_daemon_structs_cleanups_c;
  output_to "daemon/structs-cleanups.h"
Daemon.generate_daemon_structs_cleanups_h;

See commits 32f0f9b032db592b50c4a4b0da29ef0de0478633 and
31fb6e20418e8f1b0647c92af0464f2009e9a997.

So structs cleanups could stay in libutils -- OTOH, structs printing
is only used in the library, and by guestfish.

Thanks,
-- 
Pino Toscano

signature.asc
Description: This is a digitally signed message part.
___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 05/13] common/mlstdutils: Implement complete set of byte swapping functions.

[Richard W.M. Jones]

This implements all of:

 val int_of_le16 : string -> int64
 val le16_of_int : int64 -> string
 val int_of_be16 : string -> int64
 val be16_of_int : int64 -> string
 val int_of_le32 : string -> int64
 val le32_of_int : int64 -> string
 val int_of_be32 : string -> int64
 val be32_of_int : int64 -> string
 val int_of_le64 : string -> int64
 val le64_of_int : int64 -> string
 val int_of_be64 : string -> int64
 val be64_of_int : int64 -> string

and tests.
---
 common/mlstdutils/std_utils.ml   | 131 +++
 common/mlstdutils/std_utils.mli  |  23 +-
 common/mlstdutils/std_utils_tests.ml |  22 --
 3 files changed, 169 insertions(+), 7 deletions(-)

diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index 7b8d65f66..f545c6f7a 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -272,6 +272,21 @@ external identity : 'a -> 'a = "%identity"
 let roundup64 i a = let a = a -^ 1L in (i +^ a) &^ (~^ a)
 let div_roundup64 i a = (i +^ a -^ 1L) /^ a
 
+let int_of_le16 str =
+  assert (String.length str = 2);
+  let c0 = Char.code (String.unsafe_get str 0) in
+  let c1 = Char.code (String.unsafe_get str 1) in
+  Int64.of_int c0 +^
+(Int64.shift_left (Int64.of_int c1) 8)
+
+let le16_of_int i =
+  let c0 = i &^ 0xffL in
+  let c1 = Int64.shift_right (i &^ 0xff00L) 8 in
+  let b = Bytes.create 2 in
+  Bytes.unsafe_set b 0 (Char.unsafe_chr (Int64.to_int c0));
+  Bytes.unsafe_set b 1 (Char.unsafe_chr (Int64.to_int c1));
+  Bytes.to_string b
+
 let int_of_le32 str =
   assert (String.length str = 4);
   let c0 = Char.code (String.unsafe_get str 0) in
@@ -295,6 +310,122 @@ let le32_of_int i =
   Bytes.unsafe_set b 3 (Char.unsafe_chr (Int64.to_int c3));
   Bytes.to_string b
 
+let int_of_le64 str =
+  assert (String.length str = 8);
+  let c0 = Char.code (String.unsafe_get str 0) in
+  let c1 = Char.code (String.unsafe_get str 1) in
+  let c2 = Char.code (String.unsafe_get str 2) in
+  let c3 = Char.code (String.unsafe_get str 3) in
+  let c4 = Char.code (String.unsafe_get str 4) in
+  let c5 = Char.code (String.unsafe_get str 5) in
+  let c6 = Char.code (String.unsafe_get str 6) in
+  let c7 = Char.code (String.unsafe_get str 7) in
+  Int64.of_int c0 +^
+(Int64.shift_left (Int64.of_int c1) 8) +^
+(Int64.shift_left (Int64.of_int c2) 16) +^
+(Int64.shift_left (Int64.of_int c3) 24) +^
+(Int64.shift_left (Int64.of_int c4) 32) +^
+(Int64.shift_left (Int64.of_int c5) 40) +^
+(Int64.shift_left (Int64.of_int c6) 48) +^
+(Int64.shift_left (Int64.of_int c7) 56)
+
+let le64_of_int i =
+  let c0 = i &^ 0xffL in
+  let c1 = Int64.shift_right (i &^ 0xff00L) 8 in
+  let c2 = Int64.shift_right (i &^ 0xffL) 16 in
+  let c3 = Int64.shift_right (i &^ 0xff00L) 24 in
+  let c4 = Int64.shift_right (i &^ 0xffL) 32 in
+  let c5 = Int64.shift_right (i &^ 0xff00L) 40 in
+  let c6 = Int64.shift_right (i &^ 0xffL) 48 in
+  let c7 = Int64.shift_right (i &^ 0xff00L) 56 in
+  let b = Bytes.create 8 in
+  Bytes.unsafe_set b 0 (Char.unsafe_chr (Int64.to_int c0));
+  Bytes.unsafe_set b 1 (Char.unsafe_chr (Int64.to_int c1));
+  Bytes.unsafe_set b 2 (Char.unsafe_chr (Int64.to_int c2));
+  Bytes.unsafe_set b 3 (Char.unsafe_chr (Int64.to_int c3));
+  Bytes.unsafe_set b 4 (Char.unsafe_chr (Int64.to_int c4));
+  Bytes.unsafe_set b 5 (Char.unsafe_chr (Int64.to_int c5));
+  Bytes.unsafe_set b 6 (Char.unsafe_chr (Int64.to_int c6));
+  Bytes.unsafe_set b 7 (Char.unsafe_chr (Int64.to_int c7));
+  Bytes.to_string b
+
+let int_of_be16 str =
+  assert (String.length str = 2);
+  let c0 = Char.code (String.unsafe_get str 0) in
+  let c1 = Char.code (String.unsafe_get str 1) in
+  Int64.of_int c1 +^
+(Int64.shift_left (Int64.of_int c0) 8)
+
+let be16_of_int i =
+  let c0 = i &^ 0xffL in
+  let c1 = Int64.shift_right (i &^ 0xff00L) 8 in
+  let b = Bytes.create 2 in
+  Bytes.unsafe_set b 0 (Char.unsafe_chr (Int64.to_int c1));
+  Bytes.unsafe_set b 1 (Char.unsafe_chr (Int64.to_int c0));
+  Bytes.to_string b
+
+let int_of_be32 str =
+  assert (String.length str = 4);
+  let c0 = Char.code (String.unsafe_get str 0) in
+  let c1 = Char.code (String.unsafe_get str 1) in
+  let c2 = Char.code (String.unsafe_get str 2) in
+  let c3 = Char.code (String.unsafe_get str 3) in
+  Int64.of_int c3 +^
+(Int64.shift_left (Int64.of_int c2) 8) +^
+(Int64.shift_left (Int64.of_int c1) 16) +^
+(Int64.shift_left (Int64.of_int c0) 24)
+
+let be32_of_int i =
+  let c0 = i &^ 0xffL in
+  let c1 = Int64.shift_right (i &^ 0xff00L) 8 in
+  let c2 = Int64.shift_right (i &^ 0xffL) 16 in
+  let c3 = Int64.shift_right (i &^ 0xff00L) 24 in
+  let b = Bytes.create 4 in
+  Bytes.unsafe_set b 0 (Char.unsafe_chr (Int64.to_int c3));
+  Bytes.unsafe_set b 1 (Char.unsafe_chr (Int64.to_int c2));
+  Bytes.unsafe_set b 2 (Char.unsafe_chr (Int64.to_int c1));
+  Bytes.unsafe_set b 3 (Char.unsafe_chr (Int64.to_int c0));
+  

[Libguestfs] [PATCH v7 02/13] mllib: Move Progress OCaml bindings to common/mlprogress.

[Richard W.M. Jones]

The ‘Progress’ module is a self-contained library with the only
dependencies being:

 - the C ‘progress’ implementation

Move it to a separate ‘common/mlprogress’ directory.

This change is pure code refactoring.
---
 .gitignore|   1 +
 Makefile.am   |   1 +
 common/mlprogress/Makefile.am | 111 ++
 {mllib => common/mlprogress}/progress-c.c |   0
 {mllib => common/mlprogress}/progress.ml  |   0
 {mllib => common/mlprogress}/progress.mli |   0
 configure.ac  |   1 +
 docs/C_SOURCE_FILES   |   2 +-
 docs/guestfs-hacking.pod  |   4 ++
 mllib/Makefile.am |   7 +-
 resize/Makefile.am|   9 ++-
 sparsify/Makefile.am  |   9 ++-
 12 files changed, 136 insertions(+), 9 deletions(-)

diff --git a/.gitignore b/.gitignore
index 2367cddcb..ea245c49d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -124,6 +124,7 @@ Makefile.in
 /common/errnostring/errnostring-gperf.gperf
 /common/errnostring/errnostring.h
 /common/miniexpect/miniexpect.3
+/common/mlprogress/.depend
 /common/mlvisit/.depend
 /common/mlvisit/visit_tests
 /common/protocol/guestfs_protocol.c
diff --git a/Makefile.am b/Makefile.am
index 499a1d279..bd0fc94e7 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -154,6 +154,7 @@ SUBDIRS += csharp
 # shared code used by other OCaml tools, so these must come first.
 if HAVE_OCAML
 SUBDIRS += \
+   common/mlprogress \
common/mlvisit \
mllib \
customize \
diff --git a/common/mlprogress/Makefile.am b/common/mlprogress/Makefile.am
new file mode 100644
index 0..d4a229451
--- /dev/null
+++ b/common/mlprogress/Makefile.am
@@ -0,0 +1,111 @@
+# 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 = \
+   progress.mli
+
+SOURCES_ML = \
+   progress.ml
+
+SOURCES_C = \
+   progress-c.c
+
+if HAVE_OCAML
+
+# 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 = libmlprogress.a
+
+if !HAVE_OCAMLOPT
+MLPROGRESS_CMA = mlprogress.cma
+else
+MLPROGRESS_CMA = mlprogress.cmxa
+endif
+
+noinst_DATA = $(MLPROGRESS_CMA)
+
+libmlprogress_a_SOURCES = $(SOURCES_C)
+libmlprogress_a_CPPFLAGS = \
+   -I. \
+   -I$(top_builddir) \
+   -I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
+   -I$(shell $(OCAMLC) -where) \
+   -I$(top_srcdir)/common/utils \
+   -I$(top_srcdir)/lib \
+   -I$(top_srcdir)/common/progress
+libmlprogress_a_CFLAGS = \
+   $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+   $(LIBVIRT_CFLAGS) $(LIBXML2_CFLAGS) \
+   -fPIC
+
+BOBJECTS = $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+# -I $(top_builddir)/lib/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+   -package str,unix \
+   -I $(top_builddir)/common/utils/.libs \
+   -I $(top_builddir)/lib/.libs \
+   -I $(top_builddir)/gnulib/lib/.libs \
+   -I $(top_builddir)/ocaml \
+   -I $(builddir)
+
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+else
+OBJECTS = $(XOBJECTS)
+endif
+
+libmlprogress_a_DEPENDENCIES = $(OBJECTS)
+
+$(MLPROGRESS_CMA): $(OBJECTS) libmlprogress.a
+   $(OCAMLFIND) mklib $(OCAMLPACKAGES) \
+   $(OBJECTS) $(libmlprogress_a_OBJECTS) \
+   -cclib -lprogress \
+   -o mlprogress
+
+# 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 $@
+

[Libguestfs] [PATCH v7 08/13] common/utils: Refactor stdlib, gnulib and libxml2 cleanup functions.

[Richard W.M. Jones]

This refactoring change just moves the cleanup functions around in the
common/utils directory.

libxml2 cleanups are moved to a separate object file, so that we can
still link to libutils even if the main program is not using libxml2
anywhere.

cleanup.c is renamed to cleanups.c.

A new header file cleanups.h is introduced which will replace
guestfs-internal-frontend-cleanups.h (fully replaced in a later commit).
---
 .gitignore   |   3 +-
 common/utils/Makefile.am |   4 +-
 common/utils/{cleanup.c => cleanups.c}   | 105 ++-
 common/utils/cleanups.h  |  82 
 common/utils/guestfs-internal-frontend.h |  58 +
 common/utils/libxml2-cleanups.c  |  94 +++
 docs/C_SOURCE_FILES  |   4 +-
 ocaml/Makefile.am|   1 +
 python/Makefile.am   |  15 +++--
 9 files changed, 216 insertions(+), 150 deletions(-)

diff --git a/.gitignore b/.gitignore
index c347e31bd..ef3b9997f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -488,6 +488,8 @@ Makefile.in
 /python/bindtests.py
 /python/build
 /python/c-ctype.h
+/python/cleanups.c
+/python/cleanups.h
 /python/config.h
 /python/dist
 /python/examples/guestfs-python.3
@@ -496,7 +498,6 @@ Makefile.in
 /python/guestfs.pyc
 /python/guestfs.pyo
 /python/guestfs-internal-all.h
-/python/guestfs-internal-frontend-cleanups.h
 /python/guestfs-internal-frontend.h
 /python/ignore-value.h
 /python/MANIFEST
diff --git a/common/utils/Makefile.am b/common/utils/Makefile.am
index 93f42293a..5c9728797 100644
--- a/common/utils/Makefile.am
+++ b/common/utils/Makefile.am
@@ -33,9 +33,11 @@ noinst_LTLIBRARIES = libutils.la
 
 libutils_la_SOURCES = \
../../lib/guestfs.h \
-   cleanup.c \
+   cleanups.c \
+   cleanups.h \
guestfs-internal-frontend.h \
guestfs-internal-frontend-cleanups.h \
+   libxml2-cleanups.c \
structs-cleanup.c \
structs-print.c \
structs-print.h \
diff --git a/common/utils/cleanup.c b/common/utils/cleanups.c
similarity index 70%
rename from common/utils/cleanup.c
rename to common/utils/cleanups.c
index 6c4558c39..c9a34c2ef 100644
--- a/common/utils/cleanup.c
+++ b/common/utils/cleanups.c
@@ -1,5 +1,5 @@
 /* libguestfs
- * Copyright (C) 2013 Red Hat Inc.
+ * Copyright (C) 2013-2017 Red Hat Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -63,16 +63,12 @@
 #include 
 #include 
 
-#include 
-#include 
-#include 
-#include 
-
 #include "hash.h"
 
-#include "guestfs.h"
 #include "guestfs-internal-frontend.h"
 
+/* Stdlib cleanups. */
+
 void
 guestfs_int_cleanup_free (void *ptr)
 {
@@ -80,21 +76,6 @@ guestfs_int_cleanup_free (void *ptr)
 }
 
 void
-guestfs_int_cleanup_free_string_list (char ***ptr)
-{
-  guestfs_int_free_string_list (*ptr);
-}
-
-void
-guestfs_int_cleanup_hash_free (void *ptr)
-{
-  Hash_table *h = * (Hash_table **) ptr;
-
-  if (h)
-hash_free (h);
-}
-
-void
 guestfs_int_cleanup_unlink_free (char **ptr)
 {
   char *filename = *ptr;
@@ -106,69 +87,6 @@ guestfs_int_cleanup_unlink_free (char **ptr)
 }
 
 void
-guestfs_int_cleanup_xmlFree (void *ptr)
-{
-  xmlChar *buf = * (xmlChar **) ptr;
-
-  if (buf)
-xmlFree (buf);
-}
-
-void
-guestfs_int_cleanup_xmlBufferFree (void *ptr)
-{
-  xmlBufferPtr xb = * (xmlBufferPtr *) ptr;
-
-  if (xb)
-xmlBufferFree (xb);
-}
-
-void
-guestfs_int_cleanup_xmlFreeDoc (void *ptr)
-{
-  xmlDocPtr doc = * (xmlDocPtr *) ptr;
-
-  if (doc)
-xmlFreeDoc (doc);
-}
-
-void
-guestfs_int_cleanup_xmlFreeURI (void *ptr)
-{
-  xmlURIPtr uri = * (xmlURIPtr *) ptr;
-
-  if (uri)
-xmlFreeURI (uri);
-}
-
-void
-guestfs_int_cleanup_xmlFreeTextWriter (void *ptr)
-{
-  xmlTextWriterPtr xo = * (xmlTextWriterPtr *) ptr;
-
-  if (xo)
-xmlFreeTextWriter (xo);
-}
-
-void
-guestfs_int_cleanup_xmlXPathFreeContext (void *ptr)
-{
-  xmlXPathContextPtr ctx = * (xmlXPathContextPtr *) ptr;
-
-  if (ctx)
-xmlXPathFreeContext (ctx);
-}
-
-void
-guestfs_int_cleanup_xmlXPathFreeObject (void *ptr)
-{
-  xmlXPathObjectPtr obj = * (xmlXPathObjectPtr *) ptr;
-
-  if (obj)
-xmlXPathFreeObject (obj);
-}
-
-void
 guestfs_int_cleanup_fclose (void *ptr)
 {
   FILE *f = * (FILE **) ptr;
@@ -185,3 +103,20 @@ guestfs_int_cleanup_pclose (void *ptr)
   if (f)
 pclose (f);
 }
+
+void
+guestfs_int_cleanup_free_string_list (char ***ptr)
+{
+  guestfs_int_free_string_list (*ptr);
+}
+
+/* Gnulib cleanups. */
+
+void
+guestfs_int_cleanup_hash_free (void *ptr)
+{
+  Hash_table *h = * (Hash_table **) ptr;
+
+  if (h)
+hash_free (h);
+}
diff --git a/common/utils/cleanups.h b/common/utils/cleanups.h
new file mode 100644
index 0..df62cafd6
--- /dev/null
+++ b/common/utils/cleanups.h
@@ -0,0 +1,82 @@
+/* libguestfs
+ * Copyright (C) 2013-2017 Red Hat Inc.
+ *
+ * This library is free 

[Libguestfs] [PATCH v7 13/13] daemon: Link guestfsd with libutils.

[Richard W.M. Jones]

After the previous refactoring, we are able to link the daemon to
common/utils, and also remove some of the "duplicate" functions that
the daemon carried ("duplicate" in quotes because they were often not
exact duplicates).

Also this removes the duplicate reimplementation of (most) cleanup
functions in the daemon, since those are provided by libutils now.

It also allows us in future (but not in this commit) to move utility
functions from the daemon into libutils.
---
 daemon/Makefile.am   |  8 +--
 daemon/augeas.c  |  2 +-
 daemon/btrfs.c   | 18 +++
 daemon/cleanups.c| 49 +---
 daemon/cleanups.h| 51 -
 daemon/daemon.h  | 31 -
 daemon/debug.c   |  4 ++--
 daemon/echo-daemon.c |  2 +-
 daemon/guestfsd.c| 64 
 daemon/ldm.c |  2 +-
 daemon/lvm.c |  4 ++--
 daemon/md.c  |  8 ---
 daemon/stat.c|  2 +-
 docs/C_SOURCE_FILES  |  1 -
 generator/daemon.ml  |  8 +++
 15 files changed, 53 insertions(+), 201 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 0d3dde516..db19594b8 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -49,6 +49,8 @@ endif
 guestfsd_SOURCES = \
../common/errnostring/errnostring.h \
../common/protocol/guestfs_protocol.h \
+   ../common/utils/cleanups.h \
+   ../common/utils/utils.h \
9p.c \
acl.c \
actions.h \
@@ -62,7 +64,6 @@ guestfsd_SOURCES = \
cap.c \
checksum.c \
cleanups.c \
-   cleanups.h \
cmp.c \
command.c \
command.h \
@@ -178,6 +179,7 @@ guestfsd_SOURCES = \
 guestfsd_LDADD = \
../common/errnostring/liberrnostring.la \
../common/protocol/libprotocol.la \
+   ../common/utils/libutils.la \
$(ACL_LIBS) \
$(CAP_LIBS) \
$(YAJL_LIBS) \
@@ -206,7 +208,9 @@ guestfsd_CPPFLAGS = \
-I$(top_srcdir)/common/errnostring \
-I$(top_builddir)/common/errnostring \
-I$(top_srcdir)/common/protocol \
-   -I$(top_builddir)/common/protocol
+   -I$(top_builddir)/common/protocol \
+   -I$(top_srcdir)/common/utils \
+   -I$(top_builddir)/common/utils
 guestfsd_CFLAGS = \
$(WARN_CFLAGS) $(WERROR_CFLAGS) \
$(RPC_CFLAGS) \
diff --git a/daemon/augeas.c b/daemon/augeas.c
index 5adc959a5..bd54c4849 100644
--- a/daemon/augeas.c
+++ b/daemon/augeas.c
@@ -436,7 +436,7 @@ do_aug_ls (const char *path)
   if (matches == NULL)
 return NULL;   /* do_aug_match has already sent the error */
 
-  sort_strings (matches, count_strings ((void *) matches));
+  sort_strings (matches, guestfs_int_count_strings ((void *) matches));
   return matches;  /* Caller frees. */
 }
 
diff --git a/daemon/btrfs.c b/daemon/btrfs.c
index ae2310b53..5f1e5d1d0 100644
--- a/daemon/btrfs.c
+++ b/daemon/btrfs.c
@@ -152,7 +152,7 @@ do_mkfs_btrfs (char *const *devices,
int leafsize, const char *label, const char *metadata,
int nodesize, int sectorsize)
 {
-  const size_t nr_devices = count_strings (devices);
+  const size_t nr_devices = guestfs_int_count_strings (devices);
   const size_t MAX_ARGS = nr_devices + 64;
   const char *argv[MAX_ARGS];
   size_t i = 0, j;
@@ -500,7 +500,7 @@ do_btrfs_subvolume_list (const mountable_t *fs)
 
   guestfs_int_btrfssubvolume_list *ret = NULL;
 
-  const size_t nr_subvolumes = count_strings (lines);
+  const size_t nr_subvolumes = guestfs_int_count_strings (lines);
 
   ret = malloc (sizeof *ret);
   if (!ret) {
@@ -733,7 +733,7 @@ int
 do_btrfs_device_add (char *const *devices, const char *fs)
 {
   static int btrfs_device_add_needs_force = -1;
-  const size_t nr_devices = count_strings (devices);
+  const size_t nr_devices = guestfs_int_count_strings (devices);
   const size_t MAX_ARGS = nr_devices + 8;
   const char *argv[MAX_ARGS];
   size_t i = 0, j;
@@ -781,7 +781,7 @@ do_btrfs_device_add (char *const *devices, const char *fs)
 int
 do_btrfs_device_delete (char *const *devices, const char *fs)
 {
-  const size_t nr_devices = count_strings (devices);
+  const size_t nr_devices = guestfs_int_count_strings (devices);
 
   if (nr_devices == 0)
 return 0;
@@ -1391,7 +1391,7 @@ do_btrfs_qgroup_show (const char *path)
*  0/59249849344   9249849344
*
*/
-  const size_t nr_qgroups = count_strings (lines) - 2;
+  const size_t nr_qgroups = guestfs_int_count_strings (lines) - 2;
   guestfs_int_btrfsqgroup_list *ret = NULL;
   ret = malloc (sizeof *ret);
   if (!ret) {
@@ -1821,7 +1821,7 @@ do_btrfs_balance_status (const char *path)
   if (!lines)
 return NULL;
 
-  nlines = count_strings (lines);
+  nlines = guestfs_int_count_strings (lines);
 
   ret = calloc (1, sizeof *ret);
   if (ret == NULL) {
@@ -1938,7 +1938,7 @@ do_btrfs_scrub_status (const char *path)
   if 

[Libguestfs] [PATCH v7 12/13] utils: Rename ‘guestfs-internal-frontend.h’ to ‘guestfs-utils.h’.

[Richard W.M. Jones]

The reason it's not just ‘utils.h’ is because Pino is worried that we
might pick up /usr/include/utils.h from a rogue library.
---
 .gitignore   |  2 +-
 builder/index-validate.c |  2 +-
 builder/pxzcat-c.c   |  2 +-
 common/edit/file-edit.c  |  2 +-
 common/mlutils/c_utils-c.c   |  2 +-
 common/options/options.h |  2 +-
 common/options/uri.c |  2 +-
 common/parallel/domains.c|  2 +-
 common/parallel/estimate-max-threads.c   |  2 +-
 common/parallel/parallel.c   |  2 +-
 common/progress/progress.c   |  2 +-
 common/utils/Makefile.am |  2 +-
 common/utils/cleanups.c  |  2 +-
 .../utils/{guestfs-internal-frontend.h => guestfs-utils.h}   |  6 +++---
 common/utils/utils.c |  2 +-
 common/visit/visit.c |  2 +-
 common/windows/windows.c |  2 +-
 docs/C_SOURCE_FILES  |  2 +-
 erlang/main.c|  2 +-
 fish/fish.h  |  2 +-
 fuse/guestunmount.c  |  2 +-
 fuse/test-fuse.c |  2 +-
 fuse/test-guestmount-fd.c|  2 +-
 fuse/test-guestunmount-fd.c  |  2 +-
 generator/OCaml.ml   |  2 +-
 generator/erlang.ml  |  6 +++---
 generator/fish.ml|  4 ++--
 generator/java.ml|  2 +-
 generator/lua.ml |  2 +-
 generator/php.ml |  2 +-
 generator/python.ml  |  2 +-
 generator/ruby.ml|  2 +-
 generator/tests_c_api.ml |  2 +-
 java/handle.c|  2 +-
 lib/Makefile.am  |  2 +-
 lib/guestfs-internal-all.h   |  9 -
 lib/guestfs-internal.h   |  5 ++---
 lib/unit-tests.c |  2 +-
 make-fs/make-fs.c|  2 +-
 mllib/getopt-c.c |  2 +-
 mllib/uri-c.c|  2 +-
 ocaml/guestfs-c.c|  2 +-
 p2v/p2v.h|  4 ++--
 python/MANIFEST.in   |  4 ++--
 python/Makefile.am   | 12 ++--
 rescue/escape.c  |  2 +-
 rescue/rescue.c  |  2 +-
 rescue/suggest.c |  2 +-
 test-tool/test-tool.c|  2 +-
 tests/c-api/test-add-drive-opts.c|  2 +-
 tests/c-api/test-add-libvirt-dom.c   |  2 +-
 tests/c-api/test-backend-settings.c  |  2 +-
 tests/c-api/test-config.c|  2 +-
 tests/c-api/test-create-handle.c |  2 +-
 tests/c-api/test-debug-to-file.c |  2 +-
 tests/c-api/test-environment.c   |  2 +-
 tests/c-api/test-event-string.c  |  2 +-
 tests/c-api/test-last-errno.c|  2 +-
 tests/c-api/test-private-data.c  |  2 +-
 tests/c-api/test-user-cancel.c   |  2 +-
 tests/c-api/tests-main.c |  2 +-
 tests/charsets/test-charset-fidelity.c   |  2 +-
 tests/disks/test-add-disks.c |  2 +-
 tests/events/test-libvirt-auth-callbacks.c   |  2 +-
 tests/mount-local/test-parallel-mount-local.c|  2 +-
 tests/parallel/test-parallel.c   |  2 +-
 tests/regressions/rhbz1055452.c  |  2 +-
 tests/regressions/rhbz501893.c   |  2 +-
 tests/regressions/rhbz790721.c   |  2 +-
 

[Libguestfs] [PATCH v7 11/13] mllib, v2v: Split out OCaml utils bindings ‘common/mlutils’.

[Richard W.M. Jones]

Create a module ‘C_utils’ containing functions like ‘drive_name’ and
‘shell_unquote’ which come from the C utilities.

The new directory ‘common/mlutils’ also contains the ‘Unix_utils’
wrappers around POSIX functions missing from the OCaml stdlib.
---
 .gitignore  |   3 +
 Makefile.am |  24 ++---
 builder/Makefile.am |   6 +-
 common/mlutils/Makefile.am  | 154 
 v2v/utils-c.c => common/mlutils/c_utils-c.c |   6 +-
 common/mlutils/c_utils.ml   |  26 +
 common/mlutils/c_utils.mli  |  30 ++
 common/mlutils/c_utils_unit_tests.ml|  81 +++
 common/mlutils/dummy.c  |   2 +
 {mllib => common/mlutils}/unix_utils-c.c|   0
 {mllib => common/mlutils}/unix_utils.ml |   0
 {mllib => common/mlutils}/unix_utils.mli|   0
 configure.ac|   1 +
 customize/Makefile.am   |   5 +-
 dib/Makefile.am |   5 +-
 docs/C_SOURCE_FILES |   5 +-
 docs/guestfs-hacking.pod|   5 +
 get-kernel/Makefile.am  |   5 +-
 mllib/Makefile.am   |   8 +-
 resize/Makefile.am  |   5 +-
 sparsify/Makefile.am|   5 +-
 sysprep/Makefile.am |   5 +-
 v2v/Makefile.am |  12 ++-
 v2v/convert_linux.ml|   3 +-
 v2v/create_libvirt_xml.ml   |   1 +
 v2v/parse_libvirt_xml.ml|   3 +-
 v2v/utils.ml|   5 -
 v2v/utils.mli   |  11 --
 v2v/v2v.ml  |   1 +
 v2v/v2v_unit_tests.ml   |  46 -
 30 files changed, 366 insertions(+), 97 deletions(-)

diff --git a/.gitignore b/.gitignore
index 019b96da5..cd8051d08 100644
--- a/.gitignore
+++ b/.gitignore
@@ -130,6 +130,9 @@ Makefile.in
 /common/mlstdutils/libdir.ml
 /common/mlstdutils/oUnit-*
 /common/mlstdutils/std_utils_tests
+/common/mlutils/.depend
+/common/mlutils/c_utils_unit_tests
+/common/mlutils/oUnit-*
 /common/mlvisit/.depend
 /common/mlvisit/visit_tests
 /common/mlxml/.depend
diff --git a/Makefile.am b/Makefile.am
index b14ce4813..9122d44ac 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -155,18 +155,18 @@ SUBDIRS += csharp
 # OCaml tools.  Note 'common/ml*', 'mllib' and 'customize' contain
 # shared code used by other OCaml tools, so these must come first.
 if HAVE_OCAML
-SUBDIRS += \
-   common/mlprogress \
-   common/mlvisit \
-   common/mlxml \
-   mllib \
-   customize \
-   builder builder/templates \
-   get-kernel \
-   resize \
-   sparsify \
-   sysprep \
-   v2v
+SUBDIRS += common/mlutils
+SUBDIRS += common/mlprogress
+SUBDIRS += common/mlvisit
+SUBDIRS += common/mlxml
+SUBDIRS += mllib
+SUBDIRS += customize
+SUBDIRS += builder builder/templates
+SUBDIRS += get-kernel
+SUBDIRS += resize
+SUBDIRS += sparsify
+SUBDIRS += sysprep
+SUBDIRS += v2v
 if HAVE_OCAML_PKG_LIBVIRT
 SUBDIRS += v2v/test-harness
 endif
diff --git a/builder/Makefile.am b/builder/Makefile.am
index 5f0606ca4..09ae4ae3c 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -125,6 +125,7 @@ OCAMLPACKAGES = \
-I $(top_builddir)/gnulib/lib/.libs \
-I $(top_builddir)/ocaml \
-I $(top_builddir)/common/mlstdutils \
+   -I $(top_builddir)/common/mlutils \
-I $(top_builddir)/mllib \
-I $(top_builddir)/customize
 OCAMLPACKAGES_TESTS =
@@ -157,6 +158,7 @@ endif
 OCAMLLINKFLAGS = \
mlstdutils.$(MLARCHIVE) \
mlguestfs.$(MLARCHIVE) \
+   mlcutils.$(MLARCHIVE) \
mllib.$(MLARCHIVE) \
customize.$(MLARCHIVE) \
$(LINK_CUSTOM_OCAMLC_ONLY)
@@ -164,6 +166,7 @@ OCAMLLINKFLAGS = \
 virt_builder_DEPENDENCIES = \
$(OBJECTS) \
../common/mlstdutils/mlstdutils.$(MLARCHIVE) \
+   ../common/mlutils/mlcutils.$(MLARCHIVE) \
../mllib/mllib.$(MLARCHIVE) \
../customize/customize.$(MLARCHIVE) \
$(top_srcdir)/ocaml-link.sh
@@ -236,6 +239,7 @@ endif
 yajl_tests_DEPENDENCIES = \
$(yajl_tests_THEOBJECTS) \
../common/mlstdutils/mlstdutils.$(MLARCHIVE) \
+   ../common/mlutils/mlcutils.$(MLARCHIVE) \
../mllib/mllib.$(MLARCHIVE) \
../customize/customize.$(MLARCHIVE) \
$(top_srcdir)/ocaml-link.sh
@@ -307,7 +311,7 @@ depend: .depend
 
 .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
rm -f $@ $@-t
-   $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I 
$(abs_top_builddir)/mlstdutils -I $(abs_top_builddir)/mllib -I 
$(abs_top_builddir)/customize $^ | \
+   $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I 
$(abs_top_builddir)/mlstdutils -I 

[Libguestfs] [PATCH v7 10/13] utils: Split out structs cleanups and printing into common/structs.

[Richard W.M. Jones]

These won't be used by the daemon, so interferes with us using
common/utils in the daemon, so they are moved to a different library.
---
 .gitignore   |  8 +++---
 Makefile.am  |  4 ++-
 align/Makefile.am|  2 ++
 align/scan.c |  1 +
 cat/Makefile.am  | 10 
 cat/filesystems.c|  1 +
 cat/log.c|  1 +
 cat/tail.c   |  1 +
 common/mlvisit/Makefile.am   |  3 ++-
 common/structs/Makefile.am   | 44 
 common/utils/Makefile.am | 16 
 common/utils/guestfs-internal-frontend.h |  5 
 common/visit/Makefile.am |  3 ++-
 common/visit/visit.c |  1 +
 configure.ac |  1 +
 df/Makefile.am   |  2 ++
 df/df.c  |  1 +
 diff/Makefile.am |  1 +
 docs/C_SOURCE_FILES  |  8 +++---
 docs/guestfs-hacking.pod |  5 
 fish/Makefile.am |  4 +++
 generator/c.ml   | 17 +---
 generator/c.mli  |  4 +--
 generator/java.ml|  1 +
 generator/main.ml| 12 -
 generator/tests_c_api.ml |  1 +
 inspector/Makefile.am|  2 ++
 inspector/inspector.c|  1 +
 java/Makefile.am |  2 ++
 lib/Makefile.am  |  6 -
 lib/file.c   |  1 +
 lib/fuse.c   |  1 +
 lib/inspect-apps.c   |  1 +
 lib/inspect-fs-windows.c |  1 +
 lib/inspect-fs.c |  1 +
 lib/launch.c |  1 +
 lib/listfs.c |  1 +
 lib/mountable.c  |  2 +-
 make-fs/Makefile.am  |  2 ++
 make-fs/make-fs.c|  1 +
 sysprep/Makefile.am  |  2 ++
 tests/c-api/Makefile.am  |  2 ++
 tests/c-api/tests-main.c |  1 +
 43 files changed, 133 insertions(+), 52 deletions(-)

diff --git a/.gitignore b/.gitignore
index ef3b9997f..019b96da5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -137,10 +137,10 @@ Makefile.in
 /common/protocol/guestfs_protocol.h
 /common/protocol/guestfs_protocol.x
 /common/qemuopts/qemuopts-tests
-/common/utils/guestfs-internal-frontend-cleanups.h
-/common/utils/structs-cleanup.c
-/common/utils/structs-print.c
-/common/utils/structs-print.h
+/common/structs/structs-cleanups.c
+/common/structs/structs-cleanups.h
+/common/structs/structs-print.c
+/common/structs/structs-print.h
 /compile
 /config.cache
 /config.guess
diff --git a/Makefile.am b/Makefile.am
index 64ac23f2e..b14ce4813 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -38,7 +38,9 @@ SUBDIRS += gnulib/tests
 endif
 
 # Basic source for the library.
-SUBDIRS += common/errnostring common/protocol common/qemuopts common/utils
+SUBDIRS += common/errnostring common/protocol common/qemuopts
+SUBDIRS += common/utils
+SUBDIRS += common/structs
 SUBDIRS += lib docs examples po
 
 # The daemon and the appliance.
diff --git a/align/Makefile.am b/align/Makefile.am
index 8d4fce11b..cc8df13f7 100644
--- a/align/Makefile.am
+++ b/align/Makefile.am
@@ -31,6 +31,7 @@ virt_alignment_scan_SOURCES = \
 virt_alignment_scan_CPPFLAGS = \
-DGUESTFS_WARN_DEPRECATED=1 \
-I$(top_srcdir)/common/utils -I$(top_builddir)/common/utils \
+   -I$(top_srcdir)/common/structs -I$(top_builddir)/common/structs \
-I$(top_srcdir)/lib -I$(top_builddir)/lib \
-I$(top_srcdir)/common/options -I$(top_builddir)/common/options \
-I$(top_srcdir)/common/parallel -I$(top_builddir)/common/parallel \
@@ -46,6 +47,7 @@ virt_alignment_scan_CFLAGS = \
 virt_alignment_scan_LDADD = \
$(top_builddir)/common/options/liboptions.la \
$(top_builddir)/common/parallel/libparallel.la \
+   $(top_builddir)/common/structs/libstructs.la \
$(top_builddir)/common/utils/libutils.la \
$(top_builddir)/lib/libguestfs.la \
$(LIBXML2_LIBS) \
diff --git a/align/scan.c b/align/scan.c
index 4fa95c0a3..b9f29868c 100644
--- a/align/scan.c
+++ b/align/scan.c
@@ -41,6 +41,7 @@
 #include "getprogname.h"
 
 #include "guestfs.h"
+#include "structs-cleanups.h"
 #include "options.h"
 #include "display-options.h"
 #include "parallel.h"
diff --git a/cat/Makefile.am b/cat/Makefile.am
index 4b9171937..3fb579769 100644
--- a/cat/Makefile.am
+++ b/cat/Makefile.am
@@ -39,6 +39,7 @@ virt_cat_CPPFLAGS = \
-DGUESTFS_WARN_DEPRECATED=1 \
-DLOCALEBASEDIR=\""$(datadir)/locale"\" \
-I$(top_srcdir)/common/utils 

[Libguestfs] [PATCH v7 03/13] mllib: Move Xml (libxml2) OCaml bindings to common/mlxml.

[Richard W.M. Jones]

The ‘Xml’ module is a self-contained library of bindings for libxml2,
with no other dependencies.

Move it to a separate ‘common/mlxml’ directory.

This is not pure refactoring.  For unclear reasons, the previous
version of ‘Xml.parse_file’ read the whole file into memory and then
called ‘xmlReadMemory’.  This was quite inefficient, and unnecessary
because we could use ‘xmlReadFile’ to read and parse the file
efficiently.  Changing the code to use ‘xmlReadFile’ also removes the
unnecessary dependency on ‘Common_utils.read_whole_file’.
---
 .gitignore  |   1 +
 Makefile.am |   1 +
 common/mlxml/Makefile.am| 107 
 {mllib => common/mlxml}/xml-c.c |  21 
 {mllib => common/mlxml}/xml.ml  |   8 +--
 {mllib => common/mlxml}/xml.mli |   0
 configure.ac|   1 +
 docs/C_SOURCE_FILES |   2 +-
 docs/guestfs-hacking.pod|   4 ++
 mllib/Makefile.am   |  13 +++--
 v2v/Makefile.am |  11 -
 v2v/test-harness/Makefile.am|   3 +-
 12 files changed, 158 insertions(+), 14 deletions(-)

diff --git a/.gitignore b/.gitignore
index ea245c49d..a82a1f674 100644
--- a/.gitignore
+++ b/.gitignore
@@ -127,6 +127,7 @@ Makefile.in
 /common/mlprogress/.depend
 /common/mlvisit/.depend
 /common/mlvisit/visit_tests
+/common/mlxml/.depend
 /common/protocol/guestfs_protocol.c
 /common/protocol/guestfs_protocol.h
 /common/protocol/guestfs_protocol.x
diff --git a/Makefile.am b/Makefile.am
index bd0fc94e7..48f538475 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -156,6 +156,7 @@ if HAVE_OCAML
 SUBDIRS += \
common/mlprogress \
common/mlvisit \
+   common/mlxml \
mllib \
customize \
builder builder/templates \
diff --git a/common/mlxml/Makefile.am b/common/mlxml/Makefile.am
new file mode 100644
index 0..1a989949f
--- /dev/null
+++ b/common/mlxml/Makefile.am
@@ -0,0 +1,107 @@
+# 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 = \
+   xml.mli
+
+SOURCES_ML = \
+   xml.ml
+
+SOURCES_C = \
+   xml-c.c
+
+if HAVE_OCAML
+
+# 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 = libmlxml.a
+
+if !HAVE_OCAMLOPT
+MLXML_CMA = mlxml.cma
+else
+MLXML_CMA = mlxml.cmxa
+endif
+
+noinst_DATA = $(MLXML_CMA)
+
+libmlxml_a_SOURCES = $(SOURCES_C)
+libmlxml_a_CPPFLAGS = \
+   -I. \
+   -I$(top_builddir) \
+   -I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
+   -I$(shell $(OCAMLC) -where)
+libmlxml_a_CFLAGS = \
+   $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+   $(LIBXML2_CFLAGS) \
+   -fPIC
+
+BOBJECTS = $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+# -I $(top_builddir)/lib/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+   -package str,unix \
+   -I $(top_builddir)/common/utils/.libs \
+   -I $(top_builddir)/lib/.libs \
+   -I $(top_builddir)/gnulib/lib/.libs \
+   -I $(builddir)
+
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+else
+OBJECTS = $(XOBJECTS)
+endif
+
+libmlxml_a_DEPENDENCIES = $(OBJECTS)
+
+$(MLXML_CMA): $(OBJECTS) libmlxml.a
+   $(OCAMLFIND) mklib $(OCAMLPACKAGES) \
+   $(OBJECTS) $(libmlxml_a_OBJECTS) \
+   -cclib '$(LIBXML2_LIBS)' \
+   -o mlxml
+
+# Dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+   rm -f $@ $@-t
+   $(OCAMLFIND) ocamldep -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
+
+endif
+
+.PHONY: depend docs
diff --git a/mllib/xml-c.c 

[Libguestfs] [PATCH v7 01/13] mllib: Move Visit OCaml bindings to common/mlvisit.

[Richard W.M. Jones]

The ‘Visit’ module is a self-contained library with the only
dependencies being:

 - the C ‘visit’ implementation

 - the guestfs OCaml bindings

Move it to a separate ‘common/mlvisit’ directory.

This change is not entirely refactoring.  Two other fixes are made:

 - remove unsafe use of CLEANUP_FREE from a function which could
   raise an OCaml exception (cleanup handlers would not be called
   correctly if the exception is thrown)

 - don't link directly to common/visit/visit.c, but instead use
   the library (common/visit/libvisit.la)
---
 .gitignore   |   3 +-
 Makefile.am  |   5 +-
 common/mlvisit/Makefile.am   | 152 +++
 common/mlvisit/dummy.c   |   2 +
 {mllib => common/mlvisit}/visit-c.c  |   6 +-
 {mllib => common/mlvisit}/visit.ml   |   0
 {mllib => common/mlvisit}/visit.mli  |   0
 {mllib => common/mlvisit}/visit_tests.ml |   0
 configure.ac |   1 +
 docs/C_SOURCE_FILES  |   3 +-
 docs/guestfs-hacking.pod |   4 +
 mllib/Makefile.am|  30 +-
 sysprep/Makefile.am  |  10 +-
 13 files changed, 180 insertions(+), 36 deletions(-)

diff --git a/.gitignore b/.gitignore
index 69e1ae160..2367cddcb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -124,6 +124,8 @@ Makefile.in
 /common/errnostring/errnostring-gperf.gperf
 /common/errnostring/errnostring.h
 /common/miniexpect/miniexpect.3
+/common/mlvisit/.depend
+/common/mlvisit/visit_tests
 /common/protocol/guestfs_protocol.c
 /common/protocol/guestfs_protocol.h
 /common/protocol/guestfs_protocol.x
@@ -366,7 +368,6 @@ 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/Makefile.am b/Makefile.am
index ae77cdda2..499a1d279 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -150,10 +150,11 @@ endif
 # Unconditional because nothing is built yet.
 SUBDIRS += csharp
 
-# OCaml tools.  Note 'mllib' and 'customize' contain shared code used
-# by other OCaml tools, so these must come first.
+# OCaml tools.  Note 'common/ml*', 'mllib' and 'customize' contain
+# shared code used by other OCaml tools, so these must come first.
 if HAVE_OCAML
 SUBDIRS += \
+   common/mlvisit \
mllib \
customize \
builder builder/templates \
diff --git a/common/mlvisit/Makefile.am b/common/mlvisit/Makefile.am
new file mode 100644
index 0..51cbd2de6
--- /dev/null
+++ b/common/mlvisit/Makefile.am
@@ -0,0 +1,152 @@
+# 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) \
+   visit_tests.ml
+
+SOURCES_MLI = \
+   visit.mli
+
+SOURCES_ML = \
+   visit.ml
+
+SOURCES_C = \
+   visit-c.c
+
+if HAVE_OCAML
+
+# 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 = libmlvisit.a
+
+if !HAVE_OCAMLOPT
+MLVISIT_CMA = mlvisit.cma
+else
+MLVISIT_CMA = mlvisit.cmxa
+endif
+
+noinst_DATA = $(MLVISIT_CMA)
+
+libmlvisit_a_SOURCES = $(SOURCES_C)
+libmlvisit_a_CPPFLAGS = \
+   -I. \
+   -I$(top_builddir) \
+   -I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
+   -I$(shell $(OCAMLC) -where) \
+   -I$(top_srcdir)/lib \
+   -I$(top_srcdir)/common/visit
+libmlvisit_a_CFLAGS = \
+   $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+   $(LIBVIRT_CFLAGS) $(LIBXML2_CFLAGS) \
+   -fPIC
+
+BOBJECTS = $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+# -I $(top_builddir)/lib/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+   -package str,unix \
+   -I $(top_builddir)/lib/.libs \
+   -I $(top_builddir)/gnulib/lib/.libs \
+   -I $(top_builddir)/ocaml \
+   -I $(top_builddir)/common/utils/.libs \
+   -I 

[Libguestfs] [PATCH v7 06/13] common/mlstdutils: Implement ‘Char.mem’, ‘String.span’ and ‘String.cspan’.

[Richard W.M. Jones]

Char.mem tells you if a byte is a member of a string.

String.span and String.cspan are like the C functions strspn and
strcspn.
---
 common/mlstdutils/std_utils.ml   | 27 +++
 common/mlstdutils/std_utils.mli  | 12 
 common/mlstdutils/std_utils_tests.ml | 21 +
 3 files changed, 60 insertions(+)

diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index f545c6f7a..a153ceb7f 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -74,6 +74,15 @@ module Char = struct
   | 'e' | 'E' -> 14
   | 'f' | 'F' -> 15
   | _ -> -1
+
+let mem c str =
+  let len = String.length str in
+  let rec loop i =
+if i >= len then false
+else if String.unsafe_get str i = c then true
+else loop (i+1)
+  in
+  loop 0
 end
 
 module String = struct
@@ -246,6 +255,24 @@ module String = struct
   List.map f (explode str)
 
 let spaces n = String.make n ' '
+
+let span str accept =
+  let len = String.length str in
+  let rec loop i =
+if i >= len then len
+else if Char.mem (String.unsafe_get str i) accept then loop (i+1)
+else i
+  in
+  loop 0
+
+let cspan str reject =
+  let len = String.length str in
+  let rec loop i =
+if i >= len then len
+else if Char.mem (String.unsafe_get str i) reject then i
+else loop (i+1)
+  in
+  loop 0
 end
 
 let (//) = Filename.concat
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index 686d4193f..b61b9bb02 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -41,6 +41,9 @@ module Char : sig
 val hexdigit : char -> int
 (** Return the value of a hex digit.  If the char is not in
 the set [[0-9a-fA-F]] then this returns [-1]. *)
+
+val mem : char -> string -> bool
+(** [mem c str] returns true if the byte [c] is contained in [str]. *)
 end
 (** Override the Char module from stdlib. *)
 
@@ -109,6 +112,15 @@ module String : sig
 (** Explode string, then map function over the characters. *)
 val spaces : int -> string
 (** [spaces n] creates a string of n spaces. *)
+val span : string -> string -> int
+val cspan : string -> string -> int
+(** [span str accept] returns the length in bytes of the initial
+segment of [str] which contains only bytes in [accept].
+
+[cspan str reject] returns the length in bytes of the initial
+segment of [str] which contains only bytes {!i not} in [reject].
+
+These work exactly like the C functions [strspn] and [strcspn]. *)
 end
 (** Override the String module from stdlib. *)
 
diff --git a/common/mlstdutils/std_utils_tests.ml 
b/common/mlstdutils/std_utils_tests.ml
index 6bc74fb63..2789766c6 100644
--- a/common/mlstdutils/std_utils_tests.ml
+++ b/common/mlstdutils/std_utils_tests.ml
@@ -50,6 +50,14 @@ and test_swap int_of_x x_of_int i s =
   assert_equal_int64 i (int_of_x s);
   assert_equal_string s (x_of_int i)
 
+(* Test Std_utils.Char.mem. *)
+let test_char_mem ctx =
+  assert_bool "Char.mem" (Char.mem 'a' "abc");
+  assert_bool "Char.mem" (Char.mem 'b' "abc");
+  assert_bool "Char.mem" (Char.mem 'c' "abc");
+  assert_bool "Char.mem" (not (Char.mem 'd' "abc"));
+  assert_bool "Char.mem" (not (Char.mem 'a' ""))
+
 (* Test Std_utils.String.is_prefix. *)
 let test_string_is_prefix ctx =
   assert_bool "String.is_prefix,," (String.is_prefix "" "");
@@ -91,16 +99,29 @@ let test_string_lines_split ctx =
   assert_equal_stringlist ["A\nB"; ""] (String.lines_split "A\\\nB\n");
   assert_equal_stringlist ["A\nB\n"] (String.lines_split "A\\\nB\\\n")
 
+(* Test Std_utils.String.span and cspan. *)
+let test_string_span ctx =
+  assert_equal_int 3 (String.span "aaabb" "a");
+  assert_equal_int 3 (String.span "aaaba" "a");
+  assert_equal_int 3 (String.span "aba" "ab");
+  assert_equal_int 0 (String.span "" "ab");
+  assert_equal_int 3 (String.cspan "defab" "ab");
+  assert_equal_int 3 (String.cspan "defba" "ab");
+  assert_equal_int 3 (String.cspan "def" "ab");
+  assert_equal_int 0 (String.cspan "" "ab")
+
 (* Suites declaration. *)
 let suite =
   "mllib Std_utils" >:::
 [
   "subdirectory" >:: test_subdirectory;
   "numeric.byteswap" >:: test_byteswap;
+  "char.mem" >:: test_char_mem;
   "strings.is_prefix" >:: test_string_is_prefix;
   "strings.is_suffix" >:: test_string_is_suffix;
   "strings.find" >:: test_string_find;
   "strings.lines_split" >:: test_string_lines_split;
+  "strings.span" >:: test_string_span;
 ]
 
 let () =
-- 
2.13.0

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 09/13] common/utils: cleanups: Add CLEANUP_CLOSE function.

[Richard W.M. Jones]

This is present in the daemon, but the function could be used
throughout the code.
---
 common/utils/cleanups.c | 9 +
 common/utils/cleanups.h | 4 
 2 files changed, 13 insertions(+)

diff --git a/common/utils/cleanups.c b/common/utils/cleanups.c
index c9a34c2ef..47da587bb 100644
--- a/common/utils/cleanups.c
+++ b/common/utils/cleanups.c
@@ -87,6 +87,15 @@ guestfs_int_cleanup_unlink_free (char **ptr)
 }
 
 void
+guestfs_int_cleanup_close (void *ptr)
+{
+  const int fd = * (int *) ptr;
+
+  if (fd >= 0)
+close (fd);
+}
+
+void
 guestfs_int_cleanup_fclose (void *ptr)
 {
   FILE *f = * (FILE **) ptr;
diff --git a/common/utils/cleanups.h b/common/utils/cleanups.h
index df62cafd6..75df0074c 100644
--- a/common/utils/cleanups.h
+++ b/common/utils/cleanups.h
@@ -26,6 +26,8 @@
   __attribute__((cleanup(guestfs_int_cleanup_hash_free)))
 #define CLEANUP_UNLINK_FREE \
   __attribute__((cleanup(guestfs_int_cleanup_unlink_free)))
+#define CLEANUP_CLOSE  \
+  __attribute__((cleanup(guestfs_int_cleanup_close)))
 #define CLEANUP_FCLOSE  \
   __attribute__((cleanup(guestfs_int_cleanup_fclose)))
 #define CLEANUP_PCLOSE  \
@@ -50,6 +52,7 @@
 #define CLEANUP_FREE
 #define CLEANUP_HASH_FREE
 #define CLEANUP_UNLINK_FREE
+#define CLEANUP_CLOSE
 #define CLEANUP_FCLOSE
 #define CLEANUP_PCLOSE
 #define CLEANUP_FREE_STRING_LIST
@@ -68,6 +71,7 @@
 extern void guestfs_int_cleanup_free (void *ptr);
 extern void guestfs_int_cleanup_hash_free (void *ptr);
 extern void guestfs_int_cleanup_unlink_free (char **ptr);
+extern void guestfs_int_cleanup_close (void *ptr);
 extern void guestfs_int_cleanup_fclose (void *ptr);
 extern void guestfs_int_cleanup_pclose (void *ptr);
 extern void guestfs_int_cleanup_free_string_list (char ***ptr);
-- 
2.13.0

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 07/13] common/utils: Move ‘uefi.c’ to ‘lib/’.

[Richard W.M. Jones]

This was only used inside the library, so move it there.
---
 .gitignore   |  2 +-
 common/utils/Makefile.am |  4 +---
 common/utils/guestfs-internal-frontend.h | 12 
 docs/C_SOURCE_FILES  |  2 +-
 generator/UEFI.ml|  3 ++-
 generator/main.ml|  2 +-
 lib/Makefile.am  |  3 ++-
 lib/appliance-uefi.c |  2 +-
 lib/guestfs-internal.h   | 12 
 9 files changed, 21 insertions(+), 21 deletions(-)

diff --git a/.gitignore b/.gitignore
index 991b1ab94..c347e31bd 100644
--- a/.gitignore
+++ b/.gitignore
@@ -141,7 +141,6 @@ Makefile.in
 /common/utils/structs-cleanup.c
 /common/utils/structs-print.c
 /common/utils/structs-print.h
-/common/utils/uefi.c
 /compile
 /config.cache
 /config.guess
@@ -341,6 +340,7 @@ Makefile.in
 /lib/structs-copy.c
 /lib/structs-free.c
 /lib/unit-tests
+/lib/uefi.c
 /libguestfs.spec
 /libguestfs-*.tar.gz
 /libtool
diff --git a/common/utils/Makefile.am b/common/utils/Makefile.am
index 81a567b86..93f42293a 100644
--- a/common/utils/Makefile.am
+++ b/common/utils/Makefile.am
@@ -21,8 +21,7 @@ generator_built = \
guestfs-internal-frontend-cleanups.h \
structs-cleanup.c \
structs-print.c \
-   structs-print.h \
-   uefi.c
+   structs-print.h
 
 BUILT_SOURCES = \
$(generator_built)
@@ -40,7 +39,6 @@ libutils_la_SOURCES = \
structs-cleanup.c \
structs-print.c \
structs-print.h \
-   uefi.c \
utils.c
 libutils_la_CPPFLAGS = \
-DGUESTFS_WARN_DEPRECATED=1 \
diff --git a/common/utils/guestfs-internal-frontend.h 
b/common/utils/guestfs-internal-frontend.h
index e48f4eb49..489b54ffd 100644
--- a/common/utils/guestfs-internal-frontend.h
+++ b/common/utils/guestfs-internal-frontend.h
@@ -102,18 +102,6 @@ extern void guestfs_int_fadvise_noreuse (int fd);
 //extern void guestfs_int_fadvise_willneed (int fd);
 extern char *guestfs_int_shell_unquote (const char *str);
 
-/* uefi.c */
-struct uefi_firmware {
-  const char *code;/* code file (NULL = end of list) */
-  const char *code_debug;  /* code file with debugging msgs (may be NULL)*/
-  const char *vars;/* vars template file */
-  int flags;/* various flags, see below */
-#define UEFI_FLAG_SECURE_BOOT_REQUIRED 1 /* secure boot (see RHBZ#1367615) */
-};
-extern struct uefi_firmware guestfs_int_uefi_i386_firmware[];
-extern struct uefi_firmware guestfs_int_uefi_x86_64_firmware[];
-extern struct uefi_firmware guestfs_int_uefi_aarch64_firmware[];
-
 /* These functions are used internally by the CLEANUP_* macros.
  * Don't call them directly.
  */
diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index ce09299ba..f9ffb0a7d 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -48,7 +48,6 @@ common/utils/guestfs-internal-frontend.h
 common/utils/structs-cleanup.c
 common/utils/structs-print.c
 common/utils/structs-print.h
-common/utils/uefi.c
 common/utils/utils.c
 common/visit/visit.c
 common/visit/visit.h
@@ -329,6 +328,7 @@ lib/structs-copy.c
 lib/structs-free.c
 lib/tmpdirs.c
 lib/tsk.c
+lib/uefi.c
 lib/umask.c
 lib/unit-tests.c
 lib/version.c
diff --git a/generator/UEFI.ml b/generator/UEFI.ml
index 5c5e02bab..17418f473 100644
--- a/generator/UEFI.ml
+++ b/generator/UEFI.ml
@@ -86,7 +86,8 @@ let generate_uefi_c () =
   pr "\n";
   pr "#include \n";
   pr "\n";
-  pr "#include \"guestfs-internal-frontend.h\"\n";
+  pr "#include \"guestfs.h\"\n";
+  pr "#include \"guestfs-internal.h\"\n";
 
   List.iter (
 fun arch ->
diff --git a/generator/main.ml b/generator/main.ml
index 0e1c01f74..8ff698130 100644
--- a/generator/main.ml
+++ b/generator/main.ml
@@ -94,7 +94,7 @@ Run it from the top source directory using the command
 C.generate_client_structs_print_c;
   output_to "common/utils/structs-print.h"
 C.generate_client_structs_print_h;
-  output_to "common/utils/uefi.c"
+  output_to "lib/uefi.c"
 UEFI.generate_uefi_c;
   output_to "lib/guestfs.h"
 C.generate_guestfs_h;
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 18a912d74..1a736e4bd 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -122,10 +122,11 @@ libguestfs_la_SOURCES = \
structs-free.c \
tmpdirs.c \
tsk.c \
+   uefi.c \
umask.c \
+   version.c \
wait.c \
whole-file.c \
-   version.c \
yara.c \
libguestfs.syms
 
diff --git a/lib/appliance-uefi.c b/lib/appliance-uefi.c
index 1612c5db5..986989e67 100644
--- a/lib/appliance-uefi.c
+++ b/lib/appliance-uefi.c
@@ -19,7 +19,7 @@
 /**
  * Find the UEFI firmware needed to boot the appliance.
  *
- * See also F (autogenerated file) containing the
+ * See also F (autogenerated file) containing the
  * firmware file locations.
  */
 
diff --git a/lib/guestfs-internal.h 

[Libguestfs] [PATCH v7 00/13] Refactor utilities

[Richard W.M. Jones]

This is just the utilities part of the patch series from:

https://www.redhat.com/archives/libguestfs/2017-June/msg00103.html

I believe this addresses everything raised in comments on that
patch series.

Rich.

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v6 04/41] mllib: Split ‘Common_utils’ into ‘Std_utils’ + ‘Common_utils’.

[Richard W.M. Jones]

On Fri, Jun 16, 2017 at 03:24:40PM +0200, Pino Toscano wrote:
> On Thursday, 15 June 2017 19:05:54 CEST Richard W.M. Jones wrote:
> > The new module ‘Std_utils’ contains only functions which are pure
> > OCaml and depend only on the OCaml stdlib.  Therefore these functions
> > may be used by the generator.
> 
> Hm can we please use a better name than Std_utils? Otherwise there's
> a bit of confusion between two generic names such as Std_utils and
> Common_utils.

I had another part of this plan which I didn't yet implement (because
it's not necessary for getting the inspection stuff rewritten).  That
was to observe that after all these changes, Common_utils only
contains functions like "message", "open_guestfs", "external_command"
and others which are only used by the tools, and therefore we could
rename Common_utils -> Tools_utils.

Granted I haven't done that yet done that, but I think it will make
more sense after that (future) change.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-builder quickly builds VMs from scratch
http://libguestfs.org/virt-builder.1.html

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v6 05/41] utils: Split out cleanups into common/cleanups.

[Richard W.M. Jones]

On Mon, Jun 19, 2017 at 10:25:33AM +0200, Pino Toscano wrote:
> On Friday, 16 June 2017 16:58:53 CEST Richard W.M. Jones wrote:
> > On Fri, Jun 16, 2017 at 03:24:55PM +0200, Pino Toscano wrote:
> > > On Thursday, 15 June 2017 19:05:55 CEST Richard W.M. Jones wrote:
> > > > Those cleanups which only depend on libc, gnulib or libxml2 are split
> > > > out into a separate common/cleanups directory.
> > > > ---
> > > 
> > > IMHO a single cleanups.c source should be enough, otherwise it's overly
> > > split...
> > 
> > I think you do need to split it.  The reason is that if the program
> > uses libcleanups.la but doesn't link to (eg) libxml2 then the link
> > will fail.  We could either force everything to link unnecessarily to
> > libxml2 or we can split the object files so that the libxml2
> > dependency is never pulled in if the main program doesn't use it.
> 
> This is for the libxml2 parts though. Also, I see that the cleanups are
> split from libutils, but then
> a) libcleanups is basically used where libutils is
> b) patch #14 makes the daemon link both libcleanup and libutils
> so IMHO the libc + gnulib cleanups could simply stay where they are,
> in libutils

OK, I'll combine gnulib cleanups back into libc cleanups.

Also I checked and you are correct that everywhere which uses
common/cleanups also uses common/utils, so I'll put cleanups back
into utils.

Rich.

> > And the same applies (but a bit less) to gnulib.  I'm not sure
> > anything doesn't link to gnulib though, and probably everything should
> > (except examples but they don't use cleanups).
> 
> I think it's basically used everywhere, even more so after the switch
> to getprogname (which makes gnulib needed on Linux).
> 
> -- 
> Pino Toscano



> ___
> Libguestfs mailing list
> Libguestfs@redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs


-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-builder quickly builds VMs from scratch
http://libguestfs.org/virt-builder.1.html

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v6 11/41] utils: Rename ‘guestfs-internal-frontend.h’ to ‘utils.h’.

[Richard W.M. Jones]

On Mon, Jun 19, 2017 at 10:30:47AM +0200, Pino Toscano wrote:
> On Friday, 16 June 2017 17:03:34 CEST Richard W.M. Jones wrote:
> > On Fri, Jun 16, 2017 at 03:42:35PM +0200, Pino Toscano wrote:
> > > NACK to utils.h -- in the past I've seen a couple of libraries
> > > installing public includes as utils.h. They have been fixed, but
> > > I'd like to avoid conflicts between an installed header and a project
> > > header.
> > 
> > Can we prevent incorrect installation (which I agree could be a huge
> > problem) in some other way?  Maybe it can be done with an
> > install-*-hook.  I will see ...
> 
> Oh sorry, most probably I did not explain very well. The situation that
> I'd like to avoid is: a library installs /usr/include/utils.h (evil!),
> or /usr/include/$foo/utils.h, and we make use of it (directly or
> indirectly) by including /usr/include/$foo.
> 
> Possibly it is a so-corner-case that could be ignored for now, though.

I think the build would fail badly if we included the wrong utils.h.

However we can call it "guestfs-utils.h" if you like.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines.  Supports shell scripting,
bindings from many languages.  http://libguestfs.org

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 5/9] builder: add a template parameter to get_index

[Cédric Bosdonnat]

get_index now gets a new template parameter. Setting it to true will
make the index parsing less picky about missing important data. This
can be used to parse a partial index file.
---
 builder/builder.ml   |  2 +-
 builder/index_parser.ml  | 26 ++
 builder/index_parser.mli |  4 +++-
 3 files changed, 22 insertions(+), 10 deletions(-)

diff --git a/builder/builder.ml b/builder/builder.ml
index b0a48ea89..99cd488b2 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -207,7 +207,7 @@ let main () =
   ~tmpdir in
   match source.Sources.format with
   | Sources.FormatNative ->
-Index_parser.get_index ~downloader ~sigchecker source
+Index_parser.get_index ~downloader ~sigchecker ~template:false 
source
   | Sources.FormatSimpleStreams ->
 Simplestreams_parser.get_index ~downloader ~sigchecker source
   ) sources
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index 468805cf8..c70909e44 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -24,7 +24,7 @@ open Utils
 open Printf
 open Unix
 
-let get_index ~downloader ~sigchecker
+let get_index ~downloader ~sigchecker ~template
   { Sources.uri = uri; proxy = proxy } =
   let corrupt_file () =
 error (f_"The index file downloaded from ‘%s’ is corrupt.\nYou need to ask 
the supplier of this file to fix it and upload a fixed version.") uri
@@ -99,8 +99,10 @@ let get_index ~downloader ~sigchecker
   let arch =
 try List.assoc ("arch", None) fields
 with Not_found ->
-  eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog n;
-corrupt_file () in
+  if template then "" else (
+eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog n;
+corrupt_file ()
+  ) in
   let signature_uri =
 try Some (make_absolute_uri (List.assoc ("sig", None) fields))
 with Not_found -> None in
@@ -112,7 +114,7 @@ let get_index ~downloader ~sigchecker
   let revision =
 try Rev_int (int_of_string (List.assoc ("revision", None) fields))
 with
-| Not_found -> Rev_int 1
+| Not_found -> if template then Rev_int 0 else Rev_int 1
 | Failure _ ->
   eprintf (f_"%s: cannot parse ‘revision’ field for ‘%s’\n") prog 
n;
   corrupt_file () in
@@ -122,11 +124,19 @@ let get_index ~downloader ~sigchecker
 try Int64.of_string (List.assoc ("size", None) fields)
 with
 | Not_found ->
-  eprintf (f_"%s: no ‘size’ field for ‘%s’\n") prog n;
-  corrupt_file ()
+  if template then
+Int64.zero
+  else (
+eprintf (f_"%s: no ‘size’ field for ‘%s’\n") prog n;
+corrupt_file ()
+  )
 | Failure _ ->
-  eprintf (f_"%s: cannot parse ‘size’ field for ‘%s’\n") prog n;
-  corrupt_file () in
+  if template then
+Int64.zero
+  else (
+eprintf (f_"%s: cannot parse ‘size’ field for ‘%s’\n") prog n;
+corrupt_file ()
+  ) in
   let compressed_size =
 try Some (Int64.of_string (List.assoc ("compressed_size", None) 
fields))
 with
diff --git a/builder/index_parser.mli b/builder/index_parser.mli
index b8d8ddf3d..aa5f84730 100644
--- a/builder/index_parser.mli
+++ b/builder/index_parser.mli
@@ -16,4 +16,6 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t -> 
Sources.source -> Index.index
+val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t -> 
template:bool -> Sources.source -> Index.index
+(** [get_index download sigchecker source] will parse the source index file
+ into an index entry list. *)
-- 
2.12.2

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 9/9] Add a virt-builder-repository tool

[Cédric Bosdonnat]

virt-builder-repository allows users to easily create or update
a virt-builder source repository out of disk images. The tool can
be run in either interactive or automated mode.
---
 .gitignore  |   3 +
 builder/Makefile.am |  84 +-
 builder/repository_main.ml  | 584 
 builder/test-docs.sh|   2 +
 builder/virt-builder-repository.pod | 213 +
 5 files changed, 883 insertions(+), 3 deletions(-)
 create mode 100644 builder/repository_main.ml
 create mode 100644 builder/virt-builder-repository.pod

diff --git a/.gitignore b/.gitignore
index b9e00ee04..ca0baff64 100644
--- a/.gitignore
+++ b/.gitignore
@@ -96,13 +96,16 @@ Makefile.in
 /builder/oUnit-*
 /builder/*.qcow2
 /builder/stamp-virt-builder.pod
+/builder/stamp-virt-builder-repository.pod
 /builder/stamp-virt-index-validate.pod
 /builder/test-config/virt-builder/repos.d/test-index.conf
 /builder/test-console-*.sh
 /builder/test-simplestreams/virt-builder/repos.d/cirros.conf
 /builder/test-website/virt-builder/repos.d/libguestfs.conf
 /builder/virt-builder
+/builder/virt-builder-repository
 /builder/virt-builder.1
+/builder/virt-builder-repository.1
 /builder/virt-index-validate
 /builder/virt-index-validate.1
 /builder/*.xz
diff --git a/builder/Makefile.am b/builder/Makefile.am
index bf4ccb7d7..df09c3f3d 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -21,6 +21,8 @@ AM_YFLAGS = -d
 
 EXTRA_DIST = \
$(SOURCES_MLI) $(SOURCES_ML) $(SOURCES_C) \
+   $(REPOSITORY_SOURCES_ML) \
+   $(REPOSITORY_SOURCES_MLI) \
libguestfs.gpg \
opensuse.gpg \
test-console.sh \
@@ -38,6 +40,7 @@ EXTRA_DIST = \
test-virt-index-validate-good-2 \
test-virt-index-validate-good-3 \
virt-builder.pod \
+   virt-builder-repository.pod \
virt-index-validate.pod \
yajl_tests.ml
 
@@ -85,13 +88,44 @@ SOURCES_C = \
setlocale-c.c \
yajl-c.c
 
+REPOSITORY_SOURCES_ML = \
+   utils.ml \
+   index.ml \
+   cache.ml \
+   downloader.ml \
+   sigchecker.ml \
+   ini_reader.ml \
+   index_parser.ml \
+   yajl.ml \
+   paths.ml \
+   sources.ml \
+   repository_main.ml
+
+REPOSITORY_SOURCES_MLI = \
+   cache.mli \
+   downloader.mli \
+   index.mli \
+   index_parser.mli \
+   ini_reader.mli \
+   sigchecker.mli \
+   sources.mli \
+   yajl.mli
+
+REPOSITORY_SOURCES_C = \
+   index-scan.c \
+   index-struct.c \
+   index-parse.c \
+   index-parser-c.c \
+   yajl-c.c
+
+
 man_MANS =
 noinst_DATA =
 bin_PROGRAMS =
 
 if HAVE_OCAML
 
-bin_PROGRAMS += virt-builder
+bin_PROGRAMS += virt-builder virt-builder-repository
 
 virt_builder_SOURCES = $(SOURCES_C)
 virt_builder_CPPFLAGS = \
@@ -101,8 +135,7 @@ virt_builder_CPPFLAGS = \
-I$(shell $(OCAMLC) -where) \
-I$(top_srcdir)/gnulib/lib \
-I$(top_srcdir)/common/utils \
-   -I$(top_srcdir)/lib \
-   -I$(top_srcdir)/fish
+   -I$(top_srcdir)/lib
 virt_builder_CFLAGS = \
-pthread \
$(WARN_CFLAGS) $(WERROR_CFLAGS) \
@@ -115,6 +148,26 @@ virt_builder_CFLAGS = \
 BOBJECTS = $(SOURCES_ML:.ml=.cmo)
 XOBJECTS = $(BOBJECTS:.cmo=.cmx)
 
+virt_builder_repository_SOURCES = $(REPOSITORY_SOURCES_C)
+virt_builder_repository_CPPFLAGS = \
+   -I. \
+   -I$(top_builddir) \
+   -I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
+   -I$(shell $(OCAMLC) -where) \
+   -I$(top_srcdir)/gnulib/lib \
+   -I$(top_srcdir)/lib \
+   -I$(top_srcdir)/fish
+virt_builder_repository_CFLAGS = \
+   -pthread \
+   $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+   -Wno-unused-macros \
+   $(LIBLZMA_CFLAGS) \
+   $(LIBTINFO_CFLAGS) \
+   $(LIBXML2_CFLAGS) \
+   $(YAJL_CFLAGS)
+REPOSITORY_BOBJECTS = $(REPOSITORY_SOURCES_ML:.ml=.cmo)
+REPOSITORY_XOBJECTS = $(REPOSITORY_BOBJECTS:.cmo=.cmx)
+
 # -I $(top_builddir)/lib/.libs is a hack which forces corresponding -L
 # option to be passed to gcc, so we don't try linking against an
 # installed copy of libguestfs.
@@ -149,8 +202,10 @@ OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
 
 if !HAVE_OCAMLOPT
 OBJECTS = $(BOBJECTS)
+REPOSITORY_OBJECTS = $(REPOSITORY_BOBJECTS)
 else
 OBJECTS = $(XOBJECTS)
+REPOSITORY_OBJECTS = $(REPOSITORY_XOBJECTS)
 endif
 
 OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) mllib.$(MLARCHIVE) 
customize.$(MLARCHIVE) $(LINK_CUSTOM_OCAMLC_ONLY)
@@ -165,6 +220,15 @@ virt_builder_LINK = \
  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) 
\
  $(OBJECTS) -o $@
 
+virt_builder_repository_DEPENDENCIES = \
+   $(REPOSITORY_OBJECTS) \
+   ../mllib/mllib.$(MLARCHIVE) \
+   $(top_srcdir)/ocaml-link.sh
+virt_builder_repository_LINK = \
+   $(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) 
\
+ 

[Libguestfs] [PATCH v7 1/9] lib/osinfo.c: Extract xml processing into a callback

[Cédric Bosdonnat]

In order to further reuse the osinfo database parsing in OCAML, this
commit extracts the XML processing for the distro ISOs and places it
into a newly created callback.

This will later help other code to traverse the osinfo DB files and
let them extract what they need from them.
---
 lib/osinfo.c | 80 +---
 1 file changed, 39 insertions(+), 41 deletions(-)

diff --git a/lib/osinfo.c b/lib/osinfo.c
index ea2a7659a..3514585c7 100644
--- a/lib/osinfo.c
+++ b/lib/osinfo.c
@@ -52,6 +52,7 @@
 #include 
 #include 
 #include 
+#include 
 #include 
 #include 
 #include 
@@ -71,10 +72,11 @@ gl_lock_define_initialized (static, osinfo_db_lock);
 static ssize_t osinfo_db_size = 0; /* 0 = unread, -1 = error, >= 1 = #records 
*/
 static struct osinfo *osinfo_db = NULL;
 
-static int read_osinfo_db (guestfs_h *g);
-static void free_osinfo_db_entry (struct osinfo *);
-
 #define XMLSTREQ(a,b) (xmlStrEqual((a),(b)) == 1)
+typedef int (*read_osinfo_db_callback) (guestfs_h *g, const char *path, void 
*opaque);
+
+static int read_osinfo_db (guestfs_h *g, read_osinfo_db_callback callback, 
void *opaque);
+static void free_osinfo_db_entry (struct osinfo *);
 
 /* Given one or more fields from the header of a CD/DVD/ISO, look up
  * the media in the libosinfo database and return our best guess for
@@ -87,14 +89,24 @@ static void free_osinfo_db_entry (struct osinfo *);
  */
 int
 guestfs_int_osinfo_map (guestfs_h *g, const struct guestfs_isoinfo *isoinfo,
-   const struct osinfo **osinfo_ret)
+const struct osinfo **osinfo_ret)
 {
   size_t i;
 
   /* We only need to lock the database when reading it for the first time. */
   gl_lock_lock (osinfo_db_lock);
   if (osinfo_db_size == 0) {
-if (read_osinfo_db (g) == -1) {
+if (read_osinfo_db (g, read_osinfo_db_xml, NULL) == -1) {
+  /* Fatal error: free any database entries which have been read, and
+   * mark the database as having a permanent error.
+   */
+  if (osinfo_db_size > 0) {
+for (i = 0; i < (size_t) osinfo_db_size; ++i)
+  free_osinfo_db_entry (_db[i]);
+  }
+  free (osinfo_db);
+  osinfo_db = NULL;
+  osinfo_db_size = -1;
   gl_lock_unlock (osinfo_db_lock);
   return -1;
 }
@@ -156,19 +168,16 @@ guestfs_int_osinfo_map (guestfs_h *g, const struct 
guestfs_isoinfo *isoinfo,
  * Try to use the shared osinfo database layout (and location) first:
  * https://gitlab.com/libosinfo/libosinfo/blob/master/docs/database-layout.txt
  */
-static int read_osinfo_db_xml (guestfs_h *g, const char *filename);
-
-static int read_osinfo_db_flat (guestfs_h *g, const char *directory);
-static int read_osinfo_db_three_levels (guestfs_h *g, const char *directory);
-static int read_osinfo_db_directory (guestfs_h *g, const char *directory);
+static int read_osinfo_db_xml (guestfs_h *g, const char *pathname, void *data);
+static int read_osinfo_db_flat (guestfs_h *g, const char *directory, 
read_osinfo_db_callback callback, void *opaque);
+static int read_osinfo_db_three_levels (guestfs_h *g, const char *directory, 
read_osinfo_db_callback callback, void *opaque);
+static int read_osinfo_db_directory (guestfs_h *g, const char *directory, 
read_osinfo_db_callback callback, void *opaque);
 
 static int
-read_osinfo_db (guestfs_h *g)
+read_osinfo_db (guestfs_h *g,
+read_osinfo_db_callback callback, void *opaque)
 {
   int r;
-  size_t i;
-
-  assert (osinfo_db_size == 0);
 
   /* (1) Try the shared osinfo directory, using either the
* $OSINFO_SYSTEM_DIR envvar or its default value.
@@ -181,59 +190,47 @@ read_osinfo_db (guestfs_h *g)
 if (path == NULL)
   path = "/usr/share/osinfo";
 os_path = safe_asprintf (g, "%s/os", path);
-r = read_osinfo_db_three_levels (g, os_path);
+r = read_osinfo_db_three_levels (g, os_path, callback, opaque);
   }
   if (r == -1)
-goto error;
+return -1;
   else if (r == 1)
 return 0;
 
   /* (2) Try the libosinfo directory, using the newer three-directory
* layout ($LIBOSINFO_DB_PATH / "os" / $group-ID / [file.xml]).
*/
-  r = read_osinfo_db_three_levels (g, LIBOSINFO_DB_PATH "/os");
+  r = read_osinfo_db_three_levels (g, LIBOSINFO_DB_PATH "/os", callback, 
opaque);
   if (r == -1)
-goto error;
+return -1;
   else if (r == 1)
 return 0;
 
   /* (3) Try the libosinfo directory, using the old flat directory
* layout ($LIBOSINFO_DB_PATH / "oses" / [file.xml]).
*/
-  r = read_osinfo_db_flat (g, LIBOSINFO_DB_PATH "/oses");
+  r = read_osinfo_db_flat (g, LIBOSINFO_DB_PATH "/oses", callback, opaque);
   if (r == -1)
-goto error;
+return -1;
   else if (r == 1)
 return 0;
 
   /* Nothing found. */
   return 0;
-
- error:
-  /* Fatal error: free any database entries which have been read, and
-   * mark the database as having a permanent error.
-   */
-  if (osinfo_db_size > 0) {
-for (i = 0; i < (size_t) osinfo_db_size; 

[Libguestfs] [PATCH v7 6/9] builder: add Index.write_entry function

[Cédric Bosdonnat]

Add a function to properly write virt-builder source index entries.
Note that this function is very similar to Index.print_entry that is
meant for debugging purposes.
---
 .gitignore|   1 +
 builder/Makefile.am   |  36 +++-
 builder/index.mli |   3 +
 builder/index_parser.ml   |  54 ++
 builder/index_parser.mli  |   4 ++
 builder/index_parser_tests.ml | 129 ++
 6 files changed, 225 insertions(+), 2 deletions(-)
 create mode 100644 builder/index_parser_tests.ml

diff --git a/.gitignore b/.gitignore
index 69e1ae160..b9e00ee04 100644
--- a/.gitignore
+++ b/.gitignore
@@ -106,6 +106,7 @@ Makefile.in
 /builder/virt-index-validate
 /builder/virt-index-validate.1
 /builder/*.xz
+/builder/index_parser_tests
 /builder/yajl_tests
 /cat/stamp-virt-*.pod
 /cat/virt-cat
diff --git a/builder/Makefile.am b/builder/Makefile.am
index 218f64b4c..bf4ccb7d7 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -217,13 +217,36 @@ yajl_tests_BOBJECTS = \
yajl_tests.cmo
 yajl_tests_XOBJECTS = $(yajl_tests_BOBJECTS:.cmo=.cmx)
 
+index_parser_tests_SOURCES = \
+   index-scan.c \
+   index-struct.c \
+   index-parser-c.c \
+   index-parse.c
+index_parser_tests_CPPFLAGS = $(virt_builder_CPPFLAGS)
+index_parser_tests_BOBJECTS = \
+   utils.cmo \
+   cache.cmo \
+   downloader.cmo \
+   sigchecker.cmo \
+   index.cmo \
+   ini_reader.cmo \
+   index_parser.cmo \
+   index_parser_tests.cmo
+index_parser_tests_XOBJECTS = $(index_parser_tests_BOBJECTS:.cmo=.cmx)
+
 # Can't call the following as _OBJECTS because automake gets confused.
 if HAVE_OCAMLOPT
 yajl_tests_THEOBJECTS = $(yajl_tests_XOBJECTS)
 yajl_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
+index_parser_tests_THEOBJECTS = $(index_parser_tests_XOBJECTS)
+index_parser_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 else
 yajl_tests_THEOBJECTS = $(yajl_tests_BOBJECTS)
 yajl_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
+index_parser_tests_THEOBJECTS = $(index_parser_tests_BOBJECTS)
+index_parser_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 endif
 
 yajl_tests_DEPENDENCIES = \
@@ -236,6 +259,15 @@ yajl_tests_LINK = \
  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) 
$(OCAMLPACKAGES_TESTS) $(OCAMLLINKFLAGS) \
  $(yajl_tests_THEOBJECTS) -o $@
 
+index_parser_tests_DEPENDENCIES = \
+   $(index_parser_tests_THEOBJECTS) \
+   ../mllib/mllib.$(MLARCHIVE) \
+   $(top_srcdir)/ocaml-link.sh
+index_parser_tests_LINK = \
+   $(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) 
$(OCAMLPACKAGES_TESTS) $(OCAMLLINKFLAGS) \
+ $(index_parser_tests_THEOBJECTS) -o $@
+
 TESTS = \
test-docs.sh \
test-virt-builder-list.sh \
@@ -249,8 +281,8 @@ if ENABLE_APPLIANCE
 TESTS += test-virt-builder.sh
 endif ENABLE_APPLIANCE
 if HAVE_OCAML_PKG_OUNIT
-check_PROGRAMS += yajl_tests
-TESTS += yajl_tests
+check_PROGRAMS += yajl_tests index_parser_tests
+TESTS += yajl_tests index_parser_tests
 endif
 
 check-valgrind:
diff --git a/builder/index.mli b/builder/index.mli
index ff5ec4a35..6202d636e 100644
--- a/builder/index.mli
+++ b/builder/index.mli
@@ -39,3 +39,6 @@ and entry = {
 }
 
 val print_entry : out_channel -> (string * entry) -> unit
+(** Debugging helper function dumping an index entry to a stream.
+To write entries for non-debugging purpose, use the
+[Index_parser.write_entry] function. *)
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index c70909e44..c56c4b8f8 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -236,3 +236,57 @@ let get_index ~downloader ~sigchecker ~template
   in
 
   get_index ()
+
+let write_entry chan (name, { Index.printable_name = printable_name;
+  file_uri = file_uri;
+  arch = arch;
+  osinfo = osinfo;
+  signature_uri = signature_uri;
+  checksums = checksums;
+  revision = revision;
+  format = format;
+  size = size;
+  compressed_size = compressed_size;
+  expand = expand;
+  lvexpand = lvexpand;
+  notes = notes;
+  aliases = aliases;
+  hidden = hidden }) =
+  let fp fs = fprintf chan fs in
+  fp "[%s]\n" name;
+  may (fp "name=%s\n") printable_name;
+  may (fp "osinfo=%s\n") osinfo;
+  fp "file=%s\n" file_uri;
+  fp "arch=%s\n" arch;
+  may (fp "sig=%s\n") signature_uri;
+  (match checksums with
+  | None -> ()
+  | Some checksums ->
+List.iter (
+  fun c ->
+fp "checksum[%s]=%s\n"
+  

[Libguestfs] [PATCH v7 8/9] mllib: add XPath helper xpath_get_nodes()

[Cédric Bosdonnat]

This function will allow more OCaml-ish processing of XPath queries
with multiple results.
---
 mllib/xpath_helpers.ml  | 9 +
 mllib/xpath_helpers.mli | 4 
 2 files changed, 13 insertions(+)

diff --git a/mllib/xpath_helpers.ml b/mllib/xpath_helpers.ml
index d651fab23..c66a21c44 100644
--- a/mllib/xpath_helpers.ml
+++ b/mllib/xpath_helpers.ml
@@ -51,3 +51,12 @@ let xpath_eval_default parsefn xpath expr default =
 let xpath_string_default = xpath_eval_default identity
 let xpath_int_default = xpath_eval_default int_of_string
 let xpath_int64_default = xpath_eval_default Int64.of_string
+
+let xpath_get_nodes xpathctx expr =
+  let obj = Xml.xpath_eval_expression xpathctx expr in
+  let nodes = ref [] in
+  for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
+let node = Xml.xpathobj_node obj i in
+push_back nodes node
+  done;
+  !nodes
diff --git a/mllib/xpath_helpers.mli b/mllib/xpath_helpers.mli
index 7434ba645..83c770281 100644
--- a/mllib/xpath_helpers.mli
+++ b/mllib/xpath_helpers.mli
@@ -31,3 +31,7 @@ val xpath_int_default : Xml.xpathctx -> string -> int -> int
 val xpath_int64_default : Xml.xpathctx -> string -> int64 -> int64
 (** Parse an xpath expression and return a string/int; if the expression
 doesn't match, return the default. *)
+
+val xpath_get_nodes : Xml.xpathctx -> string -> Xml.node list
+(** Parse an XPath expression and return a list with the matching
+XML nodes. *)
-- 
2.12.2

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 3/9] mllib: ocaml wrapper for lib/osinfo

[Cédric Bosdonnat]

Provide osinfo database parsing API in OCaml.
---
 lib/osinfo.c  |  39 +
 mllib/Makefile.am |  11 --
 mllib/osinfo-c.c  | 103 ++
 mllib/osinfo.ml   |  26 ++
 mllib/osinfo.mli  |  31 
 5 files changed, 208 insertions(+), 2 deletions(-)
 create mode 100644 mllib/osinfo-c.c
 create mode 100644 mllib/osinfo.ml
 create mode 100644 mllib/osinfo.mli

diff --git a/lib/osinfo.c b/lib/osinfo.c
index 5ccb554be..9a411b28d 100644
--- a/lib/osinfo.c
+++ b/lib/osinfo.c
@@ -52,6 +52,45 @@
 
 #include "osinfo.h"
 
+#ifndef GUESTFS_PRIVATE
+#undef perrorf
+static void perrorf(guestfs_h *g, const char *fmt, ...)
+__attribute__((format (printf,2,3)));
+
+static void perrorf(guestfs_h *g, const char *fmt, ...)
+{
+  va_list args;
+  CLEANUP_FREE char *msg = NULL;
+  CLEANUP_FREE char *fs = NULL;
+
+  ignore_value (asprintf (, "%s\n", fmt));
+
+  va_start (args, fmt);
+  /* Ignoring the result is fine since perror
+   * can take NULL input */
+  ignore_value (vasprintf (, fs, args));
+  va_end (args);
+  perror (msg);
+}
+
+#undef debug
+static void debug(guestfs_h *g, const char *fmt, ...)
+__attribute__((format (printf,2,3)));
+
+static void
+debug(guestfs_h *g, const char *fmt, ...)
+{
+  va_list args;
+  CLEANUP_FREE char *fs = NULL;
+
+  ignore_value (asprintf (, "%s\n", fmt));
+
+  va_start (args, fmt);
+  vfprintf (stderr, fs, args);
+  va_end (args);
+}
+#endif /* GUESTFS_PRIVATE */
+
 
 /* Read the libosinfo XML database files.  The lock is held while
  * this is called.
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index ee2f1a7a8..ee16fe7ef 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -36,6 +36,7 @@ SOURCES_MLI = \
curl.mli \
getopt.mli \
JSON.mli \
+   osinfo.mli \
planner.mli \
progress.mli \
regedit.mli \
@@ -63,7 +64,8 @@ SOURCES_ML = \
curl.ml \
checksums.ml \
xml.ml \
-   xpath_helpers.ml
+   xpath_helpers.ml \
+   osinfo.ml
 
 SOURCES_C = \
../common/visit/visit.c \
@@ -71,8 +73,12 @@ SOURCES_C = \
../common/options/keys.c \
../common/options/uri.c \
../common/progress/progress.c \
+   ../lib/alloc.c \
+   ../lib/osinfo.c \
+   ../lib/osinfo.h \
common_utils-c.c \
getopt-c.c \
+   osinfo-c.c \
progress-c.c \
unix_utils-c.c \
uri-c.c \
@@ -106,7 +112,8 @@ libmllib_a_CPPFLAGS = \
-I$(top_srcdir)/lib \
-I$(top_srcdir)/common/visit \
-I$(top_srcdir)/common/options \
-   -I$(top_srcdir)/common/progress
+   -I$(top_srcdir)/common/progress \
+   -DLIBOSINFO_DB_PATH='"$(datadir)/libosinfo/db"'
 libmllib_a_CFLAGS = \
$(WARN_CFLAGS) $(WERROR_CFLAGS) \
$(LIBVIRT_CFLAGS) $(LIBXML2_CFLAGS) \
diff --git a/mllib/osinfo-c.c b/mllib/osinfo-c.c
new file mode 100644
index 0..84760a85f
--- /dev/null
+++ b/mllib/osinfo-c.c
@@ -0,0 +1,103 @@
+/* Bindings for osinfo db reading function.
+ * Copyright (C) 2016 Red Hat Inc.
+ * Copyright (C) 2017 SUSE 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 
+
+#include 
+#include 
+#include 
+#include 
+#include 
+
+#include 
+#include 
+#include 
+#include 
+#include 
+
+#include "guestfs.h"
+#include "guestfs-internal.h"
+#include "osinfo.h"
+
+#pragma GCC diagnostic ignored "-Wmissing-prototypes"
+
+struct callback_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 callback */
+  value *fvp;   /* callback. */
+};
+
+static int read_osinfo_db_callback_wrapper (guestfs_h *g, const char *path, 
void *opaque);
+
+value
+guestfs_int_mllib_read_osinfo_db (value gv, value fv)
+{
+  CAMLparam2 (gv, fv);
+  guestfs_h *g = (guestfs_h *) Int64_val (gv);
+  struct callback_wrapper_args args;
+
+  /* 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);
+
+  exn = Val_unit;
+
+  

[Libguestfs] [PATCH v7 7/9] mllib: add do_mv helper function to Common_utils

[Cédric Bosdonnat]

---
 mllib/common_utils.ml  | 6 ++
 mllib/common_utils.mli | 3 +++
 2 files changed, 9 insertions(+)

diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 6a9b08973..8ed7c7554 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -1188,3 +1188,9 @@ let inspect_decrypt g =
* function.
*)
   c_inspect_decrypt g#ocaml_handle (Guestfs.c_pointer g#ocaml_handle)
+
+let do_mv src dest =
+  let cmd = [ "mv"; src; dest ] in
+  let r = run_command cmd in
+  if r <> 0 then
+error (f_"moving file '%s' to '%s' failed") src dest
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index c088f8497..2f01cdeae 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -498,3 +498,6 @@ val inspect_decrypt : Guestfs.guestfs -> unit
 (** Simple implementation of decryption: look for any [crypto_LUKS]
 partitions and decrypt them, then rescan for VGs.  This only works
 for Fedora whole-disk encryption. *)
+
+val do_mv : string -> string -> unit
+(** Run the mv command, and exit with an error if it failed *)
-- 
2.12.2

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 4/9] builder: rename docs test script

[Cédric Bosdonnat]

Rename test-virt-builder-docs.sh into test-docs.sh to include test
for another tool's documentation.
---
 builder/Makefile.am | 4 ++--
 builder/{test-virt-builder-docs.sh => test-docs.sh} | 0
 2 files changed, 2 insertions(+), 2 deletions(-)
 rename builder/{test-virt-builder-docs.sh => test-docs.sh} (100%)

diff --git a/builder/Makefile.am b/builder/Makefile.am
index d56b394b7..218f64b4c 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -28,7 +28,7 @@ EXTRA_DIST = \
test-simplestreams/streams/v1/index.json \
test-simplestreams/streams/v1/net.cirros-cloud_released_download.json \
test-virt-builder.sh \
-   test-virt-builder-docs.sh \
+   test-docs.sh \
test-virt-builder-list.sh \
test-virt-builder-list-simplestreams.sh \
test-virt-builder-planner.sh \
@@ -237,7 +237,7 @@ yajl_tests_LINK = \
  $(yajl_tests_THEOBJECTS) -o $@
 
 TESTS = \
-   test-virt-builder-docs.sh \
+   test-docs.sh \
test-virt-builder-list.sh \
test-virt-index-validate.sh \
$(SLOW_TESTS)
diff --git a/builder/test-virt-builder-docs.sh b/builder/test-docs.sh
similarity index 100%
rename from builder/test-virt-builder-docs.sh
rename to builder/test-docs.sh
-- 
2.12.2

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 0/9] Introducing virt-builder-repository

[Cédric Bosdonnat]

Hi all,

Here is an update of the series fixing Pino's latest comment.
It just doesn't implement the change based on never-accepted
run commands patch.

Cédric Bosdonnat (9):
  lib/osinfo.c: Extract xml processing into a callback
  lib: extract osinfo DB traversing API
  mllib: ocaml wrapper for lib/osinfo
  builder: rename docs test script
  builder: add a template parameter to get_index
  builder: add Index.write_entry function
  mllib: add do_mv helper function to Common_utils
  mllib: add XPath helper xpath_get_nodes()
  Add a virt-builder-repository tool

 .gitignore |   4 +
 builder/Makefile.am| 124 -
 builder/builder.ml |   2 +-
 builder/index.mli  |   3 +
 builder/index_parser.ml|  80 ++-
 builder/index_parser.mli   |   8 +-
 builder/index_parser_tests.ml  | 129 +
 builder/repository_main.ml | 584 +
 .../{test-virt-builder-docs.sh => test-docs.sh}|   2 +
 builder/virt-builder-repository.pod| 213 
 lib/Makefile.am|   2 +
 lib/osinfo-iso.c   | 462 
 lib/osinfo.c   | 489 ++---
 lib/osinfo.h   |  27 +
 mllib/Makefile.am  |  11 +-
 mllib/common_utils.ml  |   6 +
 mllib/common_utils.mli |   3 +
 mllib/osinfo-c.c   | 103 
 mllib/osinfo.ml|  26 +
 mllib/osinfo.mli   |  31 ++
 mllib/xpath_helpers.ml |   9 +
 mllib/xpath_helpers.mli|   4 +
 22 files changed, 1869 insertions(+), 453 deletions(-)
 create mode 100644 builder/index_parser_tests.ml
 create mode 100644 builder/repository_main.ml
 rename builder/{test-virt-builder-docs.sh => test-docs.sh} (93%)
 create mode 100644 builder/virt-builder-repository.pod
 create mode 100644 lib/osinfo-iso.c
 create mode 100644 lib/osinfo.h
 create mode 100644 mllib/osinfo-c.c
 create mode 100644 mllib/osinfo.ml
 create mode 100644 mllib/osinfo.mli

-- 
2.12.2

___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

[Libguestfs] [PATCH v7 2/9] lib: extract osinfo DB traversing API

[Cédric Bosdonnat]

Split lib/osinfo.c to provide an API for other pieces of code (namely
mllib) to reuse it. The ISO-related processing is thus moved into a
lib/osinfo-iso.c file.
---
 lib/Makefile.am  |   2 +
 lib/osinfo-iso.c | 462 +++
 lib/osinfo.c | 420 +-
 lib/osinfo.h |  27 
 4 files changed, 493 insertions(+), 418 deletions(-)
 create mode 100644 lib/osinfo-iso.c
 create mode 100644 lib/osinfo.h

diff --git a/lib/Makefile.am b/lib/Makefile.am
index 360ce9c92..2cb83f2bb 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -113,7 +113,9 @@ libguestfs_la_SOURCES = \
lpj.c \
match.c \
mountable.c \
+   osinfo.h \
osinfo.c \
+   osinfo-iso.c \
private-data.c \
proto.c \
qemu.c \
diff --git a/lib/osinfo-iso.c b/lib/osinfo-iso.c
new file mode 100644
index 0..059d72def
--- /dev/null
+++ b/lib/osinfo-iso.c
@@ -0,0 +1,462 @@
+/* libguestfs
+ * Copyright (C) 2012 Red Hat Inc.
+ *
+ * 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
+ */
+
+/* Read libosinfo XML files to parse out just the
+ * os/media/iso/system-id and os/media/iso/volume-id fields, which we
+ * can then use to map install media to operating systems.
+ *
+ * Note some assumptions here:
+ *
+ * (1) We have to do some translation of the distro names and versions
+ * stored in the libosinfo files and the standard names returned by
+ * libguestfs.
+ *
+ * (2) Media detection is only part of the story.  We may still need
+ * to inspect inside the image.
+ *
+ * (3) We only read the XML database files (at most) once per process,
+ * and keep them cached.  They are only read at all if someone tries
+ * to inspect a CD/DVD/ISO.
+ *
+ * XXX Currently the database is not freed when the program exits /
+ * library is unloaded, although we should probably do that.
+ */
+
+#include 
+
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+#include 
+
+#include 
+#include 
+
+#include "ignore-value.h"
+#include "glthread/lock.h"
+#include "c-ctype.h"
+
+#include "guestfs.h"
+#include "guestfs-internal.h"
+
+#include "osinfo.h"
+
+gl_lock_define_initialized (static, osinfo_db_lock);
+static ssize_t osinfo_db_size = 0; /* 0 = unread, -1 = error, >= 1 = #records 
*/
+static struct osinfo *osinfo_db = NULL;
+
+static void free_osinfo_db_entry (struct osinfo *);
+
+#define XMLSTREQ(a,b) (xmlStrEqual((a),(b)) == 1)
+
+static int read_osinfo_db_xml (guestfs_h *g, const char *pathname, void *data);
+
+/* Given one or more fields from the header of a CD/DVD/ISO, look up
+ * the media in the libosinfo database and return our best guess for
+ * the operating system.
+ *
+ * This returns:
+ *   -1 => a fatal error ('error' has been called, caller must not ignore it)
+ *   0  => could not locate the OS
+ *   1  => matching OS found, the osinfo_ret pointer has been filled in
+ */
+int
+guestfs_int_osinfo_map (guestfs_h *g, const struct guestfs_isoinfo *isoinfo,
+const struct osinfo **osinfo_ret)
+{
+  size_t i;
+
+  /* We only need to lock the database when reading it for the first time. */
+  gl_lock_lock (osinfo_db_lock);
+  if (osinfo_db_size == 0) {
+if (read_osinfo_db (g, read_osinfo_db_xml, NULL) == -1) {
+  /* Fatal error: free any database entries which have been read, and
+   * mark the database as having a permanent error.
+   */
+  if (osinfo_db_size > 0) {
+for (i = 0; i < (size_t) osinfo_db_size; ++i)
+  free_osinfo_db_entry (_db[i]);
+  }
+  free (osinfo_db);
+  osinfo_db = NULL;
+  osinfo_db_size = -1;
+  gl_lock_unlock (osinfo_db_lock);
+  return -1;
+}
+  }
+  gl_lock_unlock (osinfo_db_lock);
+
+  if (osinfo_db_size <= 0)
+return 0;
+
+  /* Look in the database to see if we can find a match. */
+  for (i = 0; i < (size_t) osinfo_db_size; ++i) {
+if (osinfo_db[i].re_system_id) {
+  if (!isoinfo->iso_system_id ||
+  !match (g, isoinfo->iso_system_id, osinfo_db[i].re_system_id))
+continue;
+}
+
+if (osinfo_db[i].re_volume_id) {
+  if (!isoinfo->iso_volume_id ||
+  !match (g, isoinfo->iso_volume_id, osinfo_db[i].re_volume_id))
+

Re: [Libguestfs] [PATCH v6 11/41] utils: Rename ‘guestfs-internal-frontend.h’ to ‘utils.h’.

[Pino Toscano]

On Friday, 16 June 2017 17:03:34 CEST Richard W.M. Jones wrote:
> On Fri, Jun 16, 2017 at 03:42:35PM +0200, Pino Toscano wrote:
> > NACK to utils.h -- in the past I've seen a couple of libraries
> > installing public includes as utils.h. They have been fixed, but
> > I'd like to avoid conflicts between an installed header and a project
> > header.
> 
> Can we prevent incorrect installation (which I agree could be a huge
> problem) in some other way?  Maybe it can be done with an
> install-*-hook.  I will see ...

Oh sorry, most probably I did not explain very well. The situation that
I'd like to avoid is: a library installs /usr/include/utils.h (evil!),
or /usr/include/$foo/utils.h, and we make use of it (directly or
indirectly) by including /usr/include/$foo.

Possibly it is a so-corner-case that could be ignored for now, though.

-- 
Pino Toscano

signature.asc
Description: This is a digitally signed message part.
___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs

Re: [Libguestfs] [PATCH v6 05/41] utils: Split out cleanups into common/cleanups.

[Pino Toscano]

On Friday, 16 June 2017 16:58:53 CEST Richard W.M. Jones wrote:
> On Fri, Jun 16, 2017 at 03:24:55PM +0200, Pino Toscano wrote:
> > On Thursday, 15 June 2017 19:05:55 CEST Richard W.M. Jones wrote:
> > > Those cleanups which only depend on libc, gnulib or libxml2 are split
> > > out into a separate common/cleanups directory.
> > > ---
> > 
> > IMHO a single cleanups.c source should be enough, otherwise it's overly
> > split...
> 
> I think you do need to split it.  The reason is that if the program
> uses libcleanups.la but doesn't link to (eg) libxml2 then the link
> will fail.  We could either force everything to link unnecessarily to
> libxml2 or we can split the object files so that the libxml2
> dependency is never pulled in if the main program doesn't use it.

This is for the libxml2 parts though. Also, I see that the cleanups are
split from libutils, but then
a) libcleanups is basically used where libutils is
b) patch #14 makes the daemon link both libcleanup and libutils
so IMHO the libc + gnulib cleanups could simply stay where they are,
in libutils

> And the same applies (but a bit less) to gnulib.  I'm not sure
> anything doesn't link to gnulib though, and probably everything should
> (except examples but they don't use cleanups).

I think it's basically used everywhere, even more so after the switch
to getprogname (which makes gnulib needed on Linux).

-- 
Pino Toscano

signature.asc
Description: This is a digitally signed message part.
___
Libguestfs mailing list
Libguestfs@redhat.com
https://www.redhat.com/mailman/listinfo/libguestfs