aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-04-22 11:41:52 +0200
committerLudovic Courtès <ludo@gnu.org>2014-04-22 11:41:52 +0200
commit6ef3644e3462d4a98323f556eefa92a6765ed437 (patch)
treec540c4cebb281bfb516e87f73f9951e2995ffb2b
parent6f69588529f9898dc4f2defd21603cc4abbaca17 (diff)
downloadguix-6ef3644e3462d4a98323f556eefa92a6765ed437.tar
guix-6ef3644e3462d4a98323f556eefa92a6765ed437.tar.gz
pk-crypto: Add pretty-printer to 'gcry-error' exceptions.
* 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.
-rw-r--r--guix/nar.scm2
-rw-r--r--guix/pk-crypto.scm15
-rw-r--r--guix/scripts/archive.scm6
-rwxr-xr-xguix/scripts/substitute-binary.scm2
4 files changed, 17 insertions, 8 deletions
diff --git a/guix/nar.scm b/guix/nar.scm
index 6beda91c02..0a7187c2dd 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -370,7 +370,7 @@ protected from GC."
(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 \
diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm
index 351bf929c5..71104128c1 100644
--- a/guix/pk-crypto.scm
+++ b/guix/pk-crypto.scm
@@ -143,7 +143,7 @@ thrown along with 'gcry-error'."
(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 @@ is 'private-key'.)"
(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 @@ s-expression like: (genkey (rsa (nbits 4:2048)))."
(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 @@ use pattern matching."
(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
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 0a2e186da6..84904e29da 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -123,7 +123,7 @@ Export/import one or more packages from/to the store.\n"))
(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 @@ this may take time...~%"))
(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 @@ the input port."
(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)))))
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 8e35612e3a..c70a4f626c 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -252,7 +252,7 @@ failure."
(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))))))))