aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-12-30 22:29:12 +0100
committerLudovic Courtès <ludo@gnu.org>2013-12-30 22:29:12 +0100
commitdedb5d947ee2890524a5c6fb1343b3299e7731c3 (patch)
treeee9767de32d8c7e3f60be659ac5599c05626f348
parent36341854dfedc3d173d09e686ffc3e255c102b01 (diff)
downloadpatches-dedb5d947ee2890524a5c6fb1343b3299e7731c3.tar
patches-dedb5d947ee2890524a5c6fb1343b3299e7731c3.tar.gz
pk-crypto: Fix 'canonical-sexp->sexp' for atoms.
* guix/pk-crypto.scm (canonical-sexp->sexp): Add hack to extract an atom's buffer. * tests/pk-crypto.scm ("sexp->canonical-sexp->sexp"): Add sample.
-rw-r--r--guix/pk-crypto.scm9
-rw-r--r--tests/pk-crypto.scm5
2 files changed, 12 insertions, 2 deletions
diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm
index cf18faea04..d5b3eeb350 100644
--- a/guix/pk-crypto.scm
+++ b/guix/pk-crypto.scm
@@ -319,7 +319,14 @@ use pattern matching."
result))
'()
sexp))
- (canonical-sexp->string sexp))) ; XXX: not very useful
+
+ ;; 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
diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm
index de775d2e19..6774dd4157 100644
--- a/tests/pk-crypto.scm
+++ b/tests/pk-crypto.scm
@@ -203,7 +203,10 @@
(string-downcase
"00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45")))
(e ,(base16-string->bytevector
- "010001")))))))
+ "010001"))))
+
+ ,(base16-string->bytevector
+ "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb"))))
(test-equal "sexp->canonical-sexp->sexp"
lst
(map (compose canonical-sexp->sexp sexp->canonical-sexp)