From 171fcdc5143d17fcac517f8a1b4be1246735b035 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Thu, 3 Apr 2014 15:09:00 +0200 Subject: [PATCH 1/5] More info at unpinning Ref #1303 --- src/client/opamPinCommand.ml | 53 +++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 25 deletions(-) diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index be407a3af2f..8d2b5b67479 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -174,31 +174,34 @@ let unpin name = let pin_f = OpamPath.Switch.pinned t.root t.switch in let pins = OpamFile.Pinned.safe_read pin_f in - if not (OpamPackage.Name.Map.mem name pins) then - (OpamGlobals.note "%s is not pinned." (OpamPackage.Name.to_string name); - false) - else - let needs_reinstall = - match OpamPackage.Name.Map.find name pins with - | Version _ -> false - | _ -> OpamState.is_name_installed t name - in - let nv_pin = OpamPackage.pinned name in - let nv_v = OpamState.pinning_version t nv_pin in - update_set t.installed nv_pin nv_v - (OpamFile.Installed.write - (OpamPath.Switch.installed t.root t.switch)); - update_set t.installed_roots nv_pin nv_v - (OpamFile.Installed_roots.write - (OpamPath.Switch.installed_roots t.root t.switch)); - update_config t name (OpamPackage.Name.Map.remove name pins); - OpamState.remove_overlay t nv_pin; - - OpamGlobals.msg "%s is now %a\n" - (OpamPackage.Name.to_string name) - (OpamGlobals.acolor `bold) "unpinned"; - - needs_reinstall + try + let current = OpamPackage.Name.Map.find name pins in + let needs_reinstall = match current with + | Version _ -> false + | _ -> OpamState.is_name_installed t name + in + let nv_pin = OpamPackage.pinned name in + let nv_v = OpamState.pinning_version t nv_pin in + update_set t.installed nv_pin nv_v + (OpamFile.Installed.write + (OpamPath.Switch.installed t.root t.switch)); + update_set t.installed_roots nv_pin nv_v + (OpamFile.Installed_roots.write + (OpamPath.Switch.installed_roots t.root t.switch)); + update_config t name (OpamPackage.Name.Map.remove name pins); + OpamState.remove_overlay t nv_pin; + + OpamGlobals.msg "%s is now %a from %s\n" + (OpamPackage.Name.to_string name) + (OpamGlobals.acolor `bold) "unpinned" + (string_of_pin_option current); + + needs_reinstall + + with Not_found -> + OpamGlobals.note "%s is not pinned." (OpamPackage.Name.to_string name); + false + let list () = log "pin_list"; From 3391dbc6862ae2e13e33c74af39427ffa1e76391 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Tue, 15 Apr 2014 10:22:00 +0200 Subject: [PATCH 2/5] Allow pinning dev-packages without a repo Closes #941 Would be good to make specification of package name/version from the metadata work directly (name conflict will fail with a message at the moment) --- src/client/opamAction.ml | 2 +- src/client/opamArg.ml | 6 +-- src/client/opamPinCommand.ml | 17 ++++--- src/client/opamState.ml | 92 +++++++++++++++++++++--------------- src/core/opamFile.ml | 5 +- src/core/opamMisc.ml | 4 ++ src/core/opamMisc.mli | 2 + src/core/opamParallel.ml | 2 +- 8 files changed, 77 insertions(+), 53 deletions(-) diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index ca890baf511..d2faa9d7273 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -282,7 +282,7 @@ let extract_package t nv = let extract_and_copy_files dir = let () = match OpamFilename.files dir with - | [] -> log "No files found" + | [] -> log "No files found in %s" (OpamFilename.Dir.to_string dir) | [f] -> log "archive %a => extracting" (slog OpamFilename.to_string) f; OpamFilename.extract_generic_file (F f) build_dir diff --git a/src/client/opamArg.ml b/src/client/opamArg.ml index 435f63454b1..4089e68c560 100644 --- a/src/client/opamArg.ml +++ b/src/client/opamArg.ml @@ -1326,15 +1326,13 @@ let switch = term_info "switch" ~doc ~man (* PIN *) -let pin_doc = "Pin a given package to a specific version." +let pin_doc = "Pin a given package to a specific version or source." let pin ?(unpin_only=false) () = let doc = pin_doc in let man = [ `S "DESCRIPTION"; `P "This command will 'pin' a package to a specific version, or use a \ - specific source path for installing and upgrading the package. Using \ - $(b,opam pin none) will undo the 'pinned' status of \ - ."; + specific source path for installing and upgrading the package."; `P "It is possible to pin a package to a specific git commit/tag/branch \ with $(b,opam pin #)."; `P "By default, local directories will be pinned as `path` backends. \ diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index 8d2b5b67479..ee087cd8898 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -121,10 +121,14 @@ let pin name pin_option = with Not_found -> false in let pins = OpamPackage.Name.Map.remove name pins in - if OpamState.find_packages_by_name t name = None then - OpamGlobals.error_and_exit - "%s is not a valid package name." - (OpamPackage.Name.to_string name); + if OpamState.find_packages_by_name t name = None && + not (OpamState.confirm + "Package %s does not exist, create as a %s package ?" + (OpamPackage.Name.to_string name) + (OpamGlobals.colorise `bold "NEW")) + then + (OpamGlobals.msg "Aborting.\n"; + OpamGlobals.exit 0); log "Adding %a => %a" (slog string_of_pin_option) pin_option @@ -136,7 +140,6 @@ let pin name pin_option = OpamState.add_pinned_overlay t name; let nv_pin = OpamPackage.pinned name in - let nv_v = OpamState.pinning_version t nv_pin in (* Mark the previously pinned installed version, if any, as not pinned, so that we can normally switch versions *) @@ -159,9 +162,9 @@ let pin name pin_option = (string_of_pin_kind pin_kind) (string_of_pin_option pin_option); - let pin_version = OpamPackage.version nv_v in - if not no_changes && installed_version <> None then + let nv_v = OpamState.pinning_version t nv_pin in + let pin_version = OpamPackage.version nv_v in if installed_version = Some pin_version then if pin_kind = `version then None else Some true diff --git a/src/client/opamState.ml b/src/client/opamState.ml index 7c1113fd362..8af781b8ded 100644 --- a/src/client/opamState.ml +++ b/src/client/opamState.ml @@ -442,43 +442,51 @@ let local_opam ?(root=false) ?(version_override=true) nv dir = else Some opam with e -> OpamMisc.fatal e; - OpamGlobals.error "%s contains errors, ignoring" - (OpamFilename.to_string local_opam); + OpamGlobals.error "opam file for %s contains errors, ignoring" + (OpamPackage.to_string nv); None in opam, descr, files_dir (* Copies package definition from the repository to the overlay *) let add_pinned_overlay t name = + let open OpamFile in + let module Ov = OpamPath.Switch.Overlay in let nv = OpamPackage.pinned name in - let local_pin, rv = - match OpamPackage.Name.Map.find name t.pinned with - | Version v -> false, OpamPackage.create name v - | _ -> true , overlay_of_name t name in - let orig = package_repo_dir t.root t.repositories t.package_index rv in - let files = OpamFilename.rec_files orig in - let opam_f = orig // "opam" in - let url_f = orig // "url" in - let files = List.filter (fun f -> f <> opam_f && f <> url_f) files in - let overlay = OpamPath.Switch.Overlay.package t.root t.switch nv in - List.iter (fun f -> OpamFilename.copy_in ~root:orig f overlay) files; - OpamFile.OPAM.( - write - (OpamPath.Switch.Overlay.opam t.root t.switch nv) - (with_version (read opam_f) (OpamPackage.version rv)) - ); - let url = - if local_pin then - Some (url_of_locally_pinned_package t name) - else if OpamFilename.exists url_f then - try Some (OpamFile.URL.read url_f) with e -> OpamMisc.fatal e; None - else - None + let pkg_overlay f = f t.root t.switch nv in + let get_orig_meta rv = + let orig = package_repo_dir t.root t.repositories t.package_index rv in + let files = OpamFilename.rec_files orig in + let opam_f = orig // "opam" in + let url_f = orig // "url" in + let files = List.filter (fun f -> f <> opam_f && f <> url_f) files in + let opam = OPAM.read opam_f in + let url = + try Some (URL.read url_f) with e -> OpamMisc.fatal e; None in + opam, url, orig, files in - match url with - | None -> () - | Some u -> - OpamFile.URL.write (OpamPath.Switch.Overlay.url t.root t.switch nv) u + try match OpamPackage.Name.Map.find name t.pinned with + | Version v -> + let opam, url, root, files = get_orig_meta (OpamPackage.create name v) in + List.iter (fun f -> OpamFilename.copy_in ~root f (pkg_overlay Ov.package)) + files; + OPAM.write (pkg_overlay Ov.opam) (OPAM.with_version opam v); + OpamMisc.Option.iter (URL.write (pkg_overlay Ov.url)) url + | _ -> + let rv = overlay_of_name t name in + let v = OpamPackage.version rv in + let opam, _url, root, files = get_orig_meta rv in + let url = url_of_locally_pinned_package t name in + List.iter (fun f -> OpamFilename.copy_in ~root f (pkg_overlay Ov.package)) + files; + OPAM.write (pkg_overlay Ov.opam) (OPAM.with_version opam v); + URL.write (pkg_overlay Ov.url) url + with Not_found -> (* No original meta, just write the URL file *) + let url = url_of_locally_pinned_package t name in + let opam = OPAM.with_name OPAM.empty name in + let opam = OPAM.with_version opam (OpamPackage.Version.of_string "0") in + OPAM.write (pkg_overlay Ov.opam) opam; + URL.write (pkg_overlay Ov.url) url let remove_overlay t nv = OpamFilename.rmdir (OpamPath.Switch.Overlay.package t.root t.switch nv) @@ -786,14 +794,15 @@ let available_packages t = | None -> false | Some opam -> let has_repository () = - OpamPackage.Map.mem nv t.package_index in + OpamPackage.Map.mem nv t.package_index || + OpamPackage.Name.Map.mem (OpamPackage.name nv) t.pinned in consistent_ocaml_version t opam && consistent_os opam && consistent_available_field t opam && has_repository () in let _pinned, set = - OpamPackage.Map.fold (fun nv _ (pinned, set) -> + OpamPackage.Set.fold (fun nv (pinned, set) -> if OpamPackage.Name.Set.mem (OpamPackage.name nv) pinned then (* Package has already been added to the set *) (pinned, set) @@ -805,7 +814,7 @@ let available_packages t = else pinned in if filter nv1 then pinned, OpamPackage.Set.add nv1 set else pinned, set - ) t.opams (OpamPackage.Name.Set.empty, OpamPackage.Set.empty) in + ) t.packages (OpamPackage.Name.Set.empty, OpamPackage.Set.empty) in set (* Display a meaningful error for a package that doesn't exist *) @@ -1343,11 +1352,7 @@ let load_state ?(save_cache=true) call_site = OpamFile.Installed.safe_read (OpamPath.Switch.installed root switch) in let installed_roots = OpamFile.Installed_roots.safe_read (OpamPath.Switch.installed_roots root switch) in - let packages = - OpamPackage.Name.Map.fold - (fun name _ -> OpamPackage.Set.add (OpamPackage.pinned name)) - pinned - (OpamPackage.Set.of_list (OpamPackage.Map.keys opams)) in + let packages = OpamPackage.Set.of_list (OpamPackage.Map.keys opams) in let reinstall = OpamFile.Reinstall.safe_read (OpamPath.Switch.reinstall root switch) in let available_packages_stub = lazy OpamPackage.Set.empty in @@ -1358,7 +1363,18 @@ let load_state ?(save_cache=true) call_site = package_index; compiler_index; available_packages = available_packages_stub } in - let t = { t with available_packages = lazy (available_packages t) } in + let packages = + OpamPackage.Name.Map.fold + (fun name _ -> + let nv = OpamPackage.pinned name in + let rv = pinning_version t nv in + OpamPackage.Set.add nv @* OpamPackage.Set.add rv) + pinned + packages + in + let t = { t with packages } in + let available_packages = lazy (available_packages t) in + let t = { t with available_packages } in print_state t; if save_cache && not cached then save_state ~update:false t; diff --git a/src/core/opamFile.ml b/src/core/opamFile.ml index e1155a75586..4eaa461ac9a 100644 --- a/src/core/opamFile.ml +++ b/src/core/opamFile.ml @@ -1047,8 +1047,9 @@ module X = struct | Some n, Some nv -> if OpamPackage.name nv <> n then OpamGlobals.error_and_exit - "Inconsistent naming scheme in %s" - (OpamFilename.to_string filename) + "Package %s, has inconsistent 'name: %S' field." + (OpamPackage.to_string nv) + (OpamPackage.Name.to_string n) else Some n in let version_f = OpamFormat.assoc_option s s_version (OpamFormat.parse_string @> OpamPackage.Version.of_string) in diff --git a/src/core/opamMisc.ml b/src/core/opamMisc.ml index a8bb29826ed..8392b20e821 100644 --- a/src/core/opamMisc.ml +++ b/src/core/opamMisc.ml @@ -266,6 +266,10 @@ module Option = struct | None -> None | Some x -> Some (f x) + let iter f = function + | None -> () + | Some x -> f x + let default dft = function | None -> dft | Some x -> x diff --git a/src/core/opamMisc.mli b/src/core/opamMisc.mli index a24673c613a..e943e859696 100644 --- a/src/core/opamMisc.mli +++ b/src/core/opamMisc.mli @@ -198,6 +198,8 @@ val sub_at: int -> string -> string module Option: sig val map: ('a -> 'b) -> 'a option -> 'b option + val iter: ('a -> unit) -> 'a option -> unit + val default: 'a -> 'a option -> 'a end diff --git a/src/core/opamParallel.ml b/src/core/opamParallel.ml index 3599d1363ee..d03b4181e48 100644 --- a/src/core/opamParallel.ml +++ b/src/core/opamParallel.ml @@ -241,7 +241,7 @@ module Make (G : G) : SIG with module G = G let pid, status = try wait !pids with e -> - OpamGlobals.error "%s while waiting for sub-processes" + OpamGlobals.error "%s" (Printexc.to_string e); (* Cleanup *) errors := OpamMisc.IntMap.fold From 05bb85dc97bc0dfb31a188acc4783c2a24b2cc6c Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Tue, 15 Apr 2014 10:41:29 +0200 Subject: [PATCH 3/5] Allow installing absent package on "opam reinstall" (after a confirmation) Closes #1082 --- src/client/opamClient.ml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml index ce375d0c58f..1beca30bd09 100644 --- a/src/client/opamClient.ml +++ b/src/client/opamClient.ml @@ -1102,10 +1102,14 @@ module API = struct let reinstall, not_installed = get_installed_atoms t atoms in if not_installed <> [] then - OpamGlobals.error_and_exit "%s %s not installed.\n" - (OpamMisc.pretty_list - (List.map OpamFormula.short_string_of_atom not_installed)) - (match not_installed with [_] -> "is" | _ -> "are"); + (OpamGlobals.warning "%s %s not installed." + (OpamMisc.pretty_list + (List.map OpamFormula.short_string_of_atom not_installed)) + (match not_installed with [_] -> "is" | _ -> "are"); + if OpamState.confirm "Install ?" then + install_t atoms None false t) + else + let reinstall = OpamPackage.Set.of_list reinstall in let universe = OpamState.universe t Depends in let depends = (* Do not cast to a set, we need to keep the order *) From c70abd8bb2621755f859f0b663c1336d728eabf2 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Tue, 15 Apr 2014 11:41:32 +0200 Subject: [PATCH 4/5] Better error message when .install fails --- src/client/opamAction.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index d2faa9d7273..255a615de81 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -114,7 +114,8 @@ let install_package t nv = ) libraries_in_config; (* .install *) - OpamFile.Dot_install.write (OpamPath.Switch.install t.root t.switch name) install; + let install_f = OpamPath.Switch.install t.root t.switch name in + OpamFile.Dot_install.write install_f install; (* .config *) OpamFile.Dot_config.write (OpamPath.Switch.config t.root t.switch name) config; @@ -197,9 +198,11 @@ let install_package t nv = Printf.sprintf " - %s in %s" (OpamFilename.Base.to_string base) (OpamFilename.Dir.to_string dir) in - OpamSystem.internal_error + OpamGlobals.error "While installing the following files:\n%s" (String.concat "\n" (List.map print !warnings)); + failwith (Printf.sprintf "Error processing %s.install" + (OpamFilename.to_string install_f)); ) ); if not (!OpamGlobals.keep_build_dir || !OpamGlobals.debug) then From df90af066d47e8e3fe3f9303b40f0876717cb105 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Tue, 15 Apr 2014 10:44:36 +0200 Subject: [PATCH 5/5] Fix 'metadata changed' on new pins --- src/client/opamState.ml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/client/opamState.ml b/src/client/opamState.ml index 8af781b8ded..0c37399df18 100644 --- a/src/client/opamState.ml +++ b/src/client/opamState.ml @@ -2280,11 +2280,16 @@ let update_dev_package t nv = OpamMisc.Option.map OpamFile.OPAM.version opam in let repo_meta = (* Version from the repo *) - let nv = OpamPackage.create name (Option.default version user_version) in + let v = Option.default version user_version in + let nv = OpamPackage.create name v in try let dir = package_repo_dir t.root t.repositories t.package_index nv in hash_meta @@ local_opam ~root:true nv dir - with Not_found -> [] + with Not_found -> + hash_meta @@ + (Some (OpamFile.OPAM.with_name + OpamFile.OPAM.(with_version empty v) name), + None, None) in (* Do the update *) let result = fetch () in