Add renameat2

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";
@@ -229,6 +230,16 @@ let features =
       D "S_IFREG";
       S "fstatat"; S "openat"; S "unlinkat"; S "renameat"; S "mkdirat"; S "linkat"; S "symlinkat"; S "readlinkat"; S "fchownat"; S "fchmodat";
     ];
+    "RENAMEAT2", L[
+      fd_int;
+      DEFINE "_GNU_SOURCE";
+      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";

ppx_have/ppx_have.ml

@@ -92,12 +92,43 @@ let record_external have =
   in
   externals_of#structure_item
 
+let have_constr ~loc =
+  let have_constr =
+    object
+      inherit Ast_traverse.map as super
+
+      method! constructor_declaration x =
+        match super#constructor_declaration x with
+        | {
+            pcd_attributes =
+              [
+                {
+                  attr_name = { txt = "have"; _ };
+                  attr_payload = PStr (cond :: _);
+                  _;
+                };
+              ];
+            _;
+          } as x ->
+            if eval_cond ~loc cond then x
+            else
+              {
+                x with
+                pcd_name =
+                  { x.pcd_name with txt = x.pcd_name.txt ^ "__Not_available" };
+              }
+        | x -> x
+    end
+  in
+  have_constr#structure_item
+
 let have_expand ~ctxt cond items =
   let loc = Expansion_context.Extension.extension_point_loc ctxt in
   let have = eval_cond ~loc cond in
   List.iter (record_external have) items;
   match (have, !all) with
-  | true, _ -> items
+  | true, true -> items
+  | true, false -> List.map (have_constr ~loc) items
   | false, true -> List.map (invalid_external ~loc) items
   | false, false -> []
 

src/dune

@@ -51,6 +51,7 @@
    pts
    read_cred
    realpath
+   rename
    resource
    sendmsg
    signalfd

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].
@@ -211,6 +213,12 @@ external fchownat : Unix.file_descr -> string -> int -> int -> at_flag list -> u
 external fchmodat : Unix.file_descr -> string -> int -> at_flag list -> unit = "caml_extunix_fchmodat"
 ]
 
+[%%have RENAMEAT2
+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"
+]
+
 (** @raise Not_available if OS does not represent file descriptors as numbers *)
 let int_of_file_descr : Unix.file_descr -> int =
   if Obj.is_block (Obj.repr Unix.stdin) then

src/rename.c

@@ -0,0 +1,42 @@
+#define EXTUNIX_WANT_RENAMEAT2
+#include "config.h"
+
+#if defined(EXTUNIX_HAVE_RENAMEAT2)
+
+#ifndef RENAME_WHITEOUT
+#define RENAME_WHITEOUT 0
+#endif
+
+static const int rename_flags_table[] = {
+  RENAME_NOREPLACE, /* 0 */
+  RENAME_EXCHANGE, /* 1 */
+  RENAME_WHITEOUT, /* 2 */
+};
+
+#define RENAME_WHITEOUT_INDEX 2
+
+static void 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);
+  check_flag_list(v_flags);
+  int oldfd = Int_val(v_oldfd), newfd = Int_val(v_newfd);
+  const char *oldname = String_val(v_oldname), *newname = String_val(v_newname);
+  int flags = caml_convert_flag_list(v_flags, rename_flags_table);
+  caml_enter_blocking_section();
+  int ret = renameat2(oldfd, oldname, newfd, newname, flags);
+  caml_leave_blocking_section();
+  if (ret != 0) uerror("renameat2", v_oldname);
+  CAMLreturn(Val_unit);
+}
+#endif