From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id qPmkGMvww16DfQAA0tVLHw (envelope-from ) for ; Tue, 19 May 2020 14:44:27 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id OLBxFMvww17XMgAAbx9fmQ (envelope-from ) for ; Tue, 19 May 2020 14:44:27 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 0E7C994017B for ; Tue, 19 May 2020 14:44:25 +0000 (UTC) Received: from localhost ([::1]:45016 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jb3Tj-0004lb-AI for larch@yhetil.org; Tue, 19 May 2020 10:44:23 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43206) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jb3TO-0004l5-68 for guix-patches@gnu.org; Tue, 19 May 2020 10:44:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:39182) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jb3TN-0000Kd-SV for guix-patches@gnu.org; Tue, 19 May 2020 10:44:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jb3TN-0004vd-Pp for guix-patches@gnu.org; Tue, 19 May 2020 10:44:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41382] [PATCH 0/6] Allow for a cryptographic hash function migration Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 19 May 2020 14:44:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41382 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41382@debbugs.gnu.org Received: via spool by 41382-submit@debbugs.gnu.org id=B41382.158989939918874 (code B ref 41382); Tue, 19 May 2020 14:44:01 +0000 Received: (at 41382) by debbugs.gnu.org; 19 May 2020 14:43:19 +0000 Received: from localhost ([127.0.0.1]:50725 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jb3Sa-0004uA-7N for submit@debbugs.gnu.org; Tue, 19 May 2020 10:43:19 -0400 Received: from eggs.gnu.org ([209.51.188.92]:35622) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jb3SU-0004tf-Jb for 41382@debbugs.gnu.org; Tue, 19 May 2020 10:43:11 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:52485) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jb3SP-00005g-B8 for 41382@debbugs.gnu.org; Tue, 19 May 2020 10:43:01 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=53110 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jb3SO-00020K-E0 for 41382@debbugs.gnu.org; Tue, 19 May 2020 10:43:00 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= References: <20200518213116.23978-1-ludo@gnu.org> Date: Tue, 19 May 2020 16:42:58 +0200 In-Reply-To: <20200518213116.23978-1-ludo@gnu.org> ("Ludovic \=\?utf-8\?Q\?Cou\?\= \=\?utf-8\?Q\?rt\=C3\=A8s\=22's\?\= message of "Mon, 18 May 2020 23:31:16 +0200") Message-ID: <871rnggf4d.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -1.0 (-) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: 0.49 X-TUID: 8Y1Za1g7NDdg --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello, Ludovic Court=C3=A8s skribis: > Another option would be to create a data type that specifies > its algorithm and its value. We=E2=80=99d replace the =E2=80=98sha256=E2= =80=99 field with > a =E2=80=98hash=E2=80=99 field of that type (in a backward-compatible way= ). Thinking > about it, this is perhaps the better option. Here=E2=80=99s a v2 that does that: instead of adding a =E2=80=98sha512=E2= =80=99 field to , it replaces the =E2=80=98sha256=E2=80=99 field with =E2=80=98hash= =E2=80=99 and introduces a data type (similar to the data type we have). One can now write things like: (origin ;; =E2=80=A6 (hash (content-hash (base64 "=E2=80=A6") sha512))) Since it=E2=80=99s a bit verbose, one can also pass a literal string direct= ly, in which case it=E2=80=99s base32-decoded: (origin ;; =E2=80=A6 (hash (content-hash "=E2=80=A6"))) =E2=80=98content-hash=E2=80=99 uses macrology to validate as much as possib= le at macro-expansion time. There=E2=80=99s a compatibility =E2=80=98origin=E2=80=99 macro intended to = allow people to keep writing: (origin (url =E2=80=A6) (method =E2=80=A6) (sha256 =E2=80=A6)) and to automatically =E2=80=9Cconvert=E2=80=9D the =E2=80=98sha256=E2=80=99= field specification to a =E2=80=98content-hash=E2=80=99. Due to the way identifiers are matched, th= ere are cases where we can=E2=80=99t preserve the illusion of compatibility, as can be se= en with the patch below. Perhaps that=E2=80=99s acceptable, though. Thoughts? Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-packages-Introduce-content-hash-and-use-it-in-origin.patch Content-Transfer-Encoding: quoted-printable Content-Description: the patch >From 0736d19071cc898e30b0bf06b445e7434848c825 Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Ludovic=3D20Court=3DC3=3DA8s?=3D Date: Tue, 19 May 2020 15:55:08 +0200 Subject: [PATCH] packages: Introduce and use it in . * guix/packages.scm (): New record type. (define-content-hash-constructor, build-content-hash) (content-hash): New macros. (print-content-hash): New procedure. (): Rename constructor to '%origin'. [sha256]: Remove field. [hash]: New field. Adjust users. (origin-compatibility-helper, origin): New macros. (origin-sha256): New deprecated procedure. (origin->derivation): Adjust accordingly. * tests/packages.scm ("package-source-derivation, origin, sha512"): New test. * guix/tests.scm: Hide (gcrypt hash) 'sha256' for proper syntax matching. * gnu/packages/aspell.scm (aspell-dictionary) (aspell-dict-ca, aspell-dict-it): Use 'hash' and 'content-hash' for proper syntax matching. * gnu/packages/bash.scm (bash-patch): Rename 'sha256' to 'sha256-bv'. * gnu/packages/bootstrap.scm (bootstrap-executable): Rename 'sha256' to 'bv= '. * gnu/packages/readline.scm (readline-patch): Likewise. * gnu/packages/virtualization.scm (qemu-patch): Rename 'sha256' to 'sha256-bv'. * guix/import/utils.scm: Hide (gcrypt hash) 'sha256'. --- doc/guix.texi | 34 ++++++++- gnu/packages/aspell.scm | 8 +- gnu/packages/bash.scm | 8 +- gnu/packages/bootstrap.scm | 6 +- gnu/packages/readline.scm | 8 +- gnu/packages/virtualization.scm | 4 +- guix/import/utils.scm | 2 +- guix/packages.scm | 126 +++++++++++++++++++++++++++++--- guix/tests.scm | 2 +- tests/packages.scm | 28 ++++++- 10 files changed, 192 insertions(+), 34 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index fdd9622211..71b10a141d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5966,9 +5966,13 @@ specified in the @code{uri} field as a @code{git-ref= erence} object; a @end table =20 @item @code{sha256} -A bytevector containing the SHA-256 hash of the source. Typically the -@code{base32} form is used here to generate the bytevector from a -base-32 string. +A bytevector containing the SHA-256 hash of the source. This is +equivalent to providing a @code{content-hash} SHA256 object in the +@code{hash} field described below. + +@item @code{hash} +The @code{content-hash} object of the source---see below for how to use +@code{content-hash}. =20 You can obtain this information using @code{guix download} (@pxref{Invoking guix download}) or @code{guix hash} (@pxref{Invoking @@ -6013,6 +6017,30 @@ this is @code{#f}, a sensible default is used. @end table @end deftp =20 +@deftp {Data Type} content-hash @var{value} [@var{algorithm}] +Construct a content hash object for the given @var{algorithm}, and with +@var{value} as its hash value. When @var{algorithm} is omitted, assume +it is @code{sha256}. + +@var{value} can be a literal string, in which case it is base32-decoded, +or it can be a bytevector. + +The following forms are all equivalent: + +@lisp +(content-hash "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj") +(content-hash "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj" + sha256) +(content-hash (base32 + "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj")) +(content-hash (base64 "kkb+RPaP7uyMZmu4eXPVkM4BN8yhRd8BTHLslb6f/Rc=3D") + sha256) +@end lisp + +Technically, @code{content-hash} is currently implemented as a macro. +It performs sanity checks at macro-expansion time, when possible, such +as ensuring that @var{value} has the right size for @var{algorithm}. +@end deftp =20 @node Build Systems @section Build Systems diff --git a/gnu/packages/aspell.scm b/gnu/packages/aspell.scm index 7550736c40..22256f750b 100644 --- a/gnu/packages/aspell.scm +++ b/gnu/packages/aspell.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Court=C3= =A8s +;;; Copyright =C2=A9 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Cour= t=C3=A8s ;;; Copyright =C2=A9 2015, 2016 Alex Kost ;;; Copyright =C2=A9 2016 John Darrington ;;; Copyright =C2=A9 2016, 2017, 2019 Efraim Flashner @@ -111,7 +111,7 @@ dictionaries, including personal ones.") (uri (string-append "mirror://gnu/aspell/dict/" dict-name "/" prefix dict-name "-" version ".tar.bz2")) - (sha256 sha256))) + (hash (content-hash sha256)))) (build-system gnu-build-system) (arguments `(#:phases @@ -163,7 +163,7 @@ dictionaries, including personal ones.") (method url-fetch) (uri (string-append "https://www.softcatala.org/pub/softcatala/as= pell/" version "/aspell6-ca-" version ".tar.bz2")) - (sha256 sha256))) + (hash (content-hash sha256)))) (home-page "https://www.softcatala.org/pub/softcatala/aspell/")))) =20 (define-public aspell-dict-de @@ -264,7 +264,7 @@ dictionaries, including personal ones.") (uri (string-append "mirror://sourceforge/linguistico/" "Dizionario%20italiano%20per%20Aspell/" versi= on "/" "aspell6-it-" version ".tar.bz2")) - (sha256 sha256))) + (hash (content-hash sha256)))) (home-page "http://linguistico.sourceforge.net/pages/dizionario_italiano.html= ")))) =20 diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm index 1b342827c5..311e07a944 100644 --- a/gnu/packages/bash.scm +++ b/gnu/packages/bash.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Cour= t=C3=A8s +;;; Copyright =C2=A9 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovi= c Court=C3=A8s ;;; Copyright =C2=A9 2014, 2015, 2018 Mark H Weaver ;;; Copyright =C2=A9 2015, 2017 Leo Famulari ;;; Copyright =C2=A9 2016, 2017, 2018, 2019 Efraim Flashner @@ -48,12 +48,12 @@ "Return the URL of Bash patch number SEQNO." (format #f "mirror://gnu/bash/bash-5.0-patches/bash50-~3,'0d" seqno)) =20 -(define (bash-patch seqno sha256) - "Return the origin of Bash patch SEQNO, with expected hash SHA256" +(define (bash-patch seqno sha256-bv) + "Return the origin of Bash patch SEQNO, with expected hash SHA256-BV." (origin (method url-fetch) (uri (patch-url seqno)) - (sha256 sha256))) + (sha256 sha256-bv))) =20 (define-syntax-rule (patch-series (seqno hash) ...) (list (bash-patch seqno (base32 hash)) diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index f58ce2de93..a3ecb6e692 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovi= c Court=C3=A8s +;;; Copyright =C2=A9 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 = Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2014, 2015, 2018, 2019 Mark H Weaver ;;; Copyright =C2=A9 2017, 2020 Efraim Flashner ;;; Copyright =C2=A9 2018, 2020 Jan (janneke) Nieuwenhuizen @@ -151,14 +151,14 @@ built for SYSTEM." (format #f (G_ "could not find bootstrap binary '~a' \ for system '~a'") program system)))))) - ((sha256) + ((bv) (origin (method url-fetch/executable) (uri (map (cute string-append <> (bootstrap-executable-file-name system program)) %bootstrap-executable-base-urls)) (file-name program) - (sha256 sha256))))))) + (hash (content-hash bv sha256)))))))) =20 ;;; diff --git a/gnu/packages/readline.scm b/gnu/packages/readline.scm index 5f61dcb735..8a36883347 100644 --- a/gnu/packages/readline.scm +++ b/gnu/packages/readline.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2012, 2013, 2014 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2012, 2013, 2014, 2020 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2016, 2019 Efraim Flashner ;;; Copyright =C2=A9 2016 Jan Nieuwenhuizen ;;; Copyright =C2=A9 2018 Tobias Geerinckx-Rice @@ -35,12 +35,12 @@ (format #f "mirror://gnu/readline/readline-~a-patches/readline~a-~3,'0d" version (string-join (string-split version #\.) "") seqno)) =20 -(define (readline-patch version seqno sha256) - "Return the origin of Readline patch SEQNO, with expected hash SHA256" +(define (readline-patch version seqno sha256-bv) + "Return the origin of Readline patch SEQNO, with expected hash SHA256-BV" (origin (method url-fetch) (uri (patch-url version seqno)) - (sha256 sha256))) + (sha256 sha256-bv))) =20 (define-syntax-rule (patch-series version (seqno hash) ...) (list (readline-patch version seqno (base32 hash)) diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.= scm index c2025c4fbe..da110bf8c6 100644 --- a/gnu/packages/virtualization.scm +++ b/gnu/packages/virtualization.scm @@ -104,14 +104,14 @@ #:use-module (srfi srfi-1) #:use-module (ice-9 match)) =20 -(define (qemu-patch commit file-name sha256) +(define (qemu-patch commit file-name sha256-bv) "Return an origin for COMMIT." (origin (method url-fetch) (uri (string-append "http://git.qemu.org/?p=3Dqemu.git;a=3Dcommitdiff_plain;h=3D" commit)) - (sha256 sha256) + (hash (content-hash sha256-bv sha256)) (file-name file-name))) =20 (define-public qemu diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 3809c3d074..0cfa1f8321 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -24,7 +24,7 @@ (define-module (guix import utils) #:use-module (guix base32) #:use-module ((guix build download) #:prefix build:) - #:use-module (gcrypt hash) + #:use-module ((gcrypt hash) #:hide (sha256)) #:use-module (guix http-client) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix utils) diff --git a/guix/packages.scm b/guix/packages.scm index c1c4805ae9..3d9988d836 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -35,6 +35,8 @@ #:use-module (guix build-system) #:use-module (guix search-paths) #:use-module (guix sets) + #:use-module (guix deprecation) + #:use-module (guix i18n) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module (ice-9 regex) @@ -44,16 +46,23 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (rnrs bytevectors) #:use-module (web uri) #:re-export (%current-system %current-target-system search-path-specification) ;for convenience - #:export (origin + #:export (content-hash + content-hash? + content-hash-algorithm + content-hash-value + + origin origin? this-origin origin-uri origin-method - origin-sha256 + origin-hash + origin-sha256 ;deprecated origin-file-name origin-actual-file-name origin-patches @@ -157,15 +166,79 @@ ;;; ;;; Code: =20 +;; Crytographic content hash. +(define-immutable-record-type + (%content-hash algorithm value) + content-hash? + (algorithm content-hash-algorithm) ;symbol + (value content-hash-value)) ;bytevector + +(define-syntax-rule (define-content-hash-constructor name + (algorithm size) ...) + "Define NAME as a constructor that ensures that (1) its +second argument is among the listed ALGORITHM, and (2), when possible, that +its first argument has the right size for the chosen algorithm." + (define-syntax name + (lambda (s) + (syntax-case s (algorithm ...) + ((_ bv algorithm) + (let ((bv* (syntax->datum #'bv))) + (when (and (bytevector? bv*) + (not (=3D size (bytevector-length bv*)))) + (syntax-violation 'content-hash "invalid content hash length"= s)) + #'(%content-hash 'algorithm bv))) + ...)))) + +(define-content-hash-constructor build-content-hash + (sha256 32) + (sha512 64)) + +(define-syntax content-hash + (lambda (s) + "Return a content hash with the given parameters. The default hash +algorithm is sha256. If the first argument is a literal string, it is dec= oded +as base32. Otherwise, it must be a bytevector." + ;; What we'd really want here is something like C++ 'constexpr'. + (syntax-case s () + ((_ str) + (string? (syntax->datum #'str)) + #'(content-hash str sha256)) + ((_ str algorithm) + (string? (syntax->datum #'str)) + (with-syntax ((bv (base32 (syntax->datum #'str)))) + #'(content-hash bv algorithm))) + ((_ (id str) algorithm) + (and (string? (syntax->datum #'str)) + (free-identifier=3D? #'id #'base32)) + (with-syntax ((bv (nix-base32-string->bytevector (syntax->datum #'s= tr)))) + #'(content-hash bv algorithm))) + ((_ (id str) algorithm) + (and (string? (syntax->datum #'str)) + (free-identifier=3D? #'id #'base64)) + (with-syntax ((bv (base64-decode (syntax->datum #'str)))) + #'(content-hash bv algorithm))) + ((_ bv) + #'(content-hash bv sha256)) + ((_ bv hash) + #'(build-content-hash bv hash))))) + +(define (print-content-hash hash port) + (format port "#" + (content-hash-algorithm hash) + (bytevector->nix-base32-string (content-hash-value hash)))) + +(set-record-type-printer! print-content-hash) + + ;; The source of a package, such as a tarball URL and fetcher---called ;; "origin" to avoid name clash with `package-source', `source', etc. (define-record-type* - origin make-origin + %origin make-origin origin? this-origin (uri origin-uri) ; string (method origin-method) ; procedure - (sha256 origin-sha256) ; bytevector + (hash origin-hash) ; (file-name origin-file-name (default #f)) ; optional file name =20 ;; Patches are delayed so that the 'search-patch' calls are made lazily, @@ -188,12 +261,37 @@ (patch-guile origin-patch-guile ; package or #f (default #f))) =20 +(define-syntax origin-compatibility-helper + (syntax-rules (sha256) + ((_ () (fields ...)) + (%origin fields ...)) + ((_ ((sha256 exp) rest ...) (others ...)) + (%origin others ... + (hash (content-hash exp sha256)) + rest ...)) + ((_ (field rest ...) (others ...)) + (origin-compatibility-helper (rest ...) + (others ... field))))) + +(define-syntax-rule (origin fields ...) + "Build an record, automatically converting 'sha256' field +specifications to 'hash'." + (origin-compatibility-helper (fields ...) ())) + +(define-deprecated (origin-sha256 origin) + origin-hash + (let ((hash (origin-hash origin))) + (unless (eq? (content-hash-algorithm hash) 'sha256) + (raise (condition (&message + (message (G_ "no SHA256 hash for origin")))))) + (content-hash-value hash))) + (define (print-origin origin port) "Write a concise representation of ORIGIN to PORT." (match origin - (($ uri method sha256 file-name patches) + (($ uri method hash file-name patches) (simple-format port "#" - uri (bytevector->base32-string sha256) + uri hash (force patches) (number->string (object-address origin) 16))))) =20 @@ -238,6 +336,7 @@ name of its URI." ;; git, svn, cvs, etc. reference #f)))) =20 + (define %supported-systems ;; This is the list of system types that are supported. By default, we ;; expect all packages to build successfully here. @@ -1388,14 +1487,19 @@ unless you know what you are doing." #:optional (system (%current-system))) "Return the derivation corresponding to ORIGIN." (match origin - (($ uri method sha256 name (=3D force ()) #f) + (($ uri method hash name (=3D force ()) #f) ;; No patches, no snippet: this is a fixed-output derivation. - (method uri 'sha256 sha256 name #:system system)) - (($ uri method sha256 name (=3D force (patches ...)) snippet + (method uri + (content-hash-algorithm hash) + (content-hash-value hash) + name #:system system)) + (($ uri method hash name (=3D force (patches ...)) snippet (flags ...) inputs (modules ...) guile-for-build) ;; Patches and/or a snippet. - (mlet %store-monad ((source (method uri 'sha256 sha256 name - #:system system)) + (mlet %store-monad ((source (method uri + (content-hash-algorithm hash) + (content-hash-value hash) + name #:system system)) (guile (package->derivation (or guile-for-build (default-guile)) system diff --git a/guix/tests.scm b/guix/tests.scm index 95a7d7c4b8..3ccf049a7d 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -26,7 +26,7 @@ #:use-module (guix monads) #:use-module ((guix utils) #:select (substitute-keyword-arguments)) #:use-module ((guix build utils) #:select (mkdir-p)) - #:use-module (gcrypt hash) + #:use-module ((gcrypt hash) #:hide (sha256)) #:use-module (guix build-system gnu) #:use-module (gnu packages base) #:use-module (gnu packages bootstrap) diff --git a/tests/packages.scm b/tests/packages.scm index c528d2080c..4935d4503e 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -29,7 +29,7 @@ #:renamer (lambda (name) (cond ((eq? name 'location) 'make-location) (else name)))) - #:use-module (gcrypt hash) + #:use-module ((gcrypt hash) #:hide (sha256)) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix grafts) @@ -51,6 +51,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (ice-9 vlist) #:use-module (ice-9 regex) @@ -497,6 +498,31 @@ (search-path %load-path "guix/base32.scm") get-bytevector-all))))) =20 +(test-equal "package-source-derivation, origin, sha512" + "hello" + (let* ((bash (search-bootstrap-binary "bash" (%current-system))) + (builder (add-text-to-store %store "my-fixed-builder.sh" + "echo -n hello > $out" '())) + (method (lambda* (url hash-algo hash #:optional name + #:rest rest) + (and (eq? hash-algo 'sha512) + (raw-derivation name bash (list builder) + #:sources (list builder) + #:hash hash + #:hash-algo hash-algo)))) + (source (origin + (method method) + (uri "unused://") + (file-name "origin-sha512") + (hash (content-hash + (bytevector-hash (string->utf8 "hello") + (hash-algorithm sha512)) + sha512)))) + (drv (package-source-derivation %store source)) + (output (derivation->output-path drv))) + (build-derivations %store (list drv)) + (call-with-input-file output get-string-all))) + (unless (network-reachable?) (test-skip 1)) (test-equal "package-source-derivation, snippet" "OK" --=20 2.26.2 --=-=-=--