Hello community, here is the log from the commit of package guile-gcrypt for openSUSE:Factory checked in at 2020-11-26 23:14:43 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/guile-gcrypt (Old) and /work/SRC/openSUSE:Factory/.guile-gcrypt.new.5913 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "guile-gcrypt" Thu Nov 26 23:14:43 2020 rev:7 rq:850988 version:0.3.0 Changes: -------- --- /work/SRC/openSUSE:Factory/guile-gcrypt/guile-gcrypt.changes 2020-07-06 16:37:07.512607231 +0200 +++ /work/SRC/openSUSE:Factory/.guile-gcrypt.new.5913/guile-gcrypt.changes 2020-11-26 23:15:53.833061039 +0100 @@ -1,0 +2,10 @@ +Fri Nov 6 17:15:43 UTC 2020 - Jonathan Brielmaier <[email protected]> + +- Update to 0.3.0: + * ‘sexp->canonical-sexp->sexp’ now accepts integers + * (gcrypt common) exports ‘error/’ constants and error handling procedures + * ‘verify’ now throws upon errors other than ‘error/bad-signature’ + * (gcrypt hmac) and (gcrypt hash) export bindings for their syntax literals + * New ‘hash-algorithm-name’ and ‘mac-algorithm-name’ procedures + +------------------------------------------------------------------- Old: ---- v0.2.1.tar.gz New: ---- v0.3.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ guile-gcrypt.spec ++++++ --- /var/tmp/diff_new_pack.gmxO8Q/_old 2020-11-26 23:15:54.809061798 +0100 +++ /var/tmp/diff_new_pack.gmxO8Q/_new 2020-11-26 23:15:54.813061801 +0100 @@ -17,7 +17,7 @@ Name: guile-gcrypt -Version: 0.2.1 +Version: 0.3.0 Release: 0 Summary: Cryptography library for Guile using Libgcrypt License: GPL-3.0-or-later ++++++ v0.2.1.tar.gz -> v0.3.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/NEWS new/guile-gcrypt/NEWS --- old/guile-gcrypt/NEWS 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/NEWS 2020-05-23 12:23:29.000000000 +0200 @@ -2,14 +2,22 @@ #+TITLE: Guile-Gcrypt NEWS – history of user-visible changes #+STARTUP: content hidestars -Copyright © 2019 Ludovic Courtès <[email protected]> +Copyright © 2019, 2020 Ludovic Courtès <[email protected]> Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. +Run “info guile-gcrypt” for details about the changes described below. Please send Guix bug reports to <https://notabug.org/cwebber/guile-gcrypt>. +* Changes in 0.3.0 (since 0.2.1) +** ‘sexp->canonical-sexp->sexp’ now accepts integers +** (gcrypt common) exports ‘error/’ constants and error handling procedures +** ‘verify’ now throws upon errors other than ‘error/bad-signature’ +** (gcrypt hmac) and (gcrypt hash) export bindings for their syntax literals +** New ‘hash-algorithm-name’ and ‘mac-algorithm-name’ procedures + * Changes in 0.2.1 (since 0.2.0) ** libgcrypt is now always properly initialized (https://bugs.gnu.org/37616) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/README new/guile-gcrypt/README --- old/guile-gcrypt/README 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/README 2020-05-23 12:23:29.000000000 +0200 @@ -1,7 +1,7 @@ Guile-Gcrypt — Guile bindings to Libgcrypt ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Guile-Gcrypt provides a Guile 2.x interface to a subset of the +Guile-Gcrypt provides a Guile 3.x/2.x interface to a subset of the GNU Libgcrypt crytographic library, which is itself used by the GNU Privacy Guard (GPG). @@ -12,7 +12,7 @@ Requirements: - • GNU Guile 2.x, https://gnu.org/software/guile/ + • GNU Guile 3.x or 2.x >= 2.0.10, https://gnu.org/software/guile/ • GNU Libgcrypt 1.8.x or later, https://gnupg.org/ For more information, patches, bug reports, and all that, see: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/configure.ac new/guile-gcrypt/configure.ac --- old/guile-gcrypt/configure.ac 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/configure.ac 2020-05-23 12:23:29.000000000 +0200 @@ -1,4 +1,4 @@ -AC_INIT([Guile-Gcrypt], [0.2.0], [[email protected]], +AC_INIT([Guile-Gcrypt], [0.3.0], [[email protected]], [guile-gcrypt], [https://notabug.org/cwebber/guile-gcrypt]) AC_CONFIG_AUX_DIR([build-aux]) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/gcrypt/common.scm new/guile-gcrypt/gcrypt/common.scm --- old/guile-gcrypt/gcrypt/common.scm 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/gcrypt/common.scm 2020-05-23 12:23:29.000000000 +0200 @@ -1,5 +1,5 @@ ;;; guile-gcrypt --- crypto tooling for guile -;;; Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <[email protected]> ;;; Copyright © 2019 Mathieu Othacehe <[email protected]> ;;; ;;; This file is part of guile-gcrypt. @@ -22,7 +22,11 @@ #:use-module (system foreign) #:use-module (ice-9 match) #:re-export (gcrypt-version) - #:export (error-source error-string)) + #:export (gcrypt-error + strip-error-source + error-code=? + error-source + error-string)) ;;; Commentary: ;;; @@ -30,6 +34,332 @@ ;;; ;;; Code: +(define-syntax GPG_ERR_SOURCE_GCRYPT ;from <gpg-error.h> + (identifier-syntax 1)) + +(define-inlinable (strip-error-source error) + "Strip the error source bits from ERROR, a libgpg-error error code." + (logand error #xfffff)) + +(define-inlinable (gcrypt-error value) + "Return VALUE as a libgpg-error code originating from Libgcrypt." + (logior (ash GPG_ERR_SOURCE_GCRYPT 24) + (strip-error-source value))) + +(define-inlinable (error-code=? error1 error2) + "Return true if ERROR1 and ERROR2 denote the same error code, regardless of +the error source." + (= (strip-error-source error1) (strip-error-source error2))) + +(define-syntax define-error-codes + (syntax-rules () + "Define one variable for each error code given, using +GPG_ERR_SOURCE_GCRYPT as the error source." + ((_ name value rest ...) + (begin + (define-public name value) + (define-error-codes rest ...))) + ((_) + #t))) + +;; GPG_ERR_ values of 'gpg_err_code_t' in <gpg-error.h>. +(define-error-codes + error/no-error 0 + error/general 1 + error/unknown-packet 2 + error/unknown-version 3 + error/public-key-algo 4 + error/digest-algo 5 + error/bad-public-key 6 + error/bad-secret-key 7 + error/bad-signature 8 + error/no-public-key 9 + error/checksum 10 + error/bad-passphrase 11 + error/cipher-algo 12 + error/keyring-open 13 + error/invalid-packet 14 + error/invalid-armor 15 + error/no-user-id 16 + error/no-secret-key 17 + error/wrong-secret-key 18 + error/bad-key 19 + error/compr-algo 20 + error/no-prime 21 + error/no-encoding-method 22 + error/no-encryption-scheme 23 + error/no-signature-scheme 24 + error/invalid-attr 25 + error/no-value 26 + error/not-found 27 + error/value-not-found 28 + error/syntax 29 + error/bad-mpi 30 + error/invalid-passphrase 31 + error/sig-class 32 + error/resource-limit 33 + error/invalid-keyring 34 + error/trustdb 35 + error/bad-cert 36 + error/invalid-user-id 37 + error/unexpected 38 + error/time-conflict 39 + error/keyserver 40 + error/wrong-public-key-algo 41 + error/weak-key 43 + ;; The answer. + error/invalid-key-length 44 + error/invalid-argument 45 + error/bad-uri 46 + error/invalid-uri 47 + error/network 48 + error/unknown-host 49 + error/selftest-failed 50 + error/not-encrypted 51 + error/not-processed 52 + error/unusable-public-key 53 + error/unusable-secret-key 54 + error/invalid-value 55 + error/bad-cert-chain 56 + error/missing-cert 57 + error/no-data 58 + error/bug 59 + error/not-supported 60 + error/invalid-op 61 + error/timeout 62 + error/internal 63 + error/eof-gcrypt 64 + error/invalid-object 65 + error/too-short 66 + error/too-large 67 + error/no-obj 68 + error/not-implemented 69 + error/conflict 70 + error/invalid-cipher-mode 71 + error/invalid-flag 72 + error/invalid-handle 73 + error/truncated 74 + error/incomplete-line 75 + error/invalid-response 76 + error/no-agent 77 + error/agent 78 + error/invalid-data 79 + error/assuan-server-fault 80 + error/assuan 81 + error/invalid-session-key 82 + error/invalid-sexp 83 + error/unsupported-algorithm 84 + error/no-pin-entry 85 + error/pin-entry 86 + error/bad-pin 87 + error/invalid-name 88 + error/bad-data 89 + error/invalid-parameter 90 + error/wrong-card 91 + error/no-dirmngr 92 + error/dirmngr 93 + error/cert-revoked 94 + error/no-crl-known 95 + error/crl-too-old 96 + error/line-too-long 97 + error/not-trusted 98 + error/canceled 99 + error/bad-ca-cert 100 + error/cert-expired 101 + error/cert-too-young 102 + error/unsupported-cert 103 + error/unknown-sexp 104 + error/unsupported-protection 105 + error/corrupted-protection 106 + error/ambiguous-name 107 + error/card 108 + error/card-reset 109 + error/card-removed 110 + error/invalid-card 111 + error/card-not-present 112 + error/no-pkcs15-app 113 + error/not-confirmed 114 + error/configuration 115 + error/no-policy-match 116 + error/invalid-index 117 + error/invalid-id 118 + error/no-scdaemon 119 + error/scdaemon 120 + error/unsupported-protocol 121 + error/bad-pin-method 122 + error/card-not-initialized 123 + error/unsupported-operation 124 + error/wrong-key-usage 125 + error/nothing-found 126 + error/wrong-blob-type 127 + error/missing-value 128 + error/hardware 129 + error/pin-blocked 130 + error/use-conditions 131 + error/pin-not-synced 132 + error/invalid-crl 133 + error/bad-ber 134 + error/invalid-ber 135 + error/element-not-found 136 + error/identifier-not-found 137 + error/invalid-tag 138 + error/invalid-length 139 + error/invalid-keyinfo 140 + error/unexpected-tag 141 + error/not-der-encoded 142 + error/no-cms-obj 143 + error/invalid-cms-obj 144 + error/unknown-cms-obj 145 + error/unsupported-cms-obj 146 + error/unsupported-encoding 147 + error/unsupported-cms-version 148 + error/unknown-algorithm 149 + error/invalid-engine 150 + error/public-key-not-trusted 151 + error/decrypt-failed 152 + error/key-expired 153 + error/sig-expired 154 + error/encoding-problem 155 + error/invalid-state 156 + error/dup-value 157 + error/missing-action 158 + error/module-not-found 159 + error/invalid-oid-string 160 + error/invalid-time 161 + error/invalid-crl-obj 162 + error/unsupported-crl-version 163 + error/invalid-cert-obj 164 + error/unknown-name 165 + error/locale-problem 166 + error/not-locked 167 + error/protocol-violation 168 + error/invalid-mac 169 + error/invalid-request 170 + error/unknown-extn 171 + error/unknown-crit-extn 172 + error/locked 173 + error/unknown-option 174 + error/unknown-command 175 + error/not-operational 176 + error/no-passphrase 177 + error/no-pin 178 + error/not-enabled 179 + error/no-engine 180 + error/missing-key 181 + error/too-many 182 + error/limit-reached 183 + error/not-initialized 184 + error/missing-issuer-cert 185 + error/no-keyserver 186 + error/invalid-curve 187 + error/unknown-curve 188 + error/dup-key 189 + error/ambiguous 190 + error/no-crypt-ctx 191 + error/wrong-crypt-ctx 192 + error/bad-crypt-ctx 193 + error/crypt-ctx-conflict 194 + error/broken-public-key 195 + error/broken-secret-key 196 + error/mac-algo 197 + error/fully-canceled 198 + error/unfinished 199 + error/buffer-too-short 200 + error/sexp-invalid-len-spec 201 + error/sexp-string-too-long 202 + error/sexp-unmatched-paren 203 + error/sexp-not-canonical 204 + error/sexp-bad-character 205 + error/sexp-bad-quotation 206 + error/sexp-zero-prefix 207 + error/sexp-nested-dh 208 + error/sexp-unmatched-dh 209 + error/sexp-unexpected-punc 210 + error/sexp-bad-hex-char 211 + error/sexp-odd-hex-numbers 212 + error/sexp-bad-oct-char 213 + error/subkeys-exp-or-rev 217 + error/db-corrupted 218 + error/server-failed 219 + error/no-name 220 + error/no-key 221 + error/legacy-key 222 + error/request-too-short 223 + error/request-too-long 224 + error/obj-term-state 225 + error/no-cert-chain 226 + error/cert-too-large 227 + error/invalid-record 228 + error/bad-mac 229 + error/unexpected-msg 230 + error/compr-failed 231 + error/would-wrap 232 + error/fatal-alert 233 + error/no-cipher 234 + error/missing-client-cert 235 + error/close-notify 236 + error/ticket-expired 237 + error/bad-ticket 238 + error/unknown-identity 239 + error/bad-hs-cert 240 + error/bad-hs-cert-req 241 + error/bad-hs-cert-ver 242 + error/bad-hs-change-cipher 243 + error/bad-hs-client-hello 244 + error/bad-hs-server-hello 245 + error/bad-hs-server-hello-done 246 + error/bad-hs-finished 247 + error/bad-hs-server-kex 248 + error/bad-hs-client-kex 249 + error/bogus-string 250 + error/forbidden 251 + error/key-disabled 252 + error/key-on-card 253 + error/invalid-lock-obj 254 + error/true 255 + error/false 256 + error/ass-general 257 + error/ass-accept-failed 258 + error/ass-connect-failed 259 + error/ass-invalid-response 260 + error/ass-invalid-value 261 + error/ass-incomplete-line 262 + error/ass-line-too-long 263 + error/ass-nested-commands 264 + error/ass-no-data-cb 265 + error/ass-no-inquire-cb 266 + error/ass-not-a-server 267 + error/ass-not-a-client 268 + error/ass-server-start 269 + error/ass-read-error 270 + error/ass-write-error 271 + error/ass-too-much-data 273 + error/ass-unexpected-cmd 274 + error/ass-unknown-cmd 275 + error/ass-syntax 276 + error/ass-canceled 277 + error/ass-no-input 278 + error/ass-no-output 279 + error/ass-parameter 280 + error/ass-unknown-inquire 281 + error/engine-too-old 300 + error/window-too-small 301 + error/window-too-large 302 + error/missing-envvar 303 + error/user-id-exists 304 + error/name-exists 305 + error/dup-name 306 + error/too-young 307 + error/too-old 308 + error/unknown-flag 309 + error/invalid-order 310 + error/already-fetched 311 + error/try-later 312 + error/wrong-name 313 + error/no-auth 314 + error/bad-auth 315 + error/system-bug 666) + (define error-source (let ((proc (libgcrypt->procedure '* "gcry_strsource" (list int)))) (lambda (err) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/gcrypt/hash.scm new/guile-gcrypt/gcrypt/hash.scm --- old/guile-gcrypt/gcrypt/hash.scm 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/gcrypt/hash.scm 2020-05-23 12:23:29.000000000 +0200 @@ -1,5 +1,5 @@ ;;; guile-gcrypt --- crypto tooling for guile -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2019, 2020 Ludovic Courtès <[email protected]> ;;; Copyright © 2019 Mathieu Othacehe <[email protected]> ;;; ;;; This file is part of guile-gcrypt. @@ -27,6 +27,7 @@ #:use-module (srfi srfi-26) #:export (hash-algorithm lookup-hash-algorithm + hash-algorithm-name hash-size bytevector-hash @@ -35,8 +36,6 @@ file-hash open-hash-input-port - sha1 - sha256 open-sha256-port port-sha256 file-sha256 @@ -54,11 +53,18 @@ ;;; (define-syntax-rule (define-hash-algorithms name->integer - symbol->integer hash-size + symbol->integer integer->symbol hash-size (name id size) ...) "Define hash algorithms with their NAME, numerical ID, and SIZE in bytes." (begin - (define-enumerate-type name->integer symbol->integer + ;; Make sure NAME is bound to follow best practices for syntax matching + ;; (info "(guile) Syntax Rules"). As a bonus, it provides convenient + ;; shorthand procedures. + (define-public name + (cut bytevector-hash <> id)) + ... + + (define-enumerate-type name->integer symbol->integer integer->symbol (name id) ...) (define-lookup-procedure hash-size @@ -75,7 +81,7 @@ ;; 'GCRY_MD_' values as of Libgcrypt 1.8.3. (define-hash-algorithms hash-algorithm - lookup-hash-algorithm + lookup-hash-algorithm hash-algorithm-name hash-size (md5 1 16) @@ -127,12 +133,6 @@ (bytevector->pointer bv) (bytevector-length bv)) digest)))) -(define sha1 - (cut bytevector-hash <> (hash-algorithm sha1))) - -(define sha256 - (cut bytevector-hash <> (hash-algorithm sha256))) - (define open-md (let ((proc (libgcrypt->procedure int "gcry_md_open" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/gcrypt/internal.scm new/guile-gcrypt/gcrypt/internal.scm --- old/guile-gcrypt/gcrypt/internal.scm 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/gcrypt/internal.scm 2020-05-23 12:23:29.000000000 +0200 @@ -1,5 +1,5 @@ ;;; guile-gcrypt --- crypto tooling for guile -;;; Copyright © 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2019, 2020 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of guile-gcrypt. ;;; @@ -59,6 +59,7 @@ (list ENOSYS)))))) (define-syntax-rule (define-enumerate-type name->integer symbol->integer + integer->symbol (name id) ...) (begin (define-syntax name->integer @@ -71,7 +72,11 @@ (lambda (symbol) "Look up SYMBOL and return the corresponding integer or #f if it could not be found." - (assq-ref alist symbol)))))) + (assq-ref alist symbol)))) + + (define-lookup-procedure integer->symbol + "Return the name (a symbol) corresponding to the given integer value." + (id name) ...))) (define-syntax define-lookup-procedure (lambda (s) @@ -79,7 +84,9 @@ value in O(1)." (syntax-case s () ((_ lookup docstring (index value) ...) - (let* ((values (syntax->datum #'((index . value) ...))) + (let* ((values (map cons + (syntax->datum #'(index ...)) + #'(value ...))) (min (apply min (syntax->datum #'(index ...)))) (max (apply max (syntax->datum #'(index ...)))) (array (let loop ((i max) @@ -87,7 +94,7 @@ (if (< i min) result (loop (- i 1) - (cons (or (assv-ref values i) -1) + (cons (or (assv-ref values i) *unspecified*) result)))))) #`(define lookup ;; Allocate a big sparse vector. @@ -96,7 +103,9 @@ docstring (and (<= integer #,max) (>= integer #,min) (let ((result (vector-ref values (- integer #,min)))) - (and (> result 0) result))))))))))) + (if (unspecified? result) + #f + result))))))))))) (define gcrypt-version ;; According to the manual, this function must be called before any other, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/gcrypt/mac.scm new/guile-gcrypt/gcrypt/mac.scm --- old/guile-gcrypt/gcrypt/mac.scm 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/gcrypt/mac.scm 2020-05-23 12:23:29.000000000 +0200 @@ -1,7 +1,7 @@ ;;; guile-gcrypt --- crypto tooling for guile ;;; Copyright © 2016 Christopher Allan Webber <[email protected]> ;;; Copyright © 2019 Mathieu Othacehe <[email protected]> -;;; Copyright © 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2019, 2020 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of guile-gcrypt. ;;; @@ -28,6 +28,7 @@ #:use-module (system foreign) #:export (mac-algorithm lookup-mac-algorithm + mac-algorithm-name mac-size sign-data @@ -36,12 +37,26 @@ valid-base64-signature? generate-signing-key)) +(define-syntax-rule (define-syntax-public name value) + (begin + (define-syntax name value) + (export name))) + (define-syntax-rule (define-mac-algorithms name->integer - symbol->integer mac-size + symbol->integer integer->symbol mac-size (name id size) ...) "Define hash algorithms with their NAME, numerical ID, and SIZE in bytes." (begin - (define-enumerate-type name->integer symbol->integer + ;; Make sure NAME is bound to follow best practices for syntax matching + ;; (info "(guile) Syntax Rules"). + (define-syntax-public name + (lambda (s) + (syntax-violation 'name "\ +syntactic keyword is meant to be used with 'mac-algorithm'" + s s))) + ... + + (define-enumerate-type name->integer symbol->integer integer->symbol (name id) ...) (define-lookup-procedure mac-size @@ -49,7 +64,7 @@ (id size) ...))) (define-mac-algorithms mac-algorithm - lookup-mac-algorithm + lookup-mac-algorithm mac-algorithm-name mac-size ;; GCRY_MAC_* diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/gcrypt/pk-crypto.scm new/guile-gcrypt/gcrypt/pk-crypto.scm --- old/guile-gcrypt/gcrypt/pk-crypto.scm 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/gcrypt/pk-crypto.scm 2020-05-23 12:23:29.000000000 +0200 @@ -1,5 +1,5 @@ ;;; guile-gcrypt --- crypto tooling for guile -;;; Copyright © 2013, 2014, 2015, 2017, 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2013, 2014, 2015, 2017, 2019, 2020 Ludovic Courtès <[email protected]> ;;; Copyright © 2019 Mathieu Othacehe <[email protected]> ;;; ;;; This file is part of guile-gcrypt. @@ -281,10 +281,15 @@ (let ((proc (libgcrypt->procedure int "gcry_pk_verify" '(* * *)))) (lambda (signature data public-key) "Verify that SIGNATURE is a signature of DATA with PUBLIC-KEY, all of -which are gcrypt s-expressions." - (zero? (proc (canonical-sexp->pointer signature) - (canonical-sexp->pointer data) - (canonical-sexp->pointer public-key)))))) +which are gcrypt s-expressions; return #t if the verification was successful, +#f otherwise. Raise an error if, for example, one of the given s-expressions +is invalid." + (let ((err (proc (canonical-sexp->pointer signature) + (canonical-sexp->pointer data) + (canonical-sexp->pointer public-key)))) + (cond ((zero? err) #t) + ((error-code=? error/bad-signature err) #f) + (else (throw 'gcry-error 'verify err))))))) (define generate-key (let ((proc (libgcrypt->procedure int "gcry_pk_genkey" '(* *)))) @@ -361,6 +366,11 @@ (define (sexp->canonical-sexp sexp) "Return a canonical sexp equivalent to SEXP, a Scheme sexp as returned by 'canonical-sexp->sexp'." + (define (string-hex-pad str) + (if (odd? (string-length str)) + (string-append "0" str) + str)) + ;; XXX: This is inefficient, but the Libgcrypt API doesn't allow us to do ;; much better. (string->canonical-sexp @@ -376,6 +386,9 @@ ((bytevector? item) (format port " #~a#" (bytevector->base16-string item))) + ((integer? item) + (format port " #~a#" + (string-hex-pad (number->string item 16)))) (else (error "unsupported sexp item type" item)))) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/guile-gcrypt.texi new/guile-gcrypt/guile-gcrypt.texi --- old/guile-gcrypt/guile-gcrypt.texi 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/guile-gcrypt.texi 2020-05-23 12:23:29.000000000 +0200 @@ -10,7 +10,7 @@ @include version.texi @copying -Copyright @copyright{} 2018, 2019 Ludovic Courtès@* +Copyright @copyright{} 2018, 2019, 2020 Ludovic Courtès@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -105,7 +105,20 @@ proc (error-source err) (error-string err)))) @end lisp -These two procedures are detailed below. +These two procedures are detailed below. You can also refer to one of +the @code{error/} constants exported by @code{(gcrypt common)} when +looking for a specific error: + +@lisp +(catch 'gcry-error + (lambda () + ;; Do something with Guile-Gcrypt... + ) + (lambda (key proc err) + (if (error-code=? err error/bad-signature) + (format (current-error-port) "Uh oh, bad signature!\n") + (format (current-error-port) @dots{})))) +@end lisp @deffn {Scheme Procedure} error-source @var{err} Return the error source (a string) for @var{err}, an error code as thrown @@ -150,6 +163,11 @@ @code{#f} if @var{id} does not denote a known hash algorithm. @end deffn +@deffn {Scheme Procedure} hash-algorithm-name @var{algorithm} +Return the name, a symbol, of @var{algorithm}, a value as returned by +@code{hash-algorithm}. +@end deffn + @deffn {Scheme Procedure} hash-size @var{algorithm} Return the size in bytes of hashes produced by @var{algorithm}. @end deffn @@ -157,9 +175,16 @@ The procedures below offer several ways to compute a hash. @deffn {Scheme Procedure} bytevector-hash @var{bv} @var{algorithm} +@deffnx {Scheme Procedure} crc32 @var{bv} @deffnx {Scheme Procedure} sha1 @var{bv} @deffnx {Scheme Procedure} sha256 @var{bv} +@deffnx {Scheme Procedure} sha512 @var{bv} +@deffnx {Scheme Procedure} sha3-512 @var{bv} Return the hash @var{algorithm} of @var{bv} as a bytevector. + +Shorthand procedures like @code{sha256} are available for all the +algorithms that are valid identifiers for @code{hash-algorithm} though +for brevity only a handful are listed here. @end deffn @deffn {Scheme Procedure} open-hash-port @var{algorithm} @@ -228,6 +253,11 @@ @code{#f} if @var{id} does not denote a known MAC algorithm. @end deffn +@deffn {Scheme Procedure} mac-algorithm-name @var{algorithm} +Return the name, a symbol, of @var{algorithm}, a value as returned by +@code{mac-algorithm}. +@end deffn + @deffn {Scheme Procedure} mac-size @var{algorithm} Return the size in bytes of MACs produced by @var{algorithm}. @end deffn diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/tests/hash.scm new/guile-gcrypt/tests/hash.scm --- old/guile-gcrypt/tests/hash.scm 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/tests/hash.scm 2020-05-23 12:23:29.000000000 +0200 @@ -1,5 +1,5 @@ ;;; guile-gcrypt --- crypto tooling for guile -;;; Copyright © 2013, 2014, 2017, 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2013, 2014, 2017, 2019, 2020 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of guile-gcrypt. ;;; @@ -57,6 +57,10 @@ (hash-algorithm blake2b-512) (lookup-hash-algorithm 'blake2b-512)) +(test-eq "hash-algorithm-name" + 'sha3-512 + (hash-algorithm-name (hash-algorithm sha3-512))) + (test-equal "hash-size" (list 20 32 64) (map hash-size @@ -82,8 +86,7 @@ (test-equal "sha512, empty" "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" - (bytevector->base16-string - (bytevector-hash #vu8() (hash-algorithm sha512)))) + (bytevector->base16-string (sha512 #vu8()))) (test-equal "sha512, hello" %hello-sha512 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/tests/mac.scm new/guile-gcrypt/tests/mac.scm --- old/guile-gcrypt/tests/mac.scm 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/tests/mac.scm 2020-05-23 12:23:29.000000000 +0200 @@ -1,6 +1,6 @@ ;;; guile-gcrypt --- crypto tooling for guile ;;; Copyright © 2016 Christopher Allan Webber <[email protected]> -;;; Copyright © 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2019, 2020 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of guile-gcrypt. ;;; @@ -28,6 +28,10 @@ (mac-algorithm hmac-sha3-256) (lookup-mac-algorithm 'hmac-sha3-256)) +(test-eq "mac-algorithm-name" + 'hmac-sha3-512 + (mac-algorithm-name (mac-algorithm hmac-sha3-512))) + (test-equal "mac-size" (list 32 28 64 64) (map mac-size diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/guile-gcrypt/tests/pk-crypto.scm new/guile-gcrypt/tests/pk-crypto.scm --- old/guile-gcrypt/tests/pk-crypto.scm 2019-12-15 21:22:10.000000000 +0100 +++ new/guile-gcrypt/tests/pk-crypto.scm 2020-05-23 12:23:29.000000000 +0200 @@ -1,5 +1,5 @@ ;;; guile-gcrypt --- crypto tooling for guile -;;; Copyright © 2013, 2014, 2017, 2019 Ludovic Courtès <[email protected]> +;;; Copyright © 2013, 2014, 2017, 2019, 2020 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of guile-gcrypt. ;;; @@ -21,6 +21,7 @@ #:use-module (gcrypt utils) #:use-module (gcrypt base16) #:use-module (gcrypt hash) + #:use-module (gcrypt common) ;error codes #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -194,6 +195,21 @@ string->canonical-sexp) (list %key-pair %ecc-key-pair))) +(test-equal "sign + verify, bogus signature" + `(verify . ,(gcrypt-error error/invalid-object)) + (catch 'gcry-error + (lambda () + (let* ((pair (string->canonical-sexp %key-pair)) + (secret (find-sexp-token pair 'private-key)) + (public (find-sexp-token pair 'public-key)) + (data (bytevector->hash-data + (sha256 (string->utf8 "Hello, world.")) + #:key-type (key-type public))) + (bogus (string->canonical-sexp "(bogus sig)"))) + (verify bogus data public))) + (lambda (key proc error) + (cons proc error)))) + (test-assert "sign + verify" (let* ((pair (string->canonical-sexp %key-pair)) (secret (find-sexp-token pair 'private-key)) @@ -285,4 +301,12 @@ sexp (canonical-sexp->sexp (sexp->canonical-sexp sexp)))) +;; In Guile-Gcrypt <= 0.2.1, 'canonical-sexp->sexp' did not support integers. +(test-equal "sexp->canonical-sexp, big integers" + '(a (b #vu8(#x01 #x23 #x45 #x67 #x89)) + (c #vu8(#x98 #x76 #x54 #x32 #x10))) + (canonical-sexp->sexp + (sexp->canonical-sexp + '(a (b #x123456789) (c #x9876543210))))) + (test-end) _______________________________________________ openSUSE Commits mailing list -- [email protected] To unsubscribe, email [email protected] List Netiquette: https://en.opensuse.org/openSUSE:Mailing_list_netiquette List Archives: https://lists.opensuse.org/archives/list/[email protected]
