Browse Source
Switch to Guile-Gcrypt.
This removes (guix hash) and (guix pk-crypto), which now live as part of Guile-Gcrypt (version 0.1.0.) * guix/gcrypt.scm, guix/hash.scm, guix/pk-crypto.scm, tests/hash.scm, tests/pk-crypto.scm: Remove. * configure.ac: Test for Guile-Gcrypt. Remove LIBGCRYPT and LIBGCRYPT_LIBDIR assignments. * m4/guix.m4 (GUIX_ASSERT_LIBGCRYPT_USABLE): Remove. * README: Add Guile-Gcrypt to the dependencies; move libgcrypt as "required unless --disable-daemon". * doc/guix.texi (Requirements): Likewise. * gnu/packages/bash.scm, guix/derivations.scm, guix/docker.scm, guix/git.scm, guix/http-client.scm, guix/import/cpan.scm, guix/import/cran.scm, guix/import/crate.scm, guix/import/elpa.scm, guix/import/gnu.scm, guix/import/hackage.scm, guix/import/texlive.scm, guix/import/utils.scm, guix/nar.scm, guix/pki.scm, guix/scripts/archive.scm, guix/scripts/authenticate.scm, guix/scripts/download.scm, guix/scripts/hash.scm, guix/scripts/pack.scm, guix/scripts/publish.scm, guix/scripts/refresh.scm, guix/scripts/substitute.scm, guix/store.scm, guix/store/deduplication.scm, guix/tests.scm, tests/base32.scm, tests/builders.scm, tests/challenge.scm, tests/cpan.scm, tests/crate.scm, tests/derivations.scm, tests/gem.scm, tests/nar.scm, tests/opam.scm, tests/pki.scm, tests/publish.scm, tests/pypi.scm, tests/store-deduplication.scm, tests/store.scm, tests/substitute.scm: Adjust imports. * gnu/system/vm.scm: Likewise. (guile-sqlite3&co): Rename to... (gcrypt-sqlite3&co): ... this. Add GUILE-GCRYPT. (expression->derivation-in-linux-vm)[config]: Remove. (iso9660-image)[config]: Remove. (qemu-image)[config]: Remove. (system-docker-image)[config]: Remove. * guix/scripts/pack.scm: Adjust imports. (guile-sqlite3&co): Rename to... (gcrypt-sqlite3&co): ... this. Add GUILE-GCRYPT. (self-contained-tarball)[build]: Call 'make-config.scm' without #:libgcrypt argument. (squashfs-image)[libgcrypt]: Remove. [build]: Call 'make-config.scm' without #:libgcrypt. (docker-image)[config, json]: Remove. [build]: Add GUILE-GCRYPT to the extensions Remove (guix config) from the imported modules. * guix/self.scm (specification->package): Remove "libgcrypt", add "guile-gcrypt". (compiled-guix): Remove #:libgcrypt. [guile-gcrypt]: New variable. [dependencies]: Add it. [*core-modules*]: Remove #:libgcrypt from 'make-config.scm' call. Add #:extensions. [*config*]: Remove #:libgcrypt from 'make-config.scm' call. (%dependency-variables): Remove %libgcrypt. (make-config.scm): Remove #:libgcrypt. * build-aux/build-self.scm (guile-gcrypt): New variable. (make-config.scm): Remove #:libgcrypt. (build-program)[fake-gcrypt-hash]: New variable. Add (gcrypt hash) to the imported modules. Adjust load path assignments. * gnu/packages/package-management.scm (guix)[propagated-inputs]: Add GUILE-GCRYPT. [arguments]: In 'wrap-program' phase, add GUILE-GCRYPT to the search path.gn-latest-20200428
Ludovic Courtès
2 years ago
No known key found for this signature in database
GPG Key ID: 90B11993D9AEBB5
56 changed files with 180 additions and 1241 deletions
Split View
Diff Options
-
+0 -5Makefile.am
-
+2 -1README
-
+70 -13build-aux/build-self.scm
-
+6 -7configure.ac
-
+3 -1doc/guix.texi
-
+1 -1gnu/packages/bash.scm
-
+4 -1gnu/packages/package-management.scm
-
+19 -29gnu/system/vm.scm
-
+1 -1guix/derivations.scm
-
+1 -1guix/docker.scm
-
+0 -49guix/gcrypt.scm
-
+1 -1guix/git.scm
-
+0 -184guix/hash.scm
-
+1 -1guix/http-client.scm
-
+1 -1guix/import/cpan.scm
-
+1 -1guix/import/cran.scm
-
+1 -1guix/import/crate.scm
-
+1 -1guix/import/elpa.scm
-
+1 -1guix/import/gnu.scm
-
+1 -1guix/import/hackage.scm
-
+1 -1guix/import/texlive.scm
-
+1 -1guix/import/utils.scm
-
+2 -2guix/nar.scm
-
+0 -407guix/pk-crypto.scm
-
+1 -1guix/pki.scm
-
+1 -1guix/scripts/archive.scm
-
+1 -1guix/scripts/authenticate.scm
-
+1 -1guix/scripts/download.scm
-
+3 -3guix/scripts/hash.scm
-
+16 -44guix/scripts/pack.scm
-
+2 -2guix/scripts/publish.scm
-
+1 -1guix/scripts/refresh.scm
-
+2 -2guix/scripts/substitute.scm
-
+11 -15guix/self.scm
-
+1 -1guix/store.scm
-
+1 -1guix/store/deduplication.scm
-
+1 -1guix/tests.scm
-
+0 -18m4/guix.m4
-
+1 -1tests/base32.scm
-
+1 -1tests/builders.scm
-
+1 -1tests/challenge.scm
-
+1 -1tests/cpan.scm
-
+1 -1tests/crate.scm
-
+1 -1tests/derivations.scm
-
+1 -1tests/gem.scm
-
+0 -128tests/hash.scm
-
+1 -1tests/nar.scm
-
+1 -1tests/opam.scm
-
+1 -1tests/packages.scm
-
+0 -290tests/pk-crypto.scm
-
+2 -2tests/pki.scm
-
+2 -2tests/publish.scm
-
+1 -1tests/pypi.scm
-
+1 -1tests/store-deduplication.scm
-
+1 -1tests/store.scm
-
+2 -2tests/substitute.scm
+ 0
- 5
Makefile.am
View File
| @@ -63,9 +63,6 @@ MODULES = \ | |||
| guix/base64.scm \ | |||
| guix/cpio.scm \ | |||
| guix/records.scm \ | |||
| guix/gcrypt.scm \ | |||
| guix/hash.scm \ | |||
| guix/pk-crypto.scm \ | |||
| guix/pki.scm \ | |||
| guix/progress.scm \ | |||
| guix/combinators.scm \ | |||
| @@ -331,8 +328,6 @@ SCM_TESTS = \ | |||
| tests/base32.scm \ | |||
| tests/base64.scm \ | |||
| tests/cpio.scm \ | |||
| tests/hash.scm \ | |||
| tests/pk-crypto.scm \ | |||
| tests/pki.scm \ | |||
| tests/print.scm \ | |||
| tests/sets.scm \ | |||
+ 2
- 1
README
View File
| @@ -21,7 +21,7 @@ Guix is based on the [[https://nixos.org/nix/][Nix]] package manager. | |||
| GNU Guix currently depends on the following packages: | |||
| - [[https://gnu.org/software/guile/][GNU Guile 2.2.x or 2.0.x]], version 2.0.13 or later | |||
| - [[https://gnupg.org/][GNU libgcrypt]] | |||
| - [[https://notabug.org/cwebber/guile-gcrypt][Guile-Gcrypt]] 0.1.0 or later | |||
| - [[https://www.gnu.org/software/make/][GNU Make]] | |||
| - [[https://www.gnutls.org][GnuTLS]] compiled with guile support enabled | |||
| - [[https://notabug.org/civodul/guile-sqlite3][Guile-SQLite3]], version 0.1.0 or later | |||
| @@ -31,6 +31,7 @@ GNU Guix currently depends on the following packages: | |||
| Unless `--disable-daemon' was passed, the following packages are needed: | |||
| - [[https://gnupg.org/][GNU libgcrypt]] | |||
| - [[https://sqlite.org/][SQLite 3]] | |||
| - [[https://gcc.gnu.org][GCC's g++]] | |||
| - optionally [[http://www.bzip.org][libbz2]] | |||
+ 70
- 13
build-aux/build-self.scm
View File
| @@ -22,6 +22,7 @@ | |||
| #:use-module (guix ui) | |||
| #:use-module (guix config) | |||
| #:use-module (guix modules) | |||
| #:use-module (guix build-system gnu) | |||
| #:use-module (srfi srfi-1) | |||
| #:use-module (srfi srfi-19) | |||
| #:use-module (rnrs io ports) | |||
| @@ -72,7 +73,7 @@ | |||
| (variables rest ...)))))) | |||
| (variables %localstatedir %storedir %sysconfdir %system))) | |||
| (define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2 | |||
| (define* (make-config.scm #:key zlib gzip xz bzip2 | |||
| (package-name "GNU Guix") | |||
| (package-version "0") | |||
| (bug-report-address "bug-guix@gnu.org") | |||
| @@ -92,7 +93,6 @@ | |||
| %state-directory | |||
| %store-database-directory | |||
| %config-directory | |||
| %libgcrypt | |||
| %libz | |||
| %gzip | |||
| %bzip2 | |||
| @@ -137,9 +137,6 @@ | |||
| (define %xz | |||
| #+(and xz (file-append xz "/bin/xz"))) | |||
| (define %libgcrypt | |||
| #+(and libgcrypt | |||
| (file-append libgcrypt "/lib/libgcrypt"))) | |||
| (define %libz | |||
| #+(and zlib | |||
| (file-append zlib "/lib/libz"))))))) | |||
| @@ -200,6 +197,44 @@ person's version identifier." | |||
| ;; XXX: Replace with a Git commit id. | |||
| (date->string (current-date 0) "~Y~m~d.~H")) | |||
| (define guile-gcrypt | |||
| ;; The host Guix may or may not have 'guile-gcrypt', which was introduced in | |||
| ;; August 2018. If it has it, it's at least version 0.1.0, which is good | |||
| ;; enough. If it doesn't, specify our own package because the target Guix | |||
| ;; requires it. | |||
| (match (find-best-packages-by-name "guile-gcrypt" #f) | |||
| (() | |||
| (package | |||
| (name "guile-gcrypt") | |||
| (version "0.1.0") | |||
| (home-page "https://notabug.org/cwebber/guile-gcrypt") | |||
| (source (origin | |||
| (method url-fetch) | |||
| (uri (string-append home-page "/archive/v" version ".tar.gz")) | |||
| (sha256 | |||
| (base32 | |||
| "1gir7ifknbmbvjlql5j6wzk7bkb5lnmq80q59ngz43hhpclrk5k3")) | |||
| (file-name (string-append name "-" version ".tar.gz")))) | |||
| (build-system gnu-build-system) | |||
| (native-inputs | |||
| `(("pkg-config" ,(specification->package "pkg-config")) | |||
| ("autoconf" ,(specification->package "autoconf")) | |||
| ("automake" ,(specification->package "automake")) | |||
| ("texinfo" ,(specification->package "texinfo")))) | |||
| (inputs | |||
| `(("guile" ,(specification->package "guile")) | |||
| ("libgcrypt" ,(specification->package "libgcrypt")))) | |||
| (synopsis "Cryptography library for Guile using Libgcrypt") | |||
| (description | |||
| "Guile-Gcrypt provides a Guile 2.x interface to a subset of the | |||
| GNU Libgcrypt crytographic library. It provides modules for cryptographic | |||
| hash functions, message authentication codes (MAC), public-key cryptography, | |||
| strong randomness, and more. It is implemented using the foreign function | |||
| interface (FFI) of Guile.") | |||
| (license #f))) ;license:gpl3+ | |||
| ((package . _) | |||
| package))) | |||
| (define* (build-program source version | |||
| #:optional (guile-version (effective-version)) | |||
| #:key (pull-version 0)) | |||
| @@ -212,10 +247,21 @@ person's version identifier." | |||
| (('gnu _ ...) #t) | |||
| (_ #f))) | |||
| (define fake-gcrypt-hash | |||
| ;; Fake (gcrypt hash) module; see below. | |||
| (scheme-file "hash.scm" | |||
| #~(define-module (gcrypt hash) | |||
| #:export (sha1 sha256)))) | |||
| (with-imported-modules `(((guix config) | |||
| => ,(make-config.scm | |||
| #:libgcrypt | |||
| (specification->package "libgcrypt"))) | |||
| => ,(make-config.scm)) | |||
| ;; To avoid relying on 'with-extensions', which was | |||
| ;; introduced in 0.15.0, provide a fake (gcrypt | |||
| ;; hash) just so that we can build modules, and | |||
| ;; adjust %LOAD-PATH later on. | |||
| ((gcrypt hash) => ,fake-gcrypt-hash) | |||
| ,@(source-module-closure `((guix store) | |||
| (guix self) | |||
| (guix derivations) | |||
| @@ -237,13 +283,24 @@ person's version identifier." | |||
| (match %load-path | |||
| ((front _ ...) | |||
| (unless (string=? front source) ;already done? | |||
| (set! %load-path (list source front))))))) | |||
| ;; Only load our own modules or those of Guile. | |||
| (set! %load-path | |||
| (list source | |||
| (string-append #$guile-gcrypt | |||
| "/share/guile/site/" | |||
| (effective-version)) | |||
| front))))))) | |||
| ;; Only load Guile-Gcrypt, our own modules, or those | |||
| ;; of Guile. | |||
| (match %load-compiled-path | |||
| ((front _ ... sys1 sys2) | |||
| (set! %load-compiled-path | |||
| (list front sys1 sys2))))) | |||
| (unless (string-prefix? #$guile-gcrypt front) | |||
| (set! %load-compiled-path | |||
| (list (string-append #$guile-gcrypt | |||
| "/lib/guile/" | |||
| (effective-version) | |||
| "/site-ccache") | |||
| front sys1 sys2)))))) | |||
| (use-modules (guix store) | |||
| (guix self) | |||
+ 6
- 7
configure.ac
View File
| @@ -130,6 +130,11 @@ if test "x$guix_cv_have_recent_guile_sqlite3" != "xyes"; then | |||
| AC_MSG_ERROR([A recent Guile-SQLite3 could not be found; please install it.]) | |||
| fi | |||
| GUILE_MODULE_AVAILABLE([have_guile_gcrypt], [(gcrypt hash)]) | |||
| if test "x$have_guile_gcrypt" != "xyes"; then | |||
| AC_MSG_ERROR([Guile-Gcrypt could not be found; please install it.]) | |||
| fi | |||
| dnl Make sure we have a full-fledged Guile. | |||
| GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads]) | |||
| @@ -213,16 +218,10 @@ AC_ARG_WITH([libgcrypt-libdir], | |||
| esac]) | |||
| dnl If none of the --with-libgcrypt-* options was used, try to determine the | |||
| dnl absolute file name of libgcrypt.so. | |||
| dnl the library directory. | |||
| case "x$LIBGCRYPT_PREFIX$LIBGCRYPT_LIBDIR" in | |||
| xnono) | |||
| GUIX_LIBGCRYPT_LIBDIR([LIBGCRYPT_LIBDIR]) | |||
| if test "x$LIBGCRYPT_LIBDIR" != x; then | |||
| LIBGCRYPT="$LIBGCRYPT_LIBDIR/libgcrypt" | |||
| else | |||
| dnl 'config-daemon.ac' expects "no" in this case. | |||
| LIBGCRYPT_LIBDIR="no" | |||
| fi | |||
| ;; | |||
| esac | |||
+ 3
- 1
doc/guix.texi
View File
| @@ -620,7 +620,8 @@ GNU Guix depends on the following packages: | |||
| @itemize | |||
| @item @url{http://gnu.org/software/guile/, GNU Guile}, version 2.0.13 or | |||
| later, including 2.2.x; | |||
| @item @url{http://gnupg.org/, GNU libgcrypt}; | |||
| @item @url{https://notabug.org/cwebber/guile-gcrypt, Guile-Gcrypt}, version | |||
| 0.1.0 or later; | |||
| @item | |||
| @uref{http://gnutls.org/, GnuTLS}, specifically its Guile bindings | |||
| (@pxref{Guile Preparations, how to install the GnuTLS bindings for | |||
| @@ -662,6 +663,7 @@ Unless @code{--disable-daemon} was passed to @command{configure}, the | |||
| following packages are also needed: | |||
| @itemize | |||
| @item @url{http://gnupg.org/, GNU libgcrypt}; | |||
| @item @url{http://sqlite.org, SQLite 3}; | |||
| @item @url{http://gcc.gnu.org, GCC's g++}, with support for the | |||
| C++11 standard. | |||
+ 1
- 1
gnu/packages/bash.scm
View File
| @@ -36,7 +36,7 @@ | |||
| #:use-module (guix store) | |||
| #:use-module (guix build-system gnu) | |||
| #:autoload (guix gnupg) (gnupg-verify*) | |||
| #:autoload (guix hash) (port-sha256) | |||
| #:autoload (gcrypt hash) (port-sha256) | |||
| #:autoload (guix base32) (bytevector->nix-base32-string) | |||
| #:use-module (srfi srfi-1) | |||
| #:use-module (srfi srfi-26) | |||
+ 4
- 1
gnu/packages/package-management.scm
View File
| @@ -213,6 +213,7 @@ | |||
| ;; Guile-JSON, and Guile-Git automatically. | |||
| (let* ((out (assoc-ref outputs "out")) | |||
| (guile (assoc-ref inputs "guile")) | |||
| (gcrypt (assoc-ref inputs "guile-gcrypt")) | |||
| (json (assoc-ref inputs "guile-json")) | |||
| (sqlite (assoc-ref inputs "guile-sqlite3")) | |||
| (git (assoc-ref inputs "guile-git")) | |||
| @@ -220,7 +221,8 @@ | |||
| "guile-bytestructures")) | |||
| (ssh (assoc-ref inputs "guile-ssh")) | |||
| (gnutls (assoc-ref inputs "gnutls")) | |||
| (deps (list json sqlite gnutls git bs ssh)) | |||
| (deps (list gcrypt json sqlite gnutls | |||
| git bs ssh)) | |||
| (effective | |||
| (read-line | |||
| (open-pipe* OPEN_READ | |||
| @@ -279,6 +281,7 @@ | |||
| '()))) | |||
| (propagated-inputs | |||
| `(("gnutls" ,gnutls) | |||
| ("guile-gcrypt" ,guile-gcrypt) | |||
| ("guile-json" ,guile-json) | |||
| ("guile-sqlite3" ,guile-sqlite3) | |||
| ("guile-ssh" ,guile-ssh) | |||
+ 19
- 29
gnu/system/vm.scm
View File
| @@ -32,7 +32,7 @@ | |||
| #:use-module (guix modules) | |||
| #:use-module (guix scripts pack) | |||
| #:use-module (guix utils) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base32) | |||
| #:use-module ((guix self) #:select (make-config.scm)) | |||
| @@ -43,7 +43,7 @@ | |||
| #:use-module (gnu packages cdrom) | |||
| #:use-module (gnu packages compression) | |||
| #:use-module (gnu packages guile) | |||
| #:autoload (gnu packages gnupg) (libgcrypt) | |||
| #:autoload (gnu packages gnupg) (guile-gcrypt) | |||
| #:use-module (gnu packages gawk) | |||
| #:use-module (gnu packages bash) | |||
| #:use-module (gnu packages less) | |||
| @@ -124,10 +124,12 @@ | |||
| (('gnu rest ...) #t) | |||
| (rest #f))) | |||
| (define guile-sqlite3&co | |||
| ;; Guile-SQLite3 and its propagated inputs. | |||
| (cons guile-sqlite3 | |||
| (package-transitive-propagated-inputs guile-sqlite3))) | |||
| (define gcrypt-sqlite3&co | |||
| ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs. | |||
| (append-map (lambda (package) | |||
| (cons package | |||
| (package-transitive-propagated-inputs package))) | |||
| (list guile-gcrypt guile-sqlite3))) | |||
| (define* (expression->derivation-in-linux-vm name exp | |||
| #:key | |||
| @@ -164,10 +166,6 @@ based on the size of the closure of REFERENCES-GRAPHS. | |||
| When REFERENCES-GRAPHS is true, it must be a list of file name/store path | |||
| pairs, as for `derivation'. The files containing the reference graphs are | |||
| made available under the /xchg CIFS share." | |||
| (define config | |||
| ;; (guix config) module for consumption by (guix gcrypt). | |||
| (make-config.scm #:libgcrypt libgcrypt)) | |||
| (define user-builder | |||
| (program-file "builder-in-linux-vm" exp)) | |||
| @@ -195,12 +193,14 @@ made available under the /xchg CIFS share." | |||
| (define builder | |||
| ;; Code that launches the VM that evaluates EXP. | |||
| (with-extensions guile-sqlite3&co | |||
| (with-extensions gcrypt-sqlite3&co | |||
| (with-imported-modules `(,@(source-module-closure | |||
| '((guix build utils) | |||
| (gnu build vm)) | |||
| #:select? not-config?) | |||
| ((guix config) => ,config)) | |||
| ;; For consumption by (gnu store database). | |||
| ((guix config) => ,(make-config.scm))) | |||
| #~(begin | |||
| (use-modules (guix build utils) | |||
| (gnu build vm)) | |||
| @@ -255,9 +255,6 @@ made available under the /xchg CIFS share." | |||
| "Return a bootable, stand-alone iso9660 image. | |||
| INPUTS is a list of inputs (as for packages)." | |||
| (define config | |||
| (make-config.scm #:libgcrypt libgcrypt)) | |||
| (define schema | |||
| (and register-closures? | |||
| (local-file (search-path %load-path | |||
| @@ -265,12 +262,12 @@ INPUTS is a list of inputs (as for packages)." | |||
| (expression->derivation-in-linux-vm | |||
| name | |||
| (with-extensions guile-sqlite3&co | |||
| (with-extensions gcrypt-sqlite3&co | |||
| (with-imported-modules `(,@(source-module-closure '((gnu build vm) | |||
| (guix store database) | |||
| (guix build utils)) | |||
| #:select? not-config?) | |||
| ((guix config) => ,config)) | |||
| ((guix config) => ,(make-config.scm))) | |||
| #~(begin | |||
| (use-modules (gnu build vm) | |||
| (guix store database) | |||
| @@ -347,9 +344,6 @@ INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy | |||
| all of INPUTS into the image being built. When REGISTER-CLOSURES? is true, | |||
| register INPUTS in the store database of the image so that Guix can be used in | |||
| the image." | |||
| (define config | |||
| (make-config.scm #:libgcrypt libgcrypt)) | |||
| (define schema | |||
| (and register-closures? | |||
| (local-file (search-path %load-path | |||
| @@ -357,13 +351,13 @@ the image." | |||
| (expression->derivation-in-linux-vm | |||
| name | |||
| (with-extensions guile-sqlite3&co | |||
| (with-extensions gcrypt-sqlite3&co | |||
| (with-imported-modules `(,@(source-module-closure '((gnu build vm) | |||
| (gnu build bootloader) | |||
| (guix store database) | |||
| (guix build utils)) | |||
| #:select? not-config?) | |||
| ((guix config) => ,config)) | |||
| ((guix config) => ,(make-config.scm))) | |||
| #~(begin | |||
| (use-modules (gnu build bootloader) | |||
| (gnu build vm) | |||
| @@ -462,10 +456,6 @@ makes sense when you want to build a GuixSD Docker image that has Guix | |||
| installed inside of it. If you don't need Guix (e.g., your GuixSD Docker | |||
| image just contains a web server that is started by the Shepherd), then you | |||
| should set REGISTER-CLOSURES? to #f." | |||
| (define config | |||
| ;; (guix config) module for consumption by (guix gcrypt). | |||
| (make-config.scm #:libgcrypt libgcrypt)) | |||
| (define schema | |||
| (and register-closures? | |||
| (local-file (search-path %load-path | |||
| @@ -475,8 +465,8 @@ should set REGISTER-CLOSURES? to #f." | |||
| (name -> (string-append name ".tar.gz")) | |||
| (graph -> "system-graph")) | |||
| (define build | |||
| (with-extensions (cons guile-json ;for (guix docker) | |||
| guile-sqlite3&co) ;for (guix store database) | |||
| (with-extensions (cons guile-json ;for (guix docker) | |||
| gcrypt-sqlite3&co) ;for (guix store database) | |||
| (with-imported-modules `(,@(source-module-closure | |||
| '((guix docker) | |||
| (guix store database) | |||
| @@ -484,7 +474,7 @@ should set REGISTER-CLOSURES? to #f." | |||
| (guix build store-copy) | |||
| (gnu build vm)) | |||
| #:select? not-config?) | |||
| ((guix config) => ,config)) | |||
| ((guix config) => ,(make-config.scm))) | |||
| #~(begin | |||
| (use-modules (guix docker) | |||
| (guix build utils) | |||
+ 1
- 1
guix/derivations.scm
View File
| @@ -35,7 +35,7 @@ | |||
| #:use-module (guix memoization) | |||
| #:use-module (guix combinators) | |||
| #:use-module (guix monads) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix records) | |||
| #:use-module (guix sets) | |||
+ 1
- 1
guix/docker.scm
View File
| @@ -19,7 +19,7 @@ | |||
| ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
| (define-module (guix docker) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base16) | |||
| #:use-module ((guix build utils) | |||
| #:select (mkdir-p | |||
+ 0
- 49
guix/gcrypt.scm
View File
| @@ -1,49 +0,0 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | |||
| ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> | |||
| ;;; | |||
| ;;; This file is part of GNU Guix. | |||
| ;;; | |||
| ;;; GNU Guix is free software; you can redistribute it and/or modify it | |||
| ;;; under the terms of the GNU General Public License as published by | |||
| ;;; the Free Software Foundation; either version 3 of the License, or (at | |||
| ;;; your option) any later version. | |||
| ;;; | |||
| ;;; GNU Guix is distributed in the hope that it will be useful, but | |||
| ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |||
| ;;; GNU General Public License for more details. | |||
| ;;; | |||
| ;;; You should have received a copy of the GNU General Public License | |||
| ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
| (define-module (guix gcrypt) | |||
| #:use-module (guix config) | |||
| #:use-module (system foreign) | |||
| #:export (gcrypt-version | |||
| libgcrypt-func)) | |||
| ;;; Commentary: | |||
| ;;; | |||
| ;;; Common code for the GNU Libgcrypt bindings. Loading this module | |||
| ;;; initializes Libgcrypt as a side effect. | |||
| ;;; | |||
| ;;; Code: | |||
| (define libgcrypt-func | |||
| (let ((lib (dynamic-link %libgcrypt))) | |||
| (lambda (func) | |||
| "Return a pointer to symbol FUNC in libgcrypt." | |||
| (dynamic-func func lib)))) | |||
| (define gcrypt-version | |||
| ;; According to the manual, this function must be called before any other, | |||
| ;; and it's not clear whether it can be called more than once. So call it | |||
| ;; right here from the top level. | |||
| (let* ((ptr (libgcrypt-func "gcry_check_version")) | |||
| (proc (pointer->procedure '* ptr '(*))) | |||
| (version (pointer->string (proc %null-pointer)))) | |||
| (lambda () | |||
| "Return the version number of libgcrypt as a string." | |||
| version))) | |||
| ;;; gcrypt.scm ends here | |||
+ 1
- 1
guix/git.scm
View File
| @@ -21,7 +21,7 @@ | |||
| #:use-module (git) | |||
| #:use-module (git object) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module ((guix build utils) #:select (mkdir-p)) | |||
| #:use-module (guix store) | |||
| #:use-module (guix utils) | |||
+ 0
- 184
guix/hash.scm
View File
| @@ -1,184 +0,0 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | |||
| ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org> | |||
| ;;; | |||
| ;;; This file is part of GNU Guix. | |||
| ;;; | |||
| ;;; GNU Guix is free software; you can redistribute it and/or modify it | |||
| ;;; under the terms of the GNU General Public License as published by | |||
| ;;; the Free Software Foundation; either version 3 of the License, or (at | |||
| ;;; your option) any later version. | |||
| ;;; | |||
| ;;; GNU Guix is distributed in the hope that it will be useful, but | |||
| ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |||
| ;;; GNU General Public License for more details. | |||
| ;;; | |||
| ;;; You should have received a copy of the GNU General Public License | |||
| ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
| (define-module (guix hash) | |||
| #:use-module (guix gcrypt) | |||
| #:use-module (rnrs bytevectors) | |||
| #:use-module (ice-9 binary-ports) | |||
| #:use-module (system foreign) | |||
| #:use-module ((guix build utils) #:select (dump-port)) | |||
| #:use-module (srfi srfi-11) | |||
| #:use-module (srfi srfi-26) | |||
| #:export (sha1 | |||
| sha256 | |||
| open-sha256-port | |||
| port-sha256 | |||
| file-sha256 | |||
| open-sha256-input-port)) | |||
| ;;; Commentary: | |||
| ;;; | |||
| ;;; Cryptographic hashes. | |||
| ;;; | |||
| ;;; Code: | |||
| ;;; | |||
| ;;; Hash. | |||
| ;;; | |||
| (define-syntax GCRY_MD_SHA256 | |||
| ;; Value as of Libgcrypt 1.5.2. | |||
| (identifier-syntax 8)) | |||
| (define-syntax GCRY_MD_SHA1 | |||
| (identifier-syntax 2)) | |||
| (define bytevector-hash | |||
| (let ((hash (pointer->procedure void | |||
| (libgcrypt-func "gcry_md_hash_buffer") | |||
| `(,int * * ,size_t)))) | |||
| (lambda (bv type size) | |||
| "Return the hash TYPE, of SIZE bytes, of BV as a bytevector." | |||
| (let ((digest (make-bytevector size))) | |||
| (hash type (bytevector->pointer digest) | |||
| (bytevector->pointer bv) (bytevector-length bv)) | |||
| digest)))) | |||
| (define sha1 | |||
| (cut bytevector-hash <> GCRY_MD_SHA1 20)) | |||
| (define sha256 | |||
| (cut bytevector-hash <> GCRY_MD_SHA256 (/ 256 8))) | |||
| (define open-sha256-md | |||
| (let ((open (pointer->procedure int | |||
| (libgcrypt-func "gcry_md_open") | |||
| `(* ,int ,unsigned-int)))) | |||
| (lambda () | |||
| (let* ((md (bytevector->pointer (make-bytevector (sizeof '*)))) | |||
| (err (open md GCRY_MD_SHA256 0))) | |||
| (if (zero? err) | |||
| (dereference-pointer md) | |||
| (throw 'gcrypt-error err)))))) | |||
| (define md-write | |||
| (pointer->procedure void | |||
| (libgcrypt-func "gcry_md_write") | |||
| `(* * ,size_t))) | |||
| (define md-read | |||
| (pointer->procedure '* | |||
| (libgcrypt-func "gcry_md_read") | |||
| `(* ,int))) | |||
| (define md-close | |||
| (pointer->procedure void | |||
| (libgcrypt-func "gcry_md_close") | |||
| '(*))) | |||
| (define (open-sha256-port) | |||
| "Return two values: an output port, and a thunk. When the thunk is called, | |||
| it returns the SHA256 hash (a bytevector) of all the data written to the | |||
| output port." | |||
| (define sha256-md | |||
| (open-sha256-md)) | |||
| (define digest #f) | |||
| (define position 0) | |||
| (define (finalize!) | |||
| (let ((ptr (md-read sha256-md 0))) | |||
| (set! digest (bytevector-copy (pointer->bytevector ptr 32))) | |||
| (md-close sha256-md))) | |||
| (define (write! bv offset len) | |||
| (if (zero? len) | |||
| (begin | |||
| (finalize!) | |||
| 0) | |||
| (let ((ptr (bytevector->pointer bv offset))) | |||
| (md-write sha256-md ptr len) | |||
| (set! position (+ position len)) | |||
| len))) | |||
| (define (get-position) | |||
| position) | |||
| (define (close) | |||
| (unless digest | |||
| (finalize!))) | |||
| (values (make-custom-binary-output-port "sha256" | |||
| write! get-position #f | |||
| close) | |||
| (lambda () | |||
| (unless digest | |||
| (finalize!)) | |||
| digest))) | |||
| (define (port-sha256 port) | |||
| "Return the SHA256 hash (a bytevector) of all the data drained from PORT." | |||
| (let-values (((out get) | |||
| (open-sha256-port))) | |||
| (dump-port port out) | |||
| (close-port out) | |||
| (get))) | |||
| (define (file-sha256 file) | |||
| "Return the SHA256 hash (a bytevector) of FILE." | |||
| (call-with-input-file file port-sha256)) | |||
| (define (open-sha256-input-port port) | |||
| "Return an input port that wraps PORT and a thunk to get the hash of all the | |||
| data read from PORT. The thunk always returns the same value." | |||
| (define md | |||
| (open-sha256-md)) | |||
| (define (read! bv start count) | |||
| (let ((n (get-bytevector-n! port bv start count))) | |||
| (if (eof-object? n) | |||
| 0 | |||
| (begin | |||
| (unless digest | |||
| (let ((ptr (bytevector->pointer bv start))) | |||
| (md-write md ptr n))) | |||
| n)))) | |||
| (define digest #f) | |||
| (define (finalize!) | |||
| (let ((ptr (md-read md 0))) | |||
| (set! digest (bytevector-copy (pointer->bytevector ptr 32))) | |||
| (md-close md))) | |||
| (define (get-hash) | |||
| (unless digest | |||
| (finalize!)) | |||
| digest) | |||
| (define (unbuffered port) | |||
| ;; Guile <= 2.0.9 does not support 'setvbuf' on custom binary input ports. | |||
| (setvbuf port _IONBF) | |||
| port) | |||
| (values (unbuffered (make-custom-binary-input-port "sha256" read! #f #f #f)) | |||
| get-hash)) | |||
| ;;; hash.scm ends here | |||
+ 1
- 1
guix/http-client.scm
View File
| @@ -34,7 +34,7 @@ | |||
| #:use-module (guix ui) | |||
| #:use-module (guix utils) | |||
| #:use-module (guix base64) | |||
| #:autoload (guix hash) (sha256) | |||
| #:autoload (gcrypt hash) (sha256) | |||
| #:use-module ((guix build utils) | |||
| #:select (mkdir-p dump-port)) | |||
| #:use-module ((guix build download) | |||
+ 1
- 1
guix/import/cpan.scm
View File
| @@ -27,7 +27,7 @@ | |||
| #:use-module (srfi srfi-1) | |||
| #:use-module (srfi srfi-26) | |||
| #:use-module (json) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix store) | |||
| #:use-module (guix utils) | |||
| #:use-module (guix base32) | |||
+ 1
- 1
guix/import/cran.scm
View File
| @@ -29,7 +29,7 @@ | |||
| #:use-module (web uri) | |||
| #:use-module (guix memoization) | |||
| #:use-module (guix http-client) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix store) | |||
| #:use-module (guix base32) | |||
| #:use-module ((guix download) #:select (download-to-store)) | |||
+ 1
- 1
guix/import/crate.scm
View File
| @@ -20,7 +20,7 @@ | |||
| #:use-module (guix base32) | |||
| #:use-module (guix build-system cargo) | |||
| #:use-module ((guix download) #:prefix download:) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix http-client) | |||
| #:use-module (guix import json) | |||
| #:use-module (guix import utils) | |||
+ 1
- 1
guix/import/elpa.scm
View File
| @@ -32,7 +32,7 @@ | |||
| #:use-module (guix http-client) | |||
| #:use-module (guix store) | |||
| #:use-module (guix ui) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix upstream) | |||
| #:use-module (guix packages) | |||
+ 1
- 1
guix/import/gnu.scm
View File
| @@ -21,7 +21,7 @@ | |||
| #:use-module (guix import utils) | |||
| #:use-module (guix utils) | |||
| #:use-module (guix store) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix upstream) | |||
| #:use-module (srfi srfi-1) | |||
+ 1
- 1
guix/import/hackage.scm
View File
| @@ -33,7 +33,7 @@ | |||
| #:use-module ((guix import utils) #:select (factorize-uri recursive-import)) | |||
| #:use-module (guix import cabal) | |||
| #:use-module (guix store) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix memoization) | |||
| #:use-module (guix upstream) | |||
+ 1
- 1
guix/import/texlive.scm
View File
| @@ -26,7 +26,7 @@ | |||
| #:use-module (srfi srfi-34) | |||
| #:use-module (web uri) | |||
| #:use-module (guix http-client) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix memoization) | |||
| #:use-module (guix store) | |||
| #:use-module (guix base32) | |||
+ 1
- 1
guix/import/utils.scm
View File
| @@ -23,7 +23,7 @@ | |||
| (define-module (guix import utils) | |||
| #:use-module (guix base32) | |||
| #:use-module ((guix build download) #:prefix build:) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix http-client) | |||
| #:use-module ((guix licenses) #:prefix license:) | |||
| #:use-module (guix utils) | |||
+ 2
- 2
guix/nar.scm
View File
| @@ -25,9 +25,9 @@ | |||
| #:use-module (guix store) | |||
| #:use-module (guix store database) | |||
| #:use-module (guix ui) ; for '_' | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix pki) | |||
| #:use-module (guix pk-crypto) | |||
| #:use-module (gcrypt pk-crypto) | |||
| #:use-module (srfi srfi-1) | |||
| #:use-module (srfi srfi-11) | |||
| #:use-module (srfi srfi-26) | |||
+ 0
- 407
guix/pk-crypto.scm
View File
| @@ -1,407 +0,0 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | |||
| ;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> | |||
| ;;; | |||
| ;;; This file is part of GNU Guix. | |||
| ;;; | |||
| ;;; GNU Guix is free software; you can redistribute it and/or modify it | |||
| ;;; under the terms of the GNU General Public License as published by | |||
| ;;; the Free Software Foundation; either version 3 of the License, or (at | |||
| ;;; your option) any later version. | |||
| ;;; | |||
| ;;; GNU Guix is distributed in the hope that it will be useful, but | |||
| ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |||
| ;;; GNU General Public License for more details. | |||
| ;;; | |||
| ;;; You should have received a copy of the GNU General Public License | |||
| ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
| (define-module (guix pk-crypto) | |||
| #:use-module (guix base16) | |||
| #:use-module (guix gcrypt) | |||
| #:use-module (system foreign) | |||
| #:use-module (rnrs bytevectors) | |||
| #:use-module (ice-9 match) | |||
| #:use-module (ice-9 rdelim) | |||
| #:export (canonical-sexp? | |||
| error-source | |||
| error-string | |||
| string->canonical-sexp | |||
| canonical-sexp->string | |||
| read-file-sexp | |||
| number->canonical-sexp | |||
| canonical-sexp-car | |||
| canonical-sexp-cdr | |||
| canonical-sexp-nth | |||
| canonical-sexp-nth-data | |||
| canonical-sexp-length | |||
| canonical-sexp-null? | |||
| canonical-sexp-list? | |||
| bytevector->hash-data | |||
| hash-data->bytevector | |||
| key-type | |||
| sign | |||
| verify | |||
| generate-key | |||
| find-sexp-token | |||
| canonical-sexp->sexp | |||
| sexp->canonical-sexp) | |||
| #:re-export (gcrypt-version)) | |||
| ;;; Commentary: | |||
| ;;; | |||
| ;;; Public key cryptographic routines from GNU Libgcrypt. | |||
| ;;;; | |||
| ;;; Libgcrypt uses "canonical s-expressions" to represent key material, | |||
| ;;; parameters, and data. We keep it as an opaque object to map them to | |||
| ;;; Scheme s-expressions because (1) Libgcrypt sexps may be stored in secure | |||
| ;;; memory, and (2) the read syntax is different. | |||
| ;;; | |||
| ;;; A 'canonical-sexp->sexp' procedure is provided nevertheless, for use in | |||
| ;;; cases where it is safe to move data out of Libgcrypt---e.g., when | |||
| ;;; processing ACL entries, public keys, etc. | |||
| ;;; | |||
| ;;; Canonical sexps were defined by Rivest et al. in the IETF draft at | |||
| ;;; <http://people.csail.mit.edu/rivest/Sexp.txt> for the purposes of SPKI | |||
| ;;; (see <http://www.ietf.org/rfc/rfc2693.txt>.) | |||
| ;;; | |||
| ;;; Code: | |||
| ;; Libgcrypt "s-expressions". | |||
| (define-wrapped-pointer-type <canonical-sexp> | |||
| canonical-sexp? | |||
| naked-pointer->canonical-sexp | |||
| canonical-sexp->pointer | |||
| (lambda (obj port) | |||
| ;; Don't print OBJ's external representation: we don't want key material | |||
| ;; to leak in backtraces and such. | |||
| (format port "#<canonical-sexp ~a | ~a>" | |||
| (number->string (object-address obj) 16) | |||
| (number->string (pointer-address (canonical-sexp->pointer obj)) | |||
| 16)))) | |||
| (define finalize-canonical-sexp! | |||
| (libgcrypt-func "gcry_sexp_release")) | |||
| (define-inlinable (pointer->canonical-sexp ptr) | |||
| "Return a <canonical-sexp> that wraps PTR." | |||
| (let* ((sexp (naked-pointer->canonical-sexp ptr)) | |||
| (ptr* (canonical-sexp->pointer sexp))) | |||
| ;; Did we already have a <canonical-sexp> object for PTR? | |||
| (when (equal? ptr ptr*) | |||
| ;; No, so we can safely add a finalizer (in Guile 2.0.9 | |||
| ;; 'set-pointer-finalizer!' *adds* a finalizer rather than replacing the | |||
| ;; existing one.) | |||
| (set-pointer-finalizer! ptr finalize-canonical-sexp!)) | |||
| sexp)) | |||
| (define error-source | |||
| (let* ((ptr (libgcrypt-func "gcry_strsource")) | |||
| (proc (pointer->procedure '* ptr (list int)))) | |||
| (lambda (err) | |||
| "Return the error source (a string) for ERR, an error code as thrown | |||
| along with 'gcry-error'." | |||
| (pointer->string (proc err))))) | |||
| (define error-string | |||
| (let* ((ptr (libgcrypt-func "gcry_strerror")) | |||
| (proc (pointer->procedure '* ptr (list int)))) | |||
| (lambda (err) | |||
| "Return the error description (a string) for ERR, an error code as | |||
| thrown along with 'gcry-error'." | |||
| (pointer->string (proc err))))) | |||
| (define string->canonical-sexp | |||
| (let* ((ptr (libgcrypt-func "gcry_sexp_new")) | |||
| (proc (pointer->procedure int ptr `(* * ,size_t ,int)))) | |||
| (lambda (str) | |||
| "Parse STR and return the corresponding gcrypt s-expression." | |||
| ;; When STR comes from 'canonical-sexp->string', it may contain | |||
| ;; characters that are really meant to be interpreted as bytes as in a C | |||
| ;; 'char *'. Thus, convert STR to ISO-8859-1 so the byte values of the | |||
| ;; characters are preserved. | |||
| (let* ((sexp (bytevector->pointer (make-bytevector (sizeof '*)))) | |||
| (err (proc sexp (string->pointer str "ISO-8859-1") 0 1))) | |||
| (if (= 0 err) | |||
| (pointer->canonical-sexp (dereference-pointer sexp)) | |||
| (throw 'gcry-error 'string->canonical-sexp err)))))) | |||
| (define-syntax GCRYSEXP_FMT_ADVANCED | |||
| (identifier-syntax 3)) | |||
| (define canonical-sexp->string | |||
| (let* ((ptr (libgcrypt-func "gcry_sexp_sprint")) | |||
| (proc (pointer->procedure size_t ptr `(* ,int * ,size_t)))) | |||
| (lambda (sexp) | |||
| "Return a textual representation of SEXP." | |||
| (let loop ((len 1024)) | |||
| (let* ((buf (bytevector->pointer (make-bytevector len))) | |||
| (size (proc (canonical-sexp->pointer sexp) | |||
| GCRYSEXP_FMT_ADVANCED buf len))) | |||
| (if (zero? size) | |||
| (loop (* len 2)) | |||
| (pointer->string buf size "ISO-8859-1"))))))) | |||
| (define (read-file-sexp file) | |||
| "Return the canonical sexp read from FILE." | |||
| (call-with-input-file file | |||
| (compose string->canonical-sexp | |||
| read-string))) | |||
| (define canonical-sexp-car | |||
| (let* ((ptr (libgcrypt-func "gcry_sexp_car")) | |||
| (proc (pointer->procedure '* ptr '(*)))) | |||
| (lambda (lst) | |||
| "Return the first element of LST, an sexp, if that element is a list; | |||
| return #f if LST or its first element is not a list (this is different from | |||
| the usual Lisp 'car'.)" | |||
| (let ((result (proc (canonical-sexp->pointer lst)))) | |||
| (if (null-pointer? result) | |||
| #f | |||
| (pointer->canonical-sexp result)))))) | |||
| (define canonical-sexp-cdr | |||
| (let* ((ptr (libgcrypt-func "gcry_sexp_cdr")) | |||
| (proc (pointer->procedure '* ptr '(*)))) | |||
| (lambda (lst) | |||
| "Return the tail of LST, an sexp, or #f if LST is not a list." | |||
| (let ((result (proc (canonical-sexp->pointer lst)))) | |||
| (if (null-pointer? result) | |||
| #f | |||
| (pointer->canonical-sexp result)))))) | |||
| (define canonical-sexp-nth | |||
| (let* ((ptr (libgcrypt-func "gcry_sexp_nth")) | |||
| (proc (pointer->procedure '* ptr `(* ,int)))) | |||
| (lambda (lst index) | |||
| "Return the INDEXth nested element of LST, an s-expression. Return #f | |||
| if that element does not exist, or if it's an atom. (Note: this is obviously | |||
| different from Scheme's 'list-ref'.)" | |||
| (let ((result (proc (canonical-sexp->pointer lst) index))) | |||
| (if (null-pointer? result) | |||
| #f | |||
| (pointer->canonical-sexp result)))))) | |||
| (define (dereference-size_t p) | |||
| "Return the size_t value pointed to by P." | |||
| (bytevector-uint-ref (pointer->bytevector p (sizeof size_t)) | |||
| 0 (native-endianness) | |||
| (sizeof size_t))) | |||
| (define canonical-sexp-length | |||
| (let* ((ptr (libgcrypt-func "gcry_sexp_length")) | |||
| (proc (pointer->procedure int ptr '(*)))) | |||
| (lambda (sexp) | |||
| "Return the length of SEXP if it's a list (including the empty list); | |||
| return zero if SEXP is an atom." | |||
| (proc (canonical-sexp->pointer sexp))))) | |||
| (define token-string? | |||
| (let ((token-cs (char-set-union char-set:digit | |||
| char-set:letter | |||
| (char-set #\- #\. #\/ #\_ | |||
| #\: #\* #\+ #\=)))) | |||
| (lambda (str) | |||
| "Return #t if STR is a token as per Section 4.3 of | |||
| <http://people.csail.mit.edu/rivest/Sexp.txt>." | |||
| (and (not (string-null? str)) | |||
| (string-every token-cs str) | |||
| (not (char-set-contains? char-set:digit (string-ref str 0))))))) | |||
| (define canonical-sexp-nth-data | |||
| (let* ((ptr (libgcrypt-func "gcry_sexp_nth_data")) | |||
| (proc (pointer->procedure '* ptr `(* ,int *)))) | |||
| (lambda (lst index) | |||
| "Return as a symbol (for \"sexp tokens\") or a bytevector (for any other | |||
| \"octet string\") the INDEXth data element (atom) of LST, an s-expression. | |||
| Return #f if that element does not exist, or if it's a list." | |||
| (let* ((size* (bytevector->pointer (make-bytevector (sizeof '*)))) | |||
| (result (proc (canonical-sexp->pointer lst) index size*))) | |||
| (if (null-pointer? result) | |||
| #f | |||
| (let* ((len (dereference-size_t size*)) | |||
| (str (pointer->string result len "ISO-8859-1"))) | |||
| ;; The sexp spec speaks of "tokens" and "octet strings". | |||
| ;; Sometimes these octet strings are actual strings (text), | |||
| ;; sometimes they're bytevectors, and sometimes they're | |||
| ;; multi-precision integers (MPIs). Only the application knows. | |||
| ;; However, for convenience, we return a symbol when a token is | |||
| ;; encountered since tokens are frequent (at least in the 'car' | |||
| ;; of each sexp.) | |||
| (if (token-string? str) | |||
| (string->symbol str) ; an sexp "token" | |||
| (bytevector-copy ; application data, textual or binary | |||
| (pointer->bytevector result len))))))))) | |||
| (define (number->canonical-sexp number) | |||
| "Return an s-expression representing NUMBER." | |||
| (string->canonical-sexp (string-append "#" (number->string number 16) "#"))) | |||
| (define* (bytevector->hash-data bv | |||
| #:optional | |||
| (hash-algo "sha256") | |||
| #:key (key-type 'ecc)) | |||
| "Given BV, a bytevector containing a hash of type HASH-ALGO, return an | |||
| s-expression suitable for use as the 'data' argument for 'sign'. KEY-TYPE | |||
| must be a symbol: 'dsa, 'ecc, or 'rsa." | |||
| (string->canonical-sexp | |||
| (format #f "(data (flags ~a) (hash \"~a\" #~a#))" | |||
| (case key-type | |||
| ((ecc dsa) "rfc6979") | |||
| ((rsa) "pkcs1") | |||
| (else (error "unknown key type" key-type))) | |||
| hash-algo | |||
| (bytevector->base16-string bv)))) | |||
| (define (key-type sexp) | |||
| "Return a symbol denoting the type of public or private key represented by | |||
| SEXP--e.g., 'rsa', 'ecc'--or #f if SEXP does not denote a valid key." | |||
| (case (canonical-sexp-nth-data sexp 0) | |||
| ((public-key private-key) | |||
| (canonical-sexp-nth-data (canonical-sexp-nth sexp 1) 0)) | |||
| (else #f))) | |||
| (define* (hash-data->bytevector data) | |||
| "Return two values: the hash value (a bytevector), and the hash algorithm (a | |||
| string) extracted from DATA, an sexp as returned by 'bytevector->hash-data'. | |||
| Return #f if DATA does not conform." | |||
| (let ((hash (find-sexp-token data 'hash))) | |||
| (if hash | |||
| (let ((algo (canonical-sexp-nth-data hash 1)) | |||
| (value (canonical-sexp-nth-data hash 2))) | |||
| (values value (symbol->string algo))) | |||
| (values #f #f)))) | |||
| (define sign | |||
| (let* ((ptr (libgcrypt-func "gcry_pk_sign")) | |||
| (proc (pointer->procedure int ptr '(* * *)))) | |||
| (lambda (data secret-key) | |||
| "Sign DATA, a canonical s-expression representing a suitable hash, with | |||
| SECRET-KEY (a canonical s-expression whose car is 'private-key'.) Note that | |||
| DATA must be a 'data' s-expression, as returned by | |||
| 'bytevector->hash-data' (info \"(gcrypt) Cryptographic Functions\")." | |||
| (let* ((sig (bytevector->pointer (make-bytevector (sizeof '*)))) | |||
| (err (proc sig (canonical-sexp->pointer data) | |||
| (canonical-sexp->pointer secret-key)))) | |||
| (if (= 0 err) | |||
| (pointer->canonical-sexp (dereference-pointer sig)) | |||
| (throw 'gcry-error 'sign err)))))) | |||
| (define verify | |||
| (let* ((ptr (libgcrypt-func "gcry_pk_verify")) | |||
| (proc (pointer->procedure int ptr '(* * *)))) | |||
| (lambda (signature data public-key) | |||
| "Verify that SIGNATURE is a signature of DATA with PUBLIC-KEY, all of | |||
| which are gcrypt s-expressions." | |||
| (zero? (proc (canonical-sexp->pointer signature) | |||
| (canonical-sexp->pointer data) | |||
| (canonical-sexp->pointer public-key)))))) | |||
| (define generate-key | |||
| (let* ((ptr (libgcrypt-func "gcry_pk_genkey")) | |||
| (proc (pointer->procedure int ptr '(* *)))) | |||
| (lambda (params) | |||
| "Return as an s-expression a new key pair for PARAMS. PARAMS must be an | |||
| s-expression like: (genkey (rsa (nbits 4:2048)))." | |||
| (let* ((key (bytevector->pointer (make-bytevector (sizeof '*)))) | |||
| (err (proc key (canonical-sexp->pointer params)))) | |||
| (if (zero? err) | |||
| (pointer->canonical-sexp (dereference-pointer key)) | |||
| (throw 'gcry-error 'generate-key err)))))) | |||
| (define find-sexp-token | |||
| (let* ((ptr (libgcrypt-func "gcry_sexp_find_token")) | |||
| (proc (pointer->procedure '* ptr `(* * ,size_t)))) | |||
| (lambda (sexp token) | |||
| "Find in SEXP the first element whose 'car' is TOKEN and return it; | |||
| return #f if not found." | |||
| (let* ((token (string->pointer (symbol->string token))) | |||
| (res (proc (canonical-sexp->pointer sexp) token 0))) | |||
| (if (null-pointer? res) | |||
| #f | |||
| (pointer->canonical-sexp res)))))) | |||
| (define-inlinable (canonical-sexp-null? sexp) | |||
| "Return #t if SEXP is the empty-list sexp." | |||
| (null-pointer? (canonical-sexp->pointer sexp))) | |||
| (define (canonical-sexp-list? sexp) | |||
| "Return #t if SEXP is a list." | |||
| (or (canonical-sexp-null? sexp) | |||
| (> (canonical-sexp-length sexp) 0))) | |||
| (define (canonical-sexp-fold proc seed sexp) | |||
| "Fold PROC (as per SRFI-1) over SEXP, a canonical sexp." | |||
| (if (canonical-sexp-list? sexp) | |||
| (let ((len (canonical-sexp-length sexp))) | |||
| (let loop ((index 0) | |||
| (result seed)) | |||
| (if (= index len) | |||
| result | |||
| (loop (+ 1 index) | |||
| ;; XXX: Call 'nth-data' *before* 'nth' to work around | |||
| ;; <https://bugs.g10code.com/gnupg/issue1594>, which | |||
| ;; affects 1.6.0 and earlier versions. | |||
| (proc (or (canonical-sexp-nth-data sexp index) | |||
| (canonical-sexp-nth sexp index)) | |||
| result))))) | |||
| (error "sexp is not a list" sexp))) | |||
| (define (canonical-sexp->sexp sexp) | |||
| "Return a Scheme sexp corresponding to SEXP. This is particularly useful to | |||
| compare sexps (since Libgcrypt does not provide an 'equal?' procedure), or to | |||
| use pattern matching." | |||
| (if (canonical-sexp-list? sexp) | |||
| (reverse | |||
| (canonical-sexp-fold (lambda (item result) | |||
| (cons (if (canonical-sexp? item) | |||
| (canonical-sexp->sexp item) | |||
| item) | |||
| result)) | |||
| '() | |||
| sexp)) | |||
| ;; As of Libgcrypt 1.6.0, there's no function to extract the buffer of a | |||
| ;; non-list sexp (!), so we first enlist SEXP, then get at its buffer. | |||
| (let ((sexp (string->canonical-sexp | |||
| (string-append "(" (canonical-sexp->string sexp) | |||
| ")")))) | |||
| (or (canonical-sexp-nth-data sexp 0) | |||
| (canonical-sexp-nth sexp 0))))) | |||
| (define (sexp->canonical-sexp sexp) | |||
| "Return a canonical sexp equivalent to SEXP, a Scheme sexp as returned by | |||
| 'canonical-sexp->sexp'." | |||
| ;; XXX: This is inefficient, but the Libgcrypt API doesn't allow us to do | |||
| ;; much better. | |||
| (string->canonical-sexp | |||
| (call-with-output-string | |||
| (lambda (port) | |||
| (define (write item) | |||
| (cond ((list? item) | |||
| (display "(" port) | |||
| (for-each write item) | |||
| (display ")" port)) | |||
| ((symbol? item) | |||
| (format port " ~a" item)) | |||
| ((bytevector? item) | |||
| (format port " #~a#" | |||
| (bytevector->base16-string item))) | |||
| (else | |||
| (error "unsupported sexp item type" item)))) | |||
| (write sexp))))) | |||
| (define (gcrypt-error-printer port key args default-printer) | |||
| "Print the gcrypt error specified by ARGS." | |||
| (match args | |||
| ((proc err) | |||
| (format port "In procedure ~a: ~a: ~a" | |||
| proc (error-source err) (error-string err))))) | |||
| (set-exception-printer! 'gcry-error gcrypt-error-printer) | |||
| ;;; pk-crypto.scm ends here | |||
+ 1
- 1
guix/pki.scm
View File
| @@ -18,7 +18,7 @@ | |||
| (define-module (guix pki) | |||
| #:use-module (guix config) | |||
| #:use-module (guix pk-crypto) | |||
| #:use-module (gcrypt pk-crypto) | |||
| #:use-module ((guix utils) #:select (with-atomic-file-output)) | |||
| #:use-module ((guix build utils) #:select (mkdir-p)) | |||
| #:use-module (ice-9 match) | |||
+ 1
- 1
guix/scripts/archive.scm
View File
| @@ -29,7 +29,7 @@ | |||
| #:use-module (guix monads) | |||
| #:use-module (guix ui) | |||
| #:use-module (guix pki) | |||
| #:use-module (guix pk-crypto) | |||
| #:use-module (gcrypt pk-crypto) | |||
| #:use-module (guix scripts) | |||
| #:use-module (guix scripts build) | |||
| #:use-module (gnu packages) | |||
+ 1
- 1
guix/scripts/authenticate.scm
View File
| @@ -19,7 +19,7 @@ | |||
| (define-module (guix scripts authenticate) | |||
| #:use-module (guix config) | |||
| #:use-module (guix base16) | |||
| #:use-module (guix pk-crypto) | |||
| #:use-module (gcrypt pk-crypto) | |||
| #:use-module (guix pki) | |||
| #:use-module (guix ui) | |||
| #:use-module (ice-9 binary-ports) | |||
+ 1
- 1
guix/scripts/download.scm
View File
| @@ -20,7 +20,7 @@ | |||
| #:use-module (guix ui) | |||
| #:use-module (guix scripts) | |||
| #:use-module (guix store) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base16) | |||
| #:use-module (guix base32) | |||
| #:use-module ((guix download) #:hide (url-fetch)) | |||
+ 3
- 3
guix/scripts/hash.scm
View File
| @@ -20,7 +20,7 @@ | |||
| (define-module (guix scripts hash) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix serialization) | |||
| #:use-module (guix ui) | |||
| #:use-module (guix scripts) | |||
| @@ -44,7 +44,7 @@ | |||
| `((format . ,bytevector->nix-base32-string))) | |||
| (define (show-help) | |||
| (display (G_ "Usage: guix hash [OPTION] FILE | |||
| (display (G_ "Usage: gcrypt hash [OPTION] FILE | |||
| Return the cryptographic hash of FILE. | |||
| Supported formats: 'nix-base32' (default), 'base32', and 'base16' ('hex' | |||
| @@ -93,7 +93,7 @@ and 'hexadecimal' can be used as well).\n")) | |||
| (exit 0))) | |||
| (option '(#\V "version") #f #f | |||
| (lambda args | |||
| (show-version-and-exit "guix hash"))))) | |||
| (show-version-and-exit "gcrypt hash"))))) | |||
+ 16
- 44
guix/scripts/pack.scm
View File
| @@ -41,7 +41,7 @@ | |||
| #:use-module (gnu packages guile) | |||
| #:use-module (gnu packages base) | |||
| #:autoload (gnu packages package-management) (guix) | |||
| #:autoload (gnu packages gnupg) (libgcrypt) | |||
| #:autoload (gnu packages gnupg) (guile-gcrypt) | |||
| #:autoload (gnu packages guile) (guile2.0-json guile-json) | |||
| #:use-module (srfi srfi-1) | |||
| #:use-module (srfi srfi-9) | |||
| @@ -95,10 +95,12 @@ found." | |||
| (('gnu _ ...) #t) | |||
| (_ #f))) | |||
| (define guile-sqlite3&co | |||
| ;; Guile-SQLite3 and its propagated inputs. | |||
| (cons guile-sqlite3 | |||
| (package-transitive-propagated-inputs guile-sqlite3))) | |||
| (define gcrypt-sqlite3&co | |||
| ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs. | |||
| (append-map (lambda (package) | |||
| (cons package | |||
| (package-transitive-propagated-inputs package))) | |||
| (list guile-gcrypt guile-sqlite3))) | |||
| (define* (self-contained-tarball name profile | |||
| #:key target | |||
| @@ -124,16 +126,14 @@ added to the pack." | |||
| "guix/store/schema.sql")))) | |||
| (define build | |||
| (with-imported-modules `(((guix config) | |||
| => ,(make-config.scm | |||
| #:libgcrypt libgcrypt)) | |||
| (with-imported-modules `(((guix config) => ,(make-config.scm)) | |||
| ,@(source-module-closure | |||
| `((guix build utils) | |||
| (guix build union) | |||
| (guix build store-copy) | |||
| (gnu build install)) | |||
| #:select? not-config?)) | |||
| (with-extensions guile-sqlite3&co | |||
| (with-extensions gcrypt-sqlite3&co | |||
| #~(begin | |||
| (use-modules (guix build utils) | |||
| ((guix build union) #:select (relative-file-name)) | |||
| @@ -251,22 +251,14 @@ points for virtual file systems (like procfs), and optional symlinks. | |||
| SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be | |||
| added to the pack." | |||
| (define libgcrypt | |||
| ;; XXX: Not strictly needed, but pulled by (guix store database). | |||
| (module-ref (resolve-interface '(gnu packages gnupg)) | |||
| 'libgcrypt)) | |||
| (define build | |||
| (with-imported-modules `(((guix config) | |||
| => ,(make-config.scm | |||
| #:libgcrypt libgcrypt)) | |||
| (with-imported-modules `(((guix config) => ,(make-config.scm)) | |||
| ,@(source-module-closure | |||
| '((guix build utils) | |||
| (guix build store-copy) | |||
| (gnu build install)) | |||
| #:select? not-config?)) | |||
| (with-extensions guile-sqlite3&co | |||
| (with-extensions gcrypt-sqlite3&co | |||
| #~(begin | |||
| (use-modules (guix build utils) | |||
| (gnu build install) | |||
| @@ -349,32 +341,12 @@ must a be a GNU triplet and it is used to derive the architecture metadata in | |||
| the image." | |||
| (define defmod 'define-module) ;trick Geiser | |||
| (define config | |||
| ;; (guix config) module for consumption by (guix gcrypt). | |||
| (scheme-file "gcrypt-config.scm" | |||
| #~(begin | |||
| (#$defmod (guix config) | |||
| #:export (%libgcrypt)) | |||
| ;; XXX: Work around <http://bugs.gnu.org/15602>. | |||
| (eval-when (expand load eval) | |||
| (define %libgcrypt | |||
| #+(file-append libgcrypt "/lib/libgcrypt")))))) | |||
| (define json | |||
| ;; Pick the guile-json package that corresponds to the Guile used to build | |||
| ;; derivations. | |||
| (if (string-prefix? "2.0" (package-version (default-guile))) | |||
| guile2.0-json | |||
| guile-json)) | |||
| (define build | |||
| ;; Guile-JSON is required by (guix docker). | |||
| (with-extensions (list json) | |||
| (with-imported-modules `(,@(source-module-closure '((guix docker) | |||
| (guix build store-copy)) | |||
| #:select? not-config?) | |||
| ((guix config) => ,config)) | |||
| ;; Guile-JSON and Guile-Gcrypt are required by (guix docker). | |||
| (with-extensions (list guile-json guile-gcrypt) | |||
| (with-imported-modules (source-module-closure '((guix docker) | |||
| (guix build store-copy)) | |||
| #:select? not-config?) | |||
| #~(begin | |||
| (use-modules (guix docker) (srfi srfi-19) (guix build store-copy)) | |||
+ 2
- 2
guix/scripts/publish.scm
View File
| @@ -44,9 +44,9 @@ | |||
| #:use-module (guix base64) | |||
| #:use-module (guix config) | |||
| #:use-module (guix derivations) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix pki) | |||
| #:use-module (guix pk-crypto) | |||
| #:use-module (gcrypt pk-crypto) | |||
| #:use-module (guix workers) | |||
| #:use-module (guix store) | |||
| #:use-module ((guix serialization) #:select (write-file)) | |||
+ 1
- 1
guix/scripts/refresh.scm
View File
| @@ -23,7 +23,7 @@ | |||
| (define-module (guix scripts refresh) | |||
| #:use-module (guix ui) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix scripts) | |||
| #:use-module (guix store) | |||
| #:use-module (guix utils) | |||
+ 2
- 2
guix/scripts/substitute.scm
View File
| @@ -26,11 +26,11 @@ | |||
| #:use-module (guix config) | |||
| #:use-module (guix records) | |||
| #:use-module ((guix serialization) #:select (restore-file)) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix base64) | |||
| #:use-module (guix cache) | |||
| #:use-module (guix pk-crypto) | |||
| #:use-module (gcrypt pk-crypto) | |||
| #:use-module (guix pki) | |||
| #:use-module ((guix build utils) #:select (mkdir-p dump-port)) | |||
| #:use-module ((guix build download) | |||
+ 11
- 15
guix/self.scm
View File
| @@ -83,8 +83,8 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." | |||
| ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) | |||
| ("guile-git" (ref '(gnu packages guile) 'guile-git)) | |||
| ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) | |||
| ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-gcrypt)) | |||
| ("gnutls" (ref '(gnu packages tls) 'gnutls)) | |||
| ("libgcrypt" (ref '(gnu packages gnupg) 'libgcrypt)) | |||
| ("zlib" (ref '(gnu packages compression) 'zlib)) | |||
| ("gzip" (ref '(gnu packages compression) 'gzip)) | |||
| ("bzip2" (ref '(gnu packages compression) 'bzip2)) | |||
| @@ -454,7 +454,6 @@ assumed to be part of MODULES." | |||
| (name (string-append "guix-" version)) | |||
| (guile-version (effective-version)) | |||
| (guile-for-build (guile-for-build guile-version)) | |||
| (libgcrypt (specification->package "libgcrypt")) | |||
| (zlib (specification->package "zlib")) | |||
| (gzip (specification->package "gzip")) | |||
| (bzip2 (specification->package "bzip2")) | |||
| @@ -481,6 +480,10 @@ assumed to be part of MODULES." | |||
| "guile-sqlite3" | |||
| "guile2.0-sqlite3")) | |||
| (define guile-gcrypt | |||
| (package-for-guile guile-version | |||
| "guile-gcrypt")) | |||
| (define gnutls | |||
| (package-for-guile guile-version | |||
| "gnutls" "guile2.0-gnutls")) | |||
| @@ -489,7 +492,7 @@ assumed to be part of MODULES." | |||
| (match (append-map (lambda (package) | |||
| (cons (list "x" package) | |||
| (package-transitive-propagated-inputs package))) | |||
| (list gnutls guile-git guile-json | |||
| (list guile-gcrypt gnutls guile-git guile-json | |||
| guile-ssh guile-sqlite3)) | |||
| (((labels packages _ ...) ...) | |||
| packages))) | |||
| @@ -513,10 +516,7 @@ assumed to be part of MODULES." | |||
| ;; rebuilt when the version changes, which in turn means we | |||
| ;; can have substitutes for it. | |||
| #:extra-modules | |||
| `(((guix config) | |||
| => ,(make-config.scm #:libgcrypt | |||
| (specification->package | |||
| "libgcrypt")))) | |||
| `(((guix config) => ,(make-config.scm))) | |||
| ;; (guix man-db) is needed at build-time by (guix profiles) | |||
| ;; but we don't need to compile it; not compiling it allows | |||
| @@ -526,6 +526,7 @@ assumed to be part of MODULES." | |||
| ("guix/store/schema.sql" | |||
| ,(local-file "../guix/store/schema.sql"))) | |||
| #:extensions (list guile-gcrypt) | |||
| #:guile-for-build guile-for-build)) | |||
| (define *extra-modules* | |||
| @@ -600,8 +601,7 @@ assumed to be part of MODULES." | |||
| '() | |||
| #:extra-modules | |||
| `(((guix config) | |||
| => ,(make-config.scm #:libgcrypt libgcrypt | |||
| #:zlib zlib | |||
| => ,(make-config.scm #:zlib zlib | |||
| #:gzip gzip | |||
| #:bzip2 bzip2 | |||
| #:xz xz | |||
| @@ -684,7 +684,7 @@ assumed to be part of MODULES." | |||
| (define %dependency-variables | |||
| ;; (guix config) variables corresponding to dependencies. | |||
| '(%libgcrypt %libz %xz %gzip %bzip2)) | |||
| '(%libz %xz %gzip %bzip2)) | |||
| (define %persona-variables | |||
| ;; (guix config) variables that define Guix's persona. | |||
| @@ -703,7 +703,7 @@ assumed to be part of MODULES." | |||
| (variables rest ...)))))) | |||
| (variables %localstatedir %storedir %sysconfdir %system))) | |||
| (define* (make-config.scm #:key libgcrypt zlib gzip xz bzip2 | |||
| (define* (make-config.scm #:key zlib gzip xz bzip2 | |||
| (package-name "GNU Guix") | |||
| (package-version "0") | |||
| (bug-report-address "bug-guix@gnu.org") | |||
| @@ -723,7 +723,6 @@ assumed to be part of MODULES." | |||
| %state-directory | |||
| %store-database-directory | |||
| %config-directory | |||
| %libgcrypt | |||
| %libz | |||
| %gzip | |||
| %bzip2 | |||
| @@ -766,9 +765,6 @@ assumed to be part of MODULES." | |||
| (define %xz | |||
| #+(and xz (file-append xz "/bin/xz"))) | |||
| (define %libgcrypt | |||
| #+(and libgcrypt | |||
| (file-append libgcrypt "/lib/libgcrypt"))) | |||
| (define %libz | |||
| #+(and zlib | |||
| (file-append zlib "/lib/libz")))) | |||
+ 1
- 1
guix/store.scm
View File
| @@ -25,7 +25,7 @@ | |||
| #:use-module (guix monads) | |||
| #:use-module (guix base16) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix profiling) | |||
| #:autoload (guix build syscalls) (terminal-columns) | |||
| #:use-module (rnrs bytevectors) | |||
+ 1
- 1
guix/store/deduplication.scm
View File
| @@ -21,7 +21,7 @@ | |||
| ;;; timestamps, deduplicating, etc. | |||
| (define-module (guix store deduplication) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix build utils) | |||
| #:use-module (guix base16) | |||
| #:use-module (srfi srfi-11) | |||
+ 1
- 1
guix/tests.scm
View File
| @@ -22,7 +22,7 @@ | |||
| #:use-module (guix packages) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix serialization) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix build-system gnu) | |||
| #:use-module (gnu packages bootstrap) | |||
| #:use-module (srfi srfi-34) | |||
+ 0
- 18
m4/guix.m4
View File
| @@ -18,24 +18,6 @@ dnl | |||
| dnl You should have received a copy of the GNU General Public License | |||
| dnl along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
| dnl GUIX_ASSERT_LIBGCRYPT_USABLE | |||
| dnl | |||
| dnl Assert that GNU libgcrypt is usable from Guile. | |||
| AC_DEFUN([GUIX_ASSERT_LIBGCRYPT_USABLE], | |||
| [AC_CACHE_CHECK([whether $LIBGCRYPT can be dynamically loaded], | |||
| [guix_cv_libgcrypt_usable_p], | |||
| [GUILE_CHECK([retval], | |||
| [(dynamic-func \"gcry_md_hash_buffer\" (dynamic-link \"$LIBGCRYPT\"))]) | |||
| if test "$retval" = 0; then | |||
| guix_cv_libgcrypt_usable_p="yes" | |||
| else | |||
| guix_cv_libgcrypt_usable_p="no" | |||
| fi]) | |||
| if test "x$guix_cv_libgcrypt_usable_p" != "xyes"; then | |||
| AC_MSG_ERROR([GNU libgcrypt does not appear to be usable; see `--with-libgcrypt-prefix' and `README'.]) | |||
| fi]) | |||
| dnl GUIX_SYSTEM_TYPE | |||
| dnl | |||
| dnl Determine the Guix host system type, and store it in the | |||
+ 1
- 1
tests/base32.scm
View File
| @@ -17,7 +17,7 @@ | |||
| ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
| (define-module (test-base32) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix utils) | |||
| #:use-module (srfi srfi-1) | |||
+ 1
- 1
tests/builders.scm
View File
| @@ -25,7 +25,7 @@ | |||
| #:use-module (guix utils) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix derivations) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix tests) | |||
| #:use-module ((guix packages) | |||
| #:select (package-derivation package-native-search-paths)) | |||
+ 1
- 1
tests/challenge.scm
View File
| @@ -18,7 +18,7 @@ | |||
| (define-module (test-challenge) | |||
| #:use-module (guix tests) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix store) | |||
| #:use-module (guix monads) | |||
| #:use-module (guix derivations) | |||
+ 1
- 1
tests/cpan.scm
View File
| @@ -20,7 +20,7 @@ | |||
| (define-module (test-cpan) | |||
| #:use-module (guix import cpan) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix tests) | |||
| #:use-module (guix grafts) | |||
| #:use-module (srfi srfi-64) | |||
+ 1
- 1
tests/crate.scm
View File
| @@ -21,7 +21,7 @@ | |||
| #:use-module (guix import crate) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix build-system cargo) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix tests) | |||
| #:use-module (ice-9 iconv) | |||
| #:use-module (ice-9 match) | |||
+ 1
- 1
tests/derivations.scm
View File
| @@ -23,7 +23,7 @@ | |||
| #:use-module (guix grafts) | |||
| #:use-module (guix store) | |||
| #:use-module (guix utils) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix tests) | |||
| #:use-module (guix tests http) | |||
+ 1
- 1
tests/gem.scm
View File
| @@ -21,7 +21,7 @@ | |||
| (define-module (test-gem) | |||
| #:use-module (guix import gem) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix tests) | |||
| #:use-module ((guix build utils) #:select (delete-file-recursively)) | |||
| #:use-module (srfi srfi-41) | |||
+ 0
- 128
tests/hash.scm
View File
| @@ -1,128 +0,0 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | |||
| ;;; Copyright © 2013, 2014, 2017, 2018 Ludovic Courtès <ludo@gnu.org> | |||
| ;;; | |||
| ;;; This file is part of GNU Guix. | |||
| ;;; | |||
| ;;; GNU Guix is free software; you can redistribute it and/or modify it | |||
| ;;; under the terms of the GNU General Public License as published by | |||
| ;;; the Free Software Foundation; either version 3 of the License, or (at | |||
| ;;; your option) any later version. | |||
| ;;; | |||
| ;;; GNU Guix is distributed in the hope that it will be useful, but | |||
| ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |||
| ;;; GNU General Public License for more details. | |||
| ;;; | |||
| ;;; You should have received a copy of the GNU General Public License | |||
| ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
| (define-module (test-hash) | |||
| #:use-module (guix hash) | |||
| #:use-module (guix base16) | |||
| #:use-module (srfi srfi-1) | |||
| #:use-module (srfi srfi-11) | |||
| #:use-module (srfi srfi-64) | |||
| #:use-module (rnrs bytevectors) | |||
| #:use-module (rnrs io ports)) | |||
| ;; Test the (guix hash) module. | |||
| (define %empty-sha256 | |||
| ;; SHA256 hash of the empty string. | |||
| (base16-string->bytevector | |||
| "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")) | |||
| (define %hello-sha256 | |||
| ;; SHA256 hash of "hello world" | |||
| (base16-string->bytevector | |||
| "b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9")) | |||
| (test-begin "hash") | |||
| (test-equal "sha1, empty" | |||
| (base16-string->bytevector "da39a3ee5e6b4b0d3255bfef95601890afd80709") | |||
| (sha1 #vu8())) | |||
| (test-equal "sha1, hello" | |||
| (base16-string->bytevector "2aae6c35c94fcfb415dbe95f408b9ce91ee846ed") | |||
| (sha1 (string->utf8 "hello world"))) | |||
| (test-equal "sha256, empty" | |||
| %empty-sha256 | |||
| (sha256 #vu8())) | |||
| (test-equal "sha256, hello" | |||
| %hello-sha256 | |||
| (sha256 (string->utf8 "hello world"))) | |||
| (test-equal "open-sha256-port, empty" | |||
| %empty-sha256 | |||
| (let-values (((port get) | |||
| (open-sha256-port))) | |||
| (close-port port) | |||
| (get))) | |||
| (test-equal "open-sha256-port, hello" | |||
| (list %hello-sha256 (string-length "hello world")) | |||
| (let-values (((port get) | |||
| (open-sha256-port))) | |||
| (put-bytevector port (string->utf8 "hello world")) | |||
| (force-output port) | |||
| (list (get) (port-position port)))) | |||
| (test-assert "port-sha256" | |||
| (let* ((file (search-path %load-path "ice-9/psyntax.scm")) | |||
| (size (stat:size (stat file))) | |||
| (contents (call-with-input-file file get-bytevector-all))) | |||
| (equal? (sha256 contents) | |||
| (call-with-input-file file port-sha256)))) | |||
| (test-equal "open-sha256-input-port, empty" | |||
| `("" ,%empty-sha256) | |||
| (let-values (((port get) | |||
| (open-sha256-input-port (open-string-input-port "")))) | |||
| (let ((str (get-string-all port))) | |||
| (list str (get))))) | |||
| (test-equal "open-sha256-input-port, hello" | |||
| `("hello world" ,%hello-sha256) | |||
| (let-values (((port get) | |||
| (open-sha256-input-port | |||
| (open-bytevector-input-port | |||
| (string->utf8 "hello world"))))) | |||
| (let ((str (get-string-all port))) | |||
| (list str (get))))) | |||
| (test-equal "open-sha256-input-port, hello, one two" | |||
| (list (string->utf8 "hel") (string->utf8 "lo") | |||
| (base16-string->bytevector ; echo -n hello | sha256sum | |||
| "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824") | |||
| " world") | |||
| (let-values (((port get) | |||
| (open-sha256-input-port | |||
| (open-bytevector-input-port (string->utf8 "hello world"))))) | |||
| (let* ((one (get-bytevector-n port 3)) | |||
| (two (get-bytevector-n port 2)) | |||
| (hash (get)) | |||
| (three (get-string-all port))) | |||
| (list one two hash three)))) | |||
| (test-equal "open-sha256-input-port, hello, read from wrapped port" | |||
| (list (string->utf8 "hello") | |||
| (base16-string->bytevector ; echo -n hello | sha256sum | |||
| "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824") | |||
| " world") | |||
| (let*-values (((wrapped) | |||
| (open-bytevector-input-port (string->utf8 "hello world"))) | |||
| ((port get) | |||
| (open-sha256-input-port wrapped))) | |||
| (let* ((hello (get-bytevector-n port 5)) | |||
| (hash (get)) | |||
| ;; Now read from WRAPPED to make sure its current position is | |||
| ;; correct. | |||
| (world (get-string-all wrapped))) | |||
| (list hello hash world)))) | |||
| (test-end) | |||
+ 1
- 1
tests/nar.scm
View File
| @@ -21,7 +21,7 @@ | |||
| #:use-module (guix nar) | |||
| #:use-module (guix serialization) | |||
| #:use-module (guix store) | |||
| #:use-module ((guix hash) | |||
| #:use-module ((gcrypt hash) | |||
| #:select (open-sha256-port open-sha256-input-port)) | |||
| #:use-module ((guix packages) | |||
| #:select (base32)) | |||
+ 1
- 1
tests/opam.scm
View File
| @@ -19,7 +19,7 @@ | |||
| (define-module (test-opam) | |||
| #:use-module (guix import opam) | |||
| #:use-module (guix base32) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix tests) | |||
| #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which)) | |||
| #:use-module (srfi srfi-64) | |||
+ 1
- 1
tests/packages.scm
View File
| @@ -28,7 +28,7 @@ | |||
| #:renamer (lambda (name) | |||
| (cond ((eq? name 'location) 'make-location) | |||
| (else name)))) | |||
| #:use-module (guix hash) | |||
| #:use-module (gcrypt hash) | |||
| #:use-module (guix derivations) | |||
| #:use-module (guix packages) | |||
| #:use-module (guix grafts) | |||
+ 0
- 290
tests/pk-crypto.scm
View File
| @@ -1,290 +0,0 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | |||
| ;;; Copyright © 2013, 2014, 2017 Ludovic Courtès <ludo@gnu.org> | |||
| ;;; | |||
| ;;; This file is part of GNU Guix. | |||
| ;;; | |||
| ;;; GNU Guix is free software; you can redistribute it and/or modify it | |||
| ;;; under the terms of the GNU General Public License as published by | |||
| ;;; the Free Software Foundation; either version 3 of the License, or (at | |||
| ;;; your option) any later version. | |||
| ;;; | |||
| ;;; GNU Guix is distributed in the hope that it will be useful, but | |||
| ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |||
| ;;; GNU General Public License for more details. | |||
| ;;; | |||
| ;;; You should have received a copy of the GNU General Public License | |||
| ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
| (define-module (test-pk-crypto) | |||
| #:use-module (guix pk-crypto) | |||
| #:use-module (guix utils) | |||
| #:use-module (guix base16) | |||
| #:use-module (guix hash) | |||
| #:use-module (srfi srfi-1) | |||
| #:use-module (srfi srfi-11) | |||
| #:use-module (srfi srfi-26) | |||
| #:use-module (srfi srfi-64) | |||
| #:use-module (rnrs bytevectors) | |||
| #:use-module (rnrs io ports) | |||
| #:use-module (ice-9 match)) | |||