[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
08/11: packages: Introduce <content-hash> and use it in <origin>.
|
From: |
guix-commits |
|
Subject: |
08/11: packages: Introduce <content-hash> and use it in <origin>. |
|
Date: |
Thu, 21 May 2020 19:39:20 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit ce0be5675b702b2ff89aed1772ebb42af4150243
Author: Ludovic Courtès <address@hidden>
AuthorDate: Tue May 19 15:55:08 2020 +0200
packages: Introduce <content-hash> and use it in <origin>.
* guix/packages.scm (<content-hash>): New record type.
(define-content-hash-constructor, build-content-hash)
(content-hash): New macros.
(print-content-hash): New procedure.
(<origin>): 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.
* tests/challenge.scm: Add #:prefix for (gcrypt hash) and adjust users.
* tests/derivations.scm: Likewise.
* tests/store.scm: Likewise.
* tests/graph.scm ("bag DAG, including origins"): Provide 'sha256' field
with the right length.
* 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/challenge.scm | 6 +-
tests/derivations.scm | 32 +++++-----
tests/graph.scm | 6 +-
tests/packages.scm | 28 ++++++++-
tests/store.scm | 8 +--
14 files changed, 220 insertions(+), 58 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 01dab5b..c1e23b5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5966,9 +5966,13 @@ 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
-@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}.
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
+@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=")
+ 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
@node Build Systems
@section Build Systems
diff --git a/gnu/packages/aspell.scm b/gnu/packages/aspell.scm
index 7550736..22256f7 100644
--- a/gnu/packages/aspell.scm
+++ b/gnu/packages/aspell.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès
<address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès
<address@hidden>
;;; Copyright © 2015, 2016 Alex Kost <address@hidden>
;;; Copyright © 2016 John Darrington <address@hidden>
;;; Copyright © 2016, 2017, 2019 Efraim Flashner <address@hidden>
@@ -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/aspell/";
version "/aspell6-ca-" version ".tar.bz2"))
- (sha256 sha256)))
+ (hash (content-hash sha256))))
(home-page "https://www.softcatala.org/pub/softcatala/aspell/";))))
(define-public aspell-dict-de
@@ -264,7 +264,7 @@ dictionaries, including personal ones.")
(uri (string-append "mirror://sourceforge/linguistico/"
"Dizionario%20italiano%20per%20Aspell/" version
"/"
"aspell6-it-" version ".tar.bz2"))
- (sha256 sha256)))
+ (hash (content-hash sha256))))
(home-page
"http://linguistico.sourceforge.net/pages/dizionario_italiano.html";))))
diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm
index 1b34282..311e07a 100644
--- a/gnu/packages/bash.scm
+++ b/gnu/packages/bash.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès
<address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès
<address@hidden>
;;; Copyright © 2014, 2015, 2018 Mark H Weaver <address@hidden>
;;; Copyright © 2015, 2017 Leo Famulari <address@hidden>
;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <address@hidden>
@@ -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))
-(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)))
(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 f58ce2d..a3ecb6e 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès
<address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic
Courtès <address@hidden>
;;; Copyright © 2014, 2015, 2018, 2019 Mark H Weaver <address@hidden>
;;; Copyright © 2017, 2020 Efraim Flashner <address@hidden>
;;; Copyright © 2018, 2020 Jan (janneke) Nieuwenhuizen <address@hidden>
@@ -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))))))))
;;;
diff --git a/gnu/packages/readline.scm b/gnu/packages/readline.scm
index 5f61dcb..8a36883 100644
--- a/gnu/packages/readline.scm
+++ b/gnu/packages/readline.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <address@hidden>
;;; Copyright © 2016, 2019 Efraim Flashner <address@hidden>
;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
;;; Copyright © 2018 Tobias Geerinckx-Rice <address@hidden>
@@ -35,12 +35,12 @@
(format #f "mirror://gnu/readline/readline-~a-patches/readline~a-~3,'0d"
version (string-join (string-split version #\.) "") seqno))
-(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)))
(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 e0b9a21..32113a0 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))
-(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=qemu.git;a=commitdiff_plain;h=";
commit))
- (sha256 sha256)
+ (hash (content-hash sha256-bv sha256))
(file-name file-name)))
(define-public qemu
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 3809c3d..0cfa1f8 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 c1c4805..3d9988d 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:
+;; Crytographic content hash.
+(define-immutable-record-type <content-hash>
+ (%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 <content-hash> 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 (= 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 decoded
+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=? #'id #'base32))
+ (with-syntax ((bv (nix-base32-string->bytevector (syntax->datum
#'str))))
+ #'(content-hash bv algorithm)))
+ ((_ (id str) algorithm)
+ (and (string? (syntax->datum #'str))
+ (free-identifier=? #'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 ~a:~a>"
+ (content-hash-algorithm hash)
+ (bytevector->nix-base32-string (content-hash-value hash))))
+
+(set-record-type-printer! <content-hash> 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>
- origin make-origin
+ %origin make-origin
origin?
this-origin
(uri origin-uri) ; string
(method origin-method) ; procedure
- (sha256 origin-sha256) ; bytevector
+ (hash origin-hash) ; <content-hash>
(file-name origin-file-name (default #f)) ; optional file name
;; 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)))
+(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 <origin> 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
- (($ <origin> uri method sha256 file-name patches)
+ (($ <origin> uri method hash file-name patches)
(simple-format port "#<origin ~s ~a ~s ~a>"
- uri (bytevector->base32-string sha256)
+ uri hash
(force patches)
(number->string (object-address origin) 16)))))
@@ -238,6 +336,7 @@ name of its URI."
;; git, svn, cvs, etc. reference
#f))))
+
(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
- (($ <origin> uri method sha256 name (= force ()) #f)
+ (($ <origin> uri method hash 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
+ (method uri
+ (content-hash-algorithm hash)
+ (content-hash-value hash)
+ name #:system system))
+ (($ <origin> uri method hash 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))
+ (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 95a7d7c..3ccf049 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/challenge.scm b/tests/challenge.scm
index bb5633a..9c6d6e0 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,7 +19,7 @@
(define-module (test-challenge)
#:use-module (guix tests)
#:use-module (guix tests http)
- #:use-module (gcrypt hash)
+ #:use-module ((gcrypt hash) #:prefix gcrypt:)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix derivations)
@@ -135,7 +135,7 @@
(mlet* %store-monad ((drv (gexp->derivation "something"
#~(list #$output #$text)))
(out -> (derivation->output-path drv))
- (hash -> (sha256 #vu8())))
+ (hash -> (gcrypt:sha256 #vu8())))
(with-derivation-narinfo* drv (sha256 => hash)
(>>= (compare-contents (list out) (%test-substitute-urls))
(match-lambda
diff --git a/tests/derivations.scm b/tests/derivations.scm
index a409fa9..9f1104a 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -23,7 +23,7 @@
#:use-module (guix grafts)
#:use-module (guix store)
#:use-module (guix utils)
- #:use-module (gcrypt hash)
+ #:use-module ((gcrypt hash) #:prefix gcrypt:)
#:use-module (guix base32)
#:use-module (guix tests)
#:use-module (guix tests http)
@@ -215,7 +215,7 @@
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
- #:hash (sha256 (string->utf8 text)))))
+ #:hash (gcrypt:sha256 (string->utf8 text)))))
(and (build-derivations %store (list drv))
(string=? (call-with-input-file (derivation->output-path drv)
get-string-all)
@@ -230,7 +230,7 @@
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
- #:hash (sha256 (random-bytevector 100))))) ;wrong
+ #:hash (gcrypt:sha256 (random-bytevector 100)))))
;wrong
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
@@ -245,7 +245,7 @@
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
- #:hash (sha256 (random-bytevector 100)))))
+ #:hash (gcrypt:sha256 (random-bytevector 100)))))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message (pk c))
"failed")))
(build-derivations %store (list drv))
@@ -273,7 +273,7 @@
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
- #:hash (sha256 (string->utf8 text)))))
+ #:hash (gcrypt:sha256 (string->utf8 text)))))
(and (with-http-server `((200 ,text))
(build-derivations %store (list drv)))
(with-http-server `((200 ,text))
@@ -317,7 +317,7 @@
(test-assert "fixed-output-derivation?"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed"
%bash `(,builder)
#:sources (list builder)
@@ -329,10 +329,10 @@
(map (lambda (hash-algorithm)
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '()))
- (sha256 (sha256 (string->utf8 "hello")))
- (hash (bytevector-hash
+ (sha256 (gcrypt:sha256 (string->utf8 "hello")))
+ (hash (gcrypt:bytevector-hash
(string->utf8 "hello")
- (lookup-hash-algorithm hash-algorithm)))
+ (gcrypt:lookup-hash-algorithm hash-algorithm)))
(drv (derivation %store
(string-append
"fixed-" (symbol->string hash-algorithm))
@@ -353,7 +353,7 @@
"echo -n hello > $out" '()))
(builder2 (add-text-to-store %store "fixed-builder2.sh"
"echo hey; echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(drv1 (derivation %store "fixed"
%bash `(,builder1)
#:hash hash #:hash-algo 'sha256))
@@ -368,7 +368,7 @@
(test-assert "fixed-output derivation, recursive"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed-rec"
%bash `(,builder)
#:sources (list builder)
@@ -390,7 +390,7 @@
"echo -n hello > $out" '()))
(builder2 (add-text-to-store %store "fixed-builder2.sh"
"echo hey; echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(fixed1 (derivation %store "fixed"
%bash `(,builder1)
#:hash hash #:hash-algo 'sha256))
@@ -427,7 +427,7 @@
"echo -n hello > $out" '()))
(builder2 (add-text-to-store %store "fixed-builder2.sh"
"echo hey; echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(fixed1 (derivation %store "fixed"
%bash `(,builder1)
#:hash hash #:hash-algo 'sha256))
@@ -680,7 +680,7 @@
(let* ((value (getenv "GUIX_STATE_DIRECTORY"))
(drv (derivation %store "leaked-env-vars" %bash
'("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
- #:hash (sha256 (string->utf8 value))
+ #:hash (gcrypt:sha256 (string->utf8 value))
#:hash-algo 'sha256
#:sources (list %bash)
#:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
@@ -1106,7 +1106,7 @@
(builder2 '(call-with-output-file (pk 'difference-here! %output)
(lambda (p)
(write "hello" p))))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(input1 (build-expression->derivation %store "fixed" builder1
#:hash hash
#:hash-algo 'sha256))
@@ -1127,7 +1127,7 @@
(builder2 '(call-with-output-file (pk 'difference-here! %output)
(lambda (p)
(write "hello" p))))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(input1 (build-expression->derivation %store "fixed" builder1
#:hash hash
#:hash-algo 'sha256))
diff --git a/tests/graph.scm b/tests/graph.scm
index 136260c..0663d13 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -162,7 +162,11 @@ edges."
(let-values (((backend nodes+edges) (make-recording-backend)))
(let* ((m (lambda* (uri hash-type hash name #:key system)
(text-file "foo-1.2.3.tar.gz" "This is a fake!")))
- (o (origin (method m) (uri "the-uri") (sha256 #vu8(0 1 2))))
+ (o (origin
+ (method m) (uri "the-uri")
+ (sha256
+ (base32
+ "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))))
(p (dummy-package "p" (source o))))
(run-with-store %store
(export-graph (list p) 'port
diff --git a/tests/packages.scm b/tests/packages.scm
index c528d20..4935d45 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)))))
+(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"
diff --git a/tests/store.scm b/tests/store.scm
index f007846..06f7939 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -22,7 +22,7 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix monads)
- #:use-module (gcrypt hash)
+ #:use-module ((gcrypt hash) #:prefix gcrypt:)
#:use-module (guix base32)
#:use-module (guix packages)
#:use-module (guix derivations)
@@ -321,7 +321,7 @@
#:env-vars `(("t2" . ,t2))))
(o (derivation->output-path d)))
(with-derivation-narinfo d
- (sha256 => (sha256 (string->utf8 t2)))
+ (sha256 => (gcrypt:sha256 (string->utf8 t2)))
(references => (list t2))
(equal? (references/substitutes s (list o t3 t2 t1))
@@ -940,7 +940,7 @@
(foldm %store-monad
(lambda (item result)
(define ref-hash
- (let-values (((port get) (open-sha256-port)))
+ (let-values (((port get) (gcrypt:open-sha256-port)))
(write-file item port)
(close-port port)
(get)))
@@ -1144,7 +1144,7 @@
(info (query-path-info %store item)))
(and (equal? (path-info-references info) (list ref))
(equal? (path-info-hash info)
- (sha256
+ (gcrypt:sha256
(string->utf8
(call-with-output-string (cut write-file item <>))))))))
- branch master updated (1ce1583 -> ef1d475), guix-commits, 2020/05/21
- 01/11: doc: Use "Alternatively" instead of "Alternately"., guix-commits, 2020/05/21
- 05/11: guix hash, guix download: Add '--hash'., guix-commits, 2020/05/21
- 06/11: guix hash, guix download: Support base64 format., guix-commits, 2020/05/21
- 07/11: packages: Add 'base64' macro., guix-commits, 2020/05/21
- 08/11: packages: Introduce <content-hash> and use it in <origin>.,
guix-commits <=
- 09/11: lint: archival: Use 'origin-hash'., guix-commits, 2020/05/21
- 02/11: maint: Add "make check-channel-news"., guix-commits, 2020/05/21
- 03/11: tests: Test 'add-to-store' with several hash algorithms., guix-commits, 2020/05/21
- 10/11: upstream: Use 'origin-hash'., guix-commits, 2020/05/21
- 04/11: tests: Test fixed-output derivations with several hash algorithms., guix-commits, 2020/05/21
- 11/11: gnu: llvm: Remove unused 'package-elisp-from-package' procedure., guix-commits, 2020/05/21