44/64: gnu: guile-gcrypt: Fix cross-compilation.

[guix-commits]

mothacehe pushed a commit to branch wip-cross-system
in repository guix.

commit c892b062e9a7d4dad73f167a9d52b87e0891bac6
Author: Mathieu Othacehe <address@hidden>
Date:   Sun Aug 18 09:47:19 2019 +0200

    gnu: guile-gcrypt: Fix cross-compilation.
    
    * gnu/packages/patches/guile-gcrypt-fix-cross-compilation.patch: New file.
    * gnu/local.mk (dist_patch_DATA): Add it.
    * gnu/packages/gnupg.scm (guile-gcrypt)[source]: Apply previous patch,
    [native-inputs]: add guile,
    [arguments]: add libgcrypt-config to PATH when cross-compiling.
---
 gnu/local.mk                                       |   1 +
 gnu/packages/gnupg.scm                             |  22 +-
 .../guile-gcrypt-fix-cross-compilation.patch       | 431 +++++++++++++++++++++
 3 files changed, 452 insertions(+), 2 deletions(-)

diff --git a/gnu/local.mk b/gnu/local.mk
index 1bb871a..9203dc4 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -923,6 +923,7 @@ dist_patch_DATA =                                           
\
   %D%/packages/patches/guile-relocatable.patch                 \
   %D%/packages/patches/guile-rsvg-pkgconfig.patch              \
   %D%/packages/patches/guile-emacs-fix-configure.patch         \
+  %D%/packages/patches/guile-gcrypt-fix-cross-compilation.patch \
   %D%/packages/patches/guile-sqlite3-fix-cross-compilation.patch \
   %D%/packages/patches/gstreamer-buffer-reset-offset.patch     \
   %D%/packages/patches/gtk2-respect-GUIX_GTK2_PATH.patch       \
diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm
index c7e6aab..69da60b 100644
--- a/gnu/packages/gnupg.scm
+++ b/gnu/packages/gnupg.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2017 Petter <address@hidden>
 ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <address@hidden>
 ;;; Copyright © 2018 Marius Bakke <address@hidden>
+;;; Copyright © 2018 Björn Höfling <address@hidden>
 ;;; Copyright © 2019 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -477,13 +478,30 @@ gpgpme starting with version 1.7.")
               (sha256
                (base32
                 "1lhgh3105yi0ggrjsjibv4wp1ipz8s17pa820hk2wln3rc04wpvf"))
-              (file-name (string-append name "-" version "-checkout"))))
+              (file-name (string-append name "-" version "-checkout"))
+              (patches
+              (search-patches "guile-gcrypt-fix-cross-compilation.patch"))))
     (build-system gnu-build-system)
