@@ -1645,6 +1645,114 @@ let reinit ?(init_config=OpamInitDefaults.init_config()) ~interactive
1645
1645
in
1646
1646
OpamRepositoryState. drop rt
1647
1647
1648
+ let has_space s = OpamStd.String. contains_char s ' '
1649
+
1650
+ let default_redirect_root = OpamFilename.Dir. of_string " C:\\ opamroot"
1651
+
1652
+ let setup_redirection target =
1653
+ let {contents = {OpamStateConfig. original_root_dir = root; _}} =
1654
+ OpamStateConfig. r
1655
+ in
1656
+ let target =
1657
+ match target with
1658
+ | Some target -> target
1659
+ | None ->
1660
+ OpamFilename. mkdir default_redirect_root;
1661
+ let readme = OpamFilename.Op. (default_redirect_root // " ReadMe.txt" ) in
1662
+ if not (OpamFilename. exists readme) then
1663
+ OpamFilename. write readme
1664
+ " This directory is used to contain redirected opam roots.\n\n \
1665
+ The contents may be shared with other users on this system." ;
1666
+ OpamSystem. mk_unique_dir ~dir: (OpamFilename.Dir. to_string default_redirect_root) ()
1667
+ in
1668
+ let root_dir = OpamFilename.Dir. of_string target in
1669
+ OpamFilename. write (OpamPath. redirected root) target;
1670
+ OpamStateConfig. update ~root_dir () ;
1671
+ root_dir
1672
+
1673
+ let get_redirected_root () =
1674
+ let {contents = {OpamStateConfig. original_root_dir = root; root_from; _}} =
1675
+ OpamStateConfig. r
1676
+ in
1677
+ let r = OpamConsole. colorise `bold (OpamFilename.Dir. to_string root) in
1678
+ let collision =
1679
+ let collision = OpamConsole. utf8_symbol OpamConsole.Symbols. collision " " in
1680
+ if collision = " " then
1681
+ " "
1682
+ else
1683
+ " " ^ collision
1684
+ in
1685
+ let options = [
1686
+ `Redirect , Printf. sprintf
1687
+ " Redirect files to a directory in %s"
1688
+ (OpamConsole. colorise `bold (OpamFilename.Dir. to_string default_redirect_root));
1689
+ `Ask , " Redirect files to an alternate directory" ;
1690
+ `Endure , Printf. sprintf
1691
+ " Do not redirect anything and stick with %s%s" r collision;
1692
+ `Quit , " Abort initialisation"
1693
+ ] in
1694
+ let default, explanation =
1695
+ match root_from with
1696
+ | `Command_line ->
1697
+ (* The user has been explicit with --root; nemo salvet modo... *)
1698
+ `Endure ,
1699
+ " You have specified a root directory for opam containing a space."
1700
+ | `Env ->
1701
+ (* The user has perhaps carelessly set an environment variable *)
1702
+ `Redirect ,
1703
+ " Your OPAMROOT environment variable contains a space."
1704
+ | `Default ->
1705
+ (* The user has fallen victim to the defaults of Windows Setup and has a
1706
+ space in their user name *)
1707
+ `Redirect ,
1708
+ Printf. sprintf
1709
+ " By default, opam would store its data in:\n \
1710
+ %s\n \
1711
+ however, this directory contains a space." r
1712
+ in
1713
+ let rec ask () =
1714
+ let check r =
1715
+ if Filename. is_relative r then begin
1716
+ OpamConsole. msg
1717
+ " That path is relative!\n \
1718
+ Please enter an absolute path without spaces.\n " ;
1719
+ ask ()
1720
+ end else if has_space r then begin
1721
+ OpamConsole. msg
1722
+ " That path contains contains a space!\n \
1723
+ Please enter an absolute path without spaces.\n " ;
1724
+ ask ()
1725
+ end else
1726
+ Some (Some r)
1727
+ in
1728
+ OpamStd.Option. replace check (OpamConsole. read " Root directory for opam: " )
1729
+ in
1730
+ let rec menu () =
1731
+ match OpamConsole. menu " Where should opam store files?" ~default ~options
1732
+ ~no: default with
1733
+ | `Redirect ->
1734
+ Some None
1735
+ | `Endure ->
1736
+ None
1737
+ | `Ask ->
1738
+ let r = ask () in
1739
+ if r = None then
1740
+ menu ()
1741
+ else
1742
+ r
1743
+ | `Quit ->
1744
+ OpamStd.Sys. exit_because `Aborted
1745
+ in
1746
+ OpamConsole. header_msg " opam root file store" ;
1747
+ OpamConsole. msg
1748
+ " \n \
1749
+ %s\n \
1750
+ \n \
1751
+ Many parts of the OCaml ecosystem do not presently work correctly\n \
1752
+ when installed to directories containing spaces. You have been warned!%s\n \
1753
+ \n " explanation collision;
1754
+ Option. map setup_redirection (menu () )
1755
+
1648
1756
let init
1649
1757
~init_config ~interactive
1650
1758
?repo ?(bypass_checks =false )
@@ -1654,10 +1762,34 @@ let init
1654
1762
shell =
1655
1763
log " INIT %a"
1656
1764
(slog @@ OpamStd.Option. to_string OpamRepositoryBackend. to_string) repo;
1765
+ let original_root = OpamStateConfig. (! r.original_root_dir) in
1766
+ let root_empty =
1767
+ not (OpamFilename. exists_dir original_root)
1768
+ || OpamFilename. dir_is_empty original_root in
1657
1769
let root = OpamStateConfig. (! r.root_dir) in
1770
+ let root, remove_root =
1771
+ let ignore_non_fatal f x =
1772
+ try f x
1773
+ with e -> OpamStd.Exn. fatal e
1774
+ in
1775
+ let new_root =
1776
+ if root_empty &&
1777
+ Sys. win32 &&
1778
+ has_space (OpamFilename.Dir. to_string root) then
1779
+ get_redirected_root ()
1780
+ else
1781
+ None
1782
+ in
1783
+ match new_root with
1784
+ | None ->
1785
+ root, (fun () -> ignore_non_fatal OpamFilename. rmdir root)
1786
+ | Some root ->
1787
+ root, (fun () ->
1788
+ ignore_non_fatal OpamFilename. rmdir root;
1789
+ ignore_non_fatal OpamFilename. rmdir original_root
1790
+ )
1791
+ in
1658
1792
let config_f = OpamPath. config root in
1659
- let root_empty =
1660
- not (OpamFilename. exists_dir root) || OpamFilename. dir_is_empty root in
1661
1793
1662
1794
let gt, rt, default_compiler =
1663
1795
if OpamFile. exists config_f then (
@@ -1671,7 +1803,7 @@ let init
1671
1803
) else (
1672
1804
if not root_empty then (
1673
1805
OpamConsole. warning " %s exists and is not empty"
1674
- (OpamFilename.Dir. to_string root );
1806
+ (OpamFilename.Dir. to_string original_root );
1675
1807
if not (OpamConsole. confirm " Proceed?" ) then
1676
1808
OpamStd.Sys. exit_because `Aborted );
1677
1809
try
@@ -1743,7 +1875,7 @@ let init
1743
1875
in
1744
1876
if failed <> [] then
1745
1877
(if root_empty then
1746
- ( try OpamFilename. rmdir root with _ -> () );
1878
+ remove_root ( ) ;
1747
1879
OpamConsole. error_and_exit `Sync_error
1748
1880
" Initial download of repository failed." );
1749
1881
let default_compiler =
@@ -1778,7 +1910,7 @@ let init
1778
1910
OpamStd.Exn. finalise e @@ fun () ->
1779
1911
if not (OpamConsole. debug () ) && root_empty then begin
1780
1912
OpamSystem. release_all_locks () ;
1781
- OpamFilename. rmdir root
1913
+ remove_root ()
1782
1914
end )
1783
1915
in
1784
1916
OpamEnv. setup root ~interactive
0 commit comments