Initial symlink sandboxing support

Author: patricoferris

lib_eio_windows/eio_windows_stubs.c

@@ -83,8 +83,23 @@ CAMLprim value caml_eio_windows_pwritev(value v_fd, value v_bufs, value v_offset
 
 // File-system operations
 
+// No follow
+void no_follow(HANDLE h) {
+  BY_HANDLE_FILE_INFORMATION b;
+
+  if (!GetFileInformationByHandle(h, &b)) {
+    caml_win32_maperr(GetLastError());
+    uerror("nofollow", Nothing);
+  }
+
+  if (b.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT) {
+    CloseHandle(h);
+    caml_unix_error(ELOOP, "nofollow", Nothing);
+  }
+}
+
 // We recreate an openat like function using NtCreateFile
-CAMLprim value caml_eio_windows_openat(value v_dirfd, value v_pathname, value v_desired_access, value v_create_disposition, value v_create_options)
+CAMLprim value caml_eio_windows_openat(value v_dirfd, value v_nofollow, value v_pathname, value v_desired_access, value v_create_disposition, value v_create_options)
 {
   CAMLparam2(v_dirfd, v_pathname);
   HANDLE h, dir;
@@ -121,14 +136,17 @@ CAMLprim value caml_eio_windows_openat(value v_dirfd, value v_pathname, value v_
   // Create the file
   r = NtCreatefile(
     &h,
-    Int_val(v_desired_access),
+    Int_val(v_desired_access) | FILE_READ_ATTRIBUTES,
     &obj_attr,
     &io_status,
     0, // Allocation size
     FILE_ATTRIBUTE_NORMAL, // TODO: Could check flags to see if we can do READONLY here a la OCaml
     (FILE_SHARE_READ | FILE_SHARE_WRITE),
     Int_val(v_create_disposition),
-    (Int_val(v_create_options) | FILE_SYNCHRONOUS_IO_NONALERT),
+    ( 
+       FILE_SYNCHRONOUS_IO_NONALERT
+      | FILE_OPEN_FOR_BACKUP_INTENT
+      | (Bool_val(v_nofollow) ? FILE_FLAG_OPEN_REPARSE_POINT : Int_val(v_create_options))),
     NULL, // Extended attribute buffer
     0     // Extended attribute buffer length
   );
@@ -138,17 +156,28 @@ CAMLprim value caml_eio_windows_openat(value v_dirfd, value v_pathname, value v_
 
   if (h == INVALID_HANDLE_VALUE) {
     caml_win32_maperr(RtlNtStatusToDosError(r));
-    uerror("openat", v_pathname);
+    uerror("openat handle", v_pathname);
   }
 
-  if (!NT_SUCCESS(r)) {
+   if (!NT_SUCCESS(r)) {
     caml_win32_maperr(RtlNtStatusToDosError(r));
     uerror("openat", Nothing);
   }
+
+  // No follow check -- Windows doesn't actually have that ability
+  // so we have to do it after the fact. This will raise if a symbolic
+  // link is encountered and will close the handle.
+  if (Bool_val(v_nofollow)) {
+    no_follow(h);
+  }
 
   CAMLreturn(caml_win32_alloc_handle(h));
 }
 
+value caml_eio_windows_openat_bytes(value* values, int argc) {
+    return caml_eio_windows_openat(values[0], values[1], values[2], values[3], values[4], values[5]);
+}
+
 CAMLprim value caml_eio_windows_unlinkat(value v_dirfd, value v_pathname, value v_dir)
 {
   CAMLparam2(v_dirfd, v_pathname);

lib_eio_windows/fs.ml

@@ -29,8 +29,8 @@ module Fd = Eio_unix.Fd
 class virtual posix_dir = object
   inherit Eio.Fs.dir
 
-  val virtual opt_nofollow : Low_level.Flags.Open.t
-  (** Extra flags for open operations. Sandboxes will add [O_NOFOLLOW] here. *)
+  val virtual opt_nofollow : bool
+  (** Emulate [O_NOFOLLOW] here. *)
 
   method virtual private resolve : string -> string
   (** [resolve path] returns the real path that should be used to access [path].
@@ -60,7 +60,7 @@ class virtual dir ~label = object (self)
 
   method open_in ~sw path =
     let open Low_level in
-    let fd = Err.run (Low_level.openat ~sw (self#resolve path)) Low_level.Flags.Open.(generic_read + synchronise) Flags.Disposition.(open_if) Flags.Create.(non_directory) in
+    let fd = Err.run (Low_level.openat ~sw ~nofollow:opt_nofollow (self#resolve path)) Low_level.Flags.Open.(generic_read + synchronise) Flags.Disposition.(open_if) Flags.Create.(non_directory) in
     (Flow.of_fd fd :> <Eio.File.ro; Eio.Flow.close>)
 
   method open_out ~sw ~append ~create path =
@@ -75,10 +75,12 @@ class virtual dir ~label = object (self)
     let flags = if append then Low_level.Flags.Open.(synchronise + append) else Low_level.Flags.Open.(generic_write + synchronise) in
     match
       self#with_parent_dir path @@ fun dirfd path ->
-      Low_level.openat ?dirfd ~sw path flags disp Flags.Create.(non_directory)
+      Low_level.openat ?dirfd ~nofollow:opt_nofollow ~sw path flags disp Flags.Create.(non_directory)
     with
     | fd -> (Flow.of_fd fd :> <Eio.File.rw; Eio.Flow.close>)
-    | exception Unix.Unix_error (ELOOP, _, _) ->
+    (* This is the result of raising [caml_unix_error(ELOOP,...)] *)
+    | exception Unix.Unix_error (EUNKNOWNERR 114, _, _) ->
+      print_endline "UNKNOWN";
       (* The leaf was a symlink (or we're unconfined and the main path changed, but ignore that).
          A leaf symlink might be OK, but we need to check it's still in the sandbox.
          todo: possibly we should limit the number of redirections here, like the kernel does. *)
@@ -133,8 +135,7 @@ end
 and sandbox ~label dir_path = object (self)
   inherit dir ~label
 
-  (* nofollow not on windows. *)
-  val opt_nofollow = Low_level.Flags.Open.empty
+  val opt_nofollow = true
 
   (* Resolve a relative path to an absolute one, with no symlinks.
      @raise Eio.Fs.Permission_denied if it's outside of [dir_path]. *)
@@ -145,9 +146,9 @@ and sandbox ~label dir_path = object (self)
       let full = Err.run Low_level.realpath (Filename.concat dir_path path) in
       let prefix_len = String.length dir_path + 1 in
       (* \\??\\ Is necessary with NtCreateFile. *)
-      if String.length full >= prefix_len && String.sub full 0 prefix_len = dir_path ^ Filename.dir_sep then
+      if String.length full >= prefix_len && String.sub full 0 prefix_len = dir_path ^ Filename.dir_sep then begin
         "\\??\\" ^ full
-      else if full = dir_path then
+      end else if full = dir_path then
         "\\??\\" ^ full
       else
         raise @@ Eio.Fs.err (Permission_denied (Err.Outside_sandbox (full, dir_path)))
@@ -167,7 +168,7 @@ and sandbox ~label dir_path = object (self)
       let dir = self#resolve dir in
       Switch.run @@ fun sw ->
       let open Low_level in
-      let dirfd = Low_level.openat ~sw dir Flags.Open.(generic_read + synchronise) Flags.Disposition.(open_if) Flags.Create.(directory) in
+      let dirfd = Low_level.openat ~sw ~nofollow:true dir Flags.Open.(generic_read + synchronise) Flags.Disposition.(open_if) Flags.Create.(directory) in
       fn (Some dirfd) leaf
     )
 end
@@ -176,7 +177,7 @@ end
 let fs = object
   inherit dir ~label:"fs"
 
-  val opt_nofollow = Low_level.Flags.Open.empty
+  val opt_nofollow = false
 
   (* No checks *)
   method private resolve path = path

lib_eio_windows/low_level.ml

@@ -199,17 +199,17 @@ let rec with_dirfd op dirfd fn =
   | Some dirfd -> Fd.use_exn op dirfd (fun fd -> fn (Some fd))
   | exception Unix.Unix_error(Unix.EINTR, _, "") -> with_dirfd op dirfd fn
 
-external eio_openat : Unix.file_descr option -> string -> Flags.Open.t -> Flags.Disposition.t -> Flags.Create.t -> Unix.file_descr = "caml_eio_windows_openat"
+external eio_openat : Unix.file_descr option -> bool -> string -> Flags.Open.t -> Flags.Disposition.t -> Flags.Create.t -> Unix.file_descr = "caml_eio_windows_openat_bytes" "caml_eio_windows_openat"
 
-let openat ?dirfd ~sw path flags dis create =
+let openat ?dirfd ?(nofollow=false) ~sw path flags dis create =
   with_dirfd "openat" dirfd @@ fun dirfd ->
   Switch.check sw;
-  in_worker_thread (fun () -> eio_openat dirfd path Flags.Open.(flags + cloexec (* + nonblock *)) dis create)
+  in_worker_thread (fun () -> eio_openat dirfd nofollow path Flags.Open.(flags + cloexec (* + nonblock *)) dis create)
   |> Fd.of_unix ~sw ~blocking:false ~close_unix:true
 
-let mkdir ?dirfd ~mode:_ path =
+let mkdir ?dirfd ?(nofollow=false) ~mode:_ path =
   Switch.run @@ fun sw ->
-  let _ : Fd.t = openat ?dirfd ~sw path Flags.Open.(generic_write + synchronise) Flags.Disposition.(create) Flags.Create.(directory) in
+  let _ : Fd.t = openat ?dirfd ~nofollow ~sw path Flags.Open.(generic_write + synchronise) Flags.Disposition.(create) Flags.Create.(directory) in
   ()
 
 external eio_unlinkat : Unix.file_descr option -> string -> bool -> unit = "caml_eio_windows_unlinkat"

lib_eio_windows/low_level.mli

@@ -39,7 +39,7 @@ val lstat : string -> Unix.LargeFile.stats
 
 val realpath : string -> string
 
-val mkdir : ?dirfd:fd -> mode:int -> string -> unit
+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
 
@@ -115,5 +115,5 @@ module Flags : sig
   end
 end
 
-val openat : ?dirfd:fd -> sw:Switch.t -> string -> Flags.Open.t -> Flags.Disposition.t -> Flags.Create.t -> fd
+val openat : ?dirfd:fd -> ?nofollow:bool-> sw:Switch.t -> string -> Flags.Open.t -> Flags.Disposition.t -> Flags.Create.t -> fd
 (** Note: the returned FD is always non-blocking and close-on-exec. *)

lib_eio_windows/test/test.ml

@@ -51,7 +51,7 @@ end
 
 let () =
   Eio_windows.run @@ fun env ->
-  Alcotest.run "eio_windows" [
+  Alcotest.run ~bail:true "eio_windows" [
     "net", Test_net.tests env;
     "fs", Test_fs.tests env;
     "timeout", Timeout.tests env;

lib_eio_windows/test/test_fs.ml

@@ -18,6 +18,7 @@ let try_write_file ~create ?append path content =
   | exception ex -> raise ex
 
 let try_mkdir path =
+  traceln "mkdir %a -> ?" Path.pp path;
   match Path.mkdir path ~perm:0o700 with
   | () -> traceln "mkdir %a -> ok" Path.pp path
   | exception ex -> raise ex
@@ -71,9 +72,12 @@ let test_cwd_no_access_abs env () =
 let test_exclusive env () =
   let cwd = Eio.Stdenv.cwd env in
   with_temp_file (cwd / "test-file") @@ fun path ->
+  Eio.traceln "fiest";
   Path.save ~create:(`Exclusive 0o666) path "first-write";
+  Eio.traceln "next";
   try 
     Path.save ~create:(`Exclusive 0o666) path "first-write";
+    Eio.traceln "nope";
     failwith "Should have failed"
   with Eio.Io (Eio.Fs.E (Already_exists _), _) -> ()
 
@@ -121,9 +125,56 @@ let test_mkdir env () =
   Unix.rmdir "subdir\\nested";
   Unix.rmdir "subdir"
 
-let test_symlink _env () =
-  (* TODO *)
-  ()
+let test_symlink env () =
+  (* 
+    Important note: assuming that neither "another" nor
+    "to-subdir" exist, the following program will behave
+    differently if you don't have the ~to_dir flag.
+
+    With [to_dir] set to [true] we get the desired UNIX behaviour,
+    without it [Unix.realpath] will actually show the parent directory
+    of "another". Presumably this is because Windows distinguishes
+    between file symlinks and directory symlinks. Fun. 
+
+  {[ Unix.symlink ~to_dir:true "another" "to-subdir";
+     Unix.mkdir "another" 0o700;
+     print_endline @@ Unix.realpath "to-subdir" |} 
+  *)
+  let cwd = Eio.Stdenv.cwd env in
+  try_mkdir (cwd / "sandbox");
+  Unix.symlink ~to_dir:true ".." "sandbox\\to-root";
+  Unix.symlink ~to_dir:true "subdir" "sandbox\\to-subdir";
+  Unix.symlink ~to_dir:true "foo" "sandbox\\dangle";
+  try_mkdir (cwd / "tmp");
+  Eio.Path.with_open_dir (cwd / "sandbox") @@ fun sandbox ->
+  try_mkdir (sandbox / "subdir");
+  try_mkdir (sandbox / "to-subdir\\nested");
+  let () =
+    try
+      try_mkdir (sandbox / "to-root\\tmp\\foo");
+      failwith "Expected permission denied to-root"
+    with Eio.Io (Eio.Fs.E (Permission_denied _), _) -> ()
+  in
+  assert (not (Sys.file_exists ".\\tmp\\foo"));
+  let () =
+    try
+      try_mkdir (sandbox / "..\\foo");
+      failwith "Expected permission denied parent foo"
+    with Eio.Io (Eio.Fs.E (Permission_denied _), _) -> ()
+  in
+  let () =
+    try
+      try_mkdir (sandbox / "to-subdir");
+      failwith "Expected already exists"
+    with Eio.Io (Eio.Fs.E (Already_exists _), _) -> ()
+  in
+  let () =
+    try
+      try_mkdir (sandbox / "dangle\\foo");
+      failwith "Expected permission denied dangle foo"
+    with Eio.Io (Eio.Fs.E (Not_found _), _) -> ()
+  in
+    ()
 
 let test_unlink env () =
   let cwd = Eio.Stdenv.cwd env in