From ce0be5675b702b2ff89aed1772ebb42af4150243 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès 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'. --- guix/import/utils.scm | 2 +- guix/packages.scm | 126 +++++++++++++++++++++++++++++++++++++++++++++----- guix/tests.scm | 2 +- 3 files changed, 117 insertions(+), 13 deletions(-) (limited to 'guix') 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) -- cgit v1.2.3