diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-05-19 15:55:08 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-05-22 01:29:39 +0200 |
commit | ce0be5675b702b2ff89aed1772ebb42af4150243 (patch) | |
tree | ec275112c97e9450ed9c4a8d30e7c153a7c10786 /guix | |
parent | 56f7ca6e7c8b5eadeee48b00bcbd78f9fa9e5f43 (diff) | |
download | patches-ce0be5675b702b2ff89aed1772ebb42af4150243.tar patches-ce0be5675b702b2ff89aed1772ebb42af4150243.tar.gz |
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'.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/import/utils.scm | 2 | ||||
-rw-r--r-- | guix/packages.scm | 126 | ||||
-rw-r--r-- | guix/tests.scm | 2 |
3 files changed, 117 insertions, 13 deletions
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> + (%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 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) |