From 6010b676c292268138df8c0ee4edd48d8b6c6301 Mon Sep 17 00:00:00 2001 From: arozovyk Date: Fri, 13 Jun 2025 15:45:56 +0200 Subject: [PATCH 1/4] Switch creation: confirm overwriting instead of error --- src/client/opamSwitchCommand.ml | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index 1c07900642e..e11c63add54 100644 --- a/src/client/opamSwitchCommand.ml +++ b/src/client/opamSwitchCommand.ml @@ -297,10 +297,22 @@ let create OpamConsole.error_and_exit `Bad_arguments "There already is an installed switch named %s" (OpamSwitch.to_string switch); - if Sys.file_exists (OpamFilename.Dir.to_string comp_dir) then - OpamConsole.error_and_exit `Bad_arguments - "Directory %S already exists, please choose a different name" - (OpamFilename.Dir.to_string comp_dir); + let comp_dir_str = OpamFilename.Dir.to_string comp_dir in + if Sys.file_exists comp_dir_str then + OpamConsole.error + "The directory %S already exists, but it doesn't appear to be a \ + valid OPAM switch.\n" comp_dir_str; + let warning = + (OpamConsole.colorise `yellow + (Printf.sprintf"Warning: proceeding will permanently erase all the \ + contents of:\n %s\n" comp_dir_str)) + in + let prompt = "Would you like to overwrite this directory and create a new switch?" in + if OpamConsole.confirm "%s\n%s" warning prompt then + OpamFilename.rmdir comp_dir + else + OpamConsole.error_and_exit `Aborted + "Switch installation was aborted by the user."; let gt, st = if not simulate then let gt = From f720e815c8eead957629148f97ba66ad451a1197 Mon Sep 17 00:00:00 2001 From: arozovyk Date: Wed, 18 Jun 2025 17:48:53 +0200 Subject: [PATCH 2/4] switch consistency check --- src/client/opamSwitchCommand.ml | 59 +++++++++++++++++++++++++++++---- 1 file changed, 53 insertions(+), 6 deletions(-) diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index e11c63add54..dc9131f20f6 100644 --- a/src/client/opamSwitchCommand.ml +++ b/src/client/opamSwitchCommand.ml @@ -287,29 +287,76 @@ let install_compiler (Success result); OpamSwitchAction.write_selections t; t +let switch_consistent gt switch = + let switch_dir = OpamPath.Switch.root gt.root switch in + match OpamFilename.dir_is_empty switch_dir with + | Some true -> + (* Directory exists and is empty *) + (* TODO: Verify whether the switch path is not pointing to internal opam + directories *) + (* if OpamFilename.dir_starts_with switch_dir gt.root then + () + else *) + OpamFilename.rmdir_cleanup switch_dir; + `Empty + | Some false -> + (* Directory exists and is not empty - verify it to be a valid switch *) + (try + match OpamFile.Switch_config.read_opt + (OpamPath.Switch.switch_config gt.root switch) with + | Some _ -> + (match OpamFile.SwitchSelections.read_opt + (OpamPath.Switch.selections gt.root switch) with + Some (switch_selections:switch_selections) -> + if OpamPackage.Set.for_all (fun p_pinned -> + let name = OpamPackage.name p_pinned in + OpamFilename.exists_dir + (OpamPath.Switch.Overlay.package gt.root switch name) + ) switch_selections.sel_pinned then + if OpamFilename.exists_dir + (OpamPath.Switch.install_dir gt.root switch) + && OpamPackage.Set.for_all ( + fun p_installed -> + (* TODO: Maybe keep only changes check? *) + OpamFile.exists (OpamPath.Switch.install gt.root switch + (OpamPackage.name p_installed)) + || OpamFile.exists (OpamPath.Switch.changes gt.root switch + (OpamPackage.name p_installed)) + ) switch_selections.sel_installed then + `Valid_switch + else + `IO_Error "Some packages are not properly installed." + else + `IO_Error "Some pinned packages have their files broken.\n "; + | None -> `IO_Error "switch-state is missing.") + | None -> `IO_Error "switch-config is missing." + with e -> + (* TODO: Files are broken, fixup? how to recover from here *) + ( `IO_Error (Printf.sprintf "Failed to read files: %s\n" (Printexc.to_string e)))) + | None -> `Not_found let create gt ~rt ?synopsis ?repos ~update_config ~invariant switch post = let update_config = update_config && not (OpamSwitch.is_external switch) in - let comp_dir = OpamPath.Switch.root gt.root switch in + let switch_dir = OpamPath.Switch.root gt.root switch in let simulate = OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show) in if OpamGlobalState.switch_exists gt switch then OpamConsole.error_and_exit `Bad_arguments "There already is an installed switch named %s" (OpamSwitch.to_string switch); - let comp_dir_str = OpamFilename.Dir.to_string comp_dir in - if Sys.file_exists comp_dir_str then + let switch_dir_str = OpamFilename.Dir.to_string switch_dir in + if Sys.file_exists switch_dir_str then OpamConsole.error "The directory %S already exists, but it doesn't appear to be a \ - valid OPAM switch.\n" comp_dir_str; + valid OPAM switch.\n" switch_dir_str; let warning = (OpamConsole.colorise `yellow (Printf.sprintf"Warning: proceeding will permanently erase all the \ - contents of:\n %s\n" comp_dir_str)) + contents of:\n %s\n" switch_dir_str)) in let prompt = "Would you like to overwrite this directory and create a new switch?" in if OpamConsole.confirm "%s\n%s" warning prompt then - OpamFilename.rmdir comp_dir + OpamFilename.rmdir switch_dir else OpamConsole.error_and_exit `Aborted "Switch installation was aborted by the user."; From 064d47ce000b2231ed5b76906ea549d37c62eedd Mon Sep 17 00:00:00 2001 From: arozovyk Date: Fri, 20 Jun 2025 08:22:29 +0200 Subject: [PATCH 3/4] todos --- src/client/opamSwitchCommand.ml | 25 ++++++++++----- src/format/opamPath.ml | 54 +++++++++++++++++++++++++++++++++ src/format/opamPath.mli | 3 ++ 3 files changed, 74 insertions(+), 8 deletions(-) diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index dc9131f20f6..ef76025ee1f 100644 --- a/src/client/opamSwitchCommand.ml +++ b/src/client/opamSwitchCommand.ml @@ -290,25 +290,26 @@ let install_compiler let switch_consistent gt switch = let switch_dir = OpamPath.Switch.root gt.root switch in match OpamFilename.dir_is_empty switch_dir with - | Some true -> + | Some true -> (* Directory exists and is empty *) (* TODO: Verify whether the switch path is not pointing to internal opam directories *) (* if OpamFilename.dir_starts_with switch_dir gt.root then () - else *) - OpamFilename.rmdir_cleanup switch_dir; - `Empty + else *) + (* Opam path, list verify if we are not removing one of those. *) +(* OpamFilename.rmdir_cleanup switch_dir; + *) `Empty | Some false -> (* Directory exists and is not empty - verify it to be a valid switch *) - (try + (try match OpamFile.Switch_config.read_opt (OpamPath.Switch.switch_config gt.root switch) with - | Some _ -> + | Some _ -> (match OpamFile.SwitchSelections.read_opt (OpamPath.Switch.selections gt.root switch) with Some (switch_selections:switch_selections) -> - if OpamPackage.Set.for_all (fun p_pinned -> + if OpamPackage.Set.for_all (fun p_pinned -> (* verify code wise if it's the case. *) let name = OpamPackage.name p_pinned in OpamFilename.exists_dir (OpamPath.Switch.Overlay.package gt.root switch name) @@ -318,13 +319,21 @@ let switch_consistent gt switch = && OpamPackage.Set.for_all ( fun p_installed -> (* TODO: Maybe keep only changes check? *) + (* TODO: there is a file in /packages/ *) + (* verify code wise if it's the case. OpamPath.overlay *) + OpamFilename.exists_dir + (OpamPath.Switch.installed_package_dir gt.root switch p_installed) + || OpamFile.exists (OpamPath.Switch.install gt.root switch (OpamPackage.name p_installed)) || OpamFile.exists (OpamPath.Switch.changes gt.root switch (OpamPackage.name p_installed)) ) switch_selections.sel_installed then + (* Have both errors shown, and fail then. *) `Valid_switch - else + (* fixup, mettre dans global state, switch-config il faut qu'il soit là. + sans me soucier. *) + else `IO_Error "Some packages are not properly installed." else `IO_Error "Some pinned packages have their files broken.\n "; diff --git a/src/format/opamPath.ml b/src/format/opamPath.ml index e32eaf9b858..a5f71433aca 100644 --- a/src/format/opamPath.ml +++ b/src/format/opamPath.ml @@ -290,3 +290,57 @@ module Builddir = struct builddir /- (OpamPackage.Name.to_string nv.name ^ ".config") end + + +let internal_paths (t : dirname) (sw : switch) : dirname list = + let open Switch in + let meta = meta t sw in + let prefix = root t sw in + [ + t / "config"; + t / "lock"; + t / "config.lock"; + t / "redirected-opamroot"; + t / "repo" / "lock"; + t / "repo" / "repos-config"; + t / "opam-init"; + t / "opam-init" / "hooks"; + t / "log"; + t / "backup"; + t / ".last-env"; + + t / "plugins"; + t / "plugins" / "bin"; + + state_cache_dir t; + + meta; + meta / "lock"; + meta / "switch-config"; + meta / "switch-state"; + meta / "packages"; + meta / "install"; + meta / "config"; + meta / "sources"; + meta / "extra-files-cache"; + meta / "overlay"; + meta / "environment"; + meta / "nix.env"; + meta / "reinstall"; + meta / "backup"; + + installed_opams t sw; + + Overlay.dir t sw; + + build_dir t sw; + remove_dir t sw; + + prefix / "lib"; + prefix / "bin"; + prefix / "doc"; + prefix / "etc"; + prefix / "share"; + prefix / "man"; + prefix / "sbin"; + ] \ No newline at end of file diff --git a/src/format/opamPath.mli b/src/format/opamPath.mli index 28a615566dd..9556d8b81c5 100644 --- a/src/format/opamPath.mli +++ b/src/format/opamPath.mli @@ -38,6 +38,7 @@ val redirected: t -> OpamFilename.t and {i ~/.opamrc}). More general (lower priority) first. *) val init_config_files: unit -> OpamFile.InitConfig.t OpamFile.t list + (** Lock for updates on the main config file (write lock when changes to switches, repositories lists are expected. No lock needed otherwise) *) val config_lock: t -> filename @@ -387,3 +388,5 @@ module Builddir: sig val config: dirname -> package -> OpamFile.Dot_config.t OpamFile.t end + +val internal_paths : t -> switch -> dirname list From b61a420525735685ed55e247711baaad59ecb0a0 Mon Sep 17 00:00:00 2001 From: arozovyk Date: Fri, 4 Jul 2025 17:18:49 +0200 Subject: [PATCH 4/4] x --- src/client/opamSwitchCommand.ml | 58 ++++++++++++++++----------------- src/format/opamPath.mli | 3 ++ 2 files changed, 32 insertions(+), 29 deletions(-) diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index ef76025ee1f..86240401b5b 100644 --- a/src/client/opamSwitchCommand.ml +++ b/src/client/opamSwitchCommand.ml @@ -287,59 +287,59 @@ let install_compiler (Success result); OpamSwitchAction.write_selections t; t -let switch_consistent gt switch = +let switch_consistent gt switch = let switch_dir = OpamPath.Switch.root gt.root switch in - match OpamFilename.dir_is_empty switch_dir with + match OpamFilename.dir_is_empty switch_dir with | Some true -> (* Directory exists and is empty *) (* TODO: Verify whether the switch path is not pointing to internal opam directories *) - (* if OpamFilename.dir_starts_with switch_dir gt.root then - () + (* if OpamFilename.dir_starts_with switch_dir gt.root then + () else *) - (* Opam path, list verify if we are not removing one of those. *) -(* OpamFilename.rmdir_cleanup switch_dir; - *) `Empty + (* Opam path, list verify if we are not removing one of those. *) + (* OpamFilename.rmdir_cleanup switch_dir; + *) `Empty | Some false -> (* Directory exists and is not empty - verify it to be a valid switch *) (try - match OpamFile.Switch_config.read_opt - (OpamPath.Switch.switch_config gt.root switch) with + match OpamFile.Switch_config.read_opt + (OpamPath.Switch.switch_config gt.root switch) with | Some _ -> (match OpamFile.SwitchSelections.read_opt (OpamPath.Switch.selections gt.root switch) with - Some (switch_selections:switch_selections) -> + Some (switch_selections:switch_selections) -> if OpamPackage.Set.for_all (fun p_pinned -> (* verify code wise if it's the case. *) - let name = OpamPackage.name p_pinned in - OpamFilename.exists_dir + let name = OpamPackage.name p_pinned in + OpamFilename.exists_dir (OpamPath.Switch.Overlay.package gt.root switch name) - ) switch_selections.sel_pinned then - if OpamFilename.exists_dir + ) switch_selections.sel_pinned then + if OpamFilename.exists_dir (OpamPath.Switch.install_dir gt.root switch) && OpamPackage.Set.for_all ( - fun p_installed -> + fun p_installed -> (* TODO: Maybe keep only changes check? *) (* TODO: there is a file in /packages/ *) (* verify code wise if it's the case. OpamPath.overlay *) - OpamFilename.exists_dir - (OpamPath.Switch.installed_package_dir gt.root switch p_installed) + OpamFilename.exists_dir + (OpamPath.Switch.installed_package_dir gt.root switch p_installed) || OpamFile.exists (OpamPath.Switch.install gt.root switch - (OpamPackage.name p_installed)) - || OpamFile.exists (OpamPath.Switch.changes gt.root switch - (OpamPackage.name p_installed)) - ) switch_selections.sel_installed then - (* Have both errors shown, and fail then. *) + (OpamPackage.name p_installed)) + || OpamFile.exists (OpamPath.Switch.changes gt.root switch + (OpamPackage.name p_installed)) + ) switch_selections.sel_installed then + (* Have both errors shown, and fail then. *) `Valid_switch - (* fixup, mettre dans global state, switch-config il faut qu'il soit là. - sans me soucier. *) + (* fixup, mettre dans global state, switch-config il faut qu'il soit là. + sans me soucier. *) else - `IO_Error "Some packages are not properly installed." + `IO_Error "Some packages are not properly installed." else `IO_Error "Some pinned packages have their files broken.\n "; - | None -> `IO_Error "switch-state is missing.") - | None -> `IO_Error "switch-config is missing." - with e -> + | None -> `IO_Error "switch-state is missing.") + | None -> `IO_Error "switch-config is missing." + with e -> (* TODO: Files are broken, fixup? how to recover from here *) ( `IO_Error (Printf.sprintf "Failed to read files: %s\n" (Printexc.to_string e)))) | None -> `Not_found @@ -359,7 +359,7 @@ let create "The directory %S already exists, but it doesn't appear to be a \ valid OPAM switch.\n" switch_dir_str; let warning = - (OpamConsole.colorise `yellow + (OpamConsole.colorise `yellow (Printf.sprintf"Warning: proceeding will permanently erase all the \ contents of:\n %s\n" switch_dir_str)) in diff --git a/src/format/opamPath.mli b/src/format/opamPath.mli index 9556d8b81c5..577890ea953 100644 --- a/src/format/opamPath.mli +++ b/src/format/opamPath.mli @@ -390,3 +390,6 @@ module Builddir: sig end val internal_paths : t -> switch -> dirname list + +(** Check if a directory path is internal *) +val is_internal_path : t -> dirname -> bool