me/guix
Archived
1
0
Fork 0
Code Activity

pk-crypto: Fix 'canonical-sexp->sexp' for atoms.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2013-12-30 22:29:12 +01:00
parent 36341854df
commit dedb5d947e
2 changed files with 12 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
guix/pk-crypto.scm
View file

@ -319,7 +319,14 @@ use pattern matching."
result)) result))
'() '()
sexp)) 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) (define (sexp->canonical-sexp sexp)
"Return a canonical sexp equivalent to SEXP, a Scheme sexp as returned by "Return a canonical sexp equivalent to SEXP, a Scheme sexp as returned by

5
tests/pk-crypto.scm
View file

@ -203,7 +203,10 @@
(string-downcase (string-downcase
"00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45"))) "00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45")))
(e ,(base16-string->bytevector (e ,(base16-string->bytevector
"010001"))))))) "010001"))))
,(base16-string->bytevector
"2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb"))))
(test-equal "sexp->canonical-sexp->sexp" (test-equal "sexp->canonical-sexp->sexp"
lst lst
(map (compose canonical-sexp->sexp sexp->canonical-sexp) (map (compose canonical-sexp->sexp sexp->canonical-sexp)