From 0bc0d6075979d71d6d31496f644fddb595701d19 Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 27 Aug 2024 17:00:56 +0200 Subject: [PATCH 1/2] reftest: add automatic update of opam file when adding a file in files/ --- master_changes.md | 1 + tests/reftests/lint.test | 16 +-- tests/reftests/readme.md | 10 +- tests/reftests/reftests.test | 73 ++++++++++ tests/reftests/run.ml | 267 +++++++++++++++++++++++++---------- 5 files changed, 282 insertions(+), 85 deletions(-) diff --git a/master_changes.md b/master_changes.md index e675dd0b5d2..ddb332b8007 100644 --- a/master_changes.md +++ b/master_changes.md @@ -223,6 +223,7 @@ users) * Fix some json output automatic replacement (duration and path on Windows) [#6184 @rjbou] * Add test for reftest syntax [#6184 @rjbou] * Add some readme file [#6184 @rjbou] + * Add new mechanism to add automatically files under `files/` directory to related opam file [#5564 @rjbou] ## Github Actions * Depexts: replace centos docker with almalinux to fake a centos [#6079 @rjbou] diff --git a/tests/reftests/lint.test b/tests/reftests/lint.test index af721529724..f9528eeecc2 100644 --- a/tests/reftests/lint.test +++ b/tests/reftests/lint.test @@ -674,7 +674,7 @@ license: "ISC" dev-repo: "hg+https://to@li.nt" bug-reports: "https://nobug" extra-files: [ "more-file-bad-md5" "md5=00000000000000000000000000000000" ] -### +### and there is content! ### opam-version: "2.0" @@ -688,14 +688,6 @@ dev-repo: "hg+https://to@li.nt" bug-reports: "https://nobug" ### and there is content! -### -hsh=`openssl md5 REPO/packages/lint/lint.2/files/more-file-good-md5 | cut -d ' ' -f 2` -echo "extra-files: [ \"more-file-good-md5\" \"md5=$hsh\" ]" >> REPO/packages/lint/lint.2/opam -### sh add-hash.sh -### opam update - -<><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><> -[default] synchronised from file://${BASEDIR}/REPO ### opam lint --package lint.1 /lint.1: Errors. error 53: Mismatching 'extra-files:' field: "more-file-bad-md5" @@ -1075,11 +1067,11 @@ maintainer: "maint@tain.er" license: "ISC" dev-repo: "hg+https://to@li.nt" bug-reports: "https://nobug" -### +### file -### +### file -### +### file ### set -ue diff --git a/tests/reftests/readme.md b/tests/reftests/readme.md index 9603efcc038..17984545a79 100644 --- a/tests/reftests/readme.md +++ b/tests/reftests/readme.md @@ -32,10 +32,16 @@ output... - use `### ` followed by the content of the file, to create a file verbatim - use `### ` followed by the content of an opam file, to - add this package to `default` repository in `./REPO`. This will also implicitly run `opam update default` + add this package to `default` repository in `./REPO`. This will also + implicitly run `opam update default`. Look for files in `files/` directory + and add 'extra-files:' field automatically. + - use `### ` followed by the content of the file, to add this file as a extra-file of the given package in the `default` repository, and - implicitely run `opam update default` + implicitly run `opam update default`. Associated opam file updated + automatically with that file as an + 'extra-files:' + - use `### ` followed by the content of an opam file, to have some fields automatically filled to be able to pin it without lint errors diff --git a/tests/reftests/reftests.test b/tests/reftests/reftests.test index c72fde51a92..56047464057 100644 --- a/tests/reftests/reftests.test +++ b/tests/reftests/reftests.test @@ -88,6 +88,79 @@ license: "MIT" dev-repo: "hg+https://pkg@op.am" bug-reports: "https://nobug" build: ["false"] +### :II:6: extra-files management +### :II:6:a: opamfile then extrafile +### +opam-version: "2.0" +### cat REPO/packages/bar/bar.1/opam +opam-version: "2.0" +### +I'm an extra file +### cat REPO/packages/bar/bar.1/opam +opam-version: "2.0" +extra-files: ["xf-bar" "md5=dbaf1ea561686374373dc7d154f3a0ff"] +### :II:6:b: extrafile then opamfile +### +I'm an another extra file +### test -f REPO/packages/baz/baz.1/opam +# Return code 1 # +### +opam-version: "2.0" +### cat REPO/packages/baz/baz.1/opam +opam-version: "2.0" +extra-files: ["xf-baz" "md5=9ac116bceba2bdf45065df19d26a6b64"] +### :II:6:c: redefinie opamfile +### +opam-version: "2.0" +### cat REPO/packages/qux/qux.1/opam +opam-version: "2.0" +### +I'm yet another extra file +### cat REPO/packages/qux/qux.1/opam +opam-version: "2.0" +extra-files: ["xf-qux" "md5=ccacf3e9d1e3f473e093042aa309e9da"] +### +opam-version: "2.0" +### cat REPO/packages/qux/qux.1/opam +opam-version: "2.0" +extra-files: ["xf-qux" "md5=ccacf3e9d1e3f473e093042aa309e9da"] +### :II:6:d: redefinie extrafile +### +I'm an yet another another extra file +### +opam-version: "2.0" +### cat REPO/packages/corge/corge.1/opam +opam-version: "2.0" +extra-files: ["xf-corge" "md5=d419630b165e4f2a1ad55d26c9b19e40"] +### +I'm the final one +### cat REPO/packages/corge/corge.1/opam +opam-version: "2.0" +extra-files: ["xf-corge" "md5=71e14bfb95ec10cb60f3b6cafd908a08"] +### :II:6:e: opamfile contains already extrafile defined +### +opam-version: "2.0" +extra-files: [ "file" "md5=00000000000000000000000000000000" ] +### cat REPO/packages/grault/grault.1/opam +opam-version: "2.0" +extra-files: [ "file" "md5=00000000000000000000000000000000" ] +### +It was not the final in the end +### cat REPO/packages/grault/grault.1/opam +opam-version: "2.0" +extra-files: [ + ["file" "md5=00000000000000000000000000000000"] + ["xf-grault" "md5=9fd8d4d58e5fd899478b03ab24a11d00"] +] +### +I'm the real final! +### cat REPO/packages/grault/grault.1/opam +opam-version: "2.0" +extra-files: [ + ["file" "md5=00000000000000000000000000000000"] + ["xf-grault" "md5=9fd8d4d58e5fd899478b03ab24a11d00"] + ["xf-grault2" "md5=5c1ff559ac6490338d362978c058f44a"] +] ### ################### ### :III: Environment variables ### ################### diff --git a/tests/reftests/run.ml b/tests/reftests/run.ml index 554a39febd3..f81b2420579 100644 --- a/tests/reftests/run.ml +++ b/tests/reftests/run.ml @@ -262,7 +262,10 @@ let rec with_temp_dir f = type command = | File_contents of string - | Repo_pkg_file_contents of string + | Repo_pkg_file_contents of + string * string (* name * version *) + * [ `opam + | `files of string (* file name *) ] | Pin_file_content of string | Cat of { files: string list; filter: (Re.t * filt_sort) list; } @@ -324,7 +327,7 @@ module Parse = struct group @@ seq [ alpha; rep @@ alt [ alnum; set "_-+" ]]; char '.'; group @@ rep1 @@ alt [ alnum; set "-_+.~" ]; - opt @@ seq [ char ':' ; group @@ rep1 @@ alt [ alnum; set "-_+.~" ]]; + opt @@ seq [ char ':' ; group @@ rep1 @@ alt [ alnum; set "-_+.~" ] ]; char '>' ] @@ -333,26 +336,24 @@ module Parse = struct if String.length str > 4 && String.sub str 1 4 = "pin:" then Pin_file_content (String.sub str 5 (String.length str - 6)) else - try - let grs = exec (compile re_package) str in - let name = Group.get grs 1 in - let version = Group.get grs 2 in - Repo_pkg_file_contents - (try - let files = Group.get grs 3 in - Printf.sprintf "%s/packages/%s/%s.%s/files/%s" - default_repo name name version files - with Not_found -> - Printf.sprintf "%s/packages/%s/%s.%s/opam" - default_repo name name version) - with Not_found -> - File_contents (String.sub str 1 (String.length str - 2)) - else if str.[0] = ':' || str.[0] = '#' then - Comment str + try + let grs = exec (compile re_package) str in + let name = Group.get grs 1 in + let version = Group.get grs 2 in + Repo_pkg_file_contents + (name, version, + try + let file = Group.get grs 3 in + `files (file) + with Not_found -> `opam) + with Not_found -> + File_contents (String.sub str 1 (String.length str - 2)) + else if str.[0] = ':' || str.[0] = '#' then + Comment str else - let varbinds, pos = - let gr = exec (compile @@ rep re_varbind) str in - List.map (fun gr -> + let varbinds, pos = + let gr = exec (compile @@ rep re_varbind) str in + List.map (fun gr -> Group.get gr 1, (match Group.get gr 2 with | "=" -> `eq @@ -362,18 +363,18 @@ module Parse = struct get_str (Group.get gr 3)) (all (compile @@ re_varbind) (Group.get gr 0)), Group.stop gr 0 - in + in let cmd, pos = try let gr = exec ~pos (compile re_str_atom) str in Some (get_str (Group.get gr 0)), Group.stop gr 0 - with Not_found -> None, pos - in + with Not_found -> None, pos + in let args = let grs = all ~pos (compile re_str_atom) str in List.map (fun gr -> Group.get gr 0) grs - in + in let get_str ?escape s = str_replace_path ?escape OpamSystem.back_to_forward (filters_of_var vars) @@ -387,29 +388,29 @@ module Parse = struct let rec get_args_rewr acc = function | [] -> List.rev acc, false, false, [], None | ("|"|">$") :: _ as rewr -> - let rec get_rewr (unordered, sort, acc) = function - | "|" :: re :: "->" :: str :: r -> - get_rewr (unordered, sort, (posix_re re, Sed (get_str str)) :: acc) r - | "|" :: "grep" :: "-v" :: re :: r -> - get_rewr (unordered, sort, (posix_re re, GrepV) :: acc) r - | "|" :: "grep" :: re :: r -> - get_rewr (unordered, sort, (posix_re re, Grep) :: acc) r - | "|" :: "sort" :: r -> - if acc <> [] then - Printf.printf "Warning: sort should appear _before_ any filters\n%!"; + let rec get_rewr (unordered, sort, acc) = function + | "|" :: re :: "->" :: str :: r -> + get_rewr (unordered, sort, (posix_re re, Sed (get_str str)) :: acc) r + | "|" :: "grep" :: "-v" :: re :: r -> + get_rewr (unordered, sort, (posix_re re, GrepV) :: acc) r + | "|" :: "grep" :: re :: r -> + get_rewr (unordered, sort, (posix_re re, Grep) :: acc) r + | "|" :: "sort" :: r -> + if acc <> [] then + Printf.printf "Warning: sort should appear _before_ any filters\n%!"; get_rewr (unordered, true, acc) r - | "|" :: "unordered" :: r -> - get_rewr (true, sort, acc) r - | "|" :: "sed-cmd" :: cmd :: r -> - let sandbox = - (* Sandbox prefix + | "|" :: "unordered" :: r -> + get_rewr (true, sort, acc) r + | "|" :: "sed-cmd" :: cmd :: r -> + let sandbox = + (* Sandbox prefix >[...] /tmp/build_592d92_dune/opam-reftest-2b89f9/OPAM/opam-init/hooks/sandbox.sh "build" "cmd" < >[...] ${BASEDIR}/opam-init/hooks/sandbox.sh "build" "cmd" < --> - >[...] cmd < + >[...] cmd < *) - seq [ - alt [ char '/'; Re.str "${" ]; + seq [ + alt [ char '/'; Re.str "${" ]; non_greedy @@ rep1 any; Re.str "sandbox.sh"; space; char '"'; @@ -418,25 +419,25 @@ module Parse = struct space; char '"'; Re.str cmd; char '"'; space; - ] - in + ] + in let with_quote_set s = set ("\"'"^s) in let opt_quoted r = [ seq @@ [ char '"'] @ r @ [ char '"'; rep1 space ]; seq @@ r @ [ rep1 space ]; - ] in + ] in let unix_prefix = (* Unix & Mac command prefix >[...] /usr/bin/cmd < >[...] /usr/bin/cmd < --> - >[...] cmd < + >[...] cmd < *) opt_quoted @@ [ rep1 @@ seq [ char '/'; rep1 @@ diff any (with_quote_set "/ ") ]; char '/'; Re.str cmd; - ] + ] in let win_prefix = (* Windows command prefix @@ -444,7 +445,7 @@ module Parse = struct >[...] C:\Windows\system32\cmd < >[...] C:\Windows\system 32\cmd < --> - >[...] cmd < + >[...] cmd < *) opt_quoted @@ [ alpha; char ':'; @@ -453,43 +454,43 @@ module Parse = struct char '\\'; opt @@ char '\\'; Re.str cmd; opt @@ Re.str ".exe"; - ] in + ] in let re = alt @@ sandbox :: unix_prefix @ win_prefix in let str = Printf.sprintf "%s " cmd in get_rewr (unordered, sort, (re, Sed str) :: acc) r - | ">$" :: output :: [] -> - unordered, sort, List.rev acc, Some (get_str output) - | [] -> - unordered, sort, List.rev acc, None - | r -> - Printf.printf + | ">$" :: output :: [] -> + unordered, sort, List.rev acc, Some (get_str output) + | [] -> + unordered, sort, List.rev acc, None + | r -> + Printf.printf "Bad rewrite %S, expecting '| RE -> STR' or '>$ VAR'\n%!" (String.concat " " r); unordered, sort, List.rev acc, None - in + in let unordered, sort, rewr, out = get_rewr (false, false, []) rewr in List.rev acc, unordered, sort, rewr, out - | arg :: r -> get_args_rewr (arg :: acc) r - in + | arg :: r -> get_args_rewr (arg :: acc) r + in let args, unordered, sort, rewr, output = get_args_rewr [] args in match cmd with | Some "opam-cat" -> - Cat { files = args; filter = rewr; } + Cat { files = args; filter = rewr; } | Some "json-cat" -> - Json { files = args; filter = rewr; } + Json { files = args; filter = rewr; } | Some cmd -> - let env, plus = - List.fold_left (fun (env,plus) (v,op,value) -> + let env, plus = + List.fold_left (fun (env,plus) (v,op,value) -> match op with | `eq -> (v,value)::env, plus | `pluseq -> env, (v^"+="^value)::plus | `eqplus -> env, (v^"=+"^value)::plus) ([],[]) varbinds - in + in (match plus with | [] -> () | _ -> - OpamConsole.error + OpamConsole.error "variable bindings at the beginning of a command does not \ support '+=' or '=+' operators: %s" (OpamStd.Format.pretty_list plus)); @@ -501,10 +502,10 @@ module Parse = struct output; unordered; sort; - } - | None -> - Export varbinds -end + } + | None -> + Export varbinds + end let parse_command = Parse.command @@ -654,6 +655,86 @@ let print_file ~filters reader names = in if not (String.equal s "\\c") then print_string (s^"\n")) +let add_extra_files fpath opamfile file = + let replace f ~default l = + let found, nl = + List.fold_left (fun (found, nl) item -> + if found then found, item::nl else + match f item with + | Some y -> true, y::nl + | None -> false, item::nl) + (false, []) l + in + (if not found then default::nl else nl) + |> List.rev + in + let open OpamParserTypes.FullPos in + let pos = (* null pos *) + { filename = opamfile.file_name; start = -1, -1; stop = -1, -1; } + in + let md5 = OpamHash.(to_string (compute ~kind:`MD5 fpath)) in + let xf_pair = + [{ pelem = String file; pos }; + { pelem = String md5; pos }] + in + let xf_pair_list = + { pelem = List { pelem = xf_pair; pos}; pos} + in + let default = + { pelem = Variable ({ pelem = "extra-files"; pos}, + xf_pair_list); pos} + in + let with_field xfiles = + Some { pelem = Variable + ({ pelem = "extra-files"; pos}, + { pelem = List { pelem = xfiles ; pos}; pos}); pos} + in + let file_contents = + replace ~default + (function + | { pelem = Variable + ({ pelem = "extra-files"; _}, + { pelem = List { pelem = xfiles ; _}; _}); _} -> + (match xfiles with + | [{ pelem = String xf; _}; + { pelem = String _checksum; _}] as xfield -> + with_field @@ + if String.equal xf file then + xf_pair + else + [{ pelem = List { pelem = xfield; pos}; pos}; + { pelem = List { pelem = xf_pair; pos}; pos}] + | { pelem = List _; _}::_ -> + (* There is only 2 construction + * 1 file, list of 2 strings + * extra-files: [ "file" "checksum" ] + * list of files + * extra-files: [[ "file" "checksum" ]] + * extra-files: [[ "file" "checksum" ] [ "file2" "checkums2"]] + *) + assert (List.for_all (function + { pelem = List + { pelem = [{ pelem = String _; _ }; + { pelem = String _; _}]; + _}; _} -> true + | _ -> false) xfiles); + with_field @@ + replace (function + | { pelem = List + { pelem = + [ { pelem = String xf; _ }; + { pelem = String _; _}]; _}; _} + when String.equal xf file -> + Some xf_pair_list + | _ -> None) + ~default:xf_pair_list xfiles + (* cf comment above *) + | _ -> assert false) + | _ -> None) + opamfile.file_contents + in + { opamfile with file_contents } + let run_test ?(vars=[]) ~opam t = let old_cwd = Sys.getcwd () in let opamroot0 = Filename.concat old_cwd ("root-"^t.repo_hash) in @@ -695,9 +776,53 @@ let run_test ?(vars=[]) ~opam t = write_file ~path ~contents; print_string contents; vars - | Repo_pkg_file_contents path -> + | Repo_pkg_file_contents (name, version, repo_file) -> let contents = String.concat "\n" out ^ "\n" in - write_file ~path ~contents; + let opam_path = + Printf.sprintf "%s/packages/%s/%s.%s/opam" + default_repo name name version + in + let file_path file = + Printf.sprintf "%s/packages/%s/%s.%s/files/%s" + default_repo name name version file + in + (match repo_file with + | `opam -> + let contents = + try + (* update with extra files if found *) + let files = + Filename.concat (Filename.dirname opam_path) "files" + |> Sys.readdir + |> Array.to_list + |> List.filter (fun f -> + not (Sys.is_directory (file_path f))) + in + match files with + | [] -> contents + | _ -> + let opamfile = OpamParser.FullPos.string contents opam_path in + List.fold_left (fun opamfile file -> + add_extra_files (file_path file) opamfile file) + opamfile files + |> OpamPrinter.FullPos.opamfile + with Sys_error _ -> contents + in + (* and write opam file *) + write_file ~path:opam_path ~contents; + | `files file -> + (* first update the given file *) + let fpath = file_path file in + write_file ~path:fpath ~contents; + (* then update the opam file *) + if Sys.file_exists opam_path then + let opamfile = OpamParser.FullPos.file opam_path in + let contents = + add_extra_files fpath opamfile file + |> OpamPrinter.FullPos.opamfile + in + write_file ~path:opam_path ~contents + ); print_string contents; ignore @@ run_cmd ~opam ~dir ~vars ~silent:true "opam" ["update"; "default"]; From 9a221be75f6e4c4428a36e57320a531f8e6b5d08 Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 29 Aug 2023 19:22:55 +0200 Subject: [PATCH 2/2] When reading opam files from repository, stop populating 'extra-files:' automatically from 'files/' directory --- doc/pages/Manual.md | 15 ++++-- master_changes.md | 3 ++ src/client/opamPinCommand.ml | 4 +- src/state/opamFileTools.ml | 38 +++++++++------- src/state/opamFileTools.mli | 5 +- src/state/opamUpdate.ml | 2 +- tests/reftests/admin.test | 2 +- tests/reftests/extrafile.test | 78 +++++++++++++++++++++----------- tests/reftests/legacy-git.test | 15 ++++++ tests/reftests/legacy-local.test | 15 ++++++ tests/reftests/repository.test | 21 +++++++++ 11 files changed, 144 insertions(+), 54 deletions(-) diff --git a/doc/pages/Manual.md b/doc/pages/Manual.md index d80a2885315..38e109ee468 100644 --- a/doc/pages/Manual.md +++ b/doc/pages/Manual.md @@ -52,7 +52,9 @@ following hierarchy: they override what may already be present in the `opam` file - [`/packages//./files/`](#files): contains files that are copied over the root of the source tree of the given package before - it gets used. + it gets used. Before opam 2.3, all files in this directory were copied. + Since opam 2.3 _only_ the files listed in the + [`extra-files`](#opamfield-extra-files) field are copied. - `/cache/`: cached package files, by checksum. Note that the cache location is configured in the [repo](#repofield-archive-mirrors) file, this name is only where `opam admin cache` puts it by default. @@ -1216,8 +1218,10 @@ files. for path portability of environment variables on Windows. - `extra-files: [ [ ] ... ]`: - optionally lists the files below `files/` with their checksums. Used - internally for integrity verifications. + lists the files below `files/` with their checksums. Used + internally for integrity verification. Before opam 2.3, listing files in + this field was optional, but since opam 2.3 all files must be listed in + this field or they will not be copied from the `files/` directory. - `pin-depends: [ [ ] ... ]`: this field has no effect on the package repository, but is useful for @@ -1294,7 +1298,10 @@ will be copied over the root of the package source. If already present, files are overwritten, and directories are recursively merged. [`opam`](#opam) file fields like [`patches:`](#opamfield-patches) refer to files at that same root, so patches specific to opam are typically included in -this subdirectory. +this subdirectory. Since opam 2.3, files must be listed in the +[`extra-files:`](#opamfield-extra-files) or they are ignored. Before +opam 2.3, all files were copied regardless of whether they appeared +in the `extra-files` list. Also see the [`extra-sources:`](#opamsection-extra-sources) opam section, which has a similar behaviour and is processed before the `files/` are copied. diff --git a/master_changes.md b/master_changes.md index ddb332b8007..b8e90329880 100644 --- a/master_changes.md +++ b/master_changes.md @@ -83,6 +83,7 @@ users) ## Repository * Mitigate curl/curl#13845 by falling back from --write-out to --fail if exit code 43 is returned by curl [#6168 @dra27 - fix #6120] * Silently mark packages requiring an unsupported version of opam as unavailable [#5665 @kit-ty-kate - fix #5631] + * When loading a repository, don't automatically populate `extra-files:` field with found files in `files/` [#5564 @rjbou] ## Lock @@ -265,6 +266,8 @@ users) ## opam-state * `OpamStateConfig.opamroot_with_provenance`: restore previous behaviour to `OpamStateConfig.opamroot` for compatibility with third party code [#6047 @dra27] * `OpamSwitchState.{,reverse_}dependencies`: make `unavailable` a non-optional argument to enforce speedups when availability information is not needed [#5317 @kit-ty-kate] + * `OpamFilteTools.add_aux_files`: ignore non registered extra-files and make the `files_subdir_hashes` argument optional (defaults to `false`) [#5564 @@rjbou] + * `OpamFileTools`: `read_opam` & `read_repo_opam` no more add non registered extra-files [#5564 @rjbou] ## opam-solver * `OpamCudfCriteria`, `OpamBuiltinZ3.Syntax`: Move `OpamBuiltinZ3.Syntax` into a dedicated module `OpamCudfCriteria` [#6130 @kit-ty-kate] diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index 3ec2b4731e6..8432d06498b 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -36,10 +36,8 @@ let string_of_pinned ?(subpath_prefix=true) opam = let read_opam_file_for_pinning ?locked ?(quiet=false) name f url = let opam0 = let dir = OpamFilename.dirname (OpamFile.filename f) in - (* don't add aux files for [project/opam] *) - let add_files = OpamUrl.local_dir url = Some dir in let opam = - (OpamFormatUpgrade.opam_file_with_aux ~quiet ~dir ~files:add_files + (OpamFormatUpgrade.opam_file_with_aux ~quiet ~dir ~files:false ~filename:f) (OpamFile.OPAM.safe_read f) in if opam = OpamFile.OPAM.empty then None else Some opam diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index db01bf0cd5f..804a54c6a17 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -1279,7 +1279,7 @@ let try_read rd f = let f = OpamFile.filename f in Some (OpamFilename.(Base.to_string (basename f)), bf) -let add_aux_files ?dir ~files_subdir_hashes opam = +let add_aux_files ?dir ?(files_subdir_hashes=false) opam = let dir = match dir with | None -> OpamFile.OPAM.get_metadata_dir ~repos_roots:(fun r -> @@ -1330,7 +1330,6 @@ let add_aux_files ?dir ~files_subdir_hashes opam = | _, (None, None) -> opam in let opam = - if not files_subdir_hashes then opam else let extra_files = OpamFilename.opt_dir files_dir >>| fun dir -> OpamFilename.rec_files dir @@ -1341,20 +1340,27 @@ let add_aux_files ?dir ~files_subdir_hashes opam = match OpamFile.OPAM.extra_files opam, extra_files with | None, None -> opam | None, Some ef -> - log ~level:2 - "Missing extra-files field for %a for %a, adding them." - (slog @@ OpamStd.List.concat_map ", " - (fun (_,f) -> OpamFilename.Base.to_string f)) ef - OpamStd.Op.(slog @@ OpamPackage.to_string @* OpamFile.OPAM.package) - opam; - let ef = - List.map - (fun (file, basename) -> - basename, - OpamHash.compute (OpamFilename.to_string file)) - ef + let log ?level act = + log ?level + "Missing extra-files field for %a for %a, %s them." + (slog @@ OpamStd.List.concat_map ", " + (fun (_,f) -> OpamFilename.Base.to_string f)) ef + OpamStd.Op.(slog @@ OpamPackage.to_string @* OpamFile.OPAM.package) + opam act in - OpamFile.OPAM.with_extra_files ef opam + if files_subdir_hashes then + (log ~level:2 "adding"; + let ef = + List.map + (fun (file, basename) -> + basename, + OpamHash.compute (OpamFilename.to_string file)) + ef + in + OpamFile.OPAM.with_extra_files ef opam) + else + (log "ignoring"; + opam) | Some ef, None -> log "Missing expected extra files %s at %s/files" (OpamStd.List.concat_map ", " @@ -1401,7 +1407,7 @@ let read_opam dir = OpamFile.make (dir // "opam") in match try_read OpamFile.OPAM.read_opt opam_file with - | Some opam, None -> Some (add_aux_files ~dir ~files_subdir_hashes:true opam) + | Some opam, None -> Some (add_aux_files ~dir ~files_subdir_hashes:false opam) | _, Some err -> OpamConsole.warning "Could not read file %s. skipping:\n%s" diff --git a/src/state/opamFileTools.mli b/src/state/opamFileTools.mli index 06280367292..744729da11f 100644 --- a/src/state/opamFileTools.mli +++ b/src/state/opamFileTools.mli @@ -83,8 +83,7 @@ val warns_to_json: ?filename:string -> (int * [`Warning|`Error] * string) list -> OpamJson.t (** Read the opam metadata from a given directory (opam file, with possible - overrides from url and descr files). Also includes the names and hashes - of files below files/ + overrides from url and descr files). Warning: use [read_repo_opam] instead for correctly reading files from repositories!*) val read_opam: dirname -> OpamFile.OPAM.t option @@ -100,7 +99,7 @@ val read_repo_opam: [files_subdir_hashes] is [true], also adds the names and hashes of files found below 'files/' *) val add_aux_files: - ?dir:dirname -> files_subdir_hashes:bool -> OpamFile.OPAM.t -> OpamFile.OPAM.t + ?dir:dirname -> ?files_subdir_hashes:bool -> OpamFile.OPAM.t -> OpamFile.OPAM.t (** {2 Tools to manipulate the [OpamFile.OPAM.t] contents} *) val map_all_variables: diff --git a/src/state/opamUpdate.ml b/src/state/opamUpdate.ml index 9fdf0f36750..c62a54eb23b 100644 --- a/src/state/opamUpdate.ml +++ b/src/state/opamUpdate.ml @@ -235,7 +235,7 @@ let pinned_package st ?version ?(autolock=false) ?(working_dir=false) name = from the repo *) let add_extra_files srcdir file opam = if OpamFilename.dirname (OpamFile.filename file) <> srcdir - then OpamFileTools.add_aux_files ~files_subdir_hashes:true opam + then OpamFileTools.add_aux_files ~files_subdir_hashes:false opam else opam in let locked = if autolock then OpamFile.OPAM.locked opam else None in diff --git a/tests/reftests/admin.test b/tests/reftests/admin.test index 525dced48d8..558c2c0fb82 100644 --- a/tests/reftests/admin.test +++ b/tests/reftests/admin.test @@ -673,7 +673,7 @@ opam-version: "2.0" ### nothing here ### OPAMDEBUGSECTIONS="opam-file" OPAMDEBUG=-2 opam admin list -opam-file Missing extra-files field for missing-file for no-extra.1, adding them. +opam-file Missing extra-files field for missing-file for no-extra.1, ignoring them. # Packages matching: available # Name # Installed # Synopsis no-extra -- diff --git a/tests/reftests/extrafile.test b/tests/reftests/extrafile.test index cff98501671..ff822f46d4a 100644 --- a/tests/reftests/extrafile.test +++ b/tests/reftests/extrafile.test @@ -155,9 +155,9 @@ Now run 'opam upgrade' to apply any package updates. ### ::::::::::::::::: ### sh -c "rm OPAM/repo/state-*.cache" ### OPAMDEBUGSECTIONS="opam-file" OPAMDEBUG=-2 opam list good-md5 -s | unordered +opam-file Missing extra-files field for p.patch for no-checksum.1, ignoring them. +opam-file Missing extra-files field for p.patch for not-mentioned.1, ignoring them. opam-file Missing expected extra files ../../../no-checksum/no-checksum.1/files/p.patch at ${BASEDIR}/OPAM/repo/default/packages/escape-good-md5/escape-good-md5.1/files -opam-file Missing extra-files field for p.patch for no-checksum.1, adding them. -opam-file Missing extra-files field for p.patch for not-mentioned.1, adding them. opam-file Missing expected extra files p.patch at ${BASEDIR}/OPAM/repo/default/packages/not-present/not-present.1/files opam-file Mismatching extra-files at ${BASEDIR}/OPAM/repo/default/packages/good-md5-good-sha256/good-md5-good-sha256.1: missing from 'files' directory (1) opam-file Missing expected extra files /etc/passwdd at ${BASEDIR}/OPAM/repo/default/packages/escape-absolute/escape-absolute.1/files @@ -355,20 +355,21 @@ The following actions will be performed: - install no-checksum 1 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> --> installed no-checksum.1 -Done. +[ERROR] The compilation of no-checksum.1 failed at "test -f p.patch". + + + + +<><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ++- The following actions failed +| - build no-checksum 1 ++- +- No changes have been performed +# Return code 31 # ### opam remove no-checksum -[ERROR] In the opam file for no-checksum.1: - - At ${BASEDIR}/OPAM/repo/default/packages/no-checksum/no-checksum.1/opam:11:2-11:13:: - expected [file checksum] - 'extra-files' has been ignored. -The following actions will be performed: -=== remove 1 package - - remove no-checksum 1 +[NOTE] no-checksum is not installed. -<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> --> removed no-checksum.1 -Done. +Nothing to do. ### opam install no-checksum --require-checksums [ERROR] In the opam file for no-checksum.1: - At ${BASEDIR}/OPAM/repo/default/packages/no-checksum/no-checksum.1/opam:11:2-11:13:: @@ -379,11 +380,21 @@ The following actions will be performed: - install no-checksum 1 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> --> installed no-checksum.1 -Done. +[ERROR] The compilation of no-checksum.1 failed at "test -f p.patch". + + + + +<><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ++- The following actions failed +| - build no-checksum 1 ++- +- No changes have been performed +# Return code 31 # ### opam source no-checksum Successfully extracted to ${BASEDIR}/no-checksum.1 ### test -f no-checksum.1/p.patch +# Return code 1 # ### opam clean --download-cache Clearing cache of downloaded files ### ::::::::::::::::: @@ -400,27 +411,42 @@ The following actions will be performed: - install not-mentioned 1 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> --> installed not-mentioned.1 -Done. +[ERROR] The compilation of not-mentioned.1 failed at "test -f p.patch". + + + + +<><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ++- The following actions failed +| - build not-mentioned 1 ++- +- No changes have been performed +# Return code 31 # ### opam remove not-mentioned -The following actions will be performed: -=== remove 1 package - - remove not-mentioned 1 +[NOTE] not-mentioned is not installed. -<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> --> removed not-mentioned.1 -Done. +Nothing to do. ### opam install not-mentioned --require-checksums The following actions will be performed: === install 1 package - install not-mentioned 1 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> --> installed not-mentioned.1 -Done. +[ERROR] The compilation of not-mentioned.1 failed at "test -f p.patch". + + + + +<><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ++- The following actions failed +| - build not-mentioned 1 ++- +- No changes have been performed +# Return code 31 # ### opam source not-mentioned Successfully extracted to ${BASEDIR}/not-mentioned.1 ### test -f not-mentioned.1/p.patch +# Return code 1 # ### opam clean --download-cache Clearing cache of downloaded files ### :II:2: not present diff --git a/tests/reftests/legacy-git.test b/tests/reftests/legacy-git.test index d97961af66c..c9c0c4707c2 100644 --- a/tests/reftests/legacy-git.test +++ b/tests/reftests/legacy-git.test @@ -652,6 +652,21 @@ Testing optional dependencies ### cp packages/P5.opam REPO/packages/P5.1/opam ### cp packages/P5/README REPO/packages/P5.1/descr ### sh mkurl.sh P5.1 P5.tar.gz +### +set -ue +for nv in REPO/packages/*; do + nv=`echo "$nv" | cut -f3 -d/` + n=`echo "$nv" | cut -f1 -d.` + path=REPO/packages/$nv + if [ -d "$path/files" ]; then + echo "extra-files:[" >> "$path/opam" + for file in `ls "$path/files"`; do + echo " [\"$file\" \"md5=`openssl md5 "$path/files/$file" | cut -f2 -d' '`\"]" >> "$path/opam" + done + echo "]" >> "$path/opam" + fi +done +### sh hash.sh ### git -C REPO/packages/ocaml.system add * ### git -C REPO/packages/ocaml.system commit -qm "Adding ocaml.system" ### git -C REPO/packages/ocaml.20 add * diff --git a/tests/reftests/legacy-local.test b/tests/reftests/legacy-local.test index 90a052801bf..511cfb6096d 100644 --- a/tests/reftests/legacy-local.test +++ b/tests/reftests/legacy-local.test @@ -640,6 +640,21 @@ Testing optional dependencies ### cp packages/P5.opam REPO/packages/P5.1/opam ### cp packages/P5/README REPO/packages/P5.1/descr ### sh mkurl.sh P5.1 P5.tar.gz +### +set -ue +for nv in REPO/packages/*; do + nv=`echo "$nv" | cut -f3 -d/` + n=`echo "$nv" | cut -f1 -d.` + path=REPO/packages/$nv + if [ -d "$path/files" ]; then + echo "extra-files:[" >> "$path/opam" + for file in `ls "$path/files"`; do + echo " [\"$file\" \"md5=`openssl md5 "$path/files/$file" | cut -f2 -d' '`\"]" >> "$path/opam" + done + echo "]" >> "$path/opam" + fi +done +### sh hash.sh ### archive-mirrors: "cache" ### opam update diff --git a/tests/reftests/repository.test b/tests/reftests/repository.test index 1f7f9e1bbf2..b69a44b676b 100644 --- a/tests/reftests/repository.test +++ b/tests/reftests/repository.test @@ -1,9 +1,21 @@ N0REP0 +### +set -ue +repo=$1 +nv=$2 +n=`echo "$nv" | cut -f1 -d.` +path=$repo/packages/$n/$nv +echo "extra-files:[" >> "$path/opam" +for file in `ls "$path/files"`; do + echo " [\"$file\" \"md5=`openssl md5 "$path/files/$file" | cut -f2 -d' '`\"]" >> "$path/opam" +done +echo "]" >> "$path/opam" ### opam-version: "2.0" build: ["test" "-f" "bar"] ### some content +### sh hash.sh REPO foo.1 ### : Internal repository storage as archive or plain directory : ### opam switch create tarring --empty ### opam update -vv | grep '^\+' | sed-cmd diff | sed-cmd patch | 'patch-[^"]+' -> 'patch' @@ -25,6 +37,7 @@ opam-version: "2.0" build: ["test" "-f" "baz"] ### some content +### sh hash.sh REPO foo.2 ### opam update default -vv | grep '^\+' | sed-cmd tar | sed-cmd diff | sed-cmd patch | 'patch-[^"]+' -> 'patch' + diff "-ruaN" "default" "default.new" (CWD=${BASEDIR}/OPAM/repo) + patch "--version" @@ -45,6 +58,7 @@ opam-version: "2.0" build: ["test" "-f" "baz"] ### some content +### sh hash.sh REPO foo.3 ### opam repository add tarred ./REPO --this-switch [tarred] Initialised ### : New tarred repositories does not change already unchanged existing ones @@ -63,6 +77,7 @@ opam-version: "2.0" build: ["test" "-f" "baz"] ### some content +### sh hash.sh REPO foo.4 ### opam update -vv | grep '^\+' | sed-cmd tar | sed-cmd diff | sed-cmd patch | 'patch-[^"]+' -> 'patch' + tar "xfz" "${BASEDIR}/OPAM/repo/tarred.tar.gz" "-C" "${OPAMTMP}" + diff "-ruaN" "tarred" "tarred.new" (CWD=${OPAMTMP}) @@ -86,6 +101,7 @@ opam-version: "2.0" build: ["test" "-f" "quux"] ### some content +### sh hash.sh REPO foo.5 ### opam update -vv | grep '^\+' | sed-cmd tar | sed-cmd diff | sed-cmd patch | 'patch-[^"]+' -> 'patch' + tar "xfz" "${BASEDIR}/OPAM/repo/tarred.tar.gz" "-C" "${OPAMTMP}" + diff "-ruaN" "tarred" "tarred.new" (CWD=${OPAMTMP}) @@ -107,6 +123,7 @@ opam-version: "2.0" build: ["test" "-f" "rab"] ### some content +### sh hash.sh REPO foo.4 ### OPAMDEBUGSECTIONS="FILE(opam) FILE(repo) FILE(repos-config) CACHE(repository)" ### opam update --debug-level=-3 | "state-[0-9A-Z]{8}" -> "state-hash" | unordered FILE(config) Read ${BASEDIR}/OPAM/config in 0.000s @@ -168,6 +185,7 @@ opam-version: "2.0" build: ["test" "-f" "oof"] ### some content +### sh hash.sh REPO2 bar.1 ### opam repository add repo2 ./REPO2 --this-switch [repo2] Initialised ### opam update --debug-level=-3 | "state-[0-9A-Z]{8}" -> "state-hash" @@ -192,6 +210,7 @@ opam-version: "2.0" build: ["test" "-f" "oof"] ### some content +### sh hash.sh REPO2 bar.2 ### opam update --debug-level=-3 | "state-[0-9A-Z]{8}" -> "state-hash" | unordered FILE(config) Read ${BASEDIR}/OPAM/config in 0.000s FILE(repos-config) Read ${BASEDIR}/OPAM/repo/repos-config in 0.000s @@ -221,11 +240,13 @@ opam-version: "2.0" build: ["test" "-f" "rab"] ### some content +### sh hash.sh REPO foo.6 ### opam-version: "2.0" build: ["test" "-f" "oof"] ### some content +### sh hash.sh REPO2 bar.3 ### opam update --debug-level=-3 | "state-[0-9A-Z]{8}" -> "state-hash" | unordered FILE(config) Read ${BASEDIR}/OPAM/config in 0.000s FILE(repos-config) Read ${BASEDIR}/OPAM/repo/repos-config in 0.000s