Merge pull request #715 from patricoferris/symlinks

Add symlink support

lib_eio/fs.ml

@@ -70,6 +70,7 @@ module Pi = struct
     val rmdir : t -> path -> unit
     val rename : t -> path -> _ dir -> path -> unit
     val read_link : t -> path -> string
+    val symlink : link_to:path -> t -> path -> unit
     val pp : t Fmt.t
     val native : t -> string -> string option
   end

lib_eio/path.ml

@@ -199,6 +199,14 @@ let rename t1 t2 =
     let bt = Printexc.get_raw_backtrace () in
     Exn.reraise_with_context ex bt "renaming %a to %a" pp t1 pp t2
 
+let symlink ~link_to source =
+  let (Resource.T (dir, ops), path) = source in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.symlink dir path ~link_to
+  with Exn.Io _ as ex ->
+    let bt = Printexc.get_raw_backtrace () in
+    Exn.reraise_with_context ex bt "creating symlink %a -> %s" pp source link_to
+
 let rec mkdirs ?(exists_ok=false) ~perm t =
   (* Check parent exists first. *)
   split t |> Option.iter (fun (parent, _) ->

lib_eio/path.mli

@@ -207,3 +207,13 @@ val rename : _ t -> _ t -> unit
 (** [rename old_t new_t] atomically unlinks [old_t] and links it as [new_t].
 
     If [new_t] already exists, it is atomically replaced. *)
+
+val symlink : link_to:string -> _ t -> unit
+(** [symlink ~link_to t] creates a symbolic link [t] to [link_to].
+
+    [t] is the symlink that is created and [link_to] is the name used in the link.
+    For example, this creates a "current" symlink pointing at "version-1.0":
+
+    {[
+      Eio.Path.symlink (dir / "current") ~link_to:"version-1.0"
+    ]} *)

lib_eio_linux/eio_linux.ml

@@ -593,6 +593,9 @@ end = struct
     | Some fd2 -> Low_level.rename t.fd old_path fd2 new_path
     | None -> raise (Unix.Unix_error (Unix.EXDEV, "rename-dst", new_path))
 
+  let symlink ~link_to t path =
+    Low_level.symlink ~link_to t.fd path
+
   let pp f t = Fmt.string f (String.escaped t.label)
 
   let fd t = t.fd

lib_eio_linux/eio_stubs.c

@@ -97,6 +97,24 @@ CAMLprim value caml_eio_renameat(value v_old_fd, value v_old_path, value v_new_f
   CAMLreturn(Val_unit);
 }
 
+CAMLprim value caml_eio_symlinkat(value v_old_path, value v_new_fd, value v_new_path) {
+  CAMLparam2(v_old_path, v_new_path);
+  char *old_path;
+  char *new_path;
+  int ret;
+  caml_unix_check_path(v_old_path, "symlinkat-old");
+  caml_unix_check_path(v_new_path, "symlinkat-new");
+  old_path = caml_stat_strdup(String_val(v_old_path));
+  new_path = caml_stat_strdup(String_val(v_new_path));
+  caml_enter_blocking_section();
+  ret = symlinkat(old_path, Int_val(v_new_fd), new_path);
+  caml_leave_blocking_section();
+  caml_stat_free(old_path);
+  caml_stat_free(new_path);
+  if (ret == -1) uerror("symlinkat", v_old_path);
+  CAMLreturn(Val_unit);
+}
+
 CAMLprim value caml_eio_getrandom(value v_ba, value v_off, value v_len) {
   CAMLparam1(v_ba);
   ssize_t ret;

lib_eio_linux/low_level.ml

@@ -330,6 +330,8 @@ external eio_mkdirat : Unix.file_descr -> string -> Unix.file_perm -> unit = "ca
 
 external eio_renameat : Unix.file_descr -> string -> Unix.file_descr -> string -> unit = "caml_eio_renameat"
 
+external eio_symlinkat : string -> Unix.file_descr -> string -> unit = "caml_eio_symlinkat"
+
 external eio_getrandom : Cstruct.buffer -> int -> int -> int = "caml_eio_getrandom"
 
 external eio_getdents : Unix.file_descr -> string list = "caml_eio_getdents"
@@ -450,6 +452,12 @@ let rename old_dir old_path new_dir new_path =
       new_parent new_leaf
   with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap_fs code name arg
 
+let symlink ~link_to dir path =
+  with_parent_dir "symlinkat-new" dir path @@ fun parent leaf ->
+  try
+    eio_symlinkat link_to parent leaf
+  with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap_fs code name arg
+
 let shutdown socket command =
   try
     Fd.use_exn "shutdown" socket @@ fun fd ->

lib_eio_linux/low_level.mli

@@ -150,6 +150,9 @@ val unlink : rmdir:bool -> dir_fd -> string -> unit
 val rename : dir_fd -> string -> dir_fd -> string -> unit
 (** [rename old_dir old_path new_dir new_path] renames [old_dir / old_path] as [new_dir / new_path]. *)
 
+val symlink : link_to:string -> dir_fd -> string -> unit
+(** [symlink ~link_to dir path] creates a new symlink at [dir / path] pointing to [link_to]. *)
+
 val pipe : sw:Switch.t -> fd * fd
 (** [pipe ~sw] returns a pair [r, w] with the readable and writeable ends of a new pipe. *)
 

lib_eio_linux/primitives.h

@@ -5,6 +5,7 @@
 CAMLprim value caml_eio_eventfd(value);
 CAMLprim value caml_eio_mkdirat(value, value, value);
 CAMLprim value caml_eio_renameat(value, value, value, value);
+CAMLprim value caml_eio_symlinkat(value, value, value);
 CAMLprim value caml_eio_getrandom(value, value, value);
 CAMLprim value caml_eio_getdents(value);
 CAMLprim value caml_eio_clone3(value, value);

lib_eio_posix/eio_posix_stubs.c

@@ -384,6 +384,27 @@ CAMLprim value caml_eio_posix_renameat(value v_old_fd, value v_old_path, value v
   CAMLreturn(Val_unit);
 }
 
+CAMLprim value caml_eio_posix_symlinkat(value v_old_path, value v_new_fd, value v_new_path) {
+  CAMLparam2(v_old_path, v_new_path);
+  size_t old_path_len = caml_string_length(v_old_path);
+  size_t new_path_len = caml_string_length(v_new_path);
+  char *old_path;
+  char *new_path;
+  int ret;
+  caml_unix_check_path(v_old_path, "symlinkat-old");
+  caml_unix_check_path(v_new_path, "symlinkat-new");
+  old_path = caml_stat_alloc(old_path_len + new_path_len + 2);
+  new_path = old_path + old_path_len + 1;
+  memcpy(old_path, String_val(v_old_path), old_path_len + 1);
+  memcpy(new_path, String_val(v_new_path), new_path_len + 1);
+  caml_enter_blocking_section();
+  ret = symlinkat(old_path, Int_val(v_new_fd), new_path);
+  caml_leave_blocking_section();
+  caml_stat_free_preserving_errno(old_path);
+  if (ret == -1) uerror("symlinkat", v_old_path);
+  CAMLreturn(Val_unit);
+}
+
 CAMLprim value caml_eio_posix_spawn(value v_errors, value v_actions) {
   CAMLparam1(v_actions);
   pid_t child_pid;

lib_eio_posix/fs.ml

@@ -94,6 +94,9 @@ end = struct
     | None -> invalid_arg "Target is not an eio_posix directory!"
     | Some new_dir -> Err.run (Low_level.rename t.fd old_path new_dir) new_path
 
+  let symlink ~link_to t path =
+    Err.run (Low_level.symlink ~link_to t.fd) path
+
   let open_dir t ~sw path =
     let flags = Low_level.Open_flags.(rdonly + directory +? path) in
     let fd = Err.run (Low_level.openat ~sw ~mode:0 t.fd path) flags in

lib_eio_posix/low_level.ml

@@ -415,6 +415,14 @@ let rename old_dir old_path new_dir new_path =
   let new_dir = Option.value new_dir ~default:at_fdcwd in
   eio_renameat old_dir old_path new_dir new_path
 
+external eio_symlinkat : string -> Unix.file_descr -> string -> unit = "caml_eio_posix_symlinkat"
+
+let symlink ~link_to new_dir new_path =
+  in_worker_thread "symlink" @@ fun () ->
+  Resolve.with_parent "symlink-new" new_dir new_path @@ fun new_dir new_path ->
+  let new_dir = Option.value new_dir ~default:at_fdcwd in
+  eio_symlinkat link_to new_dir new_path
+
 let read_link dirfd path =
   in_worker_thread "read_link" @@ fun () ->
   Resolve.with_parent "read_link" dirfd path @@ fun dirfd path ->

lib_eio_posix/low_level.mli

@@ -78,6 +78,10 @@ val mkdir : mode:int -> dir_fd -> string -> unit
 val unlink : dir:bool -> dir_fd -> string -> unit
 val rename : dir_fd -> string -> dir_fd -> string -> unit
 
+val symlink : link_to:string -> dir_fd -> string -> unit
+(** [symlink ~link_to dir path] will create a new symlink at [dir / path]
+    linking to [link_to]. *)
+
 val readdir : dir_fd -> string -> string array
 
 val readv : fd -> Cstruct.t array -> int

lib_eio_posix/primitives.h

@@ -14,6 +14,7 @@ CAMLprim value caml_eio_posix_fdopendir(value);
 CAMLprim value caml_eio_posix_mkdirat(value, value, value);
 CAMLprim value caml_eio_posix_unlinkat(value, value, value);
 CAMLprim value caml_eio_posix_renameat(value, value, value, value);
+CAMLprim value caml_eio_posix_symlinkat(value, value, value);
 CAMLprim value caml_eio_posix_make_stat(value);
 CAMLprim value caml_eio_posix_fstatat(value, value, value, value);
 CAMLprim value caml_eio_posix_fstat(value, value);

lib_eio_windows/eio_windows_stubs.c

@@ -252,6 +252,11 @@ CAMLprim value caml_eio_windows_renameat(value v_old_fd, value v_old_path, value
   uerror("renameat is not supported on windows yet", Nothing);
 }
 
+CAMLprim value caml_eio_windows_symlinkat(value v_old_path, value v_new_fd, value v_new_path)
+{
+  uerror("symlinkat is not supported on windows yet", Nothing);
+}
+
 CAMLprim value caml_eio_windows_spawn(value v_errors, value v_actions)
 {
   uerror("processes are not supported on windows yet", Nothing);

lib_eio_windows/fs.ml

@@ -172,6 +172,10 @@ end = struct
       with_parent_dir new_dir new_path @@ fun new_dir new_path ->
       Err.run (Low_level.rename ?old_dir old_path ?new_dir) new_path
 
+  let symlink ~link_to t path =
+    with_parent_dir t path @@ fun dirfd path ->
+    Err.run (Low_level.symlink ~link_to dirfd) path
+
   let close t = t.closed <- true
 
   let open_dir t ~sw path =

lib_eio_windows/low_level.ml

@@ -234,6 +234,14 @@ let rename ?old_dir old_path ?new_dir new_path =
   in_worker_thread @@ fun () ->
   eio_renameat old_dir old_path new_dir new_path
 
+
+external eio_symlinkat : string -> Unix.file_descr option -> string -> unit = "caml_eio_windows_symlinkat"
+
+let symlink ~link_to new_dir new_path =
+  with_dirfd "symlink-new" new_dir @@ fun new_dir ->
+  in_worker_thread @@ fun () ->
+  eio_symlinkat link_to new_dir new_path
+
 let lseek fd off cmd =
   Fd.use_exn "lseek" fd @@ fun fd ->
   let cmd =

lib_eio_windows/low_level.mli

@@ -48,6 +48,10 @@ val mkdir : ?dirfd:fd -> ?nofollow:bool -> mode:int -> string -> unit
 val unlink : ?dirfd:fd -> dir:bool -> string -> unit
 val rename : ?old_dir:fd -> string -> ?new_dir:fd -> string -> unit
 
+val symlink : link_to:string -> fd option -> string -> unit
+(** [symlink ~link_to dir path] will create a new symlink at [dir / path]
+    linking to [link_to]. *)
+
 val readdir : string -> string array
 
 val readv : fd -> Cstruct.t array -> int