From ce0be5675b702b2ff89aed1772ebb42af4150243 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 19 May 2020 15:55:08 +0200 Subject: 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. * 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 01dab5b72c..c1e23b5ef3 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 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 © 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2015, 2016 Alex Kost ;;; Copyright © 2016 John Darrington ;;; Copyright © 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/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 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 © 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès ;;; Copyright © 2014, 2015, 2018 Mark H Weaver ;;; Copyright © 2015, 2017 Leo Famulari ;;; Copyright © 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)) -(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 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 © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2014, 2015, 2018, 2019 Mark H Weaver ;;; Copyright © 2017, 2020 Efraim Flashner ;;; Copyright © 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)))))))) ;;; 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 © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès ;;; Copyright © 2016, 2019 Efraim Flashner ;;; Copyright © 2016 Jan Nieuwenhuizen ;;; Copyright © 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)) -(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 e0b9a21e72..32113a0f2c 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 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: +;; 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 (= 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-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 ;; 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 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))))) @@ -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 - (($ uri method sha256 name (= force ()) #f) + (($ uri method hash name (= force ()) #f) ;; No patches, no snippet: this is a fixed-output derivation. - (method uri 'sha256 sha256 name #:system system)) - (($ uri method sha256 name (= force (patches ...)) snippet + (method uri + (content-hash-algorithm hash) + (content-hash-value hash) + name #:system system)) + (($ 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 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/challenge.scm b/tests/challenge.scm index bb5633a3eb..9c6d6e0d58 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 +;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès ;;; ;;; 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 a409fa99f0..9f1104a887 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 136260c7d1..0663d13b49 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 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))))) +(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 f007846dc1..06f7939657 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 <>)))))))) -- cgit v1.2.3