+    (arguments
+     ;; When cross-compiling, the bash script libgcrypt-config provided by
+     ;; libgcrypt must be accessible during configure phase.
+     `(,@(if (%current-target-system)
+             '(#:phases
+               (modify-phases %standard-phases
+                 (add-before 'configure 'add-libgrypt-config
+                   (lambda _
+                     (setenv "PATH" (string-append
+                                     (assoc-ref %build-inputs "libgcrypt")
+                                     "/bin:"
+                                     (getenv "PATH")))
+                     #t))))
+             '())))
     (native-inputs
      `(("pkg-config" ,pkg-config)
        ("autoconf" ,autoconf)
        ("automake" ,automake)
-       ("texinfo" ,texinfo)))
+       ("texinfo" ,texinfo)
+       ("guile" ,guile-2.2)))
     (inputs
      `(("guile" ,guile-2.2)
        ("libgcrypt" ,libgcrypt)))
diff --git a/gnu/packages/patches/guile-gcrypt-fix-cross-compilation.patch 
b/gnu/packages/patches/guile-gcrypt-fix-cross-compilation.patch
new file mode 100644
index 0000000..cdf15b3
--- /dev/null
+++ b/gnu/packages/patches/guile-gcrypt-fix-cross-compilation.patch
@@ -0,0 +1,431 @@
+From 4ec6cb5209461452f7ebb0aae3ae916e28198dc9 Mon Sep 17 00:00:00 2001
+From: Mathieu Othacehe <address@hidden>
+Date: Sun, 18 Aug 2019 09:42:39 +0200
+Subject: [PATCH] build: Fix cross-compilation.
+
+---
+ Makefile.am          |  2 +-
+ configure.ac         |  7 ++++++-
+ gcrypt/common.scm    | 42 ++++++++++++++++++++++++++++--------------
+ gcrypt/hash.scm      | 28 +++++++++++-----------------
+ gcrypt/hmac.scm      | 40 +++++++++++++++++++---------------------
+ gcrypt/pk-crypto.scm | 41 ++++++++++++++++++-----------------------
+ gcrypt/random.scm    |  7 ++++---
+ 7 files changed, 87 insertions(+), 80 deletions(-)
+
+diff --git a/Makefile.am b/Makefile.am
+index 0537256..7a3d1b2 100644
+--- a/Makefile.am
++++ b/Makefile.am
+@@ -39,7 +39,7 @@ $(guile_install_go_files): install-nobase_modDATA
+ GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
+ SUFFIXES = .scm .go
+ .scm.go:
+-      $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile 
$(GUILE_WARNINGS) -o "$@" "$<"
++      $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile 
$(GUILE_TARGET) $(GUILE_WARNINGS) -o "$@" "$<"
+ 
+ moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
+ godir = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
+diff --git a/configure.ac b/configure.ac
+index e7ef6cf..7d0f569 100644
+--- a/configure.ac
++++ b/configure.ac
+@@ -73,6 +73,11 @@ AC_SUBST([LIBGCRYPT])
+ AC_SUBST([LIBGCRYPT_PREFIX])
+ AC_SUBST([LIBGCRYPT_LIBDIR])
+ 
+-GUIX_ASSERT_LIBGCRYPT_USABLE
++if test "$cross_compiling" = "no"; then
++   GUIX_ASSERT_LIBGCRYPT_USABLE
++else
++   GUILE_TARGET="--target=$host_alias"
++   AC_SUBST([GUILE_TARGET])
++fi
+ 
+ AC_OUTPUT
+diff --git a/gcrypt/common.scm b/gcrypt/common.scm
+index 189003f..a42f609 100644
+--- a/gcrypt/common.scm
++++ b/gcrypt/common.scm
+@@ -21,7 +21,8 @@
+   #:use-module (system foreign)
+   #:use-module (ice-9 match)
+   #:export (gcrypt-version
+-            libgcrypt-func
++            libgcrypt->pointer
++            libgcrypt->procedure
+             error-source error-string))
+ 
+ ;;; Commentary:
+@@ -31,34 +32,47 @@
+ ;;;
+ ;;; Code:
+ 
+-(define libgcrypt-func
+-  (let ((lib (dynamic-link %libgcrypt)))
+-    (lambda (func)
+-      "Return a pointer to symbol FUNC in libgcrypt."
+-      (dynamic-func func lib))))
++(define (libgcrypt->pointer name)
++  "Return a pointer to symbol FUNC in libgcrypt."
++  (catch #t
++    (lambda ()
++      (dynamic-func name (dynamic-link %libgcrypt)))
++    (lambda args
++      (lambda _
++        (throw 'system-error name  "~A" (list (strerror ENOSYS))
++               (list ENOSYS))))))
++
++(define (libgcrypt->procedure return name params)
++  "Return a pointer to symbol FUNC in libgcrypt."
++  (catch #t
++    (lambda ()
++      (let ((ptr (dynamic-func name (dynamic-link %libgcrypt))))
++        ;; The #:return-errno? facility was introduced in Guile 2.0.12.
++        (pointer->procedure return ptr params
++                            #:return-errno? #t)))
++    (lambda args
++      (lambda _
++        (throw 'system-error name  "~A" (list (strerror ENOSYS))
++               (list ENOSYS))))))
+ 
+ (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))))
++  (let ((proc (libgcrypt->procedure '* "gcry_check_version" '(*))))
+     (lambda ()
+       "Return the version number of libgcrypt as a string."
+-      version)))
++      (pointer->string (proc %null-pointer)))))
+ 
+ (define error-source
+-  (let* ((ptr  (libgcrypt-func "gcry_strsource"))
+-         (proc (pointer->procedure '* ptr (list int))))
++  (let ((proc (libgcrypt->procedure '* "gcry_strsource" (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))))
++  (let ((proc (libgcrypt->procedure '* "gcry_strerror" (list int))))
+     (lambda (err)
+       "Return the error description (a string) for ERR, an error code as
+ thrown along with 'gcry-error'."
+diff --git a/gcrypt/hash.scm b/gcrypt/hash.scm
+index dad06e4..1b3fa67 100644
+--- a/gcrypt/hash.scm
++++ b/gcrypt/hash.scm
+@@ -50,13 +50,13 @@
+   (identifier-syntax 2))
+ 
+ (define bytevector-hash
+-  (let ((hash (pointer->procedure void
+-                                  (libgcrypt-func "gcry_md_hash_buffer")
+-                                  `(,int * * ,size_t))))
++  (let ((proc (libgcrypt->procedure void
++                                    "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)
++        (proc type (bytevector->pointer digest)
+               (bytevector->pointer bv) (bytevector-length bv))
+         digest))))
+ 
+@@ -67,30 +67,24 @@
+   (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))))
++  (let ((proc (libgcrypt->procedure int
++                                    "gcry_md_open"
++                                    `(* ,int ,unsigned-int))))
+     (lambda ()
+       (let* ((md  (bytevector->pointer (make-bytevector (sizeof '*))))
+-             (err (open md GCRY_MD_SHA256 0)))
++             (err (proc 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)))
++  (libgcrypt->procedure void "gcry_md_write" `(* * ,size_t)))
+ 
+ (define md-read
+-  (pointer->procedure '*
+-                      (libgcrypt-func "gcry_md_read")
+-                      `(* ,int)))
++  (libgcrypt->procedure '* "gcry_md_read" `(* ,int)))
+ 
+ (define md-close
+-  (pointer->procedure void
+-                      (libgcrypt-func "gcry_md_close")
+-                      '(*)))
++  (libgcrypt->procedure void "gcry_md_close" '(*)))
+ 
+ 
+ (define (open-sha256-port)
+diff --git a/gcrypt/hmac.scm b/gcrypt/hmac.scm
+index 0d8cc61..b9e1a9e 100644
+--- a/gcrypt/hmac.scm
++++ b/gcrypt/hmac.scm
+@@ -42,11 +42,11 @@
+     (format port "#<mac ~x>"
+             (pointer-address (mac->pointer mac)))))
+ 
+-
+ (define %gcry-mac-open
+-  (pointer->procedure int (libgcrypt-func "gcry_mac_open")
+-                      `(* ,int ,unsigned-int *)))  ; gcry_mac_hd_t *HD, int 
ALGO,
+-                                                   ; unsigned int FLAGS, 
gcry_ctx_t CTX
++  (libgcrypt->procedure int "gcry_mac_open"
++                        ;; gcry_mac_hd_t *HD, int ALGO,
++                        ;; unsigned int FLAGS, gcry_ctx_t CTX
++                        `(* ,int ,unsigned-int *)))
+ 
+ (define mac-algorithms-mapping
+   (alist->hashq-table
+@@ -59,9 +59,8 @@
+   (hashq-ref mac-algorithms-mapping sym))
+ 
+ (define mac-algo-maclen
+-  (let ((proc (pointer->procedure
+-               int (libgcrypt-func "gcry_mac_get_algo_maclen")
+-               `(,int))))
++  (let ((proc (libgcrypt->procedure
++               int "gcry_mac_get_algo_maclen" `(,int))))
+     (lambda (sym)
+       "Get expected length in bytes of mac yielded by algorithm SYM"
+       (proc (mac-algo-ref sym)))))
+@@ -76,8 +75,7 @@
+         (throw 'gcry-error 'mac-open err))))
+ 
+ (define %gcry-mac-setkey
+-  (pointer->procedure int (libgcrypt-func "gcry_mac_setkey")
+-                      `(* * ,size_t)))
++  (libgcrypt->procedure int "gcry_mac_setkey" `(* * ,size_t)))
+ 
+ (define (mac-setkey mac key)
+   "Set the KEY on <mac> object MAC
+@@ -96,9 +94,9 @@ In our case, KEY is either a string or a bytevector."
+         (throw 'gcry-error 'mac-setkey err))))
+ 
+ (define mac-close
+-  (let ((proc (pointer->procedure
+-               void (libgcrypt-func "gcry_mac_close")
+-               '(*))))  ; gcry_mac_hd_t H
++  (let ((proc (libgcrypt->procedure void
++                                    "gcry_mac_close"
++                                    '(*))))  ; gcry_mac_hd_t H
+     (lambda (mac)
+       "Release all resources of MAC.
+ 
+@@ -106,9 +104,9 @@ Running this on an already closed <mac> might segfault :)"
+       (proc (mac->pointer mac)))))
+ 
+ (define mac-write
+-  (let ((proc (pointer->procedure
+-               int (libgcrypt-func "gcry_mac_write")
+-               `(* * ,size_t))))
++  (let ((proc (libgcrypt->procedure int
++                                    "gcry_mac_write"
++                                    `(* * ,size_t))))
+     (lambda (mac obj)
+       "Writes string or bytevector OBJ to MAC"
+       (let* ((bv (match obj
+@@ -124,9 +122,9 @@ Running this on an already closed <mac> might segfault :)"
+             (throw 'gcry-error 'mac-write err))))))
+ 
+ (define mac-read
+-  (let ((proc (pointer->procedure
+-               int (libgcrypt-func "gcry_mac_read")
+-               `(* * *))))
++  (let ((proc (libgcrypt->procedure int
++                                    "gcry_mac_read"
++                                    `(* * *))))
+     (lambda (mac algorithm)
+       "Get bytevector representing result of MAC's written, signed data"
+       (define (int-bv* n)
+@@ -148,9 +146,9 @@ Running this on an already closed <mac> might segfault :)"
+ ;; rather than the gcry_error_t type.
+ 
+ (define mac-verify
+-  (let ((proc (pointer->procedure
+-               int (libgcrypt-func "gcry_mac_verify")
+-               `(* * ,size_t))))
++  (let ((proc (libgcrypt->procedure int
++                                    "gcry_mac_verify"
++                                    `(* * ,size_t))))
+     (lambda (mac bv)
+       "Verify that BV matches result calculated in MAC
+ 
+diff --git a/gcrypt/pk-crypto.scm b/gcrypt/pk-crypto.scm
+index be664a3..5d614a0 100644
+--- a/gcrypt/pk-crypto.scm
++++ b/gcrypt/pk-crypto.scm
+@@ -81,7 +81,7 @@
+                             16))))
+ 
+ (define finalize-canonical-sexp!
+-  (libgcrypt-func "gcry_sexp_release"))
++  (libgcrypt->pointer "gcry_sexp_release"))
+ 
+ (define-inlinable (pointer->canonical-sexp ptr)
+   "Return a <canonical-sexp> that wraps PTR."
+@@ -96,8 +96,9 @@
+     sexp))
+ 
+ (define string->canonical-sexp
+-  (let* ((ptr  (libgcrypt-func "gcry_sexp_new"))
+-         (proc (pointer->procedure int ptr `(* * ,size_t ,int))))
++  (let ((proc (libgcrypt->procedure int
++                                    "gcry_sexp_new"
++                                    `(* * ,size_t ,int))))
+     (lambda (str)
+       "Parse STR and return the corresponding gcrypt s-expression."
+ 
+@@ -115,8 +116,9 @@
+   (identifier-syntax 3))
+ 
+ (define canonical-sexp->string
+-  (let* ((ptr  (libgcrypt-func "gcry_sexp_sprint"))
+-         (proc (pointer->procedure size_t ptr `(* ,int * ,size_t))))
++  (let ((proc (libgcrypt->procedure size_t
++                                    "gcry_sexp_sprint"
++                                    `(* ,int * ,size_t))))
+     (lambda (sexp)
+       "Return a textual representation of SEXP."
+       (let loop ((len 1024))
+@@ -134,8 +136,7 @@
+              read-string)))
+ 
+ (define canonical-sexp-car
+-  (let* ((ptr  (libgcrypt-func "gcry_sexp_car"))
+-         (proc (pointer->procedure '* ptr '(*))))
++  (let ((proc (libgcrypt->procedure '* "gcry_sexp_car" '(*))))
+     (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
+@@ -146,8 +147,7 @@ the usual Lisp 'car'.)"
+             (pointer->canonical-sexp result))))))
+ 
+ (define canonical-sexp-cdr
+-  (let* ((ptr  (libgcrypt-func "gcry_sexp_cdr"))
+-         (proc (pointer->procedure '* ptr '(*))))
++  (let ((proc (libgcrypt->procedure '* "gcry_sexp_cdr" '(*))))
+     (lambda (lst)
+       "Return the tail of LST, an sexp, or #f if LST is not a list."
+       (let ((result (proc (canonical-sexp->pointer lst))))
+@@ -156,8 +156,7 @@ the usual Lisp 'car'.)"
+             (pointer->canonical-sexp result))))))
+ 
+ (define canonical-sexp-nth
+-  (let* ((ptr  (libgcrypt-func "gcry_sexp_nth"))
+-         (proc (pointer->procedure '* ptr `(* ,int))))
++  (let ((proc (libgcrypt->procedure '* "gcry_sexp_nth" `(* ,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
+@@ -174,8 +173,7 @@ different from Scheme's 'list-ref'.)"
+                        (sizeof size_t)))
+ 
+ (define canonical-sexp-length
+-  (let* ((ptr  (libgcrypt-func "gcry_sexp_length"))
+-         (proc (pointer->procedure int ptr '(*))))
++  (let ((proc (libgcrypt->procedure int "gcry_sexp_length" '(*))))
+     (lambda (sexp)
+       "Return the length of SEXP if it's a list (including the empty list);
+ return zero if SEXP is an atom."
+@@ -194,8 +192,7 @@ return zero if SEXP is an atom."
+            (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 *))))
++  (let ((proc (libgcrypt->procedure '* "gcry_sexp_nth_data" `(* ,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.
+@@ -266,8 +263,7 @@ Return #f if DATA does not conform."
+         (values #f #f))))
+ 
+ (define sign
+-  (let* ((ptr  (libgcrypt-func "gcry_pk_sign"))
+-         (proc (pointer->procedure int ptr '(* * *))))
++  (let ((proc (libgcrypt->procedure int "gcry_pk_sign" '(* * *))))
+     (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
+@@ -281,8 +277,7 @@ DATA must be a 'data' s-expression, as returned by
+             (throw 'gcry-error 'sign err))))))
+ 
+ (define verify
+-  (let* ((ptr  (libgcrypt-func "gcry_pk_verify"))
+-         (proc (pointer->procedure int ptr '(* * *))))
++  (let ((proc (libgcrypt->procedure int "gcry_pk_verify" '(* * *))))
+     (lambda (signature data public-key)
+       "Verify that SIGNATURE is a signature of DATA with PUBLIC-KEY, all of
+ which are gcrypt s-expressions."
+@@ -291,8 +286,7 @@ which are gcrypt s-expressions."
+                    (canonical-sexp->pointer public-key))))))
+ 
+ (define generate-key
+-  (let* ((ptr  (libgcrypt-func "gcry_pk_genkey"))
+-         (proc (pointer->procedure int ptr '(* *))))
++  (let ((proc (libgcrypt->procedure int "gcry_pk_genkey" '(* *))))
+     (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)))."
+@@ -303,8 +297,9 @@ s-expression like: (genkey (rsa (nbits 4:2048)))."
+             (throw 'gcry-error 'generate-key err))))))
+ 
+ (define find-sexp-token
+-  (let* ((ptr  (libgcrypt-func "gcry_sexp_find_token"))
+-         (proc (pointer->procedure '* ptr `(* * ,size_t))))
++  (let ((proc (libgcrypt->procedure '*
++                                    "gcry_sexp_find_token"
++                                    `(* * ,size_t))))
+     (lambda (sexp token)
+       "Find in SEXP the first element whose 'car' is TOKEN and return it;
+ return #f if not found."
+diff --git a/gcrypt/random.scm b/gcrypt/random.scm
+index 5391f94..ea6f9d3 100644
+--- a/gcrypt/random.scm
++++ b/gcrypt/random.scm
+@@ -33,7 +33,8 @@
+ (define %gcry-very-strong-random 2)
+ 
+ (define %gcry-randomize
+-  (pointer->procedure void (libgcrypt-func "gcry_randomize")
++  (libgcrypt->procedure void
++                      "gcry_randomize"
+                       `(* ,size_t ,int)))  ; buffer, length, level
+ 
+ (define* (gen-random-bv #:optional (bv-length 50)
+@@ -44,8 +45,8 @@
+     bv))
+ 
+ (define %gcry-create-nonce
+-  (pointer->procedure void (libgcrypt-func "gcry_create_nonce")
+-                      `(* ,size_t)))  ; buffer, length
++  (libgcrypt->procedure void "gcry_create_nonce"
++                        `(* ,size_t)))  ; buffer, length
+ 
+ 
+ (define* (gen-random-nonce #:optional (bv-length 50))
+-- 
+2.20.1
+