diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-04-22 11:41:52 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-04-22 11:41:52 +0200 |
| commit | 6ef3644e3462d4a98323f556eefa92a6765ed437 (patch) | |
| tree | c540c4cebb281bfb516e87f73f9951e2995ffb2b /guix/pk-crypto.scm | |
| parent | 6f69588529f9898dc4f2defd21603cc4abbaca17 (diff) | |
| download | guix-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.
Diffstat (limited to 'guix/pk-crypto.scm')
| -rw-r--r-- | guix/pk-crypto.scm | 15 |
1 files changed, 12 insertions, 3 deletions
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 |