[Libguestfs] [PATCH v3 03/23] daemon: Reimplement ‘vfs_type’ API in OCaml.
Richard W.M. Jones
rjones at redhat.com
Thu Jul 27 19:43:33 UTC 2017
---
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 +
7 files changed, 141 insertions(+), 6 deletions(-)
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 8cf5d77ce..cf0e2c503 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -241,9 +241,11 @@ 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 = \
@@ -252,7 +254,9 @@ SOURCES_ML = \
structs.ml \
optgroups.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 d9858d5c8..fea322f5e 100644
--- a/daemon/blkid.c
+++ b/daemon/blkid.c
@@ -67,12 +67,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 000000000..69baa8e8d
--- /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.chomp out
+
+ | 2 -> (* means tag not found, we return "" *)
+ ""
+
+ | _ ->
+ failwithf "blkid: %s: %s: %s" device tag err
diff --git a/daemon/blkid.mli b/daemon/blkid.mli
new file mode 100644
index 000000000..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 000000000..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 the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Printf
+
+type t = {
+ m_type : mountable_type;
+ m_device : string;
+}
+and mountable_type =
+ | MountableDevice
+ | MountablePath
+ | MountableBtrfsVol of string (* volume *)
+
+let to_string { m_type = t; m_device = device } =
+ match t with
+ | MountableDevice | MountablePath -> device
+ | MountableBtrfsVol volume ->
+ sprintf "btrfsvol:%s/%s" device volume
+
+let of_device device =
+ { m_type = MountableDevice; m_device = device }
+
+let of_path path =
+ { m_type = MountablePath; m_device = path }
+
+let of_btrfsvol device volume =
+ { m_type = MountableBtrfsVol volume; m_device = device }
diff --git a/daemon/mountable.mli b/daemon/mountable.mli
new file mode 100644
index 000000000..52f1ad45b
--- /dev/null
+++ b/daemon/mountable.mli
@@ -0,0 +1,34 @@
+(* 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.
+ *)
+
+type t = {
+ m_type : mountable_type;
+ m_device : string;
+}
+and mountable_type =
+ | MountableDevice
+ | MountablePath
+ | MountableBtrfsVol of string (* volume *)
+
+val to_string : t -> string
+(** Convert the mountable back to the string used in the public API. *)
+
+val of_device : string -> t
+val of_path : string -> t
+val of_btrfsvol : string -> string -> t
+(** Create a mountable from various objects. *)
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 26ed1274e..a6eb2c273 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -4872,6 +4872,7 @@ See also C<guestfs_realpath>." };
{ defaults with
name = "vfs_type"; added = (1, 0, 75);
style = RString (RPlainString, "fstype"), [String (Mountable, "mountable")], [];
+ impl = OCaml "Blkid.vfs_type";
tests = [
InitScratchFS, Always, TestResultString (
[["vfs_type"; "/dev/sdb1"]], "ext2"), []
--
2.13.2
More information about the Libguestfs
mailing list