Add Unix.realpath.

Changes

@@ -123,6 +123,9 @@ Working version
 
 ### Other libraries:
 
+- #10047: Add `Unix.realpath`
+  (Daniel Bünzli, review by David Allsopp, Josh Berdine and Gabriel Scherer)
+
 * #10084: Unix.open_process_args* functions now look up the program in the PATH.
   This was already the case under Windows, but this is now also done under
   Unix. Note that previously the program was interpreted relative to the current

configure.ac

@@ -1377,6 +1377,8 @@ AC_CHECK_FUNC([symlink],
   [AC_CHECK_FUNC([readlink],
     [AC_CHECK_FUNC([lstat], [AC_DEFINE([HAS_SYMLINK])])])])
 
+AC_CHECK_FUNC([realpath], [AC_DEFINE([HAS_REALPATH])])
+
 # wait
 AC_CHECK_FUNC(
   [waitpid],

otherlibs/unix/Makefile

@@ -35,7 +35,7 @@ COBJS=accept.o access.o addrofstr.o alarm.o bind.o channels.o chdir.o \
   gettimeofday.o getserv.o getsockname.o getuid.o gmtime.o \
   initgroups.o isatty.o itimer.o kill.o link.o listen.o lockf.o lseek.o \
   mkdir.o mkfifo.o mmap.o mmap_ba.o \
-  nice.o open.o opendir.o pipe.o putenv.o read.o \
+  nice.o open.o opendir.o pipe.o putenv.o read.o realpath.o \
   readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \
   setgid.o setgroups.o setsid.o setuid.o shutdown.o signals.o \
   sleep.o socket.o socketaddr.o \

otherlibs/unix/realpath.c

@@ -0,0 +1,43 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                         The OCaml programmers                          */
+/*                                                                        */
+/*   Copyright 2020 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+
+#ifdef HAS_REALPATH
+
+CAMLprim value unix_realpath (value p)
+{
+  CAMLparam1 (p);
+  char *r;
+  value rp;
+
+  caml_unix_check_path (p, "realpath");
+  r = realpath (String_val (p), NULL);
+  if (r == NULL) { uerror ("realpath", p); }
+  rp = caml_copy_string (r);
+  free (r);
+  CAMLreturn (rp);
+}
+
+#else
+
+CAMLprim value unix_realpath (value p)
+{ caml_invalid_argument ("realpath not implemented"); }
+
+#endif

otherlibs/unix/unix.ml

@@ -322,6 +322,7 @@ external isatty : file_descr -> bool = "unix_isatty"
 external unlink : string -> unit = "unix_unlink"
 external rename : string -> string -> unit = "unix_rename"
 external link : ?follow:bool -> string -> string -> unit = "unix_link"
+external realpath : string -> string = "unix_realpath"
 
 module LargeFile =
   struct

otherlibs/unix/unix.mli

@@ -644,6 +644,11 @@ val link : ?follow (* thwart tools/sync_stdlib_docs *) :bool ->
                  unavailable.
    @raise ENOSYS On {e Windows} if [~follow:false] is requested. *)
 
+val realpath : string -> string
+(** [realpath p] is an absolute pathname for [p] obtained by resolving
+    all extra [/] characters, relative path segments and symbolic links.
+
+    @since 4.13.0 *)
 
 (** {1 File permissions and ownership} *)
 

otherlibs/unix/unixLabels.mli

@@ -644,6 +644,11 @@ val link : ?follow (* thwart tools/sync_stdlib_docs *) :bool ->
                  unavailable.
    @raise ENOSYS On {e Windows} if [~follow:false] is requested. *)
 
+val realpath : string -> string
+(** [realpath p] is an absolute pathname for [p] obtained by resolving
+    all extra [/] characters, relative path segments and symbolic links.
+
+    @since 4.13.0 *)
 
 (** {1 File permissions and ownership} *)
 

otherlibs/win32unix/Makefile

@@ -23,7 +23,7 @@ WIN_FILES = accept.c bind.c channels.c close.c \
   getpeername.c getpid.c getsockname.c gettimeofday.c isatty.c \
   link.c listen.c lockf.c lseek.c nonblock.c \
   mmap.c open.c pipe.c read.c readlink.c rename.c \
-  select.c sendrecv.c \
+  realpath.c select.c sendrecv.c \
   shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
   symlink.c system.c times.c truncate.c unixsupport.c windir.c winwait.c \
   write.c winlist.c winworker.c windbug.c utimes.c

otherlibs/win32unix/realpath.c

@@ -0,0 +1,79 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*                         The OCaml programmers                          */
+/*                                                                        */
+/*   Copyright 2020 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+/*
+ * Windows Vista functions enabled
+ */
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0600
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+#include <windows.h>
+#include <stdio.h>
+
+CAMLprim value unix_realpath (value p)
+{
+  CAMLparam1 (p);
+  HANDLE h;
+  wchar_t *wp;
+  wchar_t *wr;
+  DWORD wr_len;
+  value rp;
+
+  caml_unix_check_path (p, "realpath");
+  wp = caml_stat_strdup_to_utf16 (String_val (p));
+  h = CreateFile (wp, 0,
+                  FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
+                  OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+  caml_stat_free (wp);
+
+  if (h == INVALID_HANDLE_VALUE)
+  {
+    win32_maperr (GetLastError ());
+    uerror ("realpath", p);
+  }
+
+  wr_len = GetFinalPathNameByHandle (h, NULL, 0, VOLUME_NAME_DOS);
+  if (wr_len == 0)
+  {
+    win32_maperr (GetLastError ());
+    CloseHandle (h);
+    uerror ("realpath", p);
+  }
+
+  wr = caml_stat_alloc ((wr_len + 1) * sizeof (wchar_t));
+  wr_len = GetFinalPathNameByHandle (h, wr, wr_len, VOLUME_NAME_DOS);
+
+  if (wr_len == 0)
+  {
+    win32_maperr (GetLastError ());
+    CloseHandle (h);
+    caml_stat_free (wr);
+    uerror ("realpath", p);
+  }
+
+  rp = caml_copy_string_of_utf16 (wr);
+  CloseHandle (h);
+  caml_stat_free (wr);
+  CAMLreturn (rp);
+}

otherlibs/win32unix/unix.ml

@@ -364,6 +364,23 @@ external isatty : file_descr -> bool = "unix_isatty"
 external unlink : string -> unit = "unix_unlink"
 external rename : string -> string -> unit = "unix_rename"
 external link : ?follow:bool -> string -> string -> unit = "unix_link"
+external realpath : string -> string = "unix_realpath"
+
+let realpath p =
+  let cleanup p = (* Remove any \\?\ prefix. *)
+    if String.length p <= 4 then p else
+    if p.[0] = '\\' && p.[1] = '\\' && p.[2] = '?' && p.[3] = '\\'
+    then (String.sub p 4 (String.length p - 4))
+    else p
+  in
+  try cleanup (realpath p) with
+  | (Unix_error (EACCES, _, _)) as e ->
+      (* On Windows this can happen on *files* on which you don't have
+         access. POSIX realpath(3) works in this case, we emulate this. *)
+      try
+        let dir = cleanup (realpath (Filename.dirname p)) in
+        Filename.concat dir (Filename.basename p)
+      with _ -> raise e
 
 (* Operations on large files *)
 

runtime/caml/s.h.in

@@ -141,6 +141,9 @@
 
 /* Define HAS_SYMLINK if you have symlink() and readlink() and lstat(). */
 
+#undef HAS_REALPATH
+/* Define HAS_REALPATH if you have realpath(). */
+
 #undef HAS_WAIT4
 #undef HAS_WAITPID
 

testsuite/tests/lib-unix/realpath/test.ml

@@ -0,0 +1,28 @@
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+let main () =
+  (* On Windows this tests that we strip \\?\ *)
+  let cwd = String.lowercase_ascii (Sys.getcwd ()) in
+  assert (cwd = String.lowercase_ascii (Unix.realpath cwd));
+  Unix.mkdir "test_dir" 0o755;
+  close_out (open_out "test_dir/test_file");
+  let p0 = Unix.realpath "test_dir/.//test_file" in
+  let p1 = Unix.realpath "test_dir/../test_dir/test_file" in
+  assert (p0 = p1 &&
+          not (Filename.is_relative p0) &&
+          not (Filename.is_relative p1));
+  print_endline "Unix.realpath works with files";
+  let p2 = Unix.realpath "./test_dir/../test_dir/.." in
+  let p3 = Unix.realpath "." in
+  assert (p2 = p3 &&
+          not (Filename.is_relative p2) &&
+          not (Filename.is_relative p3));
+  print_endline "Unix.realpath works with directories";
+  ()
+
+let () = Unix.handle_unix_error main ()

testsuite/tests/lib-unix/realpath/test.reference

@@ -0,0 +1,2 @@
+Unix.realpath works with files
+Unix.realpath works with directories