[Libguestfs] [PATCH v3 06/23] daemon: Reimplement ‘is_dir’, ‘is_file’ and ‘is_symlink’ APIs in OCaml.

Richard W.M. Jones rjones at redhat.com
Thu Jul 27 19:43:36 UTC 2017


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

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index f1b395725..090a80329 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -247,6 +247,7 @@ SOURCES_MLI = \
 	sysroot.mli \
 	devsparts.mli \
 	file.mli \
+	is.mli \
 	mountable.mli \
 	utils.mli
 
@@ -261,6 +262,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..4929f48b3
--- /dev/null
+++ b/daemon/is.ml
@@ -0,0 +1,42 @@
+(* 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 =
+  is "is_file" S_REG followsymlinks path
+and is_dir ?(followsymlinks = false) path =
+  is "is_dir" S_DIR followsymlinks path
+and is_symlink path =
+  is "is_symlink" S_LNK false path
+
+and is func expected_kind followsymlinks path =
+  let chroot = Chroot.create ~name:(sprintf "%s: %s" func path) () in
+  let kind =
+    Chroot.f chroot (
+      fun () ->
+        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 *)
+    ) () in
+  kind = Some expected_kind
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"]]), [];
-- 
2.13.2




More information about the Libguestfs mailing list