[Libguestfs] [PATCH v10 1/6] builder: add simple OCaml osinfo-db reader

[Cédric Bosdonnat]

From: Pino Toscano <ptoscano at redhat.com>

Add a simple OCaml-based implementation of reader of the osinfo-db:
the only interface is an iterator that invokes an user-supplied
function with each XML file found.

This implementation behaves like the current C implementation, and
still supports the old libosinfo db.
---
 .gitignore          |  1 +
 builder/Makefile.am |  4 +++
 builder/osinfo.ml   | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 builder/osinfo.mli  | 22 +++++++++++++++
 4 files changed, 107 insertions(+)
 create mode 100644 builder/osinfo.ml
 create mode 100644 builder/osinfo.mli

diff --git a/.gitignore b/.gitignore
index 302aa2d81..faf6068fa 100644
--- a/.gitignore
+++ b/.gitignore
@@ -92,6 +92,7 @@ Makefile.in
 /builder/index-scan.c
 /builder/libguestfs.conf
 /builder/opensuse.conf
+/builder/osinfo_config.ml
 /builder/oUnit-*
 /builder/*.qcow2
 /builder/stamp-virt-builder.pod
diff --git a/builder/Makefile.am b/builder/Makefile.am
index 64cb20ade..76e6d4f3a 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -207,6 +207,10 @@ CLEANFILES += *.qcow2 *.xz
 
 check_DATA = $(disk_images)
 
+osinfo_config.ml: Makefile
+	echo 'let libosinfo_db_path = "$(datadir)/libosinfo/db"' > $@-t
+	mv $@-t $@
+
 fedora.qcow2: ../test-data/phony-guests/fedora.img
 	rm -f $@ $@-t
 	qemu-img convert -f raw -O qcow2 $< $@-t
diff --git a/builder/osinfo.ml b/builder/osinfo.ml
new file mode 100644
index 000000000..6c0361100
--- /dev/null
+++ b/builder/osinfo.ml
@@ -0,0 +1,80 @@
+(* virt-builder
+ * Copyright (C) 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 Common_utils
+open Osinfo_config
+
+let rec iterate_db fn =
+  let locations = ref [] in
+
+  (* (1) Try the shared osinfo directory, using either the
+   * $OSINFO_SYSTEM_DIR envvar or its default value.
+   *)
+  let () =
+    let dir =
+      try Sys.getenv "OSINFO_SYSTEM_DIR"
+      with Not_found -> "/usr/share/osinfo" in
+    push_back locations ((dir // "os"), read_osinfo_db_three_levels)
+  in
+
+  (* (2) Try the libosinfo directory, using the newer three-directory
+   * layout ($LIBOSINFO_DB_PATH / "os" / $group-ID / [file.xml]).
+   *)
+  let () =
+    let path = Osinfo_config.libosinfo_db_path // "os" in
+    push_back locations (path, read_osinfo_db_three_levels)
+  in
+
+  (* (3) Try the libosinfo directory, using the old flat directory
+   * layout ($LIBOSINFO_DB_PATH / "oses" / [file.xml]).
+   *)
+  let () =
+    let path = Osinfo_config.libosinfo_db_path // "oses" in
+    push_back locations (path, read_osinfo_db_flat)
+  in
+
+  let rec loop = function
+    | (path, f) :: paths ->
+      if is_directory path then f fn path
+      (* This is not an error: RHBZ#948324. *)
+      else loop paths
+    | [] -> ()
+  in
+
+  loop !locations
+
+and read_osinfo_db_three_levels fn path =
+  debug "osinfo: loading 3-level-directories database from %s" path;
+  let entries = Array.to_list (Sys.readdir path) in
+  let entries = List.map ((//) path) entries in
+  (* Iterate only on directories. *)
+  let entries = List.filter is_directory entries in
+  List.iter (read_osinfo_db_directory fn) entries
+
+and read_osinfo_db_flat fn path =
+  debug "osinfo: loading flat database from %s" path;
+  read_osinfo_db_directory fn path
+
+and read_osinfo_db_directory fn path =
+  let entries = Array.to_list (Sys.readdir path) in
+  let entries = List.filter (fun x -> Filename.check_suffix x ".xml") entries in
+  let entries = List.map ((//) path) entries in
+  let entries = List.filter is_regular_file entries in
+  List.iter fn entries
+
diff --git a/builder/osinfo.mli b/builder/osinfo.mli
new file mode 100644
index 000000000..949d776a9
--- /dev/null
+++ b/builder/osinfo.mli
@@ -0,0 +1,22 @@
+(* virt-builder
+ * Copyright (C) 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 iterate_db : (string -> unit) -> unit
+(** [iterate_db fun] iterates over the osinfo-db/libosinfo database
+    of OS definitions, invoking the specified [fun] on each XML file.
+ *)
-- 
2.13.2