From 36c63b45e421db5ce569c4825a0238e6e4475a15 Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Tue, 29 Aug 2023 19:22:55 +0200 Subject: [PATCH] opam files: When reading opam files from repository, no more populate automatically 'extra-files:' automatically from 'files/' directory --- 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 +++++++++ 10 files changed, 133 insertions(+), 50 deletions(-) diff --git a/master_changes.md b/master_changes.md index 9a7b2df9c26..d3d52fe739c 100644 --- a/master_changes.md +++ b/master_changes.md @@ -80,6 +80,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] + * When loading a repository, don't automatically populate `extra-files:` field with found files in `files/` [#5564 @rjbou] ## Lock @@ -253,6 +254,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 `files_subdir_hashes` argument optional, defaulted 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 49e79e2f618..af89f5c68d4 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..f523cc7737d 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..b65445f11eb 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 94abd2b1bd8..7059ac7bc28 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