Merge pull request #3750 from rgrinberg/symlink-git-diff

Resolve symlinks before running git diff

CHANGES.md

@@ -15,6 +15,8 @@ Unreleased
 - Fix `dune-package` installation when META templates are present (#3743, fixes
   #3746, @rgrinberg)
 
+- Resolve symlinks before running `$ git diff` (#3750, fixes #3740, @rgrinberg)
+
 2.7.0 (13/08/2020)
 ------------------
 

src/dune_engine/print_diff.ml

@@ -2,6 +2,19 @@ open! Stdune
 open Import
 open Fiber.O
 
+let resolve_link ~dir path file =
+  match Path.follow_symlink path with
+  | Ok p -> Path.reach ~from:dir p
+  | Error Not_a_symlink -> file
+  | Error Max_depth_exceeded ->
+    User_error.raise
+      [ Pp.textf "Unable to resolve symlink %s. Max recrusion depth exceeded"
+          (Path.to_string path)
+      ]
+  | Error (Unix_error _) ->
+    User_error.raise
+      [ Pp.textf "Unable to resolve symlink %s" (Path.to_string path) ]
+
 let print ?(skip_trailing_cr = Sys.win32) path1 path2 =
   let dir, file1, file2 =
     match
@@ -22,16 +35,19 @@ let print ?(skip_trailing_cr = Sys.win32) path1 path2 =
       ]
   in
   let normal_diff () =
-    let path, args, skip_trailing_cr_arg =
+    let path, args, skip_trailing_cr_arg, files =
       let which prog = Bin.which ~path:(Env.path Env.initial) prog in
       match which "git" with
       | Some path ->
         ( path
         , [ "diff"; "--no-index"; "--color=always"; "-u" ]
-        , "--ignore-cr-at-eol" )
+        , "--ignore-cr-at-eol"
+        , List.map
+            ~f:(fun (path, file) -> resolve_link ~dir path file)
+            [ (path1, file1); (path2, file2) ] )
       | None -> (
         match which "diff" with
-        | Some path -> (path, [ "-u" ], "--strip-trailing-cr")
+        | Some path -> (path, [ "-u" ], "--strip-trailing-cr", [ file1; file2 ])
         | None -> fallback () )
     in
     let args =
@@ -40,7 +56,7 @@ let print ?(skip_trailing_cr = Sys.win32) path1 path2 =
       else
         args
     in
-    let args = args @ [ file1; file2 ] in
+    let args = args @ files in
     Format.eprintf "%a@?" Loc.render (Loc.pp loc);
     let* () = Process.run ~dir ~env:Env.initial Strict path args in
     fallback ()

src/stdune/fpath.ml

@@ -21,3 +21,35 @@ let rec mkdir_p ?(perms = 0o777) t_s =
         let (_ : mkdir_p) = mkdir_p parent ~perms in
         Unix.mkdir t_s perms;
         Created
+
+let resolve_link path =
+  match Unix.readlink path with
+  | exception Unix.Unix_error (EINVAL, _, _) -> Ok None
+  | exception Unix.Unix_error (e, _, _) -> Error e
+  | link ->
+    Ok
+      (Some
+         ( if Filename.is_relative link then
+           Filename.concat (Filename.dirname path) link
+         else
+           link ))
+
+type follow_symlink_error =
+  | Not_a_symlink
+  | Max_depth_exceeded
+  | Unix_error of Unix.error
+
+let follow_symlink path =
+  let rec loop n path =
+    if n = 0 then
+      Error Max_depth_exceeded
+    else
+      match resolve_link path with
+      | Error e -> Error (Unix_error e)
+      | Ok None -> Ok path
+      | Ok (Some path) -> loop (n - 1) path
+  in
+  match resolve_link path with
+  | Ok None -> Error Not_a_symlink
+  | Ok (Some p) -> loop 20 p
+  | Error e -> Error (Unix_error e)

src/stdune/fpath.mli

@@ -6,3 +6,10 @@ type mkdir_p =
   | Created  (** The directory was created. *)
 
 val mkdir_p : ?perms:int -> string -> mkdir_p
+
+type follow_symlink_error =
+  | Not_a_symlink
+  | Max_depth_exceeded
+  | Unix_error of Unix.error
+
+val follow_symlink : string -> (string, follow_symlink_error) result

src/stdune/path.ml

@@ -1335,3 +1335,6 @@ let chmod ~mode ?(stats = None) ?(op = `Set) path =
         stats.st_perm land lnot mode
   in
   Unix.chmod (to_string path) mode
+
+let follow_symlink path =
+  Fpath.follow_symlink (to_string path) |> Result.map ~f:of_string

src/stdune/path.mli

@@ -384,3 +384,6 @@ val chmod :
   -> ?op:[ `Add | `Remove | `Set ]
   -> t
   -> unit
+
+(** Attempts to resolve a symlink. Returns [None] if the path isn't a symlink *)
+val follow_symlink : t -> (t, Fpath.follow_symlink_error) result