Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge pull request #4040 from hannesm/full-export-import
Include extra-files in switch export if `full` is provided, on import create an overlay directory with the file contents
  • Loading branch information
rjbou committed Mar 5, 2020
2 parents 0154b3f + 6ea4494 commit ccd1ab6
Show file tree
Hide file tree
Showing 10 changed files with 150 additions and 51 deletions.
1 change: 1 addition & 0 deletions opam-client.opam
Expand Up @@ -23,6 +23,7 @@ build: [
depends: [
"opam-state" {= "2.1.0~beta"}
"opam-solver" {= "2.1.0~beta"}
"extlib"
"re" {>= "1.9.0"}
"cmdliner" {>= "0.9.8"}
"dune" {build & >= "1.2.1"}
Expand Down
2 changes: 1 addition & 1 deletion src/client/dune
Expand Up @@ -3,7 +3,7 @@
(public_name opam-client)
(synopsis "OCaml Package Manager client and CLI library")
(modules (:standard \ opamMain get_git_version))
(libraries opam-state opam-solver re cmdliner)
(libraries opam-state opam-solver re extlib cmdliner)
(flags (:standard
(:include ../ocaml-flags-standard.sexp)
(:include ../ocaml-flags-configure.sexp)
Expand Down
45 changes: 34 additions & 11 deletions src/client/opamAction.ml
Expand Up @@ -365,18 +365,41 @@ let prepare_package_source st nv dir =
(Done None) (OpamFile.OPAM.extra_sources opam)
in
let check_extra_files =
try
List.iter (fun (src,base,hash) ->
if not (OpamHash.check_file (OpamFilename.to_string src) hash) then
failwith
(Printf.sprintf "Bad hash for %s" (OpamFilename.to_string src))
let extra_files =
let extra_files =
OpamFile.OPAM.get_extra_files
~repos_roots:(OpamRepositoryState.get_root st.switch_repos)
opam
in
if extra_files <> [] then extra_files else
match OpamFile.OPAM.extra_files opam with
| None -> []
| Some xs ->
(* lookup in switch-local hashmap overlay *)
let extra_files_dir =
OpamPath.Switch.extra_files_dir st.switch_global.root st.switch
in
OpamStd.List.filter_map (fun (base, hash) ->
let src =
OpamFilename.create extra_files_dir
(OpamFilename.Base.of_string (OpamHash.contents hash))
in
if OpamFilename.exists src then
Some (src, base, hash)
else None)
xs
in
let bad_hash =
OpamStd.List.filter_map (fun (src, base, hash) ->
if OpamHash.check_file (OpamFilename.to_string src) hash then
(OpamFilename.copy ~src ~dst:(OpamFilename.create dir base); None)
else
OpamFilename.copy ~src ~dst:(OpamFilename.create dir base))
(OpamFile.OPAM.get_extra_files
~repos_roots:(OpamRepositoryState.get_root st.switch_repos)
opam);
None
with e -> Some e
Some src) extra_files
in
if bad_hash = [] then None else
Some (Failure
(Printf.sprintf "Bad hash for %s"
(OpamStd.Format.itemize OpamFilename.to_string bad_hash)));
in
OpamFilename.mkdir dir;
get_extra_sources_job @@+ function Some _ as err -> Done err | None ->
Expand Down
5 changes: 4 additions & 1 deletion src/client/opamCommands.ml
Expand Up @@ -2245,7 +2245,9 @@ let switch =
OpamSwitchState.drop st;
`Ok ()
| Some `export, [filename] ->
OpamSwitchCommand.export
OpamGlobalState.with_ `Lock_write @@ fun gt ->
OpamRepositoryState.with_ `Lock_none gt @@ fun rt ->
OpamSwitchCommand.export rt
~full
(if filename = "-" then None
else Some (OpamFile.make (OpamFilename.of_string filename)));
Expand Down Expand Up @@ -3099,6 +3101,7 @@ let clean =
cleandir (OpamPath.Switch.backup_dir root sw);
cleandir (OpamPath.Switch.build_dir root sw);
cleandir (OpamPath.Switch.remove_dir root sw);
cleandir (OpamPath.Switch.extra_files_dir root sw);
let pinning_overlay_dirs =
List.map
(fun nv -> OpamPath.Switch.Overlay.package root sw nv.name)
Expand Down
95 changes: 66 additions & 29 deletions src/client/opamSwitchCommand.ml
Expand Up @@ -372,6 +372,22 @@ let switch lock gt switch =
let import_t ?ask importfile t =
log "import switch";

let extra_files = importfile.OpamFile.SwitchExport.extra_files in
let xfiles_dir =
OpamPath.Switch.extra_files_dir t.switch_global.root t.switch
in
OpamHash.Map.iter (fun hash content ->
let value = Base64.decode_string content in
let my = OpamHash.compute_from_string ~kind:(OpamHash.kind hash) value in
if OpamHash.contents my = OpamHash.contents hash then
let dst =
let base = OpamFilename.Base.of_string (OpamHash.contents hash) in
OpamFilename.create xfiles_dir base
in
OpamFilename.write dst value
else
failwith "Bad hash for inline extra-files") extra_files;

let import_sel = importfile.OpamFile.SwitchExport.selections in
let import_opams = importfile.OpamFile.SwitchExport.overlays in

Expand Down Expand Up @@ -454,6 +470,7 @@ let import_t ?ask importfile t =
extra_attributes = []; }
in
OpamSolution.check_solution t solution;
OpamFilename.rmdir xfiles_dir;
if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show))
then begin
(* Put imported overlays in place *)
Expand All @@ -477,44 +494,62 @@ let import_t ?ask importfile t =
end;
t

let read_overlays (read: package -> OpamFile.OPAM.t option) packages =
OpamPackage.Set.fold (fun nv acc ->
match read nv with
| Some opam ->
if OpamFile.OPAM.extra_files opam <> None then
(OpamConsole.warning
"Metadata of package %s uses a files%s subdirectory, it may not be \
re-imported correctly (skipping definition)"
(OpamPackage.to_string nv) Filename.dir_sep;
acc)
else OpamPackage.Name.Map.add nv.name opam acc
| None -> acc)
packages
OpamPackage.Name.Map.empty

let export ?(full=false) filename =
let export rt ?(full=false) filename =
let switch = OpamStateConfig.get_switch () in
let root = OpamStateConfig.(!r.root_dir) in
let export =
OpamFilename.with_flock `Lock_none (OpamPath.Switch.lock root switch)
@@ fun _ ->
let selections = S.safe_read (OpamPath.Switch.selections root switch) in
let overlays =
read_overlays (fun nv ->
OpamFileTools.read_opam
(OpamPath.Switch.Overlay.package root switch nv.name))
selections.sel_pinned
let opams =
let read_opams read pkgs =
OpamPackage.Set.fold (fun nv map ->
match read nv with
| Some opam -> OpamPackage.Map.add nv opam map
| None -> map) pkgs OpamPackage.Map.empty
in
let overlays =
read_opams (fun nv ->
OpamFileTools.read_opam
(OpamPath.Switch.Overlay.package root switch nv.name))
selections.sel_pinned
in
if not full then overlays else
OpamPackage.Map.union (fun a _ -> a) overlays
@@ read_opams (fun nv -> OpamFile.OPAM.read_opt
(OpamPath.Switch.installed_opam root switch nv))
(selections.sel_installed -- selections.sel_pinned)
in
let overlays =
if full then
OpamPackage.Name.Map.union (fun a _ -> a) overlays @@
read_overlays (fun nv ->
OpamFile.OPAM.read_opt
(OpamPath.Switch.installed_opam root switch nv))
(selections.sel_installed -- selections.sel_pinned)
else overlays
OpamPackage.Map.fold (fun nv opam nmap ->
OpamPackage.Name.Map.add nv.name opam nmap)
opams OpamPackage.Name.Map.empty
in
let extra_files =
let repos_roots = OpamRepositoryState.get_root rt in
OpamPackage.Map.fold (fun nv opam hmap ->
match OpamFile.OPAM.get_extra_files ~repos_roots opam with
| [] -> hmap
| files ->
let hmap, err =
List.fold_left (fun (hmap,err) (file, base, hash) ->
if OpamFilename.exists file &&
OpamHash.check_file (OpamFilename.to_string file) hash then
let value = Base64.encode_string (OpamFilename.read file) in
OpamHash.Map.add hash value hmap, err
else hmap, base::err)
(hmap,[]) files
in
if err <> [] then
OpamConsole.warning "Invalid hash%s, ignoring package %s extra-file%s: %s"
(match err with | [_] -> "" | _ -> "es")
(OpamPackage.to_string nv)
(match err with | [_] -> "" | _ -> "s")
(OpamStd.Format.pretty_list (List.map OpamFilename.Base.to_string err));
hmap)
opams OpamHash.Map.empty
in
{ OpamFile.SwitchExport.selections; overlays }
{ OpamFile.SwitchExport.selections; extra_files; overlays }
in
match filename with
| None -> OpamFile.SwitchExport.write_to_channel stdout export
Expand Down Expand Up @@ -546,6 +581,7 @@ let reinstall init_st =
in
import_t { OpamFile.SwitchExport.
selections = OpamSwitchState.selections init_st;
extra_files = OpamHash.Map.empty;
overlays = OpamPackage.Name.Map.empty; }
st

Expand All @@ -561,6 +597,7 @@ let import st filename =
try
let selections = OpamFile.LegacyState.read_from_string import_str in
{ OpamFile.SwitchExport.selections;
extra_files = OpamHash.Map.empty;
overlays = OpamPackage.Name.Map.empty }
with e1 -> OpamStd.Exn.fatal e1; raise e
in
Expand Down
12 changes: 9 additions & 3 deletions src/client/opamSwitchCommand.mli
Expand Up @@ -39,10 +39,16 @@ val import:
OpamFile.SwitchExport.t OpamFile.t option ->
rw switch_state

(** Export a file which contains the installed packages. If full is specified
(** Export a file which contains the installed packages. If [full] is specified
and true, export metadata of all installed packages (excluding overlay
files) as part of the export. [None] means export to stdout. *)
val export: ?full:bool -> OpamFile.SwitchExport.t OpamFile.t option -> unit
files) as part of the export. The export will be extended with a map of all
extra-files. If [None] is provided as file argument, the export is done to
stdout. *)
val export:
'a repos_state ->
?full:bool ->
OpamFile.SwitchExport.t OpamFile.t option ->
unit

(** Remove the given compiler switch, and returns the updated state (unchanged
in case [confirm] is [true] and the user didn't confirm) *)
Expand Down
28 changes: 22 additions & 6 deletions src/format/opamFile.ml
Expand Up @@ -3127,19 +3127,35 @@ end
module SwitchExportSyntax = struct

let internal = "switch-export"
let format_version = OpamVersion.of_string "2.0"
let format_version = OpamVersion.of_string "2.1"

type t = {
selections: switch_selections;
extra_files: string OpamHash.Map.t;
overlays: OPAM.t OpamPackage.Name.Map.t;
}

let empty = {
selections = SwitchSelectionsSyntax.empty;
extra_files = OpamHash.Map.empty;
overlays = OpamPackage.Name.Map.empty;
}

let fields = SwitchSelectionsSyntax.fields

let fields =
[ "extra-files", Pp.ppacc (fun extra_files t -> { t with extra_files })
(fun t -> t.extra_files)
((Pp.V.map_list ~depth:2 @@
(Pp.V.map_pair
(Pp.V.string -| Pp.of_module "checksum" (module OpamHash))
Pp.V.string)) -|
Pp.of_pair "HashMap" OpamHash.Map.(of_list, bindings))
] @
List.map
(fun (fld, ppacc) ->
fld, Pp.embed (fun selections t -> { t with selections })
(fun t -> t.selections) ppacc)
SwitchSelectionsSyntax.fields

let pp =
let name = "export-file" in
Expand All @@ -3150,8 +3166,7 @@ module SwitchExportSyntax = struct
false
| _ -> true) -|
Pp.map_pair
(Pp.I.fields ~name
~empty:SwitchSelectionsSyntax.empty fields -|
(Pp.I.fields ~name ~empty fields -|
Pp.I.show_errors ~name ())
(Pp.map_list
(Pp.I.section "package" -|
Expand All @@ -3169,14 +3184,15 @@ module SwitchExportSyntax = struct
Pp.of_pair "package-metadata-map"
OpamPackage.Name.Map.(of_list,bindings)) -|
Pp.pp
(fun ~pos:_ (selections, overlays) -> {selections; overlays})
(fun {selections; overlays} -> (selections, overlays))
(fun ~pos:_ (t, overlays) -> {t with overlays})
(fun t -> t, t.overlays)

end

module SwitchExport = struct
type t = SwitchExportSyntax.t = {
selections: switch_selections;
extra_files: string OpamHash.Map.t;
overlays: OPAM.t OpamPackage.Name.Map.t;
}

Expand Down
1 change: 1 addition & 0 deletions src/format/opamFile.mli
Expand Up @@ -683,6 +683,7 @@ end
module SwitchExport: sig
type t = {
selections: switch_selections;
extra_files: string OpamHash.Map.t;
overlays: OPAM.t OpamPackage.Name.Map.t;
}
include IO_FILE with type t := t
Expand Down
4 changes: 4 additions & 0 deletions src/format/opamPath.ml
Expand Up @@ -117,6 +117,10 @@ module Switch = struct

let sources_dir t a = meta t a / "sources"

let extra_files_dir t a = meta t a / "extra-files-cache"

let extra_file t a h = extra_files_dir t a // OpamHash.contents h

let sources t a nv = sources_dir t a / OpamPackage.to_string nv

let pinned_package t a name = sources_dir t a / OpamPackage.Name.to_string name
Expand Down
8 changes: 8 additions & 0 deletions src/format/opamPath.mli
Expand Up @@ -153,6 +153,14 @@ module Switch: sig
$meta/sources/$name.$version/} *)
val sources: t -> switch -> package -> dirname

(** Temporary switch-local directory where a by-hash map of extra files may be stored.
This is used for switch-imports: {i $meta/extra-files-cache} *)
val extra_files_dir: t -> switch -> dirname

(** Extra file with the given hash from the temporary switch-import cache:
{i $meta/extra-files-cache/HASH} *)
val extra_file: t -> switch -> OpamHash.t -> filename

(** Mirror of the sources for a given pinned package: {i
$meta/sources/$name/} (without version) *)
val pinned_package: t -> switch -> name -> dirname
Expand Down

0 comments on commit ccd1ab6

Please sign in to comment.