ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

pk-crypto: Add pretty-printer to 'gcry-error' exceptions.

Browse source 
* guix/pk-crypto.scm (string->canonical-sexp, sign, generate-key): Pass
  the procedure name as the first argument to 'throw'.
  (gcrypt-error-printer): New procedure.
  <top level>: Add call to 'set-exception-printer!'.
* guix/nar.scm (restore-one-item): Add 'proc' parameter to 'catch'
  handler for 'gcry-error.
* guix/scripts/archive.scm (%options, generate-key-pair, authorize-key):
  Likewise.
* guix/scripts/substitute-binary.scm (narinfo-signature->canonical-sexp):
  Likewise.
This commit is contained in:
Ludovic Courtès 2014-04-22 11:41:52 +02:00
parent 6f69588529
commit 6ef3644e34
4 changed files with 17 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
guix/nar.scm
View file

@ -370,7 +370,7 @@ (define (assert-valid-signature signature hash file)
(let ((signature (catch 'gcry-error
(lambda ()
(string->canonical-sexp signature))
(lambda (err . _)
(lambda (key proc err)
(raise (condition
(&message
(message "signature is not a valid \

15
guix/pk-crypto.scm
View file

@ -143,7 +143,7 @@ (define string->canonical-sexp
(err (proc sexp (string->pointer str "ISO-8859-1") 0 1)))
(if (= 0 err)
(pointer->canonical-sexp (dereference-pointer sexp))
(throw 'gcry-error err))))))
(throw 'gcry-error 'string->canonical-sexp err))))))
(define-syntax GCRYSEXP_FMT_ADVANCED
(identifier-syntax 3))
@ -296,7 +296,7 @@ (define sign
(canonical-sexp->pointer secret-key))))
(if (= 0 err)
(pointer->canonical-sexp (dereference-pointer sig))
(throw 'gry-error err))))))
(throw 'gcry-error 'sign err))))))
(define verify
(let* ((ptr (libgcrypt-func "gcry_pk_verify"))
@ -318,7 +318,7 @@ (define generate-key
(err (proc key (canonical-sexp->pointer params))))
(if (zero? err)
(pointer->canonical-sexp (dereference-pointer key))
(throw 'gcry-error err))))))
(throw 'gcry-error 'generate-key err))))))
(define find-sexp-token
(let* ((ptr (libgcrypt-func "gcry_sexp_find_token"))
@ -403,4 +403,13 @@ (define (write item)
(write sexp)))))
(define (gcrypt-error-printer port key args default-printer)
"Print the gcrypt error specified by ARGS."
(match args
((proc err)
(format port "In procedure ~a: ~a: ~a"
proc (error-source err) (error-string err)))))
(set-exception-printer! 'gcry-error gcrypt-error-printer)
;;; pk-crypto.scm ends here

6
guix/scripts/archive.scm
View file

@ -123,7 +123,7 @@ (define %options
(string->canonical-sexp
(or arg %key-generation-parameters))))
(alist-cons 'generate-key params result)))
(lambda (key err)
(lambda (key proc err)
(leave (_ "invalid key generation parameters: ~a: ~a~%")
(error-source err)
(error-string err))))))
@ -248,7 +248,7 @@ (define (generate-key-pair parameters)
(let* ((pair (catch 'gcry-error
(lambda ()
(generate-key parameters))
(lambda (key err)
(lambda (key proc err)
(leave (_ "key generation failed: ~a: ~a~%")
(error-source err)
(error-string err)))))
@ -275,7 +275,7 @@ (define (read-key)
(catch 'gcry-error
(lambda ()
(string->canonical-sexp (get-string-all (current-input-port))))
(lambda (key err)
(lambda (key proc err)
(leave (_ "failed to read public key: ~a: ~a~%")
(error-source err) (error-string err)))))

2
guix/scripts/substitute-binary.scm
View file

@ -252,7 +252,7 @@ (define (narinfo-signature->canonical-sexp str)
(catch 'gcry-error
(lambda ()
(string->canonical-sexp signature))
(lambda (err . rest)
(lambda (key proc err)
(leave (_ "signature is not a valid \
s-expression: ~s~%")
signature))))))))