~ruther/guix-local

6030d8493e13af81be63c3cee530d44b4dff1ad6 — Ludovic Courtès 12 years ago 50db7d8
pk-crypto: Use ISO-8859-1 for strings passed to 'gcry_sexp_new'.

* guix/pk-crypto.scm (string->canonical-sexp): Pass "ISO-8859-1" as the
  2nd argument to 'string->pointer'.
* tests/pk-crypto.scm ("version"): New test.
  ("hash corrupt due to restrictive locale encoding"): New test.
2 files changed, 30 insertions(+), 1 deletions(-)

M guix/pk-crypto.scm
M tests/pk-crypto.scm
M guix/pk-crypto.scm => guix/pk-crypto.scm +6 -1
@@ 134,8 134,13 @@ thrown along with 'gcry-error'."
         (proc (pointer->procedure int ptr `(* * ,size_t ,int))))
    (lambda (str)
      "Parse STR and return the corresponding gcrypt s-expression."

      ;; When STR comes from 'canonical-sexp->string', it may contain
      ;; characters that are really meant to be interpreted as bytes as in a C
      ;; 'char *'.  Thus, convert STR to ISO-8859-1 so the byte values of the
      ;; characters are preserved.
      (let* ((sexp (bytevector->pointer (make-bytevector (sizeof '*))))
             (err  (proc sexp (string->pointer str) 0 1)))
             (err  (proc sexp (string->pointer str "ISO-8859-1") 0 1)))
        (if (= 0 err)
            (pointer->canonical-sexp (dereference-pointer sexp))
            (throw 'gcry-error err))))))

M tests/pk-crypto.scm => tests/pk-crypto.scm +24 -0
@@ 64,6 64,9 @@

(test-begin "pk-crypto")

(test-assert "version"
  (gcrypt-version))

(let ((sexps '("(foo bar)"

               ;; In Libgcrypt 1.5.3 the following integer is rendered as


@@ 142,6 145,27 @@
            1+
            0)))

(let ((bv (base16-string->bytevector
           "5eff0b55c9c5f5e87b4e34cd60a2d5654ca1eb78c7b3c67c3179fed1cff07b4c")))
  (test-equal "hash corrupt due to restrictive locale encoding"
    bv

    ;; In Guix up to 0.6 included this test would fail because at some point
    ;; the hash value would be cropped to ASCII.  In practice 'guix
    ;; authenticate' would produce invalid signatures that would fail
    ;; signature verification.
    (let ((locale (setlocale LC_ALL)))
     (dynamic-wind
       (lambda ()
         (setlocale LC_ALL "C"))
       (lambda ()
         (hash-data->bytevector
          (string->canonical-sexp
           (canonical-sexp->string
            (bytevector->hash-data bv "sha256")))))
       (lambda ()
         (setlocale LC_ALL locale))))))

(gc)

;; XXX: The test below is typically too long as it needs to gather enough entropy.