diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index 9f7f7bed97e..b88ed1f2379 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -459,6 +459,7 @@ let prepare_package_source st nv dir = (OpamPackage.to_string nv ^ "/" ^ OpamFilename.Base.to_string basename) (OpamFilename.create dir basename) (OpamFile.URL.checksum urlf) + (OpamFile.URL.signed_by urlf) (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| function | Result () | Up_to_date () -> None diff --git a/src/client/opamAdminCommand.ml b/src/client/opamAdminCommand.ml index 723677b02bc..3761c10b8ba 100644 --- a/src/client/opamAdminCommand.ml +++ b/src/client/opamAdminCommand.ml @@ -157,6 +157,9 @@ let package_files_to_cache repo_root cache_dir cache_urls let checksums = OpamHash.sort (OpamFile.URL.checksum urlf) in + let signed_by = + OpamSignature.sort (OpamFile.URL.signed_by urlf) + in match checksums with | [] -> OpamConsole.warning "[%s] no checksum, not caching" @@ -172,7 +175,7 @@ let package_files_to_cache repo_root cache_dir cache_urls else OpamRepository.pull_file_to_cache label ~cache_urls ~cache_dir - checksums + checksums signed_by (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| fun r -> match OpamRepository.report_fetch_result nv r with | Not_available (_,m) -> Some m @@ -603,7 +606,7 @@ let add_hashes_command cli = hash_tables in let additions_count = ref 0 in - let get_hash hash_tables ~cache_urls ~cache_dir kind known_hashes url = + let get_hash hash_tables ~cache_urls ~cache_dir kind known_hashes signed_by url = let found = List.fold_left (fun result hash -> match result with @@ -625,7 +628,7 @@ let add_hashes_command cli = (fun () -> OpamRepository.pull_file (OpamUrl.to_string url) ~cache_dir ~cache_urls - f known_hashes [url] + f known_hashes signed_by [url] @@| function | Result () | Up_to_date () -> OpamHash.compute ~kind (OpamFilename.to_string f) @@ -669,6 +672,7 @@ let add_hashes_command cli = else has_error in let process_url has_error urlf = + let signed_by = OpamFile.URL.signed_by urlf in let hashes = OpamFile.URL.checksum urlf in let hashes = if replace then @@ -683,7 +687,7 @@ let add_hashes_command cli = if List.exists (fun h -> OpamHash.kind h = kind) hashes then has_error, hashes else match get_hash hash_tables ~cache_urls ~cache_dir kind - hashes (OpamFile.URL.url urlf) with + hashes signed_by (OpamFile.URL.url urlf) with | Some h -> has_error, hashes @ [h] | None -> OpamConsole.error "Could not get hash for %s: %s" diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index de08206ac1b..cc722a45844 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -3410,7 +3410,7 @@ let pin ?(unpin_only=false) cli = OpamRepository.pull_tree ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) - basename pin_cache_dir [] [url] @@| function + basename pin_cache_dir [] [] [url] @@| function | Not_available (_,u) -> OpamConsole.error_and_exit `Sync_error "Could not retrieve %s" u @@ -3798,7 +3798,7 @@ let source cli = ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) ?subpath - (OpamPackage.to_string nv) dir [] + (OpamPackage.to_string nv) dir [] [] [url]) with | Not_available (_,u) -> diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index 468060e7ee9..e0406278655 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -377,7 +377,7 @@ let fetch_all_pins st ?working_dir pins = let name = OpamPackage.Name.to_string name in OpamProcess.Job.Op.( OpamRepository.pull_tree ~cache_dir ?subpath ?working_dir - name srcdir [] [url] + name srcdir [] [] [url] @@| fun r -> (pinned, r)) in OpamParallel.map ~jobs:OpamStateConfig.(!r.dl_jobs) ~command pins @@ -832,7 +832,7 @@ let scan ~normalise ~recurse ?subpath url = OpamRepository.pull_tree ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) - basename pin_cache_dir [] [url] @@| function + basename pin_cache_dir [] [] [url] @@| function | Not_available (_,u) -> OpamConsole.error_and_exit `Sync_error "Could not retrieve %s" u diff --git a/src/core/opamSignature.ml b/src/core/opamSignature.ml new file mode 100644 index 00000000000..2c39caf4ad4 --- /dev/null +++ b/src/core/opamSignature.ml @@ -0,0 +1,105 @@ +(**************************************************************************) +(* *) +(* Copyright 2025 ahrefs *) +(* *) +(* All rights reserved. This file is distributed under the terms of the *) +(* GNU Lesser General Public License version 2.1, with the special *) +(* exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* TODO: proper "kind" (cypher+bitlength? sigstore uris?) *) +type kind = [ `GPG ] + +let _default_kind = `GPG +let all_kinds = [`GPG] + +type t = kind * string + +let kind = fst +let contents = snd + +(* Order by signature strength *) +let compare_kind k l = + match k, l with + | `GPG, `GPG -> 0 + +let equal_kind k1 k2 = compare_kind k1 k2 = 0 + +let compare (k,h) (l,i) = + match compare_kind k l with + | 0 -> String.compare h i + | cmp -> cmp + +let equal h h' = compare h h' = 0 + +let pfx_sep_char = '=' +let pfx_sep_str = String.make 1 pfx_sep_char + +let string_of_kind = function + | `GPG -> "gpg" + +let kind_of_string s = match String.lowercase_ascii s with + | "gpg" -> `GPG + | _ -> invalid_arg "OpamSignature.kind_of_string" + +let is_hex_str len s = + String.length s = len && OpamStd.String.is_hex s + +let len = function + | `GPG -> 16 (* dummy summy *) + +let valid kind = is_hex_str (len kind) + +let is_null h = + let count_not_zero c = + function '0' -> c | _ -> succ c + in + OpamCompat.String.fold_left count_not_zero 0 (contents h) <> 0 + +let make kind s = + if valid kind s then kind, String.lowercase_ascii s + else invalid_arg ("OpamSignature.make_"^string_of_kind kind) + +let gpg = make `GPG + +let of_string_opt s = + try + match OpamStd.String.cut_at s pfx_sep_char with + | None -> None + | Some (skind, s) -> + let kind = kind_of_string skind in + if valid kind s then Some (kind, String.lowercase_ascii s) + else None + with Invalid_argument _ -> None + +let of_string s = + match of_string_opt s with + | Some h -> h + | None -> invalid_arg "OpamSignature.of_string" + +let to_string (kind,s) = + String.concat pfx_sep_str [string_of_kind kind; s] + +let to_json s = `String (to_string s) +let of_json = function +| `String s -> of_string_opt s +| _ -> None + +let sort signatures = + List.sort (fun h h' -> compare h' h) signatures + +let check_commit `TODO (_kind, _k) = failwith "TODO" + +module O = struct + type _t = t + type t = _t + let to_string = to_string + let to_json = to_json + let of_json = of_json + let compare = compare +end + +module Set = OpamStd.Set.Make(O) + +module Map = OpamStd.Map.Make(O) diff --git a/src/core/opamSignature.mli b/src/core/opamSignature.mli new file mode 100644 index 00000000000..77e7ab27bcf --- /dev/null +++ b/src/core/opamSignature.mli @@ -0,0 +1,40 @@ +(**************************************************************************) +(* *) +(* Copyright 2025 ahrefs *) +(* *) +(* All rights reserved. This file is distributed under the terms of the *) +(* GNU Lesser General Public License version 2.1, with the special *) +(* exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* GPG, as supported by git *) +type kind = [ `GPG ] + +type t + +val kind: t -> kind + +(** The list of all the possible values of kind *) +val all_kinds : kind list + +(** The value of the hash, as a string of hexadecimal characters *) +val contents: t -> string + +val string_of_kind: kind -> string + +val gpg: string -> t + +include OpamStd.ABSTRACT with type t := t + +val of_string_opt: string -> t option +val compare_kind: kind -> kind -> int +val equal_kind: kind -> kind -> bool + +(** Check if signature contains only 0 *) +val is_null: t -> bool + +(** Sorts the list from strongest to weakest *) +val sort : t list -> t list + +val check_commit: [ `TODO ] -> t -> bool diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index 9d26b587976..9926a617a98 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -2421,34 +2421,38 @@ module URLSyntax = struct url : url; mirrors : url list; checksum: OpamHash.t list; + signed_by: OpamSignature.t list; swhid: OpamSWHID.t option; errors : (string * Pp.bad_format) list; subpath : subpath option; } - let create ?(mirrors=[]) ?(checksum=[]) ?swhid ?subpath url = + let create ?(mirrors=[]) ?(checksum=[]) ?(signed_by=[]) ?swhid ?subpath url = { - url; mirrors; checksum; swhid; errors = []; subpath; + url; mirrors; checksum; signed_by; swhid; errors = []; subpath; } let empty = { - url = OpamUrl.empty; - mirrors = []; - checksum= []; - swhid = None; - errors = []; - subpath = None; + url = OpamUrl.empty; + mirrors = []; + checksum = []; + signed_by= []; + swhid = None; + errors = []; + subpath = None; } let url t = t.url let mirrors t = t.mirrors let checksum t = t.checksum + let signed_by t = t.signed_by let swhid t = t.swhid let subpath t = t.subpath let with_url url t = { t with url } let with_mirrors mirrors t = { t with mirrors } let with_checksum checksum t = { t with checksum = checksum } + let with_signed_by signed_by t = { t with signed_by = signed_by } let with_swhid swhid t = { t with swhid = Some swhid } let with_swhid_opt swhid t = { t with swhid = swhid } let with_subpath subpath t = { t with subpath = Some subpath } @@ -2477,6 +2481,9 @@ module URLSyntax = struct "checksum", Pp.ppacc with_checksum checksum (Pp.V.map_list ~depth:1 (Pp.V.string -| Pp.of_module "checksum" (module OpamHash))); + "signed_by", Pp.ppacc with_signed_by signed_by + (Pp.V.map_list ~depth:1 + (Pp.V.string -| Pp.of_module "signed_by" (module OpamSignature))); "mirrors", Pp.ppacc with_mirrors mirrors (Pp.V.map_list ~depth:1 Pp.V.url); "subpath", Pp.ppacc_opt diff --git a/src/format/opamFile.mli b/src/format/opamFile.mli index ffb6aa28ff2..f7c5d342ba0 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -324,6 +324,7 @@ module URL: sig val create: ?mirrors:url list -> ?checksum:OpamHash.t list -> + ?signed_by:OpamSignature.t list -> ?swhid:OpamSWHID.t -> ?subpath:subpath -> url -> t @@ -335,10 +336,12 @@ module URL: sig (** Archive checksum *) val checksum: t -> OpamHash.t list val swhid: t -> OpamSWHID.t option + val signed_by: t -> OpamSignature.t list (** Constructor *) val with_url: url -> t -> t val with_checksum: OpamHash.t list -> t -> t + val with_signed_by: OpamSignature.t list -> t -> t val with_mirrors: OpamUrl.t list -> t -> t val with_swhid: OpamSWHID.t -> t -> t val with_swhid_opt: OpamSWHID.t option -> t -> t diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml index c3b9a02d222..e15762629b3 100644 --- a/src/repository/opamRepository.ml +++ b/src/repository/opamRepository.ml @@ -142,7 +142,8 @@ let fetch_from_cache = in no_concurrent_dls checksum try_cache_dl cache_urls -let validate_and_add_to_cache label url cache_dir file checksums = +let validate_and_add_to_cache label url cache_dir file checksums signed_by = + ignore signed_by; (* TODO *) try let mismatch, expected = OpamStd.List.find_map (fun c -> @@ -172,7 +173,7 @@ let validate_and_add_to_cache label url cache_dir file checksums = (* [cache_dir] used to add to cache only *) let pull_from_upstream label ?full_fetch ?(working_dir=false) ?subpath - cache_dir destdir checksums url = + cache_dir destdir checksums signed_by url = let module B = (val url_backend url: OpamRepositoryBackend.S) in let cksum = match checksums with [] -> None | c::_ -> Some c in let text = @@ -219,7 +220,7 @@ let pull_from_upstream @@| function | (Result (Some file) | Up_to_date (Some file)) as ret -> if OpamRepositoryConfig.(!r.force_checksums) = Some false - || validate_and_add_to_cache label url cache_dir file checksums + || validate_and_add_to_cache label url cache_dir file checksums signed_by then ret else let m = "Checksum mismatch" in @@ -228,16 +229,16 @@ let pull_from_upstream | Not_available _ as na -> na let pull_from_mirrors label ?full_fetch ?working_dir ?subpath - cache_dir destdir checksums urls = + cache_dir destdir checksums signed_by urls = let rec aux = function | [] -> invalid_arg "pull_from_mirrors: empty mirror list" | [url] -> pull_from_upstream label ?full_fetch ?working_dir ?subpath - cache_dir destdir checksums url + cache_dir destdir checksums signed_by url @@| fun r -> url, r | url::mirrors -> pull_from_upstream label ?full_fetch ?working_dir ?subpath - cache_dir destdir checksums url + cache_dir destdir checksums signed_by url @@+ function | Not_available (_,s) -> OpamConsole.warning "%s: download of %s failed (%s), trying mirror" @@ -258,7 +259,7 @@ let pull_from_mirrors label ?full_fetch ?working_dir ?subpath (* handle subpathes *) let pull_tree_t ?full_fetch ?cache_dir ?(cache_urls=[]) ?working_dir - dirnames checksums remote_urls = + dirnames checksums signed_by remote_urls = let extract_archive = let fallback success = function | None -> success () @@ -375,15 +376,15 @@ let pull_tree_t subpath | _ -> None, tmpdir, None in - fun label checksums remote_urls -> + fun label checksums signed_by remote_urls -> pull_from_mirrors (OpamStd.Option.default label label0) ?full_fetch ?working_dir ?subpath cache_dir destdir - checksums remote_urls + checksums signed_by remote_urls @@| fun (url, res) -> (OpamUrl.to_string_w_subpath subpath url), res in - pull label checksums remote_urls + pull label checksums signed_by remote_urls @@+ function | _, Up_to_date None -> Done (Up_to_date "no changes") | url, (Up_to_date (Some archive) | Result (Some archive)) -> @@ -407,7 +408,7 @@ let revision dirname url = B.revision dirname let pull_file label ?cache_dir ?(cache_urls=[]) ?(silent_hits=false) - file checksums remote_urls = + file checksums signed_by remote_urls = (match cache_dir with | Some cache_dir -> let text = OpamProcess.make_command_text label "dl" in @@ -439,14 +440,14 @@ let pull_file label ?cache_dir ?(cache_urls=[]) ?(silent_hits=false) label ^ ": Missing checksum, and `--require-checksums` was set.")) else OpamFilename.with_tmp_dir_job (fun tmpdir -> - pull_from_mirrors label cache_dir tmpdir checksums remote_urls + pull_from_mirrors label cache_dir tmpdir checksums signed_by remote_urls @@| function | _, Up_to_date _ -> assert false | _, Result (Some f) -> OpamFilename.move ~src:f ~dst:file; Result () | _, Result None -> let m = "is a directory" in Not_available (Some m, m) | _, (Not_available _ as na) -> na) -let pull_file_to_cache label ~cache_dir ?(cache_urls=[]) checksums remote_urls = +let pull_file_to_cache label ~cache_dir ?(cache_urls=[]) checksums signed_by remote_urls = let text = OpamProcess.make_command_text label "dl" in OpamProcess.Job.with_text text @@ fetch_from_cache cache_dir cache_urls checksums @@+ function @@ -456,7 +457,7 @@ let pull_file_to_cache label ~cache_dir ?(cache_urls=[]) checksums remote_urls = Done (Result (OpamUrl.to_string url)) | Not_available _ -> OpamFilename.with_tmp_dir_job (fun tmpdir -> - pull_from_mirrors label (Some cache_dir) tmpdir checksums remote_urls + pull_from_mirrors label (Some cache_dir) tmpdir checksums signed_by remote_urls @@| function | _, Up_to_date _ -> assert false | url, Result (Some _) -> Result (OpamUrl.to_string url) diff --git a/src/repository/opamRepository.mli b/src/repository/opamRepository.mli index 2a8f31aac52..2ad1398bffb 100644 --- a/src/repository/opamRepository.mli +++ b/src/repository/opamRepository.mli @@ -40,7 +40,7 @@ val update: repository -> dirname -> [`Changes | `No_changes] OpamProcess.job val pull_shared_tree: ?cache_dir:dirname -> ?cache_urls:OpamUrl.t list -> - (string * OpamFilename.Dir.t * subpath option) list -> OpamHash.t list -> + (string * OpamFilename.Dir.t * subpath option) list -> OpamHash.t list -> OpamSignature.t list -> url list -> string download OpamProcess.job (* Same as {!pull_shared_tree}, but for a unique label/dirname. @@ -49,13 +49,13 @@ val pull_shared_tree: val pull_tree: string -> ?full_fetch:bool -> ?cache_dir:dirname -> ?cache_urls:url list -> ?working_dir:bool -> ?subpath:subpath -> - dirname -> OpamHash.t list -> url list -> + dirname -> OpamHash.t list -> OpamSignature.t list -> url list -> string download OpamProcess.job (** Same as [pull_tree], but for fetching a single file. *) val pull_file: string -> ?cache_dir:dirname -> ?cache_urls:url list -> ?silent_hits:bool -> - filename -> OpamHash.t list -> url list -> + filename -> OpamHash.t list -> OpamSignature.t list -> url list -> unit download OpamProcess.job (** Same as [pull_file], but without a destination file: just ensures the file @@ -63,7 +63,7 @@ val pull_file: to the archive, otherwise it adds the missing links. *) val pull_file_to_cache: string -> cache_dir:dirname -> ?cache_urls:url list -> - OpamHash.t list -> url list -> string download OpamProcess.job + OpamHash.t list -> OpamSignature.t list -> url list -> string download OpamProcess.job (** The file where the file with the given hash is stored under cache at given dirname. *) diff --git a/src/state/opamUpdate.ml b/src/state/opamUpdate.ml index 352cc0a0f2f..df37c1fbc7c 100644 --- a/src/state/opamUpdate.ml +++ b/src/state/opamUpdate.ml @@ -201,6 +201,7 @@ let fetch_dev_package url srcdir ?(working_dir=false) ?subpath nv = let remote_url = OpamFile.URL.url url in let mirrors = remote_url :: OpamFile.URL.mirrors url in let checksum = OpamFile.URL.checksum url in + let signed_by = OpamFile.URL.signed_by url in log "updating %a" (slog (OpamUrl.to_string_w_subpath subpath)) remote_url; (* (slog (OpamStd.Option.to_string OpamFilename.SubPath.pretty_string)) @@ -208,7 +209,7 @@ let fetch_dev_package url srcdir ?(working_dir=false) ?subpath nv = *) OpamRepository.pull_tree ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) - (OpamPackage.to_string nv) srcdir checksum ~working_dir ?subpath mirrors + (OpamPackage.to_string nv) srcdir checksum signed_by ~working_dir ?subpath mirrors @@| OpamRepository.report_fetch_result nv let pinned_package st ?version ?(autolock=false) ?(working_dir=false) name = @@ -578,8 +579,9 @@ let download_package_source_t st url nv_dirs = nv_dirs in let checksums = OpamFile.URL.checksum url in + let signed_by = OpamFile.URL.signed_by url in (OpamRepository.pull_shared_tree ~cache_dir ~cache_urls - dirnames checksums + dirnames checksums signed_by (OpamFile.URL.url url :: OpamFile.URL.mirrors url)) @@+ function | Not_available (_s,_l) as source_result @@ -599,6 +601,7 @@ let download_package_source_t st url nv_dirs = (OpamPackage.to_string nv ^"/"^ OpamFilename.Base.to_string name) ~cache_dir ~cache_urls (OpamFile.URL.checksum u) + (OpamFile.URL.signed_by u) (OpamFile.URL.url u :: OpamFile.URL.mirrors u)) @@| fun r -> (nv, OpamFilename.Base.to_string name, r) :: ret in