cl: Several fixes
authorGuillaume LE VAILLANT <glv@posteo.net>
Fri, 12 Oct 2018 06:49:26 +0000 (08:49 +0200)
committerWerner Koch <wk@gnupg.org>
Fri, 12 Oct 2018 07:02:18 +0000 (09:02 +0200)
--

* 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@posteo.net>
lang/cl/Makefile.am
lang/cl/README
lang/cl/gpgme-package.lisp
lang/cl/gpgme.asd.in
lang/cl/gpgme.lisp

index 553926e..dee0711 100644 (file)
@@ -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
index b4a3c81..7d8e87d 100644 (file)
@@ -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
 ----
index 239d57f..25e01a8 100644 (file)
@@ -26,7 +26,8 @@
 
 (defpackage #:gpgme
   (:use #:common-lisp #:cffi #:gpg-error)
-
+  (:import-from #:trivial-garbage
+                #:finalize)
   (:export #:check-version
           #:*version*
           #:context
index 86e8d51..6c5bd1f 100644 (file)
 (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"))))
index 74cb9ed..b1a38ca 100644 (file)
 
 (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.")
 
 ;;; 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))
                     (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)
     (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
 ;;;
 ;;; 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
   (:none 0)
   (:binary 1)
   (:base64 2)
-  (:armor 3))
+  (:armor 3)
+  (:url 4)
+  (:urlesc 5)
+  (:url0 6)
+  (:mime 7))
 
 ;;;
 
   (: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."
   (:sha256 8)
   (:sha384 9)
   (:sha512 10)
+  (:sha224 11)
   (:md4 301)
   (:crc32 302)
   (:crc32-rfc1510 303)
 (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))
 
 ;;;
 
   (:local 1)
   (:extern 2)
   (:sigs 4)
+  (:sig-notations)
+  (:with-secret 16)
+  (:with-tofu 32)
+  (:ephemeral 128)
   (:validate 256))
 
 ;;;
   (: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?
 
 ;;;
 
-;; 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
 
 ;;;
 
-(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)
   (: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."
   (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?
   (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?
   (-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?
 
 ;;;
 
-(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
   "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)
   (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)
 
 ;;; 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
 
 (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."
   (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)
 
 ;;; 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
   (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)
   (: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."
   (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)
   (: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
   (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)
 (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."
 ;;; 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))))
 ;;; 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
                             :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
                             :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
                             :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
                        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
                     (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))
 
     (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 ,@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)
     ;;; 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))
   (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 ,@body)
-      (when (not (null-pointer-p ,dh)) (gpgme-data-release ,dh)))))
+  `(let ((,dh (make-instance 'data :streamspec ,streamspec)))
+     ,@body))
 
 (defun gpgme-data-get-encoding (dh)
   "Get the encoding associated with the data object DH."
                (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)))
 
   (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)))
 
 ;;; 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
                 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
                        :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
                        :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
     (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