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:
parent
6df1fb8991
commit
a2cbbb743d
|
@ -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
|
||||||
|
|
|
@ -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+
|
||||||
|
|
Loading…
Reference in New Issue