diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index 1c07900642e..86240401b5b 100644 --- a/src/client/opamSwitchCommand.ml +++ b/src/client/opamSwitchCommand.ml @@ -287,20 +287,88 @@ 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 *) + (* 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 + | 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 -> (* 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) + ) 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? *) + (* 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 + (* 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 "; + | 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); - 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 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" switch_dir_str; + let warning = + (OpamConsole.colorise `yellow + (Printf.sprintf"Warning: proceeding will permanently erase all the \ + 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 switch_dir + else + OpamConsole.error_and_exit `Aborted + "Switch installation was aborted by the user."; let gt, st = if not simulate then let gt = 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..577890ea953 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,8 @@ module Builddir: sig val config: dirname -> package -> OpamFile.Dot_config.t OpamFile.t end + +val internal_paths : t -> switch -> dirname list + +(** Check if a directory path is internal *) +val is_internal_path : t -> dirname -> bool