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.

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+