renameat2: check RENAME_WHITEOUT constructor

ygrek · Jul 17, 2023 · 51a0e3a · 51a0e3a
1 parent 1c4b711
commit 51a0e3a
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 2 deletions.
diff --git a/discover/discover.ml b/discover/discover.ml
@@ -78,6 +78,7 @@ let config_includes = [
   "caml/unixsupport.h";
   "caml/signals.h";
   "caml/alloc.h";
+  "caml/callback.h";
   "caml/custom.h";
   "caml/bigarray.h";
   "caml/version.h";
@@ -235,6 +236,10 @@ let features =
       I "fcntl.h"; I "stdio.h";
       S "renameat2";
     ];
+    "RENAME_WHITEOUT", L[
+      DEFINE "_GNU_SOURCE";
+      D "RENAME_WHITEOUT";
+    ];
     "DIRFD", L[
       fd_int;
       I "sys/types.h";

diff --git a/src/extUnix.pp.ml b/src/extUnix.pp.ml
@@ -13,6 +13,8 @@ the corresponding man pages and/or system documentation for details.
     [ENOSYS] (Not implemented) error even though the function is available. *)
 exception Not_available of string
 
+let _ = Callback.register_exception "ExtUnix.Not_available" (Not_available "")
+
 (** type of bigarray used by BA submodules that read from files into
     bigarrays or write bigarrays into files.  The only constraint here
     is [Bigarray.c_layout].
@@ -212,7 +214,7 @@ external fchmodat : Unix.file_descr -> string -> int -> at_flag list -> unit = "
 ]
 
 [%%have RENAMEAT2
-type rename_flag = RENAME_EXCHANGE | RENAME_NOREPLACE | RENAME_WHITEOUT
+type rename_flag = RENAME_EXCHANGE | RENAME_NOREPLACE | RENAME_WHITEOUT [@have RENAME_WHITEOUT]
 
 external renameat2 : Unix.file_descr -> string -> Unix.file_descr -> string -> rename_flag list -> unit = "caml_extunix_renameat2"
 ]

diff --git a/src/rename.c b/src/rename.c
@@ -9,12 +9,28 @@
 #endif
 
 static int rename_flags_table[] = {
-  RENAME_NOREPLACE, RENAME_EXCHANGE, RENAME_WHITEOUT,
+  RENAME_NOREPLACE, /* 0 */
+  RENAME_EXCHANGE, /* 1 */
+  RENAME_WHITEOUT, /* 2 */
 };
 
+#define RENAME_WHITEOUT_INDEX 2
+
+void caml_check_flag_list(value list)
+{
+  for (/*nothing*/; list != Val_emptylist; list = Field(list, 1))
+  {
+#if !defined(EXTUNIX_HAVE_RENAME_WHITEOUT)
+    if (RENAME_WHITEOUT_INDEX == Int_val(Field(list, 0)))
+      caml_raise_with_string(*caml_named_value("ExtUnix.Not_available"), "renameat2 RENAME_WHITEOUT");
+#endif
+  }
+}
+
 CAMLprim value caml_extunix_renameat2(value v_oldfd, value v_oldname, value v_newfd, value v_newname, value v_flags)
 {
   CAMLparam5(v_oldfd, v_oldname, v_newfd, v_newname, v_flags);
+  caml_check_flag_list(v_flags);
   int flags = caml_convert_flag_list(v_flags, rename_flags_table);
   caml_enter_blocking_section();
   int ret = renameat2(Int_val(v_oldfd), String_val(v_oldname), Int_val(v_newfd), String_val(v_newname), flags);