pk-crypto: 'canonical-sexp-nth-data' returns a symbol for "tokens".

* guix/pk-crypto.scm (token-string?): New procedure.
  (canonical-sexp-nth-data): Return a symbol when the element is a
  "token", and a bytevector otherwise.
  (latin1-string->bytevector): Remove.
  (hash-data->bytevector): Adjust accordingly.
* tests/pk-crypto.scm ("canonical-sexp-nth"): Adjust accordingly.  Add
  octet string example.
This commit is contained in:
Ludovic Courtès 2013-12-28 15:41:48 +01:00
parent 6df1fb8991
commit a2cbbb743d
2 changed files with 34 additions and 19 deletions

View File

@ -156,20 +156,42 @@ different from Scheme's 'list-ref'.)"
0 (native-endianness) 0 (native-endianness)
(sizeof size_t))) (sizeof size_t)))
(define token-string?
(let ((token-cs (char-set-union char-set:digit
char-set:letter
(char-set #\- #\. #\/ #\_
#\: #\* #\+ #\=))))
(lambda (str)
"Return #t if STR is a token as per Section 4.3 of
<http://people.csail.mit.edu/rivest/Sexp.txt>."
(and (not (string-null? str))
(string-every token-cs str)
(not (char-set-contains? char-set:digit (string-ref str 0)))))))
(define canonical-sexp-nth-data (define canonical-sexp-nth-data
(let* ((ptr (libgcrypt-func "gcry_sexp_nth_data")) (let* ((ptr (libgcrypt-func "gcry_sexp_nth_data"))
(proc (pointer->procedure '* ptr `(* ,int *)))) (proc (pointer->procedure '* ptr `(* ,int *))))
(lambda (lst index) (lambda (lst index)
"Return as a string the INDEXth data element (atom) of LST, an "Return as a symbol (for \"sexp tokens\") or a bytevector (for any other
s-expression. Return #f if that element does not exist, or if it's a list. \"octet string\") the INDEXth data element (atom) of LST, an s-expression.
Note that the result is a Scheme string, but depending on LST, it may need to Return #f if that element does not exist, or if it's a list."
be interpreted in the sense of a C string---i.e., as a series of octets."
(let* ((size* (bytevector->pointer (make-bytevector (sizeof '*)))) (let* ((size* (bytevector->pointer (make-bytevector (sizeof '*))))
(result (proc (canonical-sexp->pointer lst) index size*))) (result (proc (canonical-sexp->pointer lst) index size*)))
(if (null-pointer? result) (if (null-pointer? result)
#f #f
(pointer->string result (dereference-size_t size*) (let* ((len (dereference-size_t size*))
"ISO-8859-1")))))) (str (pointer->string result len "ISO-8859-1")))
;; The sexp spec speaks of "tokens" and "octet strings".
;; Sometimes these octet strings are actual strings (text),
;; sometimes they're bytevectors, and sometimes they're
;; multi-precision integers (MPIs). Only the application knows.
;; However, for convenience, we return a symbol when a token is
;; encountered since tokens are frequent (at least in the 'car'
;; of each sexp.)
(if (token-string? str)
(string->symbol str) ; an sexp "token"
(bytevector-copy ; application data, textual or binary
(pointer->bytevector result len)))))))))
(define (number->canonical-sexp number) (define (number->canonical-sexp number)
"Return an s-expression representing NUMBER." "Return an s-expression representing NUMBER."
@ -183,23 +205,15 @@ for use as the data for 'sign'."
hash-algo hash-algo
(bytevector->base16-string bv)))) (bytevector->base16-string bv))))
(define (latin1-string->bytevector str)
"Return a bytevector representing STR."
;; XXX: In Guile 2.0.9 and later, we would use 'string->bytevector' for
;; that.
(let ((bytes (map char->integer (string->list str))))
(u8-list->bytevector bytes)))
(define (hash-data->bytevector data) (define (hash-data->bytevector data)
"Return two values: the hash algorithm (a string) and the hash value (a "Return two values: the hash value (a bytevector), and the hash algorithm (a
bytevector) extract from DATA, an sexp as returned by 'bytevector->hash-data'. string) extracted from DATA, an sexp as returned by 'bytevector->hash-data'.
Return #f if DATA does not conform." Return #f if DATA does not conform."
(let ((hash (find-sexp-token data 'hash))) (let ((hash (find-sexp-token data 'hash)))
(if hash (if hash
(let ((algo (canonical-sexp-nth-data hash 1)) (let ((algo (canonical-sexp-nth-data hash 1))
(value (canonical-sexp-nth-data hash 2))) (value (canonical-sexp-nth-data hash 2)))
(values (latin1-string->bytevector value) (values value (symbol->string algo)))
algo))
(values #f #f)))) (values #f #f))))
(define sign (define sign

View File

@ -108,8 +108,9 @@
(gc) (gc)
(test-equal "canonical-sexp-nth-data" (test-equal "canonical-sexp-nth-data"
'("Name" "Otto" "Meier" #f #f #f) `(Name Otto Meier #f ,(base16-string->bytevector "123456") #f)
(let ((lst (string->canonical-sexp "(Name Otto Meier (address Burgplatz))"))) (let ((lst (string->canonical-sexp
"(Name Otto Meier (address Burgplatz) #123456#)")))
(unfold (cut > <> 5) (unfold (cut > <> 5)
(cut canonical-sexp-nth-data lst <>) (cut canonical-sexp-nth-data lst <>)
1+ 1+