Merge pull request #5457 from rjbou/opamroot-redirect

windows: opam root redirection when path contains spaces

master_changes.md

@@ -29,6 +29,7 @@ users)
   * Enhance the Git menu by warning if the user appears to need to restart the shell to pick up PATH changes [#5963 @dra27]
   * Include Git for Windows installations in the list of possibilities where the user instructed Git-for-Windows setup not to update PATH [#5963 @dra27]
   * [BUG] Fail if `--git-location` points to a directory not containing git [#6000 @dra27]
+  * Redirect the opam root to `C:\opamroot-xxx` when the opam root contains spaces on Windows [#5457 @rjbou @dra27]
 
 ## Config report
 
@@ -177,6 +178,8 @@ users)
   * Expose `OpamSolution.print_depext_msg` [#5994 @dra27]
   * Extracted `OpamSolution.install_sys_packages` from `OpamSolution.install_depexts` [#5994 @dra27]
   * `OpamInitDefaults.required_packages_for_cygwin`: no longer includes git; as the need to add that is computed in `OpamClient` [#6000 @dra27]
+  * `OpamClientConfig.opam_init`: add `original_root_dir` argument that contains the original roo directory before redirection [#5457 @rjbou]
+  * `OpamClientConfig.opam_init`: add `root_from` argument that contains the origin of used root[#5457 @dra27]
 
 ## opam-repository
   * `OpamDownload.download_command`: separate output from stdout and stderr [#5984 @kit-ty-kate]
@@ -185,13 +188,16 @@ users)
   * `OpamEnv.cygwin_non_shadowed_programs`: exposes the list of executables (not including git) which should always come from Cygwin [#6000 @dra27]
   * `opamSysInteract.Cygwin.install`: de-label `packages` argument [#6000 @dra27]
   * `OpamSysInteract.Cygwin.check_install` renamed to `analyse_install` which now also returns whether the installation found was MSYS2 or Cygwin [#6000 @dra27]
+  * `OpamStateConfig.r`, `OpamStateConfig.init`: add `original_root_dir` field to config record and argument that contains the original root directory before redirection [#5457 @rjbou]
+  * `OpamStateConfig.r`, `OpamStateConfig.init`: add `root_from` field to config record and argument that contains the origin of used root[#5457 @dra27]
 
 ## opam-solver
 
 ## opam-format
   * `OpamPath`: remove `OpamPath.Switch.last_env` function in favor to `OpamPath.last_env` as the files are no more stored in switch directory [#5962 @moyodiallo - fix #5823]
   * `OpamFilter.map_up`: correct handling of FDefined [#5983 @dra27]
   * `OpamFilter.fold_down_left`: correct handling of FDefined and FUndef [#5983 @dra27]
+  * `OpamPath`: add `redirected` the file name of redirected opam root [#5457 @rjbou]
 
 ## opam-core
   * `OpamStd.String`: add `split_quoted` that preserves quoted separator [#5935 @dra27]
@@ -208,3 +214,5 @@ users)
   * `OpamStubs.enumRegistry`: on Windows, retrieves all the values of a given type from a registry key, with their names [#6000 @dra27]
   * `OpamCompat`: add `Seq.find_map` from OCaml 4.14 [#6000 @dra27]
   * `OpamStd.Sys.{get_windows_executable_variant,get_cygwin_variant,is_cygwin_variant}`: renamed `~cygbin` to `?search_in_path` with a change in semantics so that it acts as though the directory was simply the first entry in PATH [#6000 @dra27]
+  * `OpamConsole.Symbols`: add `collision` symbol [#5457 @dra27]
+  * `OpamSystem`: add `mk_unique_dir` that returns an unique directory name as `mk_temp_dir` but not in temporary directory [#5457 @dra27]

src/client/opamArg.ml

@@ -543,6 +543,7 @@ let apply_global_options cli o =
     (* ?solver_preferences_best_effort_prefix: *)
     (* - state options - *)
     ?root_dir:o.opt_root
+    ?original_root_dir:o.opt_root
     ?current_switch:(o.opt_switch >>| OpamSwitch.of_string)
     ?switch_from:(o.opt_switch >>| fun _ -> `Command_line)
     (* ?jobs: int *)

src/client/opamCliMain.ml

@@ -181,7 +181,7 @@ let check_and_run_external_commands () =
     let yes = if yes then Some (Some true) else None in
     OpamCoreConfig.init ?yes ?confirm_level ();
     OpamFormatConfig.init ();
-    let root_dir = OpamStateConfig.opamroot () in
+    let root_from, root_dir = OpamStateConfig.opamroot () in
     let has_init, root_upgraded =
       match OpamStateConfig.load_defaults ~lock_kind:`Lock_read root_dir with
       | None -> (false, false)
@@ -210,7 +210,7 @@ let check_and_run_external_commands () =
           env_update_resolved "PATH" PlusEq
             (OpamFilename.Dir.to_string plugins_bin)
         ] in
-        OpamStateConfig.init ~root_dir ();
+        OpamStateConfig.init ~root_from ~root_dir ();
         match OpamStateConfig.get_switch_opt () with
         | None -> env_array (OpamEnv.get_pure ~updates ())
         | Some sw ->

src/client/opamClient.ml

@@ -1645,6 +1645,114 @@ let reinit ?(init_config=OpamInitDefaults.init_config()) ~interactive
   in
   OpamRepositoryState.drop rt
 
+let has_space s = OpamStd.String.contains_char s ' '
+
+let default_redirect_root = OpamFilename.Dir.of_string "C:\\opamroot"
+
+let setup_redirection target =
+  let {contents = {OpamStateConfig.original_root_dir = root; _}} =
+    OpamStateConfig.r
+  in
+  let target =
+    match target with
+    | Some target -> target
+    | None ->
+      OpamFilename.mkdir default_redirect_root;
+      let readme = OpamFilename.Op.(default_redirect_root // "ReadMe.txt") in
+      if not (OpamFilename.exists readme) then
+        OpamFilename.write readme
+          "This directory is used to contain redirected opam roots.\n\n\
+           The contents may be shared with other users on this system.";
+      OpamSystem.mk_unique_dir ~dir:(OpamFilename.Dir.to_string default_redirect_root) ()
+  in
+  let root_dir = OpamFilename.Dir.of_string target in
+  OpamFilename.write (OpamPath.redirected root) target;
+  OpamStateConfig.update ~root_dir ();
+  root_dir
+
+let get_redirected_root () =
+  let {contents = {OpamStateConfig.original_root_dir = root; root_from; _}} =
+    OpamStateConfig.r
+  in
+  let r = OpamConsole.colorise `bold (OpamFilename.Dir.to_string root) in
+  let collision =
+    let collision = OpamConsole.utf8_symbol OpamConsole.Symbols.collision "" in
+    if collision = "" then
+      ""
+    else
+      " " ^ collision
+  in
+  let options = [
+    `Redirect, Printf.sprintf
+      "Redirect files to a directory in %s"
+      (OpamConsole.colorise `bold (OpamFilename.Dir.to_string default_redirect_root));
+    `Ask, "Redirect files to an alternate directory";
+    `Endure, Printf.sprintf
+      "Do not redirect anything and stick with %s%s" r collision;
+    `Quit, "Abort initialisation"
+  ] in
+  let default, explanation =
+    match root_from with
+    | `Command_line ->
+      (* The user has been explicit with --root; nemo salvet modo... *)
+      `Endure,
+      "You have specified a root directory for opam containing a space."
+    | `Env ->
+      (* The user has perhaps carelessly set an environment variable *)
+      `Redirect,
+      "Your OPAMROOT environment variable contains a space."
+    | `Default ->
+      (* The user has fallen victim to the defaults of Windows Setup and has a
+         space in their user name *)
+      `Redirect,
+      Printf.sprintf
+        "By default, opam would store its data in:\n\
+           %s\n\
+         however, this directory contains a space." r
+  in
+  let rec ask () =
+    let check r =
+      if Filename.is_relative r then begin
+        OpamConsole.msg
+          "That path is relative!\n\
+           Please enter an absolute path without spaces.\n";
+        ask ()
+      end else if has_space r then begin
+        OpamConsole.msg
+          "That path contains contains a space!\n\
+           Please enter an absolute path without spaces.\n";
+        ask ()
+      end else
+        Some (Some r)
+    in
+    OpamStd.Option.replace check (OpamConsole.read "Root directory for opam: ")
+  in
+  let rec menu () =
+    match OpamConsole.menu "Where should opam store files?" ~default ~options
+            ~no:default with
+    | `Redirect ->
+      Some None
+    | `Endure ->
+      None
+    | `Ask ->
+      let r = ask () in
+      if r = None then
+        menu ()
+      else
+        r
+    | `Quit ->
+      OpamStd.Sys.exit_because `Aborted
+  in
+  OpamConsole.header_msg "opam root file store";
+  OpamConsole.msg
+    "\n\
+     %s\n\
+     \n\
+     Many parts of the OCaml ecosystem do not presently work correctly\n\
+     when installed to directories containing spaces. You have been warned!%s\n\
+     \n" explanation collision;
+  Option.map setup_redirection (menu ())
+
 let init
     ~init_config ~interactive
     ?repo ?(bypass_checks=false)
@@ -1654,10 +1762,34 @@ let init
     shell =
   log "INIT %a"
     (slog @@ OpamStd.Option.to_string OpamRepositoryBackend.to_string) repo;
+  let original_root = OpamStateConfig.(!r.original_root_dir) in
+  let root_empty =
+    not (OpamFilename.exists_dir original_root)
+    || OpamFilename.dir_is_empty original_root in
   let root = OpamStateConfig.(!r.root_dir) in
+  let root, remove_root =
+    let ignore_non_fatal f x =
+      try f x
+      with e -> OpamStd.Exn.fatal e
+    in
+    let new_root =
+      if root_empty &&
+         Sys.win32 &&
+         has_space (OpamFilename.Dir.to_string root) then
+        get_redirected_root ()
+      else
+        None
+    in
+    match new_root with
+    | None ->
+      root, (fun () -> ignore_non_fatal OpamFilename.rmdir root)
+    | Some root ->
+      root, (fun () ->
+        ignore_non_fatal OpamFilename.rmdir root;
+        ignore_non_fatal OpamFilename.rmdir original_root
+      )
+  in
   let config_f = OpamPath.config root in
-  let root_empty =
-    not (OpamFilename.exists_dir root) || OpamFilename.dir_is_empty root in
 
   let gt, rt, default_compiler =
     if OpamFile.exists config_f then (
@@ -1671,7 +1803,7 @@ let init
     ) else (
       if not root_empty then (
         OpamConsole.warning "%s exists and is not empty"
-          (OpamFilename.Dir.to_string root);
+          (OpamFilename.Dir.to_string original_root);
         if not (OpamConsole.confirm "Proceed?") then
           OpamStd.Sys.exit_because `Aborted);
       try
@@ -1743,7 +1875,7 @@ let init
         in
         if failed <> [] then
           (if root_empty then
-             (try OpamFilename.rmdir root with _ -> ());
+             remove_root ();
            OpamConsole.error_and_exit `Sync_error
              "Initial download of repository failed.");
         let default_compiler =
@@ -1778,7 +1910,7 @@ let init
         OpamStd.Exn.finalise e @@ fun () ->
         if not (OpamConsole.debug ()) && root_empty then begin
           OpamSystem.release_all_locks ();
-          OpamFilename.rmdir root
+          remove_root ()
         end)
   in
   OpamEnv.setup root ~interactive

src/client/opamClientConfig.ml

@@ -209,7 +209,7 @@ let opam_init ?root_dir ?strict ?solver =
   let open OpamStd.Option.Op in
 
   (* (i) get root dir *)
-  let root = OpamStateConfig.opamroot ?root_dir () in
+  let root_from, root = OpamStateConfig.opamroot ?root_dir () in
 
   (* (ii) load conf file and set defaults *)
   (* the init for OpamFormat is done in advance since (a) it has an effect on
@@ -261,5 +261,5 @@ let opam_init ?root_dir ?strict ?solver =
   OpamCoreConfig.initk ?log_dir |>
   OpamRepositoryConfig.initk |>
   OpamSolverConfig.initk ?solver |>
-  OpamStateConfig.initk ~root_dir:root |>
+  OpamStateConfig.initk ~root_dir:root ~root_from |>
   initk

src/client/opamClientConfig.mli

@@ -120,6 +120,7 @@ val opam_init:
   ?assume_depexts:bool ->
   ?cli:OpamCLIVersion.t ->
   ?scrubbed_environment_variables:string list ->
+  ?original_root_dir:OpamTypes.dirname ->
   ?current_switch:OpamSwitch.t ->
   ?switch_from:OpamStateTypes.provenance ->
   ?jobs:int Lazy.t ->

src/client/opamCommands.ml

@@ -94,7 +94,7 @@ let global_options cli =
       switch_to_updated_self
         OpamStd.Option.Op.(options.debug_level ++
                            OpamCoreConfig.E.debug () +! 0 |> abs > 0)
-        (OpamStateConfig.opamroot ?root_dir:options.opt_root ());
+        (snd (OpamStateConfig.opamroot ?root_dir:options.opt_root ()));
     let root_is_ok =
       OpamStd.Option.default false (OpamClientConfig.E.rootisok ())
     in

src/core/opamConsole.ml

@@ -105,6 +105,7 @@ module Symbols = struct
   let downwards_double_arrow = Uchar.of_int 0x21d3
   let black_down_pointing_triangle = Uchar.of_int 0x25bc
   let downwards_black_arrow = Uchar.of_int 0x2b07
+  let collision = Uchar.of_int 0x1f4a5
 end
 
 type win32_glyph_checker = {

src/core/opamConsole.mli

@@ -66,6 +66,7 @@ module Symbols : sig
   val downwards_double_arrow : Uchar.t
   val downwards_black_arrow : Uchar.t
   val black_down_pointing_triangle : Uchar.t
+  val collision : Uchar.t
 end
 
 val utf8_symbol:

src/core/opamSystem.ml

@@ -88,6 +88,13 @@ let rec mk_temp_dir ?(prefix="opam") () =
   else
     real_path s
 
+let rec mk_unique_dir ~dir ?(prefix="opam") () =
+  let s = dir / Printf.sprintf "%s-%06x" prefix (Random.int 0xFFFFFF) in
+  if Sys.file_exists s then
+    mk_unique_dir ~dir ~prefix ()
+  else
+    real_path s
+
 let safe_mkdir dir =
   try
     log "mkdir %s" dir;

src/core/opamSystem.mli

@@ -51,6 +51,10 @@ val verbose_for_base_commands: unit -> bool
     (if [prefix] is not set), pid, and random number. *)
 val mk_temp_dir: ?prefix:string -> unit -> string
 
+(** Returns a directory name, in the [~dir], composed by {i opam}
+    (if [prefix] is not set), and a random number. *)
+val mk_unique_dir: dir:string -> ?prefix:string -> unit -> string
+
 (** [copy_file src dst] copies [src] to [dst]. Remove [dst] before the copy
     if it is a link. *)
 val copy_file: string -> string -> unit

src/format/opamPath.ml

@@ -19,6 +19,8 @@ let ( /- ) dir f = OpamFile.make (dir // f)
 
 let config t = t /- "config"
 
+let redirected t = t // "redirected-opamroot"
+
 let init_config_files () =
   List.map OpamFile.make [
     OpamFilename.Dir.of_string (OpamStd.Sys.etc ()) // "opamrc";

src/format/opamPath.mli

@@ -31,6 +31,9 @@ val lock: t -> filename
 (** Main configuration file: {i $opam/config} *)
 val config: t -> OpamFile.Config.t OpamFile.t
 
+(** Redirection file for opam root: {i $opam/redirected-opamroot} *)
+val redirected: t -> OpamFilename.t
+
 (** The list of configuration files location used by default ({i /etc/opamrc}
     and {i ~/.opamrc}). More general (lower priority) first. *)
 val init_config_files: unit -> OpamFile.InitConfig.t OpamFile.t list