From 1fda6840a892e55b579dfeb8f4590b5cd2874662 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 20 Mar 2014 22:33:52 +0100
Subject: pk-crypto: Don't use Ed25519 when libgcrypt is older than 1.6.0.

* guix/pk-crypto.scm (gcrypt-version): New procedure.
* guix/scripts/archive.scm (%key-generation-parameters): New variable.
  (%options) <generate-key>: Use it.
* tests/pk-crypto.scm ("sign + verify, Ed25519"): Skip if using gcrypt < 1.6.0.
---
 guix/pk-crypto.scm       | 14 +++++++++++++-
 guix/scripts/archive.scm | 10 ++++++++--
 tests/pk-crypto.scm      |  2 ++
 3 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm
index b9ab02861c..481d3f2463 100644
--- a/guix/pk-crypto.scm
+++ b/guix/pk-crypto.scm
@@ -24,7 +24,8 @@
   #:use-module (system foreign)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
-  #:export (canonical-sexp?
+  #:export (gcrypt-version
+            canonical-sexp?
             error-source
             error-string
             string->canonical-sexp
@@ -86,6 +87,17 @@
       "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"))
 
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 0e67321026..c900fcecb9 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -87,6 +87,13 @@ Export/import one or more packages from/to the store.\n"))
   (newline)
   (show-bug-report-information))
 
+(define %key-generation-parameters
+  ;; Default key generation parameters.  We prefer Ed25519, but it was
+  ;; introduced in libgcrypt 1.6.0.
+  (if (version>? (gcrypt-version) "1.6.0")
+      "(genkey (ecdsa (curve Ed25519) (flags rfc6979)))"
+      "(genkey (rsa (nbits 4:4096)))"))
+
 (define %options
   ;; Specifications of the command-line options.
   (cons* (option '(#\h "help") #f #f
@@ -114,8 +121,7 @@ Export/import one or more packages from/to the store.\n"))
                        ;; libgcrypt 1.6.0.
                        (let ((params
                               (string->canonical-sexp
-                               (or arg "\
- (genkey (ecdsa (curve Ed25519) (flags rfc6979)))"))))
+                               (or arg %key-generation-parameters))))
                          (alist-cons 'generate-key params result)))
                      (lambda (key err)
                        (leave (_ "invalid key generation parameters: ~a: ~a~%")
diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm
index 4d498020f5..294c7f3df8 100644
--- a/tests/pk-crypto.scm
+++ b/tests/pk-crypto.scm
@@ -184,6 +184,8 @@
                        #:key-type (key-type public))
                       public)))))
 
+;; Ed25519 appeared in libgcrypt 1.6.0.
+(test-skip (if (version>? (gcrypt-version) "1.6.0") 0 1))
 (test-assert "sign + verify, Ed25519"
   (let* ((pair   (string->canonical-sexp %ecc-key-pair))
          (secret (find-sexp-token pair 'private-key))
-- 
cgit v1.2.3