[git] GPGME - branch, master, updated. gpgme-1.12.0-10-g85d7af8
by Guillaume LE VAILLANT
cvs at cvs.gnupg.org
Fri Oct 12 09:02:28 CEST 2018
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GnuPG Made Easy".
The branch, master has been updated
via 85d7af8ff2f6afd63701079e23f31be08d58a15d (commit)
via aafadb859497aa8785b7e19f267f1bfd8acfc062 (commit)
from 85dd0fa4b5f026a13da842bf64ab8a37a68918d4 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 85d7af8ff2f6afd63701079e23f31be08d58a15d
Author: Guillaume LE VAILLANT <glv at posteo.net>
Date: Fri Oct 12 08:49:26 2018 +0200
cl: Several fixes
--
* Use wrapper types calling translation functions instead of
TRANSLATE-{FROM,TO}-FOREIGN methods as they seem not to be
called in some cases.
* Use the (:STRUCT SOME-C-STRUCT) notation instead of the
deprecated direct reference to SOME-C-STRUCT.
* Add missing values in enums and bit fields.
* Use cffi-grovel to define system types (SIZE-T, OFF-T, etc).
* Wrap GPGME-DATA-T in a class (like contexts).
* Use the FINALIZE function from trivial-garbage to free the
C objects for contexts, keys and data automatically.
* Make DATA-READ-CB and DATA-WRITE-CB run faster.
* Update the README file.
Signed-off-by: Guillaume LE VAILLANT <glv at posteo.net>
diff --git a/lang/cl/Makefile.am b/lang/cl/Makefile.am
index 553926e..dee0711 100644
--- a/lang/cl/Makefile.am
+++ b/lang/cl/Makefile.am
@@ -18,7 +18,7 @@
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA
-clfiles = gpgme.asd gpgme-package.lisp gpgme.lisp
+clfiles = gpgme.asd gpgme-package.lisp gpgme-grovel.lisp gpgme.lisp
# FIXME: Should be configurable.
clfilesdir = $(datadir)/common-lisp/source/gpgme
diff --git a/lang/cl/README b/lang/cl/README
index b4a3c81..7d8e87d 100644
--- a/lang/cl/README
+++ b/lang/cl/README
@@ -3,33 +3,50 @@ Common Lisp Support for GPGME
Requirements:
-ASDF Packaging Support
-CFFI Foreign Function Interface
-gpg-error GPG Error Codes
+ASDF Packaging Support
+CFFI Foreign Function Interface
+trivial-garbage Finalizers
+gpg-error GPG Error Codes
Use with:
-> (asdf:operate 'asdf:load-op ':gpgme)
+> (asdf:load-system "gpgme")
Examples
--------
-(with-open-file (stream "/tmp/myout" :direction :output
- :if-exists :supersede :element-type '(unsigned-byte 8))
+(with-open-file (out "/tmp/myout"
+ :direction :output
+ :if-exists :supersede
+ :element-type '(unsigned-byte 8))
(with-context (ctx)
- (setf (armor-p ctx) t)
+ (setf (armorp ctx) t)
(op-export ctx "DEADBEEF" out)))
(with-context (ctx)
(with-output-to-string (out)
- (setf (armor-p ctx) t)
+ (setf (armorp ctx) t)
(op-export ctx "McTester" out)))
(gpgme:with-context (ctx :armor t)
(with-output-to-string (out)
(gpgme:op-export ctx "McTester" out)))
+(gpgme:with-context (ctx :armor t)
+ (let ((recipient1 (gpgme:get-key ctx "DEADBEEF"))
+ (recipient2 (gpgme:get-key ctx "Alice"))
+ (message "Hello, world!"))
+ (with-output-to-string (out)
+ (with-input-from-string (in message)
+ (gpgme:op-encrypt ctx (vector recipient1 recipient2) in out)))))
+
+(gpgme:with-context (ctx :armor t)
+ (let ((message "Hello, world!"))
+ (with-output-to-string (out)
+ (with-input-from-string (in message)
+ (gpgme:op-sign ctx in out)))))
+
TODO
----
diff --git a/lang/cl/gpgme-package.lisp b/lang/cl/gpgme-package.lisp
index 239d57f..25e01a8 100644
--- a/lang/cl/gpgme-package.lisp
+++ b/lang/cl/gpgme-package.lisp
@@ -26,7 +26,8 @@
(defpackage #:gpgme
(:use #:common-lisp #:cffi #:gpg-error)
-
+ (:import-from #:trivial-garbage
+ #:finalize)
(:export #:check-version
#:*version*
#:context
diff --git a/lang/cl/gpgme.asd.in b/lang/cl/gpgme.asd.in
index 86e8d51..6c5bd1f 100644
--- a/lang/cl/gpgme.asd.in
+++ b/lang/cl/gpgme.asd.in
@@ -25,11 +25,14 @@
(in-package #:gpgme-system)
(defsystem gpgme
- :description "GnuPG Made Easy."
- :author "g10 Code GmbH"
- :version "@VERSION@"
- :licence "GPL"
- :depends-on ("cffi" "gpg-error")
- :components ((:file "gpgme-package")
- (:file "gpgme"
- :depends-on ("gpgme-package"))))
+ :description "GnuPG Made Easy."
+ :author "g10 Code GmbH"
+ :version "@VERSION@"
+ :licence "GPL"
+ :defsystem-depends-on ("cffi-grovel")
+ :depends-on ("cffi" "gpg-error" "trivial-garbage")
+ :components ((:file "gpgme-package")
+ (:cffi-grovel-file "gpgme-grovel"
+ :depends-on ("gpgme-package"))
+ (:file "gpgme"
+ :depends-on ("gpgme-package" "gpgme-grovel"))))
diff --git a/lang/cl/gpgme.lisp b/lang/cl/gpgme.lisp
index 74cb9ed..b1a38ca 100644
--- a/lang/cl/gpgme.lisp
+++ b/lang/cl/gpgme.lisp
@@ -24,6 +24,12 @@
(in-package :gpgme)
+(deftype byte-array ()
+ '(simple-array (unsigned-byte 8) (*)))
+
+(deftype character-array ()
+ '(simple-array character (*)))
+
;;; Debugging.
(defvar *debug* nil "If debugging output should be given or not.")
@@ -38,23 +44,15 @@
;;; System dependencies.
-; FIXME: Use cffi-grovel? cffi-unix?
-
-(defctype size-t :unsigned-int "The system size_t type.")
-
-(defctype ssize-t :int "The system ssize_t type.")
-
-; FIXME: Ouch. Grovel? Helper function?
-(defconstant +seek-set+ 0)
-(defconstant +seek-cur+ 1)
-(defconstant +seek-end+ 2)
-(defctype off-t :long-long "The system off_t type.")
-
+; Access to ERRNO.
(defcfun ("strerror" c-strerror) :string
(err :int))
-; Access to ERRNO.
-; FIXME: Ouch. Should be grovel + helper function.
+(defun get-errno ()
+ *errno*)
+
+(defun set-errno (errno)
+ (setf *errno* errno))
(define-condition system-error (error)
((errno :initarg :errno :reader system-error-errno))
@@ -64,14 +62,6 @@
(c-strerror (system-error-errno c)))))
(:documentation "Signalled when an errno is encountered."))
-(defconstant +ebadf+ 1)
-
-; Ouch.
-(defun get-errno ()
- +ebadf+)
-
-;;; More about errno below.
-
; Needed to write passphrases.
(defcfun ("write" c-write) ssize-t
(fd :int)
@@ -83,14 +73,6 @@
(when (< res 0) (error 'system-error :errno (get-errno)))
res))
-;;; More about errno here.
-
-(defun set-errno (errno)
- (cond
- ; Works on GNU/Linux.
- ((eql errno +ebadf+) (system-write -1 (null-pointer) 0))
- (t (error 'invalid-errno :errno errno))))
-
;;;
;;; C Interface Definitions
;;;
@@ -100,22 +82,39 @@
;;; Some new data types used for easier translation.
;;; The number of include certs. Translates to NIL for default.
-(defctype cert-int-t :int)
+(defctype cert-int-t
+ (:wrapper :int
+ :from-c translate-cert-int-t-from-foreign
+ :to-c translate-cert-int-t-to-foreign))
;;; A string that may be NIL to indicate a null pointer.
-(defctype string-or-nil-t :string)
+(defctype string-or-nil-t
+ (:wrapper :string
+ :to-c translate-string-or-nil-t-to-foreign))
;;; Some opaque data types used by GPGME.
-(defctype gpgme-ctx-t :pointer "The GPGME context type.")
+(defctype gpgme-ctx-t
+ (:wrapper :pointer
+ :to-c translate-gpgme-ctx-t-to-foreign)
+ "The GPGME context type.")
-(defctype gpgme-data-t :pointer "The GPGME data object type.")
+(defctype gpgme-data-t
+ (:wrapper :pointer
+ :to-c translate-gpgme-data-t-to-foreign)
+ "The GPGME data object type.")
;;; Wrappers for the libgpg-error library.
-(defctype gpgme-error-t gpg-error::gpg-error-t "The GPGME error type.")
+(defctype gpgme-error-t
+ (:wrapper gpg-error::gpg-error-t
+ :from-c translate-gpgme-error-t-from-foreign
+ :to-c translate-gpgme-error-t-to-foreign)
+ "The GPGME error type.")
-(defctype gpgme-error-no-signal-t gpg-error::gpg-error-t
+(defctype gpgme-error-no-signal-t
+ (:wrapper gpg-error::gpg-error-t
+ :from-c translate-gpgme-error-no-signal-t-from-foreign)
"The GPGME error type (this version does not signal conditions in translation.")
(defctype gpgme-err-code-t gpg-error::gpg-err-code-t
@@ -171,7 +170,11 @@
(:none 0)
(:binary 1)
(:base64 2)
- (:armor 3))
+ (:armor 3)
+ (:url 4)
+ (:urlesc 5)
+ (:url0 6)
+ (:mime 7))
;;;
@@ -182,7 +185,11 @@
(:rsa-s 3)
(:elg-e 16)
(:dsa 17)
- (:elg 20))
+ (:ecc 18)
+ (:elg 20)
+ (:ecdsa 301)
+ (:ecdh 302)
+ (:eddsa 303))
(defcenum gpgme-hash-algo-t
"Hash algorithms from libgcrypt."
@@ -196,6 +203,7 @@
(:sha256 8)
(:sha384 9)
(:sha512 10)
+ (:sha224 11)
(:md4 301)
(:crc32 302)
(:crc32-rfc1510 303)
@@ -225,7 +233,14 @@
(defcenum gpgme-protocol-t
"The available protocols."
(:openpgp 0)
- (:cms 1))
+ (:cms 1)
+ (:gpgconf 2)
+ (:assuan 3)
+ (:g13 4)
+ (:uiserver 5)
+ (:spawn 6)
+ (:default 254)
+ (:unknown 255))
;;;
@@ -234,6 +249,10 @@
(:local 1)
(:extern 2)
(:sigs 4)
+ (:sig-notations)
+ (:with-secret 16)
+ (:with-tofu 32)
+ (:ephemeral 128)
(:validate 256))
;;;
@@ -243,7 +262,9 @@
(:human-readable 1)
(:critical 2))
-(defctype gpgme-sig-notation-t :pointer
+(defctype gpgme-sig-notation-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-sig-notation-t-from-foreign)
"Signature notation pointer type.")
;; FIXME: Doesn't this depend on endianess?
@@ -263,15 +284,115 @@
;;;
-;; FIXME: Add status codes.
(defcenum gpgme-status-code-t
"The possible status codes for the edit operation."
(:eof 0)
- (:enter 1))
+ (:enter 1)
+ (:leave 2)
+ (:abort 3)
+ (:goodsig 4)
+ (:badsig 5)
+ (:errsig 6)
+ (:badarmor 7)
+ (:rsa-or-idea 8)
+ (:keyexpired 9)
+ (:keyrevoked 10)
+ (:trust-undefined 11)
+ (:trust-never 12)
+ (:trust-marginal 13)
+ (:trust-fully 14)
+ (:trust-ultimate 15)
+ (:shm-info 16)
+ (:shm-get 17)
+ (:shm-get-bool 18)
+ (:shm-get-hidden 19)
+ (:need-passphrase 20)
+ (:validsig 21)
+ (:sig-id 22)
+ (:enc-to 23)
+ (:nodata 24)
+ (:bad-passphrase 25)
+ (:no-pubkey 26)
+ (:no-seckey 27)
+ (:need-passphrase-sym 28)
+ (:decryption-failed 29)
+ (:decryption-okay 30)
+ (:missing-passphrase 31)
+ (:good-passphrase 32)
+ (:goodmdc 33)
+ (:badmdc 34)
+ (:errmdc 35)
+ (:imported 36)
+ (:import-ok 37)
+ (:import-problem 38)
+ (:import-res 39)
+ (:file-start 40)
+ (:file-done 41)
+ (:file-error 42)
+ (:begin-decryption 43)
+ (:end-decryption 44)
+ (:begin-encryption 45)
+ (:end-encryption 46)
+ (:delete-problem 47)
+ (:get-bool 48)
+ (:get-line 49)
+ (:get-hidden 50)
+ (:got-it 51)
+ (:progress 52)
+ (:sig-created 53)
+ (:session-key 54)
+ (:notation-name 55)
+ (:notation-data 56)
+ (:policy-url 57)
+ (:begin-stream 58)
+ (:end-stream 59)
+ (:key-created 60)
+ (:userid-hint 61)
+ (:unexpected 62)
+ (:inv-recp 63)
+ (:no-recp 64)
+ (:already-signed 65)
+ (:sigexpired 66)
+ (:expsig 67)
+ (:expkeysig 68)
+ (:truncated 69)
+ (:error 70)
+ (:newsig 71)
+ (:revkeysig 72)
+ (:sig-subpacket 73)
+ (:need-passphrase-pin 74)
+ (:sc-op-failure 75)
+ (:sc-op-success 76)
+ (:cardctrl 77)
+ (:backup-key-created 78)
+ (:pka-trust-bad 79)
+ (:pka-trust-good 80)
+ (:plaintext 81)
+ (:inv-sgnr 82)
+ (:no-sgnr 83)
+ (:success 84)
+ (:decryption-info 85)
+ (:plaintext-length 86)
+ (:mountpoint 87)
+ (:pinentry-launched 88)
+ (:attribute 89)
+ (:begin-signing 90)
+ (:key-not-created 91)
+ (:inquire-maxlen 92)
+ (:failure 93)
+ (:key-considered 94)
+ (:tofu-user 95)
+ (:tofu-stats 96)
+ (:tofu-stats-long 97)
+ (:notation-flags 98)
+ (:decryption-compliance-mode 99)
+ (:verification-compliance-mode 100))
;;;
-(defctype gpgme-engine-info-t :pointer
+(defctype gpgme-engine-info-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-engine-info-t-to-foreign)
"The engine information structure pointer type.")
(defcstruct gpgme-engine-info
@@ -285,7 +406,10 @@
;;;
-(defctype gpgme-subkey-t :pointer "A subkey from a key.")
+(defctype gpgme-subkey-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-subkey-t-from-foreign)
+ "A subkey from a key.")
;; FIXME: Doesn't this depend on endianess?
(defbitfield (gpgme-subkey-bitfield :unsigned-int)
@@ -299,7 +423,9 @@
(:can-certify 64)
(:secret 128)
(:can-authenticate 256)
- (:is-qualified 512))
+ (:is-qualified 512)
+ (:is-cardkey 1024)
+ (:is-de-vs 2048))
(defcstruct gpgme-subkey
"Subkey from a key."
@@ -314,7 +440,9 @@
(expires :long))
-(defctype gpgme-key-sig-t :pointer
+(defctype gpgme-key-sig-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-key-sig-t-from-foreign)
"A signature on a user ID.")
;; FIXME: Doesn't this depend on endianess?
@@ -343,7 +471,9 @@
(sig-class :unsigned-int))
-(defctype gpgme-user-id-t :pointer
+(defctype gpgme-user-id-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-user-id-t-from-foreign)
"A user ID from a key.")
;; FIXME: Doesn't this depend on endianess?
@@ -365,7 +495,10 @@
(-last-keysig gpgme-key-sig-t))
-(defctype gpgme-key-t :pointer
+(defctype gpgme-key-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-key-t-from-foreign
+ :to-c translate-gpgme-key-t-to-foreign)
"A key from the keyring.")
;; FIXME: Doesn't this depend on endianess?
@@ -693,7 +826,9 @@
;;;
-(defctype gpgme-invalid-key-t :pointer
+(defctype gpgme-invalid-key-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-invalid-key-t-from-foreign)
"An invalid key structure.")
(defcstruct gpgme-invalid-key
@@ -708,7 +843,9 @@
"Encryption result structure."
(invalid-recipients gpgme-invalid-key-t))
-(defctype gpgme-op-encrypt-result-t :pointer
+(defctype gpgme-op-encrypt-result-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-op-encrypt-result-t-from-foreign)
"An encryption result structure.")
(defcfun ("gpgme_op_encrypt_result" c-gpgme-op-encrypt-result)
@@ -716,7 +853,15 @@
(ctx gpgme-ctx-t))
(defbitfield gpgme-encrypt-flags-t
- (:always-trust 1))
+ (:always-trust 1)
+ (:no-encrypt-to 2)
+ (:prepare 4)
+ (:expect-sign 8)
+ (:no-compress 16)
+ (:symmetric 32)
+ (:throw-keyids 64)
+ (:wrap 128)
+ (:want-address 256))
(defcfun ("gpgme_op_encrypt_start" c-gpgme-op-encrypt-start) gpgme-error-t
(ctx gpgme-ctx-t)
@@ -749,7 +894,9 @@
;;; Decryption.
-(defctype gpgme-recipient-t :pointer
+(defctype gpgme-recipient-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-recipient-t-from-foreign)
"A recipient structure.")
(defcstruct gpgme-recipient
@@ -762,7 +909,9 @@
(defbitfield gpgme-op-decrypt-result-bitfield
"Decryption result structure bitfield."
- (:wrong-key-usage 1))
+ (:wrong-key-usage 1)
+ (:is-de-vs 2)
+ (:is-mine 4))
(defcstruct gpgme-op-decrypt-result
"Decryption result structure."
@@ -771,7 +920,9 @@
(recipients gpgme-recipient-t)
(file-name :string))
-(defctype gpgme-op-decrypt-result-t :pointer
+(defctype gpgme-op-decrypt-result-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-op-decrypt-result-t-from-foreign)
"A decryption result structure.")
(defcfun ("gpgme_op_decrypt_result" c-gpgme-op-decrypt-result)
@@ -801,7 +952,9 @@
;;; Signing.
-(defctype gpgme-new-signature-t :pointer
+(defctype gpgme-new-signature-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-new-signature-t-from-foreign)
"A new signature structure.")
(defcstruct gpgme-new-signature
@@ -821,7 +974,9 @@
(invalid-signers gpgme-invalid-key-t)
(signatures gpgme-new-signature-t))
-(defctype gpgme-op-sign-result-t :pointer
+(defctype gpgme-op-sign-result-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-op-sign-result-t-from-foreign)
"A signing result structure.")
(defcfun ("gpgme_op_sign_result" c-gpgme-op-sign-result)
@@ -854,15 +1009,21 @@
(:crl-missing #x0100)
(:crl-too-old #x0200)
(:bad-policy #x0400)
- (:sys-error #x0800))
+ (:sys-error #x0800)
+ (:tofu-conflict #x1000))
-(defctype gpgme-signature-t :pointer
+(defctype gpgme-signature-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-signature-t-from-foreign)
"A signature structure.")
;; FIXME: Doesn't this depend on endianess?
(defbitfield (gpgme-signature-bitfield :unsigned-int)
"The signature bitfield."
- (:wrong-key-usage 1))
+ (:wrong-key-usage 1)
+ (:pka-trust 2)
+ (:chain-model 4)
+ (:is-de-vs 8))
(defcstruct gpgme-signature
"Signature structure."
@@ -884,7 +1045,9 @@
(signatures gpgme-signature-t)
(file-name :string))
-(defctype gpgme-op-verify-result-t :pointer
+(defctype gpgme-op-verify-result-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-op-verify-result-t-from-foreign)
"A verify result structure.")
(defcfun ("gpgme_op_verify_result" c-gpgme-op-verify-result)
@@ -913,7 +1076,9 @@
(:subkey #x0008)
(:secret #x0010))
-(defctype gpgme-import-status-t :pointer
+(defctype gpgme-import-status-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-import-status-t-from-foreign)
"An import status structure.")
(defcstruct gpgme-import-status
@@ -941,7 +1106,9 @@
(not-imported :int)
(imports gpgme-import-status-t))
-(defctype gpgme-op-import-result-t :pointer
+(defctype gpgme-op-import-result-t
+ (:wrapper :pointer
+ :from-c translate-gpgme-op-import-result-t-from-foreign)
"An import status result structure.")
(defcfun ("gpgme_op_import_result" c-gpgme-op-import-result)
@@ -977,7 +1144,8 @@
(defbitfield (gpgme-genkey-flags-t :unsigned-int)
"Flags used for the key generation result bitfield."
(:primary #x0001)
- (:sub #x0002))
+ (:sub #x0002)
+ (:uid #x0004))
(defcstruct gpgme-op-genkey-result
"Key generation result structure."
@@ -1078,21 +1246,20 @@
;;; cert-int-t is a helper type that takes care of representing the
;;; default number of certs as NIL.
-(defmethod translate-from-foreign (value (type (eql 'cert-int-t)))
+(defun translate-cert-int-t-from-foreign (value)
(cond
((eql value +include-certs-default+) nil)
(t value)))
-(defmethod translate-to-foreign (value (type (eql 'cert-int-t)))
+(defun translate-cert-int-t-to-foreign (value)
(cond
(value value)
(t +include-certs-default+)))
;;; string-or-nil-t translates a null pointer to NIL and vice versa.
;;; Translation from foreign null pointer already works as expected.
-;;; FIXME: May the "to foreign" conversion problem be a bug in CFFI?
-(defmethod translate-to-foreign (value (type (eql 'string-or-nil-t)))
+(defun translate-string-or-nil-t-to-foreign (value)
(cond
(value value)
(t (null-pointer))))
@@ -1109,12 +1276,12 @@
;;; FIXME: Should we use a hash table (or struct, or clos) instead of
;;; property list, as recommended by the Lisp FAQ?
-(defmethod translate-from-foreign (value (type (eql 'gpgme-engine-info-t)))
+(defun translate-gpgme-engine-info-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next protocol file-name version req-version home-dir)
- value gpgme-engine-info)
+ value (:struct gpgme-engine-info))
(append (list protocol (list
:file-name file-name
:version version
@@ -1122,55 +1289,53 @@
:home-dir home-dir))
next)))))
-(defmethod translate-from-foreign (value (type (eql 'gpgme-invalid-key-t)))
+(defun translate-gpgme-invalid-key-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next fpr reason)
- value gpgme-invalid-key)
+ value (:struct gpgme-invalid-key))
(append (list (list :fpr fpr
:reason reason))
next)))))
-(defmethod translate-from-foreign (value
- (type (eql 'gpgme-op-encrypt-result-t)))
+(defun translate-gpgme-op-encrypt-result-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((invalid-recipients)
- value gpgme-op-encrypt-result)
+ value (:struct gpgme-op-encrypt-result))
(list :encrypt
(list :invalid-recipients invalid-recipients))))))
-(defmethod translate-from-foreign (value (type (eql 'gpgme-recipient-t)))
+(defun translate-gpgme-recipient-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next keyid pubkey-algo status)
- value gpgme-recipient)
+ value (:struct gpgme-recipient))
(append (list (list :keyid keyid
:pubkey-algo pubkey-algo
:status status))
next)))))
-(defmethod translate-from-foreign (value
- (type (eql 'gpgme-op-decrypt-result-t)))
+(defun translate-gpgme-op-decrypt-result-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((unsupported-algorithm bitfield recipients file-name)
- value gpgme-op-decrypt-result)
+ value (:struct gpgme-op-decrypt-result))
(list :decrypt (list :unsupported-algorithm unsupported-algorithm
:bitfield bitfield
:recipients recipients
:file-name file-name))))))
-(defmethod translate-from-foreign (value (type (eql 'gpgme-new-signature-t)))
+(defun translate-gpgme-new-signature-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next type pubkey-algo hash-algo timestamp fpr sig-class)
- value gpgme-new-signature)
+ value (:struct gpgme-new-signature))
(append (list (list :type type
:pubkey-algo pubkey-algo
:hash-algo hash-algo
@@ -1179,24 +1344,23 @@
:sig-class sig-class))
next)))))
-(defmethod translate-from-foreign (value
- (type (eql 'gpgme-op-sign-result-t)))
+(defun translate-gpgme-op-sign-result-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((invalid-signers signatures)
- value gpgme-op-sign-result)
+ value (:struct gpgme-op-sign-result))
(list :sign (list :invalid-signers invalid-signers
:signatures signatures))))))
-(defmethod translate-from-foreign (value (type (eql 'gpgme-signature-t)))
+(defun translate-gpgme-signature-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next summary fpr status notations timestamp
exp-timestamp bitfield validity validity-reason
pubkey-algo hash-algo)
- value gpgme-signature)
+ value (:struct gpgme-signature))
(append (list (list :summary summary
:fpr fpr
:status status
@@ -1209,29 +1373,27 @@
:pubkey-algo pubkey-algo))
next)))))
-(defmethod translate-from-foreign (value
- (type (eql 'gpgme-op-verify-result-t)))
+(defun translate-gpgme-op-verify-result-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((signatures file-name)
- value gpgme-op-verify-result)
+ value (:struct gpgme-op-verify-result))
(list :verify (list :signatures signatures
:file-name file-name))))))
-(defmethod translate-from-foreign (value (type (eql 'gpgme-import-status-t)))
+(defun translate-gpgme-import-status-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next fpr result status)
- value gpgme-import-status)
+ value (:struct gpgme-import-status))
(append (list (list :fpr fpr
:result result
:status status))
next)))))
-(defmethod translate-from-foreign (value
- (type (eql 'gpgme-op-import-result-t)))
+(defun translate-gpgme-op-import-result-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
@@ -1240,7 +1402,7 @@
new-revocations secret-read secret-imported
secret-unchanged skipped-new-keys not-imported
imports)
- value gpgme-op-import-result)
+ value (:struct gpgme-op-import-result))
(list :verify (list :considered considered
:no-user-id no-user-id
:imported imported
@@ -1272,19 +1434,19 @@
(gpgme-strsource (gpgme-error-value c)))))
(:documentation "Signalled when a GPGME function returns an error."))
-(defmethod translate-from-foreign (value (name (eql 'gpgme-error-t)))
+(defun translate-gpgme-error-t-from-foreign (value)
"Raise a GPGME-ERROR if VALUE is non-zero."
(when (not (eql (gpgme-err-code value) :gpg-err-no-error))
(error 'gpgme-error :gpgme-error value))
(gpg-err-canonicalize value))
-(defmethod translate-to-foreign (value (name (eql 'gpgme-error-t)))
+(defun translate-gpgme-error-t-to-foreign (value)
"Canonicalize the error value."
(if (eql (gpgme-err-code value) :gpg-err-no-error)
0
(gpg-err-as-value value)))
-(defmethod translate-from-foreign (value (name (eql 'gpgme-error-no-signal-t)))
+(defun translate-gpgme-error-no-signal-t-from-foreign (value)
"Canonicalize the error value."
(gpg-err-canonicalize value))
@@ -1528,61 +1690,68 @@
(when (not (null-pointer-p handle)) (foreign-free handle))))
(defcallback data-read-cb ssize-t ((handle :pointer) (buffer :pointer)
- (size size-t))
+ (size size-t))
(when *debug* (format t "DEBUG: gpgme-data-read-cb: want ~A~%" size))
(let ((stream (gethash (pointer-address handle) *data-handles*)))
(cond
(stream
(let* ((stream-type (stream-element-type stream))
- (seq (make-array size :element-type stream-type))
- (read (read-sequence seq stream)))
- (loop for i from 0 to (- read 1)
- do (setf (mem-aref buffer :unsigned-char i)
- ;;; FIXME: This is a half-assed attempt at
- ;;; supporting character streams.
- (cond
- ((eql stream-type 'character)
- (char-code (elt seq i)))
- (t (coerce (elt seq i) stream-type)))))
- (when *debug* (format t "DEBUG: gpgme-data-read-cb: read ~A~%" read))
- read))
- (t (set-errno +ebadf+)
- -1))))
+ (seq (make-array size :element-type stream-type))
+ (read (read-sequence seq stream)))
+ (cond
+ ((equal stream-type '(unsigned-byte 8))
+ (dotimes (i read)
+ (setf (mem-aref buffer :unsigned-char i)
+ (aref (the byte-array seq) i))))
+ ((eql stream-type 'character)
+ (dotimes (i read)
+ (setf (mem-aref buffer :unsigned-char i)
+ (char-code (aref (the character-array seq) i)))))
+ (t
+ (dotimes (i read)
+ (setf (mem-aref buffer :unsigned-char i)
+ (coerce (aref seq i) '(unsigned-byte 8))))))
+ (when *debug* (format t "DEBUG: gpgme-data-read-cb: read ~A~%" read))
+ read))
+ (t
+ (set-errno +ebadf+)
+ -1))))
(defcallback data-write-cb ssize-t ((handle :pointer) (buffer :pointer)
- (size size-t))
+ (size size-t))
(when *debug* (format t "DEBUG: gpgme-data-write-cb: want ~A~%" size))
(let ((stream (gethash (pointer-address handle) *data-handles*)))
(cond
(stream
(let* ((stream-type (stream-element-type stream))
- (seq (make-array size :element-type stream-type)))
- (loop for i from 0 to (- size 1)
- do (setf (elt seq i)
- ;;; FIXME: This is a half-assed attempt at
- ;;; supporting character streams.
- (cond
- ((eql stream-type 'character)
- (code-char (mem-aref buffer :unsigned-char i)))
- (t (coerce (mem-aref buffer :unsigned-char i)
- stream-type)))))
- (write-sequence seq stream)
- ;;; FIXME: What about write errors?
- size))
- (t (set-errno +ebadf+)
- -1))))
+ (seq (make-array size :element-type stream-type)))
+ (cond
+ ((equal stream-type '(unsigned-byte 8))
+ (dotimes (i size)
+ (setf (aref (the byte-array seq) i)
+ (mem-aref buffer :unsigned-char i))))
+ ((eql stream-type 'character)
+ (dotimes (i size)
+ (setf (aref (the character-array seq) i)
+ (code-char (mem-aref buffer :unsigned-char i)))))
+ (t
+ (dotimes (i size)
+ (setf (aref seq i)
+ (coerce (mem-aref buffer :unsigned-char i) stream-type)))))
+ (write-sequence seq stream)
+ size))
+ (t
+ (set-errno +ebadf+)
+ -1))))
;;; This little helper macro allows us to swallow the cbs structure by
;;; simply setting it to a null pointer, but still protect against
;;; conditions.
(defmacro with-cbs-swallowed ((cbs) &body body)
- `(let ((,cbs (foreign-alloc 'gpgme-data-cbs)))
+ `(let ((,cbs (foreign-alloc '(:struct gpgme-data-cbs))))
(unwind-protect (progn , at body)
(when (not (null-pointer-p ,cbs)) (foreign-free ,cbs)))))
-;;; FIXME: Wrap the object and attach to it a finalizer. Requires new
-;;; CFFI. Should we use an OO interface, ie make-instance? For now,
-;;; we do not provide direct access to data objects.
(defun gpgme-data-new (stream &key encoding file-name)
"Allocate a new GPGME data object for STREAM."
(with-foreign-object (dh-p 'gpgme-data-t)
@@ -1592,12 +1761,14 @@
;;; unique C pointer as handle anyway to look up the stream in the
;;; callback. This is a convenient one to use.
(with-cbs-swallowed (cbs)
- (setf
- (foreign-slot-value cbs 'gpgme-data-cbs 'read) (callback data-read-cb)
- (foreign-slot-value cbs 'gpgme-data-cbs 'write) (callback data-write-cb)
- (foreign-slot-value cbs 'gpgme-data-cbs 'seek) (null-pointer)
- (foreign-slot-value cbs 'gpgme-data-cbs 'release) (callback
- data-release-cb))
+ (setf (foreign-slot-value cbs '(:struct gpgme-data-cbs) 'read)
+ (callback data-read-cb))
+ (setf (foreign-slot-value cbs '(:struct gpgme-data-cbs) 'write)
+ (callback data-write-cb))
+ (setf (foreign-slot-value cbs '(:struct gpgme-data-cbs) 'seek)
+ (null-pointer))
+ (setf (foreign-slot-value cbs '(:struct gpgme-data-cbs) 'release)
+ (callback data-release-cb))
(c-gpgme-data-new-from-cbs dh-p cbs cbs)
(let ((dh (mem-ref dh-p 'gpgme-data-t)))
(when encoding (gpgme-data-set-encoding dh encoding))
@@ -1619,12 +1790,33 @@
(when *debug* (format t "DEBUG: gpgme-data-release: ~A~%" dh))
(c-gpgme-data-release dh))
+(defclass data ()
+ (c-data) ; The C data object pointer
+ (:documentation "The GPGME data type."))
+
+(defmethod initialize-instance :after ((data data) &key streamspec
+ &allow-other-keys)
+ (let ((c-data (if (listp streamspec)
+ (apply #'gpgme-data-new streamspec)
+ (gpgme-data-new streamspec)))
+ (cleanup t))
+ (unwind-protect
+ (progn
+ (setf (slot-value data 'c-data) c-data)
+ (finalize data (lambda () (gpgme-data-release c-data)))
+ (setf cleanup nil))
+ (if cleanup (gpgme-data-release c-data)))))
+
+(defun translate-gpgme-data-t-to-foreign (value)
+ ;; Allow a pointer to be passed directly for the finalizer to work.
+ (cond
+ ((null value) (null-pointer))
+ ((pointerp value) value)
+ (t (slot-value value 'c-data))))
+
(defmacro with-gpgme-data ((dh streamspec) &body body)
- `(let ((,dh (if (listp ,streamspec)
- (apply 'gpgme-data-new ,streamspec)
- (gpgme-data-new ,streamspec))))
- (unwind-protect (progn , at body)
- (when (not (null-pointer-p ,dh)) (gpgme-data-release ,dh)))))
+ `(let ((,dh (make-instance 'data :streamspec ,streamspec)))
+ , at body))
(defun gpgme-data-get-encoding (dh)
"Get the encoding associated with the data object DH."
@@ -1693,7 +1885,7 @@
(setf cleanup nil))
(if cleanup (gpgme-release c-ctx)))))
-(defmethod translate-to-foreign (value (type (eql 'gpgme-ctx-t)))
+(defun translate-gpgme-ctx-t-to-foreign (value)
;; Allow a pointer to be passed directly for the finalizer to work.
(if (pointerp value) value (slot-value value 'c-ctx)))
@@ -1848,11 +2040,11 @@
(setf (slot-value key 'c-key) c-key)
(finalize key (lambda () (gpgme-key-unref c-key))))
-(defmethod translate-from-foreign (value (type (eql 'gpgme-key-t)))
+(defun translate-gpgme-key-t-from-foreign (value)
(when *debug* (format t "DEBUG: import key: ~A~%" value))
(make-instance 'key :c-key value))
-(defmethod translate-to-foreign (value (type (eql 'gpgme-key-t)))
+(defun translate-gpgme-key-t-to-foreign (value)
;; Allow a pointer to be passed directly for the finalizer to work.
(if (pointerp value) value (slot-value value 'c-key)))
@@ -1867,12 +2059,12 @@
;;; and zero length value (omit?) and human-readable (convert to string).
;;; FIXME: Turn binary data into sequence or vector or what it should be.
;;; FIXME: Turn the whole thing into a hash?
-(defmethod translate-from-foreign (value (type (eql 'gpgme-sig-notation-t)))
+(defun translate-gpgme-sig-notation-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next name value name-len value-len flags bitfield)
- value gpgme-sig-notation)
+ value (:struct gpgme-sig-notation))
(append (list (list
:name name
:value value
@@ -1883,12 +2075,12 @@
next)))))
;;; FIXME: Deal nicer with timestamps. bitfield field name?
-(defmethod translate-from-foreign (value (type (eql 'gpgme-subkey-t)))
+(defun translate-gpgme-subkey-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next bitfield pubkey-algo length keyid fpr timestamp expires)
- value gpgme-subkey)
+ value (:struct gpgme-subkey))
(append (list (list
:bitfield bitfield
:pubkey-algo pubkey-algo
@@ -1899,13 +2091,13 @@
:expires expires))
next)))))
-(defmethod translate-from-foreign (value (type (eql 'gpgme-key-sig-t)))
+(defun translate-gpgme-key-sig-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next bitfield pubkey-algo keyid timestamp expires status
uid name email comment sig-class)
- value gpgme-key-sig)
+ value (:struct gpgme-key-sig))
(append (list (list
:bitfield bitfield
:pubkey-algo pubkey-algo
@@ -1920,12 +2112,12 @@
:sig-class sig-class))
next)))))
-(defmethod translate-from-foreign (value (type (eql 'gpgme-user-id-t)))
+(defun translate-gpgme-user-id-t-from-foreign (value)
(cond
((null-pointer-p value) nil)
(t (with-foreign-slots
((next bitfield validity uid name email comment signatures)
- value gpgme-user-id)
+ value (:struct gpgme-user-id))
(append (list (list
:bitfield bitfield
:validity validity
@@ -1941,7 +2133,7 @@
(with-foreign-slots
((bitfield protocol issuer-serial issuer-name chain-id
owner-trust subkeys uids keylist-mode)
- c-key gpgme-key)
+ c-key (:struct gpgme-key))
(list
:bitfield bitfield
:protocol protocol
commit aafadb859497aa8785b7e19f267f1bfd8acfc062
Author: Werner Koch <wk at gnupg.org>
Date: Fri Oct 12 08:38:10 2018 +0200
Register DCO for Guillaume LE VAILLANT
--
diff --git a/AUTHORS b/AUTHORS
index 64a675e..3109446 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -66,6 +66,9 @@ Ben McGinnes <ben at adversary.org>
Jacob Adams <tookmund at gmail.com>
2018-06-03:ad5141df-b6cc-6c2a-59df-b2f18f7160fd at gmail.com:
+Guillaume LE VAILLANT <glv at posteo.net>
+2018-10-11:20181011113825.76f9752a at yamatai:
+
Copyright 2001, 2002, 2012, 2013 g10 Code GmbH
-----------------------------------------------------------------------
Summary of changes:
AUTHORS | 3 +
lang/cl/Makefile.am | 2 +-
lang/cl/README | 33 ++-
lang/cl/gpgme-package.lisp | 3 +-
lang/cl/gpgme.asd.in | 19 +-
lang/cl/gpgme.lisp | 502 +++++++++++++++++++++++++++++++--------------
6 files changed, 389 insertions(+), 173 deletions(-)
hooks/post-receive
--
GnuPG Made Easy
http://git.gnupg.org
More information about the Gnupg-commits
mailing list