diff options
| -rw-r--r-- | doc/guix.texi | 34 | ||||
| -rw-r--r-- | gnu/packages/aspell.scm | 8 | ||||
| -rw-r--r-- | gnu/packages/bash.scm | 8 | ||||
| -rw-r--r-- | gnu/packages/bootstrap.scm | 6 | ||||
| -rw-r--r-- | gnu/packages/readline.scm | 8 | ||||
| -rw-r--r-- | gnu/packages/virtualization.scm | 4 | ||||
| -rw-r--r-- | guix/import/utils.scm | 2 | ||||
| -rw-r--r-- | guix/packages.scm | 126 | ||||
| -rw-r--r-- | guix/tests.scm | 2 | ||||
| -rw-r--r-- | tests/challenge.scm | 6 | ||||
| -rw-r--r-- | tests/derivations.scm | 32 | ||||
| -rw-r--r-- | tests/graph.scm | 6 | ||||
| -rw-r--r-- | tests/packages.scm | 28 | ||||
| -rw-r--r-- | tests/store.scm | 8 |
14 files changed, 220 insertions, 58 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 01dab5b72c3..c1e23b5ef3b 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 | |||
| 5966 | @end table | 5966 | @end table |
| 5967 | 5967 | ||
| 5968 | @item @code{sha256} | 5968 | @item @code{sha256} |
| 5969 | A bytevector containing the SHA-256 hash of the source. Typically the | 5969 | A bytevector containing the SHA-256 hash of the source. This is |
| 5970 | @code{base32} form is used here to generate the bytevector from a | 5970 | equivalent to providing a @code{content-hash} SHA256 object in the |
| 5971 | base-32 string. | 5971 | @code{hash} field described below. |
| 5972 | |||
| 5973 | @item @code{hash} | ||
| 5974 | The @code{content-hash} object of the source---see below for how to use | ||
| 5975 | @code{content-hash}. | ||
| 5972 | 5976 | ||
| 5973 | You can obtain this information using @code{guix download} | 5977 | You can obtain this information using @code{guix download} |
| 5974 | (@pxref{Invoking guix download}) or @code{guix hash} (@pxref{Invoking | 5978 | (@pxref{Invoking guix download}) or @code{guix hash} (@pxref{Invoking |
| @@ -6013,6 +6017,30 @@ this is @code{#f}, a sensible default is used. | |||
| 6013 | @end table | 6017 | @end table |
| 6014 | @end deftp | 6018 | @end deftp |
| 6015 | 6019 | ||
| 6020 | @deftp {Data Type} content-hash @var{value} [@var{algorithm}] | ||
| 6021 | Construct a content hash object for the given @var{algorithm}, and with | ||
| 6022 | @var{value} as its hash value. When @var{algorithm} is omitted, assume | ||
| 6023 | it is @code{sha256}. | ||
| 6024 | |||
| 6025 | @var{value} can be a literal string, in which case it is base32-decoded, | ||
| 6026 | or it can be a bytevector. | ||
| 6027 | |||
| 6028 | The following forms are all equivalent: | ||
| 6029 | |||
| 6030 | @lisp | ||
| 6031 | (content-hash "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj") | ||
| 6032 | (content-hash "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj" | ||
| 6033 | sha256) | ||
| 6034 | (content-hash (base32 | ||
| 6035 | "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj")) | ||
| 6036 | (content-hash (base64 "kkb+RPaP7uyMZmu4eXPVkM4BN8yhRd8BTHLslb6f/Rc=") | ||
| 6037 | sha256) | ||
| 6038 | @end lisp | ||
| 6039 | |||
| 6040 | Technically, @code{content-hash} is currently implemented as a macro. | ||
| 6041 | It performs sanity checks at macro-expansion time, when possible, such | ||
| 6042 | as ensuring that @var{value} has the right size for @var{algorithm}. | ||
| 6043 | @end deftp | ||
| 6016 | 6044 | ||
| 6017 | @node Build Systems | 6045 | @node Build Systems |
| 6018 | @section Build Systems | 6046 | @section Build Systems |
diff --git a/gnu/packages/aspell.scm b/gnu/packages/aspell.scm index 7550736c404..22256f750b6 100644 --- a/gnu/packages/aspell.scm +++ b/gnu/packages/aspell.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> | 3 | ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> |
| 4 | ;;; Copyright © 2016 John Darrington <jmd@gnu.org> | 4 | ;;; Copyright © 2016 John Darrington <jmd@gnu.org> |
| 5 | ;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il> | 5 | ;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il> |
| @@ -111,7 +111,7 @@ dictionaries, including personal ones.") | |||
| 111 | (uri (string-append "mirror://gnu/aspell/dict/" dict-name | 111 | (uri (string-append "mirror://gnu/aspell/dict/" dict-name |
| 112 | "/" prefix dict-name "-" | 112 | "/" prefix dict-name "-" |
| 113 | version ".tar.bz2")) | 113 | version ".tar.bz2")) |
| 114 | (sha256 sha256))) | 114 | (hash (content-hash sha256)))) |
| 115 | (build-system gnu-build-system) | 115 | (build-system gnu-build-system) |
| 116 | (arguments | 116 | (arguments |
| 117 | `(#:phases | 117 | `(#:phases |
| @@ -163,7 +163,7 @@ dictionaries, including personal ones.") | |||
| 163 | (method url-fetch) | 163 | (method url-fetch) |
| 164 | (uri (string-append "https://www.softcatala.org/pub/softcatala/aspell/" | 164 | (uri (string-append "https://www.softcatala.org/pub/softcatala/aspell/" |
| 165 | version "/aspell6-ca-" version ".tar.bz2")) | 165 | version "/aspell6-ca-" version ".tar.bz2")) |
| 166 | (sha256 sha256))) | 166 | (hash (content-hash sha256)))) |
| 167 | (home-page "https://www.softcatala.org/pub/softcatala/aspell/")))) | 167 | (home-page "https://www.softcatala.org/pub/softcatala/aspell/")))) |
| 168 | 168 | ||
| 169 | (define-public aspell-dict-de | 169 | (define-public aspell-dict-de |
| @@ -264,7 +264,7 @@ dictionaries, including personal ones.") | |||
| 264 | (uri (string-append "mirror://sourceforge/linguistico/" | 264 | (uri (string-append "mirror://sourceforge/linguistico/" |
| 265 | "Dizionario%20italiano%20per%20Aspell/" version "/" | 265 | "Dizionario%20italiano%20per%20Aspell/" version "/" |
| 266 | "aspell6-it-" version ".tar.bz2")) | 266 | "aspell6-it-" version ".tar.bz2")) |
| 267 | (sha256 sha256))) | 267 | (hash (content-hash sha256)))) |
| 268 | (home-page | 268 | (home-page |
| 269 | "http://linguistico.sourceforge.net/pages/dizionario_italiano.html")))) | 269 | "http://linguistico.sourceforge.net/pages/dizionario_italiano.html")))) |
| 270 | 270 | ||
diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm index 1b342827c54..311e07a9446 100644 --- a/gnu/packages/bash.scm +++ b/gnu/packages/bash.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org> | 3 | ;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org> |
| 4 | ;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name> | 4 | ;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name> |
| 5 | ;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il> | 5 | ;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il> |
| @@ -48,12 +48,12 @@ | |||
| 48 | "Return the URL of Bash patch number SEQNO." | 48 | "Return the URL of Bash patch number SEQNO." |
| 49 | (format #f "mirror://gnu/bash/bash-5.0-patches/bash50-~3,'0d" seqno)) | 49 | (format #f "mirror://gnu/bash/bash-5.0-patches/bash50-~3,'0d" seqno)) |
| 50 | 50 | ||
| 51 | (define (bash-patch seqno sha256) | 51 | (define (bash-patch seqno sha256-bv) |
| 52 | "Return the origin of Bash patch SEQNO, with expected hash SHA256" | 52 | "Return the origin of Bash patch SEQNO, with expected hash SHA256-BV." |
| 53 | (origin | 53 | (origin |
| 54 | (method url-fetch) | 54 | (method url-fetch) |
| 55 | (uri (patch-url seqno)) | 55 | (uri (patch-url seqno)) |
| 56 | (sha256 sha256))) | 56 | (sha256 sha256-bv))) |
| 57 | 57 | ||
| 58 | (define-syntax-rule (patch-series (seqno hash) ...) | 58 | (define-syntax-rule (patch-series (seqno hash) ...) |
| 59 | (list (bash-patch seqno (base32 hash)) | 59 | (list (bash-patch seqno (base32 hash)) |
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index f58ce2de93b..a3ecb6e6928 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2014, 2015, 2018, 2019 Mark H Weaver <mhw@netris.org> | 3 | ;;; Copyright © 2014, 2015, 2018, 2019 Mark H Weaver <mhw@netris.org> |
| 4 | ;;; Copyright © 2017, 2020 Efraim Flashner <efraim@flashner.co.il> | 4 | ;;; Copyright © 2017, 2020 Efraim Flashner <efraim@flashner.co.il> |
| 5 | ;;; Copyright © 2018, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 5 | ;;; Copyright © 2018, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> |
| @@ -151,14 +151,14 @@ built for SYSTEM." | |||
| 151 | (format #f (G_ "could not find bootstrap binary '~a' \ | 151 | (format #f (G_ "could not find bootstrap binary '~a' \ |
| 152 | for system '~a'") | 152 | for system '~a'") |
| 153 | program system)))))) | 153 | program system)))))) |
| 154 | ((sha256) | 154 | ((bv) |
| 155 | (origin | 155 | (origin |
| 156 | (method url-fetch/executable) | 156 | (method url-fetch/executable) |
| 157 | (uri (map (cute string-append <> | 157 | (uri (map (cute string-append <> |
| 158 | (bootstrap-executable-file-name system program)) | 158 | (bootstrap-executable-file-name system program)) |
| 159 | %bootstrap-executable-base-urls)) | 159 | %bootstrap-executable-base-urls)) |
| 160 | (file-name program) | 160 | (file-name program) |
| 161 | (sha256 sha256))))))) | 161 | (hash (content-hash bv sha256)))))))) |
| 162 | 162 | ||
| 163 | 163 | ||
| 164 | ;;; | 164 | ;;; |
diff --git a/gnu/packages/readline.scm b/gnu/packages/readline.scm index 5f61dcb7357..8a368833474 100644 --- a/gnu/packages/readline.scm +++ b/gnu/packages/readline.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il> | 3 | ;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il> |
| 4 | ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> | 4 | ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> |
| 5 | ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> | 5 | ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> |
| @@ -35,12 +35,12 @@ | |||
| 35 | (format #f "mirror://gnu/readline/readline-~a-patches/readline~a-~3,'0d" | 35 | (format #f "mirror://gnu/readline/readline-~a-patches/readline~a-~3,'0d" |
| 36 | version (string-join (string-split version #\.) "") seqno)) | 36 | version (string-join (string-split version #\.) "") seqno)) |
| 37 | 37 | ||
| 38 | (define (readline-patch version seqno sha256) | 38 | (define (readline-patch version seqno sha256-bv) |
| 39 | "Return the origin of Readline patch SEQNO, with expected hash SHA256" | 39 | "Return the origin of Readline patch SEQNO, with expected hash SHA256-BV" |
| 40 | (origin | 40 | (origin |
| 41 | (method url-fetch) | 41 | (method url-fetch) |
| 42 | (uri (patch-url version seqno)) | 42 | (uri (patch-url version seqno)) |
| 43 | (sha256 sha256))) | 43 | (sha256 sha256-bv))) |
| 44 | 44 | ||
| 45 | (define-syntax-rule (patch-series version (seqno hash) ...) | 45 | (define-syntax-rule (patch-series version (seqno hash) ...) |
| 46 | (list (readline-patch version seqno (base32 hash)) | 46 | (list (readline-patch version seqno (base32 hash)) |
diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.scm index e0b9a21e72c..32113a0f2c3 100644 --- a/gnu/packages/virtualization.scm +++ b/gnu/packages/virtualization.scm | |||
| @@ -104,14 +104,14 @@ | |||
| 104 | #:use-module (srfi srfi-1) | 104 | #:use-module (srfi srfi-1) |
| 105 | #:use-module (ice-9 match)) | 105 | #:use-module (ice-9 match)) |
| 106 | 106 | ||
| 107 | (define (qemu-patch commit file-name sha256) | 107 | (define (qemu-patch commit file-name sha256-bv) |
| 108 | "Return an origin for COMMIT." | 108 | "Return an origin for COMMIT." |
| 109 | (origin | 109 | (origin |
| 110 | (method url-fetch) | 110 | (method url-fetch) |
| 111 | (uri (string-append | 111 | (uri (string-append |
| 112 | "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h=" | 112 | "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h=" |
| 113 | commit)) | 113 | commit)) |
| 114 | (sha256 sha256) | 114 | (hash (content-hash sha256-bv sha256)) |
| 115 | (file-name file-name))) | 115 | (file-name file-name))) |
| 116 | 116 | ||
| 117 | (define-public qemu | 117 | (define-public qemu |
diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 3809c3d0744..0cfa1f83219 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm | |||
| @@ -24,7 +24,7 @@ | |||
| 24 | (define-module (guix import utils) | 24 | (define-module (guix import utils) |
| 25 | #:use-module (guix base32) | 25 | #:use-module (guix base32) |
| 26 | #:use-module ((guix build download) #:prefix build:) | 26 | #:use-module ((guix build download) #:prefix build:) |
| 27 | #:use-module (gcrypt hash) | 27 | #:use-module ((gcrypt hash) #:hide (sha256)) |
| 28 | #:use-module (guix http-client) | 28 | #:use-module (guix http-client) |
| 29 | #:use-module ((guix licenses) #:prefix license:) | 29 | #:use-module ((guix licenses) #:prefix license:) |
| 30 | #:use-module (guix utils) | 30 | #:use-module (guix utils) |
diff --git a/guix/packages.scm b/guix/packages.scm index c1c4805ae9d..3d9988d8368 100644 --- a/guix/packages.scm +++ b/guix/packages.scm | |||
| @@ -35,6 +35,8 @@ | |||
| 35 | #:use-module (guix build-system) | 35 | #:use-module (guix build-system) |
| 36 | #:use-module (guix search-paths) | 36 | #:use-module (guix search-paths) |
| 37 | #:use-module (guix sets) | 37 | #:use-module (guix sets) |
| 38 | #:use-module (guix deprecation) | ||
| 39 | #:use-module (guix i18n) | ||
| 38 | #:use-module (ice-9 match) | 40 | #:use-module (ice-9 match) |
| 39 | #:use-module (ice-9 vlist) | 41 | #:use-module (ice-9 vlist) |
| 40 | #:use-module (ice-9 regex) | 42 | #:use-module (ice-9 regex) |
| @@ -44,16 +46,23 @@ | |||
| 44 | #:use-module (srfi srfi-26) | 46 | #:use-module (srfi srfi-26) |
| 45 | #:use-module (srfi srfi-34) | 47 | #:use-module (srfi srfi-34) |
| 46 | #:use-module (srfi srfi-35) | 48 | #:use-module (srfi srfi-35) |
| 49 | #:use-module (rnrs bytevectors) | ||
| 47 | #:use-module (web uri) | 50 | #:use-module (web uri) |
| 48 | #:re-export (%current-system | 51 | #:re-export (%current-system |
| 49 | %current-target-system | 52 | %current-target-system |
| 50 | search-path-specification) ;for convenience | 53 | search-path-specification) ;for convenience |
| 51 | #:export (origin | 54 | #:export (content-hash |
| 55 | content-hash? | ||
| 56 | content-hash-algorithm | ||
| 57 | content-hash-value | ||
| 58 | |||
| 59 | origin | ||
| 52 | origin? | 60 | origin? |
| 53 | this-origin | 61 | this-origin |
| 54 | origin-uri | 62 | origin-uri |
| 55 | origin-method | 63 | origin-method |
| 56 | origin-sha256 | 64 | origin-hash |
| 65 | origin-sha256 ;deprecated | ||
| 57 | origin-file-name | 66 | origin-file-name |
| 58 | origin-actual-file-name | 67 | origin-actual-file-name |
| 59 | origin-patches | 68 | origin-patches |
| @@ -157,15 +166,79 @@ | |||
| 157 | ;;; | 166 | ;;; |
| 158 | ;;; Code: | 167 | ;;; Code: |
| 159 | 168 | ||
| 169 | ;; Crytographic content hash. | ||
| 170 | (define-immutable-record-type <content-hash> | ||
| 171 | (%content-hash algorithm value) | ||
| 172 | content-hash? | ||
| 173 | (algorithm content-hash-algorithm) ;symbol | ||
| 174 | (value content-hash-value)) ;bytevector | ||
| 175 | |||
| 176 | (define-syntax-rule (define-content-hash-constructor name | ||
| 177 | (algorithm size) ...) | ||
| 178 | "Define NAME as a <content-hash> constructor that ensures that (1) its | ||
| 179 | second argument is among the listed ALGORITHM, and (2), when possible, that | ||
| 180 | its first argument has the right size for the chosen algorithm." | ||
| 181 | (define-syntax name | ||
| 182 | (lambda (s) | ||
| 183 | (syntax-case s (algorithm ...) | ||
| 184 | ((_ bv algorithm) | ||
| 185 | (let ((bv* (syntax->datum #'bv))) | ||
| 186 | (when (and (bytevector? bv*) | ||
| 187 | (not (= size (bytevector-length bv*)))) | ||
| 188 | (syntax-violation 'content-hash "invalid content hash length" s)) | ||
| 189 | #'(%content-hash 'algorithm bv))) | ||
| 190 | ...)))) | ||
| 191 | |||
| 192 | (define-content-hash-constructor build-content-hash | ||
| 193 | (sha256 32) | ||
| 194 | (sha512 64)) | ||
| 195 | |||
| 196 | (define-syntax content-hash | ||
| 197 | (lambda (s) | ||
| 198 | "Return a content hash with the given parameters. The default hash | ||
| 199 | algorithm is sha256. If the first argument is a literal string, it is decoded | ||
| 200 | as base32. Otherwise, it must be a bytevector." | ||
| 201 | ;; What we'd really want here is something like C++ 'constexpr'. | ||
| 202 | (syntax-case s () | ||
| 203 | ((_ str) | ||
| 204 | (string? (syntax->datum #'str)) | ||
| 205 | #'(content-hash str sha256)) | ||
| 206 | ((_ str algorithm) | ||
| 207 | (string? (syntax->datum #'str)) | ||
| 208 | (with-syntax ((bv (base32 (syntax->datum #'str)))) | ||
| 209 | #'(content-hash bv algorithm))) | ||
| 210 | ((_ (id str) algorithm) | ||
| 211 | (and (string? (syntax->datum #'str)) | ||
| 212 | (free-identifier=? #'id #'base32)) | ||
| 213 | (with-syntax ((bv (nix-base32-string->bytevector (syntax->datum #'str)))) | ||
| 214 | #'(content-hash bv algorithm))) | ||
| 215 | ((_ (id str) algorithm) | ||
| 216 | (and (string? (syntax->datum #'str)) | ||
| 217 | (free-identifier=? #'id #'base64)) | ||
| 218 | (with-syntax ((bv (base64-decode (syntax->datum #'str)))) | ||
| 219 | #'(content-hash bv algorithm))) | ||
| 220 | ((_ bv) | ||
| 221 | #'(content-hash bv sha256)) | ||
| 222 | ((_ bv hash) | ||
| 223 | #'(build-content-hash bv hash))))) | ||
| 224 | |||
| 225 | (define (print-content-hash hash port) | ||
| 226 | (format port "#<content-hash ~a:~a>" | ||
| 227 | (content-hash-algorithm hash) | ||
| 228 | (bytevector->nix-base32-string (content-hash-value hash)))) | ||
| 229 | |||
| 230 | (set-record-type-printer! <content-hash> print-content-hash) | ||
| 231 | |||
| 232 | |||
| 160 | ;; The source of a package, such as a tarball URL and fetcher---called | 233 | ;; The source of a package, such as a tarball URL and fetcher---called |
| 161 | ;; "origin" to avoid name clash with `package-source', `source', etc. | 234 | ;; "origin" to avoid name clash with `package-source', `source', etc. |
| 162 | (define-record-type* <origin> | 235 | (define-record-type* <origin> |
| 163 | origin make-origin | 236 | %origin make-origin |
| 164 | origin? | 237 | origin? |
| 165 | this-origin | 238 | this-origin |
| 166 | (uri origin-uri) ; string | 239 | (uri origin-uri) ; string |
| 167 | (method origin-method) ; procedure | 240 | (method origin-method) ; procedure |
| 168 | (sha256 origin-sha256) ; bytevector | 241 | (hash origin-hash) ; <content-hash> |
| 169 | (file-name origin-file-name (default #f)) ; optional file name | 242 | (file-name origin-file-name (default #f)) ; optional file name |
| 170 | 243 | ||
| 171 | ;; Patches are delayed so that the 'search-patch' calls are made lazily, | 244 | ;; Patches are delayed so that the 'search-patch' calls are made lazily, |
| @@ -188,12 +261,37 @@ | |||
| 188 | (patch-guile origin-patch-guile ; package or #f | 261 | (patch-guile origin-patch-guile ; package or #f |
| 189 | (default #f))) | 262 | (default #f))) |
| 190 | 263 | ||
| 264 | (define-syntax origin-compatibility-helper | ||
| 265 | (syntax-rules (sha256) | ||
| 266 | ((_ () (fields ...)) | ||
| 267 | (%origin fields ...)) | ||
| 268 | ((_ ((sha256 exp) rest ...) (others ...)) | ||
| 269 | (%origin others ... | ||
| 270 | (hash (content-hash exp sha256)) | ||
| 271 | rest ...)) | ||
| 272 | ((_ (field rest ...) (others ...)) | ||
| 273 | (origin-compatibility-helper (rest ...) | ||
| 274 | (others ... field))))) | ||
| 275 | |||
| 276 | (define-syntax-rule (origin fields ...) | ||
| 277 | "Build an <origin> record, automatically converting 'sha256' field | ||
| 278 | specifications to 'hash'." | ||
| 279 | (origin-compatibility-helper (fields ...) ())) | ||
| 280 | |||
| 281 | (define-deprecated (origin-sha256 origin) | ||
| 282 | origin-hash | ||
| 283 | (let ((hash (origin-hash origin))) | ||
| 284 | (unless (eq? (content-hash-algorithm hash) 'sha256) | ||
| 285 | (raise (condition (&message | ||
| 286 | (message (G_ "no SHA256 hash for origin")))))) | ||
| 287 | (content-hash-value hash))) | ||
| 288 | |||
| 191 | (define (print-origin origin port) | 289 | (define (print-origin origin port) |
| 192 | "Write a concise representation of ORIGIN to PORT." | 290 | "Write a concise representation of ORIGIN to PORT." |
| 193 | (match origin | 291 | (match origin |
| 194 | (($ <origin> uri method sha256 file-name patches) | 292 | (($ <origin> uri method hash file-name patches) |
| 195 | (simple-format port "#<origin ~s ~a ~s ~a>" | 293 | (simple-format port "#<origin ~s ~a ~s ~a>" |
| 196 | uri (bytevector->base32-string sha256) | 294 | uri hash |
| 197 | (force patches) | 295 | (force patches) |
| 198 | (number->string (object-address origin) 16))))) | 296 | (number->string (object-address origin) 16))))) |
| 199 | 297 | ||
| @@ -238,6 +336,7 @@ name of its URI." | |||
| 238 | ;; git, svn, cvs, etc. reference | 336 | ;; git, svn, cvs, etc. reference |
| 239 | #f)))) | 337 | #f)))) |
| 240 | 338 | ||
| 339 | |||
| 241 | (define %supported-systems | 340 | (define %supported-systems |
| 242 | ;; This is the list of system types that are supported. By default, we | 341 | ;; This is the list of system types that are supported. By default, we |
| 243 | ;; expect all packages to build successfully here. | 342 | ;; expect all packages to build successfully here. |
| @@ -1388,14 +1487,19 @@ unless you know what you are doing." | |||
| 1388 | #:optional (system (%current-system))) | 1487 | #:optional (system (%current-system))) |
| 1389 | "Return the derivation corresponding to ORIGIN." | 1488 | "Return the derivation corresponding to ORIGIN." |
| 1390 | (match origin | 1489 | (match origin |
| 1391 | (($ <origin> uri method sha256 name (= force ()) #f) | 1490 | (($ <origin> uri method hash name (= force ()) #f) |
| 1392 | ;; No patches, no snippet: this is a fixed-output derivation. | 1491 | ;; No patches, no snippet: this is a fixed-output derivation. |
| 1393 | (method uri 'sha256 sha256 name #:system system)) | 1492 | (method uri |
| 1394 | (($ <origin> uri method sha256 name (= force (patches ...)) snippet | 1493 | (content-hash-algorithm hash) |
| 1494 | (content-hash-value hash) | ||
| 1495 | name #:system system)) | ||
| 1496 | (($ <origin> uri method hash name (= force (patches ...)) snippet | ||
| 1395 | (flags ...) inputs (modules ...) guile-for-build) | 1497 | (flags ...) inputs (modules ...) guile-for-build) |
| 1396 | ;; Patches and/or a snippet. | 1498 | ;; Patches and/or a snippet. |
| 1397 | (mlet %store-monad ((source (method uri 'sha256 sha256 name | 1499 | (mlet %store-monad ((source (method uri |
| 1398 | #:system system)) | 1500 | (content-hash-algorithm hash) |
| 1501 | (content-hash-value hash) | ||
| 1502 | name #:system system)) | ||
| 1399 | (guile (package->derivation (or guile-for-build | 1503 | (guile (package->derivation (or guile-for-build |
| 1400 | (default-guile)) | 1504 | (default-guile)) |
| 1401 | system | 1505 | system |
diff --git a/guix/tests.scm b/guix/tests.scm index 95a7d7c4b87..3ccf049a7dd 100644 --- a/guix/tests.scm +++ b/guix/tests.scm | |||
| @@ -26,7 +26,7 @@ | |||
| 26 | #:use-module (guix monads) | 26 | #:use-module (guix monads) |
| 27 | #:use-module ((guix utils) #:select (substitute-keyword-arguments)) | 27 | #:use-module ((guix utils) #:select (substitute-keyword-arguments)) |
| 28 | #:use-module ((guix build utils) #:select (mkdir-p)) | 28 | #:use-module ((guix build utils) #:select (mkdir-p)) |
| 29 | #:use-module (gcrypt hash) | 29 | #:use-module ((gcrypt hash) #:hide (sha256)) |
| 30 | #:use-module (guix build-system gnu) | 30 | #:use-module (guix build-system gnu) |
| 31 | #:use-module (gnu packages base) | 31 | #:use-module (gnu packages base) |
| 32 | #:use-module (gnu packages bootstrap) | 32 | #:use-module (gnu packages bootstrap) |
diff --git a/tests/challenge.scm b/tests/challenge.scm index bb5633a3ebe..9c6d6e0d58f 100644 --- a/tests/challenge.scm +++ b/tests/challenge.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; | 3 | ;;; |
| 4 | ;;; This file is part of GNU Guix. | 4 | ;;; This file is part of GNU Guix. |
| 5 | ;;; | 5 | ;;; |
| @@ -19,7 +19,7 @@ | |||
| 19 | (define-module (test-challenge) | 19 | (define-module (test-challenge) |
| 20 | #:use-module (guix tests) | 20 | #:use-module (guix tests) |
| 21 | #:use-module (guix tests http) | 21 | #:use-module (guix tests http) |
| 22 | #:use-module (gcrypt hash) | 22 | #:use-module ((gcrypt hash) #:prefix gcrypt:) |
| 23 | #:use-module (guix store) | 23 | #:use-module (guix store) |
| 24 | #:use-module (guix monads) | 24 | #:use-module (guix monads) |
| 25 | #:use-module (guix derivations) | 25 | #:use-module (guix derivations) |
| @@ -135,7 +135,7 @@ | |||
| 135 | (mlet* %store-monad ((drv (gexp->derivation "something" | 135 | (mlet* %store-monad ((drv (gexp->derivation "something" |
| 136 | #~(list #$output #$text))) | 136 | #~(list #$output #$text))) |
| 137 | (out -> (derivation->output-path drv)) | 137 | (out -> (derivation->output-path drv)) |
| 138 | (hash -> (sha256 #vu8()))) | 138 | (hash -> (gcrypt:sha256 #vu8()))) |
| 139 | (with-derivation-narinfo* drv (sha256 => hash) | 139 | (with-derivation-narinfo* drv (sha256 => hash) |
| 140 | (>>= (compare-contents (list out) (%test-substitute-urls)) | 140 | (>>= (compare-contents (list out) (%test-substitute-urls)) |
| 141 | (match-lambda | 141 | (match-lambda |
diff --git a/tests/derivations.scm b/tests/derivations.scm index a409fa99f0d..9f1104a8879 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm | |||
| @@ -23,7 +23,7 @@ | |||
| 23 | #:use-module (guix grafts) | 23 | #:use-module (guix grafts) |
| 24 | #:use-module (guix store) | 24 | #:use-module (guix store) |
| 25 | #:use-module (guix utils) | 25 | #:use-module (guix utils) |
| 26 | #:use-module (gcrypt hash) | 26 | #:use-module ((gcrypt hash) #:prefix gcrypt:) |
| 27 | #:use-module (guix base32) | 27 | #:use-module (guix base32) |
| 28 | #:use-module (guix tests) | 28 | #:use-module (guix tests) |
| 29 | #:use-module (guix tests http) | 29 | #:use-module (guix tests http) |
| @@ -215,7 +215,7 @@ | |||
| 215 | #:env-vars `(("url" | 215 | #:env-vars `(("url" |
| 216 | . ,(object->string (%local-url)))) | 216 | . ,(object->string (%local-url)))) |
| 217 | #:hash-algo 'sha256 | 217 | #:hash-algo 'sha256 |
| 218 | #:hash (sha256 (string->utf8 text))))) | 218 | #:hash (gcrypt:sha256 (string->utf8 text))))) |
| 219 | (and (build-derivations %store (list drv)) | 219 | (and (build-derivations %store (list drv)) |
| 220 | (string=? (call-with-input-file (derivation->output-path drv) | 220 | (string=? (call-with-input-file (derivation->output-path drv) |
| 221 | get-string-all) | 221 | get-string-all) |
| @@ -230,7 +230,7 @@ | |||
| 230 | #:env-vars `(("url" | 230 | #:env-vars `(("url" |
| 231 | . ,(object->string (%local-url)))) | 231 | . ,(object->string (%local-url)))) |
| 232 | #:hash-algo 'sha256 | 232 | #:hash-algo 'sha256 |
| 233 | #:hash (sha256 (random-bytevector 100))))) ;wrong | 233 | #:hash (gcrypt:sha256 (random-bytevector 100))))) ;wrong |
| 234 | (guard (c ((store-protocol-error? c) | 234 | (guard (c ((store-protocol-error? c) |
| 235 | (string-contains (store-protocol-error-message c) "failed"))) | 235 | (string-contains (store-protocol-error-message c) "failed"))) |
| 236 | (build-derivations %store (list drv)) | 236 | (build-derivations %store (list drv)) |
| @@ -245,7 +245,7 @@ | |||
| 245 | #:env-vars `(("url" | 245 | #:env-vars `(("url" |
| 246 | . ,(object->string (%local-url)))) | 246 | . ,(object->string (%local-url)))) |
| 247 | #:hash-algo 'sha256 | 247 | #:hash-algo 'sha256 |
| 248 | #:hash (sha256 (random-bytevector 100))))) | 248 | #:hash (gcrypt:sha256 (random-bytevector 100))))) |
| 249 | (guard (c ((store-protocol-error? c) | 249 | (guard (c ((store-protocol-error? c) |
| 250 | (string-contains (store-protocol-error-message (pk c)) "failed"))) | 250 | (string-contains (store-protocol-error-message (pk c)) "failed"))) |
| 251 | (build-derivations %store (list drv)) | 251 | (build-derivations %store (list drv)) |
| @@ -273,7 +273,7 @@ | |||
| 273 | #:env-vars `(("url" | 273 | #:env-vars `(("url" |
| 274 | . ,(object->string (%local-url)))) | 274 | . ,(object->string (%local-url)))) |
| 275 | #:hash-algo 'sha256 | 275 | #:hash-algo 'sha256 |
| 276 | #:hash (sha256 (string->utf8 text))))) | 276 | #:hash (gcrypt:sha256 (string->utf8 text))))) |
| 277 | (and (with-http-server `((200 ,text)) | 277 | (and (with-http-server `((200 ,text)) |
| 278 | (build-derivations %store (list drv))) | 278 | (build-derivations %store (list drv))) |
| 279 | (with-http-server `((200 ,text)) | 279 | (with-http-server `((200 ,text)) |
| @@ -317,7 +317,7 @@ | |||
| 317 | (test-assert "fixed-output-derivation?" | 317 | (test-assert "fixed-output-derivation?" |
| 318 | (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" | 318 | (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" |
| 319 | "echo -n hello > $out" '())) | 319 | "echo -n hello > $out" '())) |
| 320 | (hash (sha256 (string->utf8 "hello"))) | 320 | (hash (gcrypt:sha256 (string->utf8 "hello"))) |
| 321 | (drv (derivation %store "fixed" | 321 | (drv (derivation %store "fixed" |
| 322 | %bash `(,builder) | 322 | %bash `(,builder) |
| 323 | #:sources (list builder) | 323 | #:sources (list builder) |
| @@ -329,10 +329,10 @@ | |||
| 329 | (map (lambda (hash-algorithm) | 329 | (map (lambda (hash-algorithm) |
| 330 | (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" | 330 | (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" |
| 331 | "echo -n hello > $out" '())) | 331 | "echo -n hello > $out" '())) |
| 332 | (sha256 (sha256 (string->utf8 "hello"))) | 332 | (sha256 (gcrypt:sha256 (string->utf8 "hello"))) |
| 333 | (hash (bytevector-hash | 333 | (hash (gcrypt:bytevector-hash |
| 334 | (string->utf8 "hello") | 334 | (string->utf8 "hello") |
| 335 | (lookup-hash-algorithm hash-algorithm))) | 335 | (gcrypt:lookup-hash-algorithm hash-algorithm))) |
| 336 | (drv (derivation %store | 336 | (drv (derivation %store |
| 337 | (string-append | 337 | (string-append |
| 338 | "fixed-" (symbol->string hash-algorithm)) | 338 | "fixed-" (symbol->string hash-algorithm)) |
| @@ -353,7 +353,7 @@ | |||
| 353 | "echo -n hello > $out" '())) | 353 | "echo -n hello > $out" '())) |
| 354 | (builder2 (add-text-to-store %store "fixed-builder2.sh" | 354 | (builder2 (add-text-to-store %store "fixed-builder2.sh" |
| 355 | "echo hey; echo -n hello > $out" '())) | 355 | "echo hey; echo -n hello > $out" '())) |
| 356 | (hash (sha256 (string->utf8 "hello"))) | 356 | (hash (gcrypt:sha256 (string->utf8 "hello"))) |
| 357 | (drv1 (derivation %store "fixed" | 357 | (drv1 (derivation %store "fixed" |
| 358 | %bash `(,builder1) | 358 | %bash `(,builder1) |
| 359 | #:hash hash #:hash-algo 'sha256)) | 359 | #:hash hash #:hash-algo 'sha256)) |
| @@ -368,7 +368,7 @@ | |||
| 368 | (test-assert "fixed-output derivation, recursive" | 368 | (test-assert "fixed-output derivation, recursive" |
| 369 | (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" | 369 | (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" |
| 370 | "echo -n hello > $out" '())) | 370 | "echo -n hello > $out" '())) |
| 371 | (hash (sha256 (string->utf8 "hello"))) | 371 | (hash (gcrypt:sha256 (string->utf8 "hello"))) |
| 372 | (drv (derivation %store "fixed-rec" | 372 | (drv (derivation %store "fixed-rec" |
| 373 | %bash `(,builder) | 373 | %bash `(,builder) |
| 374 | #:sources (list builder) | 374 | #:sources (list builder) |
| @@ -390,7 +390,7 @@ | |||
| 390 | "echo -n hello > $out" '())) | 390 | "echo -n hello > $out" '())) |
| 391 | (builder2 (add-text-to-store %store "fixed-builder2.sh" | 391 | (builder2 (add-text-to-store %store "fixed-builder2.sh" |
| 392 | "echo hey; echo -n hello > $out" '())) | 392 | "echo hey; echo -n hello > $out" '())) |
| 393 | (hash (sha256 (string->utf8 "hello"))) | 393 | (hash (gcrypt:sha256 (string->utf8 "hello"))) |
| 394 | (fixed1 (derivation %store "fixed" | 394 | (fixed1 (derivation %store "fixed" |
| 395 | %bash `(,builder1) | 395 | %bash `(,builder1) |
| 396 | #:hash hash #:hash-algo 'sha256)) | 396 | #:hash hash #:hash-algo 'sha256)) |
| @@ -427,7 +427,7 @@ | |||
| 427 | "echo -n hello > $out" '())) | 427 | "echo -n hello > $out" '())) |
| 428 | (builder2 (add-text-to-store %store "fixed-builder2.sh" | 428 | (builder2 (add-text-to-store %store "fixed-builder2.sh" |
| 429 | "echo hey; echo -n hello > $out" '())) | 429 | "echo hey; echo -n hello > $out" '())) |
| 430 | (hash (sha256 (string->utf8 "hello"))) | 430 | (hash (gcrypt:sha256 (string->utf8 "hello"))) |
| 431 | (fixed1 (derivation %store "fixed" | 431 | (fixed1 (derivation %store "fixed" |
| 432 | %bash `(,builder1) | 432 | %bash `(,builder1) |
| 433 | #:hash hash #:hash-algo 'sha256)) | 433 | #:hash hash #:hash-algo 'sha256)) |
| @@ -680,7 +680,7 @@ | |||
| 680 | (let* ((value (getenv "GUIX_STATE_DIRECTORY")) | 680 | (let* ((value (getenv "GUIX_STATE_DIRECTORY")) |
| 681 | (drv (derivation %store "leaked-env-vars" %bash | 681 | (drv (derivation %store "leaked-env-vars" %bash |
| 682 | '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out") | 682 | '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out") |
| 683 | #:hash (sha256 (string->utf8 value)) | 683 | #:hash (gcrypt:sha256 (string->utf8 value)) |
| 684 | #:hash-algo 'sha256 | 684 | #:hash-algo 'sha256 |
| 685 | #:sources (list %bash) | 685 | #:sources (list %bash) |
| 686 | #:leaked-env-vars '("GUIX_STATE_DIRECTORY")))) | 686 | #:leaked-env-vars '("GUIX_STATE_DIRECTORY")))) |
| @@ -1106,7 +1106,7 @@ | |||
| 1106 | (builder2 '(call-with-output-file (pk 'difference-here! %output) | 1106 | (builder2 '(call-with-output-file (pk 'difference-here! %output) |
| 1107 | (lambda (p) | 1107 | (lambda (p) |
| 1108 | (write "hello" p)))) | 1108 | (write "hello" p)))) |
| 1109 | (hash (sha256 (string->utf8 "hello"))) | 1109 | (hash (gcrypt:sha256 (string->utf8 "hello"))) |
| 1110 | (input1 (build-expression->derivation %store "fixed" builder1 | 1110 | (input1 (build-expression->derivation %store "fixed" builder1 |
| 1111 | #:hash hash | 1111 | #:hash hash |
| 1112 | #:hash-algo 'sha256)) | 1112 | #:hash-algo 'sha256)) |
| @@ -1127,7 +1127,7 @@ | |||
| 1127 | (builder2 '(call-with-output-file (pk 'difference-here! %output) | 1127 | (builder2 '(call-with-output-file (pk 'difference-here! %output) |
| 1128 | (lambda (p) | 1128 | (lambda (p) |
| 1129 | (write "hello" p)))) | 1129 | (write "hello" p)))) |
| 1130 | (hash (sha256 (string->utf8 "hello"))) | 1130 | (hash (gcrypt:sha256 (string->utf8 "hello"))) |
| 1131 | (input1 (build-expression->derivation %store "fixed" builder1 | 1131 | (input1 (build-expression->derivation %store "fixed" builder1 |
| 1132 | #:hash hash | 1132 | #:hash hash |
| 1133 | #:hash-algo 'sha256)) | 1133 | #:hash-algo 'sha256)) |
diff --git a/tests/graph.scm b/tests/graph.scm index 136260c7d10..0663d13b493 100644 --- a/tests/graph.scm +++ b/tests/graph.scm | |||
| @@ -162,7 +162,11 @@ edges." | |||
| 162 | (let-values (((backend nodes+edges) (make-recording-backend))) | 162 | (let-values (((backend nodes+edges) (make-recording-backend))) |
| 163 | (let* ((m (lambda* (uri hash-type hash name #:key system) | 163 | (let* ((m (lambda* (uri hash-type hash name #:key system) |
| 164 | (text-file "foo-1.2.3.tar.gz" "This is a fake!"))) | 164 | (text-file "foo-1.2.3.tar.gz" "This is a fake!"))) |
| 165 | (o (origin (method m) (uri "the-uri") (sha256 #vu8(0 1 2)))) | 165 | (o (origin |
| 166 | (method m) (uri "the-uri") | ||
| 167 | (sha256 | ||
| 168 | (base32 | ||
| 169 | "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))) | ||
| 166 | (p (dummy-package "p" (source o)))) | 170 | (p (dummy-package "p" (source o)))) |
| 167 | (run-with-store %store | 171 | (run-with-store %store |
| 168 | (export-graph (list p) 'port | 172 | (export-graph (list p) 'port |
diff --git a/tests/packages.scm b/tests/packages.scm index c528d2080c9..4935d4503e6 100644 --- a/tests/packages.scm +++ b/tests/packages.scm | |||
| @@ -29,7 +29,7 @@ | |||
| 29 | #:renamer (lambda (name) | 29 | #:renamer (lambda (name) |
| 30 | (cond ((eq? name 'location) 'make-location) | 30 | (cond ((eq? name 'location) 'make-location) |
| 31 | (else name)))) | 31 | (else name)))) |
| 32 | #:use-module (gcrypt hash) | 32 | #:use-module ((gcrypt hash) #:hide (sha256)) |
| 33 | #:use-module (guix derivations) | 33 | #:use-module (guix derivations) |
| 34 | #:use-module (guix packages) | 34 | #:use-module (guix packages) |
| 35 | #:use-module (guix grafts) | 35 | #:use-module (guix grafts) |
| @@ -51,6 +51,7 @@ | |||
| 51 | #:use-module (srfi srfi-34) | 51 | #:use-module (srfi srfi-34) |
| 52 | #:use-module (srfi srfi-35) | 52 | #:use-module (srfi srfi-35) |
| 53 | #:use-module (srfi srfi-64) | 53 | #:use-module (srfi srfi-64) |
| 54 | #:use-module (rnrs bytevectors) | ||
| 54 | #:use-module (rnrs io ports) | 55 | #:use-module (rnrs io ports) |
| 55 | #:use-module (ice-9 vlist) | 56 | #:use-module (ice-9 vlist) |
| 56 | #:use-module (ice-9 regex) | 57 | #:use-module (ice-9 regex) |
| @@ -497,6 +498,31 @@ | |||
| 497 | (search-path %load-path "guix/base32.scm") | 498 | (search-path %load-path "guix/base32.scm") |
| 498 | get-bytevector-all))))) | 499 | get-bytevector-all))))) |
| 499 | 500 | ||
| 501 | (test-equal "package-source-derivation, origin, sha512" | ||
| 502 | "hello" | ||
| 503 | (let* ((bash (search-bootstrap-binary "bash" (%current-system))) | ||
| 504 | (builder (add-text-to-store %store "my-fixed-builder.sh" | ||
| 505 | "echo -n hello > $out" '())) | ||
| 506 | (method (lambda* (url hash-algo hash #:optional name | ||
| 507 | #:rest rest) | ||
| 508 | (and (eq? hash-algo 'sha512) | ||
| 509 | (raw-derivation name bash (list builder) | ||
| 510 | #:sources (list builder) | ||
| 511 | #:hash hash | ||
| 512 | #:hash-algo hash-algo)))) | ||
| 513 | (source (origin | ||
| 514 | (method method) | ||
| 515 | (uri "unused://") | ||
| 516 | (file-name "origin-sha512") | ||
| 517 | (hash (content-hash | ||
| 518 | (bytevector-hash (string->utf8 "hello") | ||
| 519 | (hash-algorithm sha512)) | ||
| 520 | sha512)))) | ||
| 521 | (drv (package-source-derivation %store source)) | ||
| 522 | (output (derivation->output-path drv))) | ||
| 523 | (build-derivations %store (list drv)) | ||
| 524 | (call-with-input-file output get-string-all))) | ||
| 525 | |||
| 500 | (unless (network-reachable?) (test-skip 1)) | 526 | (unless (network-reachable?) (test-skip 1)) |
| 501 | (test-equal "package-source-derivation, snippet" | 527 | (test-equal "package-source-derivation, snippet" |
| 502 | "OK" | 528 | "OK" |
diff --git a/tests/store.scm b/tests/store.scm index f007846dc16..06f79396579 100644 --- a/tests/store.scm +++ b/tests/store.scm | |||
| @@ -22,7 +22,7 @@ | |||
| 22 | #:use-module (guix store) | 22 | #:use-module (guix store) |
| 23 | #:use-module (guix utils) | 23 | #:use-module (guix utils) |
| 24 | #:use-module (guix monads) | 24 | #:use-module (guix monads) |
| 25 | #:use-module (gcrypt hash) | 25 | #:use-module ((gcrypt hash) #:prefix gcrypt:) |
| 26 | #:use-module (guix base32) | 26 | #:use-module (guix base32) |
| 27 | #:use-module (guix packages) | 27 | #:use-module (guix packages) |
| 28 | #:use-module (guix derivations) | 28 | #:use-module (guix derivations) |
| @@ -321,7 +321,7 @@ | |||
| 321 | #:env-vars `(("t2" . ,t2)))) | 321 | #:env-vars `(("t2" . ,t2)))) |
| 322 | (o (derivation->output-path d))) | 322 | (o (derivation->output-path d))) |
| 323 | (with-derivation-narinfo d | 323 | (with-derivation-narinfo d |
| 324 | (sha256 => (sha256 (string->utf8 t2))) | 324 | (sha256 => (gcrypt:sha256 (string->utf8 t2))) |
| 325 | (references => (list t2)) | 325 | (references => (list t2)) |
| 326 | 326 | ||
| 327 | (equal? (references/substitutes s (list o t3 t2 t1)) | 327 | (equal? (references/substitutes s (list o t3 t2 t1)) |
| @@ -940,7 +940,7 @@ | |||
| 940 | (foldm %store-monad | 940 | (foldm %store-monad |
| 941 | (lambda (item result) | 941 | (lambda (item result) |
| 942 | (define ref-hash | 942 | (define ref-hash |
| 943 | (let-values (((port get) (open-sha256-port))) | 943 | (let-values (((port get) (gcrypt:open-sha256-port))) |
| 944 | (write-file item port) | 944 | (write-file item port) |
| 945 | (close-port port) | 945 | (close-port port) |
| 946 | (get))) | 946 | (get))) |
| @@ -1144,7 +1144,7 @@ | |||
| 1144 | (info (query-path-info %store item))) | 1144 | (info (query-path-info %store item))) |
| 1145 | (and (equal? (path-info-references info) (list ref)) | 1145 | (and (equal? (path-info-references info) (list ref)) |
| 1146 | (equal? (path-info-hash info) | 1146 | (equal? (path-info-hash info) |
| 1147 | (sha256 | 1147 | (gcrypt:sha256 |
| 1148 | (string->utf8 | 1148 | (string->utf8 |
| 1149 | (call-with-output-string (cut write-file item <>)))))))) | 1149 | (call-with-output-string (cut write-file item <>)))))))) |
| 1150 | 1150 | ||
