diff options
| -rw-r--r-- | guix/pk-crypto.scm | 48 | ||||
| -rw-r--r-- | tests/pk-crypto.scm | 5 |
2 files changed, 34 insertions, 19 deletions
diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm index 1676abe642..e5ada6a177 100644 --- a/guix/pk-crypto.scm +++ b/guix/pk-crypto.scm @@ -156,20 +156,42 @@ different from Scheme's 'list-ref'.)" 0 (native-endianness) (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 (let* ((ptr (libgcrypt-func "gcry_sexp_nth_data")) (proc (pointer->procedure '* ptr `(* ,int *)))) (lambda (lst index) - "Return as a string the INDEXth data element (atom) of LST, an -s-expression. Return #f if that element does not exist, or if it's a list. -Note that the result is a Scheme string, but depending on LST, it may need to -be interpreted in the sense of a C string---i.e., as a series of octets." + "Return as a symbol (for \"sexp tokens\") or a bytevector (for any other +\"octet string\") the INDEXth data element (atom) of LST, an s-expression. +Return #f if that element does not exist, or if it's a list." (let* ((size* (bytevector->pointer (make-bytevector (sizeof '*)))) (result (proc (canonical-sexp->pointer lst) index size*))) (if (null-pointer? result) #f - (pointer->string result (dereference-size_t size*) - "ISO-8859-1")))))) + (let* ((len (dereference-size_t size*)) + (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) "Return an s-expression representing NUMBER." @@ -183,23 +205,15 @@ for use as the data for 'sign'." hash-algo (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) - "Return two values: the hash algorithm (a string) and the hash value (a -bytevector) extract from DATA, an sexp as returned by 'bytevector->hash-data'. + "Return two values: the hash value (a bytevector), and the hash algorithm (a +string) extracted from DATA, an sexp as returned by 'bytevector->hash-data'. Return #f if DATA does not conform." (let ((hash (find-sexp-token data 'hash))) (if hash (let ((algo (canonical-sexp-nth-data hash 1)) (value (canonical-sexp-nth-data hash 2))) - (values (latin1-string->bytevector value) - algo)) + (values value (symbol->string algo))) (values #f #f)))) (define sign diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm index 85f8f9407e..8da533f5b2 100644 --- a/tests/pk-crypto.scm +++ b/tests/pk-crypto.scm @@ -108,8 +108,9 @@ (gc) (test-equal "canonical-sexp-nth-data" - '("Name" "Otto" "Meier" #f #f #f) - (let ((lst (string->canonical-sexp "(Name Otto Meier (address Burgplatz))"))) + `(Name Otto Meier #f ,(base16-string->bytevector "123456") #f) + (let ((lst (string->canonical-sexp + "(Name Otto Meier (address Burgplatz) #123456#)"))) (unfold (cut > <> 5) (cut canonical-sexp-nth-data lst <>) 1+ |