From: "Ludovic Courtès" <ludo@gnu.org>
To: 41382@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#41382] [PATCH 5/6] packages: Add 'sha512' optional field to <origin>.
Date: Mon, 18 May 2020 23:32:43 +0200 [thread overview]
Message-ID: <20200518213244.24165-5-ludo@gnu.org> (raw)
In-Reply-To: <20200518213244.24165-1-ludo@gnu.org>
* guix/packages.scm (<origin>)[sha512]: New field.
(print-origin): Honor it.
(origin->derivation): Likewise.
* tests/packages.scm ("package-source-derivation, origin, sha512"): New
test.
* doc/guix.texi (origin Reference): Document 'sha512'.
---
doc/guix.texi | 8 +++++++-
guix/packages.scm | 25 ++++++++++++++-----------
tests/packages.scm | 26 ++++++++++++++++++++++++++
3 files changed, 47 insertions(+), 12 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index fdd9622211..50d7eb7a43 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5966,10 +5966,16 @@ specified in the @code{uri} field as a @code{git-reference} object; a
@end table
@item @code{sha256}
-A bytevector containing the SHA-256 hash of the source. Typically the
+@itemx @code{sha512}
+A bytevector containing the SHA-256 (respectively SHA-512) hash of the source. Typically the
@code{base32} form is used here to generate the bytevector from a
base-32 string.
+One of these fields must be a bytevector while the others can be
+@code{#f}. When several hashes are provided, the ``strongest'' is used
+when computing the underlying fixed-output derivation
+(@pxref{Derivations}).
+
You can obtain this information using @code{guix download}
(@pxref{Invoking guix download}) or @code{guix hash} (@pxref{Invoking
guix hash}).
diff --git a/guix/packages.scm b/guix/packages.scm
index 3fff50a6e8..7cf4c9c3e6 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -164,6 +164,7 @@
(uri origin-uri) ; string
(method origin-method) ; procedure
(sha256 origin-sha256) ; bytevector
+ (sha512 origin-sha512 (default #f)) ; bytevector | #f
(file-name origin-file-name (default #f)) ; optional file name
;; Patches are delayed so that the 'search-patch' calls are made lazily,
@@ -189,9 +190,9 @@
(define (print-origin origin port)
"Write a concise representation of ORIGIN to PORT."
(match origin
- (($ <origin> uri method sha256 file-name patches)
+ (($ <origin> uri method sha256 sha512 file-name patches)
(simple-format port "#<origin ~s ~a ~s ~a>"
- uri (bytevector->base32-string sha256)
+ uri (bytevector->base32-string (or sha512 sha256))
(force patches)
(number->string (object-address origin) 16)))))
@@ -1381,18 +1382,20 @@ unless you know what you are doing."
#:optional (system (%current-system)))
"Return the derivation corresponding to ORIGIN."
(match origin
- (($ <origin> uri method sha256 name (= force ()) #f)
+ (($ <origin> uri method sha256 sha512 name (= force ()) #f)
;; No patches, no snippet: this is a fixed-output derivation.
- (method uri 'sha256 sha256 name #:system system))
- (($ <origin> uri method sha256 name (= force (patches ...)) snippet
+ (let ((algorithm (if sha512 'sha512 'sha256)))
+ (method uri algorithm (or sha512 sha256) name #:system system)))
+ (($ <origin> uri method sha256 sha512 name (= 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))
- (guile (package->derivation (or guile-for-build
- (default-guile))
- system
- #:graft? #f)))
+ (mlet* %store-monad ((algorithm -> (if sha512 'sha512 'sha256))
+ (source (method uri algorithm (or sha512 sha256)
+ name #:system system))
+ (guile (package->derivation (or guile-for-build
+ (default-guile))
+ system
+ #:graft? #f)))
(patch-and-repack source patches
#:inputs inputs
#:snippet snippet
diff --git a/tests/packages.scm b/tests/packages.scm
index c528d2080c..06d41b5ce7 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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)))))
+(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")
+ (sha256 (bytevector-hash (string->utf8 "hello")
+ (hash-algorithm sha256)))
+ (sha512 (bytevector-hash (string->utf8 "hello")
+ (hash-algorithm 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"
--
2.26.2
next prev parent reply other threads:[~2020-05-18 21:35 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-05-18 21:31 [bug#41382] [PATCH 0/6] Allow for a cryptographic hash function migration Ludovic Courtès
2020-05-18 21:32 ` [bug#41382] [PATCH 1/6] tests: Test 'add-to-store' with several hash algorithms Ludovic Courtès
2020-05-18 21:32 ` [bug#41382] [PATCH 2/6] tests: Test fixed-output derivations " Ludovic Courtès
2020-05-18 21:32 ` [bug#41382] [PATCH 3/6] guix hash, guix download: Add '--hash' Ludovic Courtès
2020-05-18 21:32 ` [bug#41382] [PATCH 4/6] guix hash, guix download: Support base64 format Ludovic Courtès
2020-05-18 21:32 ` Ludovic Courtès [this message]
2020-05-18 21:32 ` [bug#41382] [PATCH 6/6] packages: Add 'base64' macro Ludovic Courtès
2020-05-19 14:42 ` [bug#41382] [PATCH 0/6] Allow for a cryptographic hash function migration Ludovic Courtès
2020-05-19 18:00 ` Marius Bakke
2020-05-19 18:20 ` Leo Famulari
2020-05-21 20:46 ` Ludovic Courtès
2020-05-21 23:43 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20200518213244.24165-5-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=41382@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.