From patchwork Mon Sep 2 15:33:12 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 15267 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 4CA8E1734D; Mon, 2 Sep 2019 16:39:29 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,FREEMAIL_FROM, T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 836A617329 for ; Mon, 2 Sep 2019 16:39:28 +0100 (BST) Received: from localhost ([::1]:37706 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i4oQS-0006V8-0z for patchwork@mira.cbaines.net; Mon, 02 Sep 2019 11:39:28 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:42727) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i4oML-0002KV-AF for guix-patches@gnu.org; Mon, 02 Sep 2019 11:35:17 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1i4oMI-0004ak-Ej for guix-patches@gnu.org; Mon, 02 Sep 2019 11:35:13 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:50037) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1i4oMI-0004a9-9H for guix-patches@gnu.org; Mon, 02 Sep 2019 11:35:10 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1i4oMI-0006e1-3S for guix-patches@gnu.org; Mon, 02 Sep 2019 11:35:10 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#36477] [PATCH v3 27/48] gnu: guile-gcrypt: Fix cross-compilation. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 02 Sep 2019 15:35:10 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 36477 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 36477@debbugs.gnu.org Received: via spool by 36477-submit@debbugs.gnu.org id=B36477.156743848025246 (code B ref 36477); Mon, 02 Sep 2019 15:35:10 +0000 Received: (at 36477) by debbugs.gnu.org; 2 Sep 2019 15:34:40 +0000 Received: from localhost ([127.0.0.1]:58799 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1i4oLj-0006Yc-2w for submit@debbugs.gnu.org; Mon, 02 Sep 2019 11:34:40 -0400 Received: from mail-wm1-f65.google.com ([209.85.128.65]:37260) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1i4oLQ-0006Tc-Ut for 36477@debbugs.gnu.org; Mon, 02 Sep 2019 11:34:22 -0400 Received: by mail-wm1-f65.google.com with SMTP id d16so15057846wme.2 for <36477@debbugs.gnu.org>; Mon, 02 Sep 2019 08:34:16 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=kCGs/Y6CEahz95Yz/59s7XpjfVQl8u+eWQldsTZxVQY=; b=ZvBNnLslqm1hMJbxhlw/6xWM9lJnyepBAriTcV94tAfxuFbtr5GZX52GiqTPTAB111 PvlgpONFeVffiJijar7M3sbUMgTd91JP8ICVewMgtTCC4hGL/RTS9sK9FrW8vNx1b6wM pAon5tHxcRXpdKyaSk3I9fo7Evd9hczmysbE+PforGmFMhmZoqsFTNvn1CzvHSwEEQD3 CxcxaHHuFi5bfMib/NizC+1LaPJQUxBO4PLUsHe3nkb9jah0QDOGHDGg01BxSklABfH5 Q5WZAs4Ir+1lZAGHwnqKUg7p93rNaljG51J1wqKSpCmaBZXujwPjRPUUzeWP9EgrdSbl S8Sg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=kCGs/Y6CEahz95Yz/59s7XpjfVQl8u+eWQldsTZxVQY=; b=C1l+doVW4Na8SuxP0d6cmib54/YZgR4ux7aehJBmD0Kz5VEkcw1XTAJqJjwvP/dIPA PLQX5/oDtxTDEZC6h4H1hXerPtpBC8e59wxnwSOv033Ah4k+IemgG3SDosZIL/5Xs48E +PgPfoJN4qWLEycf/Sd7IaucwL58BGivxO6edzzHIa3JgTABtMEPjENodWw2rpoRh6Qz o2gXpUKiXGUN+j8stHus/aMzCbZNl+dDj1Il5NkaBhZ8dA3CLgvUTB+VHcIH9ediUeF6 Kjup+9sHQszAtyVi1Px1wjqesQqjAB0eP0QPafSdlLgSB+9weaw6c+mIaFrqENVnRm0a 6L+g== X-Gm-Message-State: APjAAAXeTv8AkB1ccKytrB3ErdTBmaqz4SZUfhImzCZ730dIvcD9hTmH NiKeTQ2uCQQNtPIBnv9dpCjUJZYY X-Google-Smtp-Source: APXvYqzEdqkVBJTcQRLXH0WBaiH/nHnMkHFpnK2HUzrYkIE3x4cVJUWys9DHMjmI3l9cdyeG1q3BeA== X-Received: by 2002:a1c:720e:: with SMTP id n14mr27715900wmc.54.1567438450739; Mon, 02 Sep 2019 08:34:10 -0700 (PDT) Received: from localhost.localdomain ([80.12.63.115]) by smtp.gmail.com with ESMTPSA id b26sm17232265wmj.14.2019.09.02.08.34.09 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 02 Sep 2019 08:34:10 -0700 (PDT) From: Mathieu Othacehe Date: Mon, 2 Sep 2019 17:33:12 +0200 Message-Id: <20190902153333.11190-28-m.othacehe@gmail.com> X-Mailer: git-send-email 2.20.1 In-Reply-To: <20190902153333.11190-1-m.othacehe@gmail.com> References: <20190902153333.11190-1-m.othacehe@gmail.com> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Mathieu Othacehe Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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(-) create mode 100644 gnu/packages/patches/guile-gcrypt-fix-cross-compilation.patch diff --git a/gnu/local.mk b/gnu/local.mk index 2cf92e4478..bc31682035 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -928,6 +928,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 c7e6aabf79..69da60b972 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -15,6 +15,7 @@ ;;; Copyright © 2017 Petter ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice ;;; Copyright © 2018 Marius Bakke +;;; Copyright © 2018 Björn Höfling ;;; Copyright © 2019 Mathieu Othacehe ;;; ;;; 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 0000000000..cdf15b39b0 --- /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 +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 "#" + (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 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 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 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 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 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 +