mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05:00
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'.
This commit is contained in:
parent
56f7ca6e7c
commit
ce0be5675b
14 changed files with 220 additions and 58 deletions
|
@ -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
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
|
||||
;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
|
||||
|
@ -111,7 +111,7 @@ (define* (aspell-dictionary dict-name full-name
|
|||
(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 @@ (define-public aspell-dict-ca
|
|||
(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 @@ (define-public aspell-dict-it
|
|||
(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"))))
|
||||
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name>
|
||||
;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
|
||||
|
@ -48,12 +48,12 @@ (define (patch-url seqno)
|
|||
"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))
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015, 2018, 2019 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2017, 2020 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2018, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
|
@ -151,14 +151,14 @@ (define bootstrap-executable
|
|||
(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))))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||
|
@ -35,12 +35,12 @@ (define (patch-url version seqno)
|
|||
(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))
|
||||
|
|
|
@ -104,14 +104,14 @@ (define-module (gnu packages virtualization)
|
|||
#: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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -35,6 +35,8 @@ (define-module (guix packages)
|
|||
#: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 @@ (define-module (guix packages)
|
|||
#: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 @@ (define-module (guix packages)
|
|||
;;;
|
||||
;;; 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 @@ (define-record-type* <origin>
|
|||
(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 @@ (define (uri->file-name 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 @@ (define* (origin->derivation origin
|
|||
#: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
|
||||
|
|
|
@ -26,7 +26,7 @@ (define-module (guix tests)
|
|||
#: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)
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; 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 @@ (define-syntax with-derivation-narinfo*
|
|||
(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
|
||||
|
|
|
@ -23,7 +23,7 @@ (define-module (test-derivations)
|
|||
#: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 @@ (define prefix-len (string-length dir))
|
|||
#: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 @@ (define prefix-len (string-length dir))
|
|||
#: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 @@ (define prefix-len (string-length dir))
|
|||
#: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 @@ (define prefix-len (string-length dir))
|
|||
#: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 @@ (define prefix-len (string-length dir))
|
|||
(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 @@ (define prefix-len (string-length dir))
|
|||
(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 @@ (define prefix-len (string-length dir))
|
|||
"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 @@ (define prefix-len (string-length dir))
|
|||
(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 @@ (define prefix-len (string-length dir))
|
|||
"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 @@ (define prefix-len (string-length dir))
|
|||
"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 @@ (define (deps path . deps)
|
|||
(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 @@ (define (record-substitutable-path-query store paths)
|
|||
(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 @@ (define (record-substitutable-path-query store paths)
|
|||
(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))
|
||||
|
|
|
@ -162,7 +162,11 @@ (define (edge->tuple source target)
|
|||
(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
|
||||
|
|
|
@ -29,7 +29,7 @@ (define-module (test-packages)
|
|||
#: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 @@ (define-module (test-packages)
|
|||
#: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 @@ (define read-at
|
|||
(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"
|
||||
|
|
|
@ -22,7 +22,7 @@ (define-module (test-store)
|
|||
#: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 @@ (define %shell
|
|||
#: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 @@ (define (touch file data)
|
|||
(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 @@ (define ref-hash
|
|||
(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 <>))))))))
|
||||
|
||||
|
|
Loading…
Reference in a new issue