[Libguestfs] [PATCH v6 20/41] daemon: Reimplement ‘is_dir’, ‘is_file’ and ‘is_symlink’ APIs in OCaml.

Richard W.M. Jones
Thu, 15 Jun 2017 17:06:10 -0000

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 306f371a1..12f1c8c5c 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -263,6 +263,7 @@ SOURCES_MLI = \
 	sysroot.mli \
 	devsparts.mli \
 	file.mli \
+	is.mli \
 	mountable.mli \
 	utils.mli

@@ -275,6 +276,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, &mode, 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, &mode, 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, &mode, 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 000000000..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 000000000..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 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+val is_file : ?followsymlinks:bool -> string -> bool
+val is_dir : ?followsymlinks:bool -> string -> bool
+val is_symlink : string -> bool
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 94391288f..421f3ac6b 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -2114,6 +2114,7 @@ See also C<guestfs_is_file>,
C<guestfs_is_dir>, C<guestfs_stat>." };
   { defaults with
     name = "is_file"; added = (0, 0, 8);
     style = RBool "fileflag", [String (Pathname, "path")],
[OBool "followsymlinks"];
+    impl = OCaml "Is.is_file";
     once_had_no_optargs = true;
     tests = [
       InitISOFS, Always, TestResultTrue (
@@ -2138,6 +2139,7 @@ See also C<guestfs_stat>." };
   { defaults with
     name = "is_dir"; added = (0, 0, 8);
     style = RBool "dirflag", [String (Pathname, "path")],
[OBool "followsymlinks"];
+    impl = OCaml "Is.is_dir";
     once_had_no_optargs = true;
     tests = [
       InitISOFS, Always, TestResultFalse (
@@ -6052,6 +6054,7 @@ See also C<guestfs_stat>." };
   { defaults with
     name = "is_symlink"; added = (1, 5, 10);
     style = RBool "flag", [String (Pathname, "path")], [];
+    impl = OCaml "Is.is_symlink";
     tests = [
       InitISOFS, Always, TestResultFalse (
         [["is_symlink"; "/directory"]]), [];
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 3ffe91537..ef6086bfe 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -577,6 +577,7 @@ return_string_list (value retv)

   List.iter (
     fun ({ name = name; style = ret, args, optargs } as f) ->
+      let uc_name = String.uppercase_ascii name in
       let ocaml_function          match f.impl with
         | OCaml f -> f
@@ -625,8 +626,8 @@ return_string_list (value retv)
           let uc_n = String.uppercase_ascii n in

           (* optargs are all passed as [None|Some _] *)
-          pr "  if ((optargs_bitmask & %s_%s_BITMASK) == 0)\n"
-             f.c_optarg_prefix uc_n;
+          pr "  if ((optargs_bitmask & GUESTFS_%s_%s_BITMASK) ==
0)\n"
+             uc_name uc_n;
           pr "    args[%d] = Val_int (0); /* None */\n" !i;
           pr "  else {\n";
           pr "    v = ";
@@ -651,7 +652,7 @@ return_string_list (value retv)
            | Bool n -> pr "Val_bool (%s)" n
            | Int n -> pr "Val_int (%s)" n
            | Int64 n -> pr "caml_copy_int64 (%s)" n
-           | String ((PlainString|Device|Dev_or_Path), n) ->
+           | String ((PlainString|Device|Pathname|Dev_or_Path), n) ->
               pr "caml_copy_string (%s)" n
            | String (Mountable, n) ->
               pr "copy_mountable (%s)" n
--
2.13.0