From 4862bc4a1a20d2abf50b39713cd12985f38adf7c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 26 Jan 2015 21:38:49 +0100 Subject: [PATCH] Add (guix gcrypt). * guix/gcrypt.scm: New file. * Makefile.am (MODULES): Add it. * guix/pk-crypto.scm: Use it. (libgcrypt-func, gcrypt-version): Remove. --- Makefile.am | 1 + guix/gcrypt.scm | 49 ++++++++++++++++++++++++++++++++++++++++++++++ guix/pk-crypto.scm | 26 +++++------------------- 3 files changed, 55 insertions(+), 21 deletions(-) create mode 100644 guix/gcrypt.scm diff --git a/Makefile.am b/Makefile.am index e15afd2ff4..4d0ef25a19 100644 --- a/Makefile.am +++ b/Makefile.am @@ -30,6 +30,7 @@ MODULES = \ guix/base32.scm \ guix/base64.scm \ guix/records.scm \ + guix/gcrypt.scm \ guix/hash.scm \ guix/pk-crypto.scm \ guix/pki.scm \ diff --git a/guix/gcrypt.scm b/guix/gcrypt.scm new file mode 100644 index 0000000000..1517501751 --- /dev/null +++ b/guix/gcrypt.scm @@ -0,0 +1,49 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; +;;; 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 . + +(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 diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm index e5d4dc9ecc..7306b66922 100644 --- a/guix/pk-crypto.scm +++ b/guix/pk-crypto.scm @@ -17,15 +17,15 @@ ;;; along with GNU Guix. If not, see . (define-module (guix pk-crypto) - #:use-module (guix config) #:use-module ((guix utils) #:select (bytevector->base16-string base16-string->bytevector)) + #:use-module (guix gcrypt) + #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) - #:export (gcrypt-version - canonical-sexp? + #:export (canonical-sexp? error-source error-string string->canonical-sexp @@ -46,7 +46,8 @@ generate-key find-sexp-token canonical-sexp->sexp - sexp->canonical-sexp)) + sexp->canonical-sexp) + #:re-export (gcrypt-version)) ;;; Commentary: @@ -81,23 +82,6 @@ (number->string (pointer-address (canonical-sexp->pointer obj)) 16)))) -(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))) - (define finalize-canonical-sexp! (libgcrypt-func "gcry_sexp_release"))