diff options
Diffstat (limited to '')
| -rw-r--r-- | lang/Makefile.am | 22 | ||||
| -rw-r--r-- | lang/README | 12 | ||||
| -rw-r--r-- | lang/cl/ChangeLog | 4 | ||||
| -rw-r--r-- | lang/cl/Makefile.am | 29 | ||||
| -rw-r--r-- | lang/cl/README | 40 | ||||
| -rw-r--r-- | lang/cl/gpgme-package.lisp | 49 | ||||
| -rw-r--r-- | lang/cl/gpgme.asd.in | 35 | ||||
| -rw-r--r-- | lang/cl/gpgme.lisp | 2077 |
8 files changed, 2268 insertions, 0 deletions
diff --git a/lang/Makefile.am b/lang/Makefile.am new file mode 100644 index 00000000..3b079920 --- /dev/null +++ b/lang/Makefile.am @@ -0,0 +1,22 @@ +# Makefile.am for gpgme/lang. +# Copyright (C) 2003, 2006 g10 Code GmbH +# +# This file is part of GPGME. +# +# GPGME is free software; you can redistribute it and/or modify it +# under the terms of the GNU Lesser General Public License as +# published by the Free Software Foundation; either version 2.1 of the +# License, or (at your option) any later version. +# +# GPGME is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General +# Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA + +SUBDIRS = cl + +EXTRA_DIST = README diff --git a/lang/README b/lang/README new file mode 100644 index 00000000..da54c78b --- /dev/null +++ b/lang/README @@ -0,0 +1,12 @@ +Language Support for GPGME +-------------------------- + +This directory contains support for other languages than C. + +Please note that language support components may be under a different +license than GPGME itself. You can find more information in each +sub-directory. + +Directory Language + +cl Common Lisp diff --git a/lang/cl/ChangeLog b/lang/cl/ChangeLog new file mode 100644 index 00000000..68622739 --- /dev/null +++ b/lang/cl/ChangeLog @@ -0,0 +1,4 @@ +2006-07-06 Marcus Brinkmann <[email protected]> + + * Initial release. + diff --git a/lang/cl/Makefile.am b/lang/cl/Makefile.am new file mode 100644 index 00000000..e0064baa --- /dev/null +++ b/lang/cl/Makefile.am @@ -0,0 +1,29 @@ +# Makefile.am for GPGME-CL. +# Copyright (C) 2003, 2006 g10 Code GmbH +# +# This file is part of GPGME-CL. +# +# GPGME-CL is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# GPGME-CL is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Lesser General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +# 02111-1307, USA + +clfiles = gpgme.asd gpgme-package.lisp gpgme.lisp + +# FIXME: Should be configurable. +clfilesdir = $(datadir)/common-lisp/source/gpgme +dist_clfiles_DATA = $(clfiles) + +EXTRA_DIST = README + + diff --git a/lang/cl/README b/lang/cl/README new file mode 100644 index 00000000..b4a3c818 --- /dev/null +++ b/lang/cl/README @@ -0,0 +1,40 @@ +Common Lisp Support for GPGME +----------------------------- + +Requirements: + +ASDF Packaging Support +CFFI Foreign Function Interface +gpg-error GPG Error Codes + +Use with: + +> (asdf:operate 'asdf:load-op ':gpgme) + + +Examples +-------- + +(with-open-file (stream "/tmp/myout" :direction :output + :if-exists :supersede :element-type '(unsigned-byte 8)) + (with-context (ctx) + (setf (armor-p ctx) t) + (op-export ctx "DEADBEEF" out))) + +(with-context (ctx) + (with-output-to-string (out) + (setf (armor-p ctx) t) + (op-export ctx "McTester" out))) + +(gpgme:with-context (ctx :armor t) + (with-output-to-string (out) + (gpgme:op-export ctx "McTester" out))) + + +TODO +---- + +* When GPGME defines macros for include cert values -2, -1, 0 and 1, + define lisp macros for them as well. + +* diff --git a/lang/cl/gpgme-package.lisp b/lang/cl/gpgme-package.lisp new file mode 100644 index 00000000..239d57fb --- /dev/null +++ b/lang/cl/gpgme-package.lisp @@ -0,0 +1,49 @@ +;;;; gpgme-package.lisp + +;;; Copyright (C) 2006 g10 Code GmbH +;;; +;;; This file is part of GPGME-CL. +;;; +;;; GPGME-CL is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published +;;; by the Free Software Foundation; either version 2 of the License, +;;; or (at your option) any later version. +;;; +;;; GPGME-CL is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GPGME; if not, write to the Free Software Foundation, +;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; Conventions: +;;; +;;; gpg-error is used for error handling. +;;; +;;; Standard I/O streams are used for input and output. + +(defpackage #:gpgme + (:use #:common-lisp #:cffi #:gpg-error) + + (:export #:check-version + #:*version* + #:context + #:protocol + #:armorp + #:textmodep + #:+include-certs-default+ + #:include-certs + #:keylist-mode + #:signers + #:sig-notations + #:with-context + #:key-data + #:get-key + #:op-encrypt + #:op-decrypt + #:op-sign + #:op-verify + #:op-import + #:op-export)) diff --git a/lang/cl/gpgme.asd.in b/lang/cl/gpgme.asd.in new file mode 100644 index 00000000..86e8d51c --- /dev/null +++ b/lang/cl/gpgme.asd.in @@ -0,0 +1,35 @@ +;;; -*- Mode: lisp -*- + +;;; Copyright (C) 2006 g10 Code GmbH +;;; +;;; This file is part of GPGME. +;;; +;;; GPGME is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 2.1 of +;;; the License, or (at your option) any later version. +;;; +;;; GPGME is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with GPGME; if not, write to the Free +;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;;; 02111-1307, USA. + +(defpackage #:gpgme-system + (:use #:common-lisp #:asdf)) + +(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")))) diff --git a/lang/cl/gpgme.lisp b/lang/cl/gpgme.lisp new file mode 100644 index 00000000..cb536fa8 --- /dev/null +++ b/lang/cl/gpgme.lisp @@ -0,0 +1,2077 @@ +;;;; gpgme.lisp + +;;; Copyright (C) 2006 g10 Code GmbH +;;; +;;; This file is part of GPGME-CL. +;;; +;;; GPGME-CL is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; GPGME-CL is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GPGME; if not, write to the Free Software Foundation, +;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +;;; TODO + +;;; Set up the library. + +(in-package :gpgme) + +;;; Debugging. + +(defvar *debug* nil "If debugging output should be given or not.") + +;;; Load the foreign library. + +(define-foreign-library libgpgme + (:unix "libgpgme.so") + (t (:default "libgpgme"))) + +(use-foreign-library libgpgme) + +;;; System dependencies. + +; FIXME: Use cffi-grovel? cffi-unix? + +(defctype size-t :unsigned-int + :documentation "The system size_t type.") + +(defctype ssize-t :int + :documentation "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 + :documentation "The system off_t type.") + +(defcfun ("strerror" c-strerror) :string + (err :int)) + +; Access to ERRNO. +; FIXME: Ouch. Should be grovel + helper function. + +(define-condition system-error (error) + ((errno :initarg :errno :reader system-error-errno)) + (:report (lambda (c stream) + (format stream "System error: ~A: ~A" + (system-error-errno c) + (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) + (buffer :string) ; Actually :pointer, but we only need string. + (size size-t)) + +(defun system-write (fd buffer size) + (let ((res (c-write fd buffer size))) + (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 +;;; + +;;; Data Type Interface + +;;; Some new data types used for easier translation. + +;;; The number of include certs. Translates to NIL for default. +(defctype cert-int-t :int) + +;;; A string that may be NIL to indicate a null pointer. +(defctype string-or-nil-t :string) + +;;; Some opaque data types used by GPGME. + +(defctype gpgme-ctx-t :pointer + :documentation "The GPGME context type.") + +(defctype gpgme-data-t :pointer + :documentation "The GPGME data object type.") + +;;; Wrappers for the libgpg-error library. + +(defctype gpgme-error-t gpg-error::gpg-error-t + :documentation "The GPGME error type.") + +(defctype gpgme-error-no-signal-t gpg-error::gpg-error-t + :documentation "The GPGME error type (this version does not + signal conditions in translation.") + +(defctype gpgme-err-code-t gpg-error::gpg-err-code-t + :documentation "The GPGME error code type.") + +(defctype gpgme-err-source-t gpg-error::gpg-err-source-t + :documentation "The GPGME error source type.") + +(defun gpgme-err-make (source code) + "Construct an error value from an error code and source." + (gpg-err-make source code)) + +(defun gpgme-error (code) + "Construct an error value from an error code." + (gpgme-err-make :gpg-err-source-gpgme code)) + +(defun gpgme-err-code (err) + "Retrieve an error code from the error value ERR." + (gpg-err-code err)) + +(defun gpgme-err-source (err) + "Retrieve an error source from the error value ERR." + (gpg-err-source err)) + +(defun gpgme-strerror (err) + "Return a string containig a description of the error code." + (gpg-strerror err)) + +(defun gpgme-strsource (err) + "Return a string containig a description of the error source." + (gpg-strsource err)) + +(defun gpgme-err-code-from-errno (err) + "Retrieve the error code for the system error. If the system error + is not mapped, :gpg-err-unknown-errno is returned." + (gpg-err-code-from-errno err)) + +(defun gpgme-err-code-to-errno (code) + "Retrieve the system error for the error code. If this is not a + system error, 0 is returned." + (gpg-err-code-to-errno code)) + +(defun gpgme-err-make-from-errno (source err) + (gpg-err-make-from-errno source err)) + +(defun gpgme-error-from-errno (err) + (gpg-error-from-errno err)) + +;;; + +(defcenum gpgme-data-encoding-t + "The possible encoding mode of gpgme-data-t objects." + (:none 0) + (:binary 1) + (:base64 2) + (:armor 3)) + +;;; + +(defcenum gpgme-pubkey-algo-t + "Public key algorithms from libgcrypt." + (:rsa 1) + (:rsa-e 2) + (:rsa-s 3) + (:elg-e 16) + (:dsa 17) + (:elg 20)) + +(defcenum gpgme-hash-algo-t + "Hash algorithms from libgcrypt." + (:none 0) + (:md5 1) + (:sha1 2) + (:rmd160 3) + (:md2 5) + (:tiger 6) + (:haval 7) + (:sha256 8) + (:sha384 9) + (:sha512 10) + (:md4 301) + (:crc32 302) + (:crc32-rfc1510 303) + (:crc24-rfc2440 304)) + +;;; + +(defcenum gpgme-sig-mode-t + "The available signature modes." + (:none 0) + (:detach 1) + (:clear 2)) + +;;; + +(defcenum gpgme-validity-t + "The available validities for a trust item or key." + (:unknown 0) + (:undefined 1) + (:never 2) + (:marginal 3) + (:full 4) + (:ultimate 5)) + +;;; + +(defcenum gpgme-protocol-t + "The available protocols." + (:openpgp 0) + (:cms 1)) + +;;; + +(defbitfield (gpgme-keylist-mode-t :unsigned-int) + "The available keylist mode flags." + (:local 1) + (:extern 2) + (:sigs 4) + (:validate 256)) + +;;; + +(defbitfield (gpgme-sig-notation-flags-t :unsigned-int) + "The available signature notation flags." + (:human-readable 1) + (:critical 2)) + +(defctype gpgme-sig-notation-t :pointer + :documentation "Signature notation pointer type.") + +;; FIXME: Doesn't this depend on endianess? +(defbitfield (gpgme-sig-notation-bitfield :unsigned-int) + (:human-readable 1) + (:critical 2)) + +(defcstruct gpgme-sig-notation + "Signature notations." + (next gpgme-sig-notation-t) + (name :pointer) + (value :pointer) + (name-len :int) + (value-len :int) + (flags gpgme-sig-notation-flags-t) + (bitfield gpgme-sig-notation-bitfield)) + +;;; + +;; FIXME: Add status codes. +(defcenum gpgme-status-code-t + "The possible status codes for the edit operation." + (:eof 0) + (:enter 1)) + +;;; + +(defctype gpgme-engine-info-t :pointer + :documentation "The engine information structure pointer type.") + +(defcstruct gpgme-engine-info + "Engine information." + (next gpgme-engine-info-t) + (protocol gpgme-protocol-t) + (file-name :string) + (version :string) + (req-version :string) + (home-dir :string)) + +;;; + +(defctype gpgme-subkey-t :pointer + :documentation "A subkey from a key.") + +;; FIXME: Doesn't this depend on endianess? +(defbitfield (gpgme-subkey-bitfield :unsigned-int) + "The subkey bitfield." + (:revoked 1) + (:expired 2) + (:disabled 4) + (:invalid 8) + (:can-encrypt 16) + (:can-sign 32) + (:can-certify 64) + (:secret 128) + (:can-authenticate 256) + (:is-qualified 512)) + +(defcstruct gpgme-subkey + "Subkey from a key." + (next gpgme-subkey-t) + (bitfield gpgme-subkey-bitfield) + (pubkey-algo gpgme-pubkey-algo-t) + (length :unsigned-int) + (keyid :string) + (-keyid :char :count 17) + (fpr :string) + (timestamp :long) + (expires :long)) + + +(defctype gpgme-key-sig-t :pointer + :documentation "A signature on a user ID.") + +;; FIXME: Doesn't this depend on endianess? +(defbitfield (gpgme-key-sig-bitfield :unsigned-int) + "The key signature bitfield." + (:revoked 1) + (:expired 2) + (:invalid 4) + (:exportable 16)) + +(defcstruct gpgme-key-sig + "A signature on a user ID." + (next gpgme-key-sig-t) + (bitfield gpgme-key-sig-bitfield) + (pubkey-algo gpgme-pubkey-algo-t) + (keyid :string) + (-keyid :char :count 17) + (timestamp :long) + (expires :long) + (status gpgme-error-no-signal-t) + (-class :unsigned-int) + (uid :string) + (name :string) + (email :string) + (comment :string) + (sig-class :unsigned-int)) + + +(defctype gpgme-user-id-t :pointer + :documentation "A user ID from a key.") + +;; FIXME: Doesn't this depend on endianess? +(defbitfield (gpgme-user-id-bitfield :unsigned-int) + "The user ID bitfield." + (:revoked 1) + (:invalid 2)) + +(defcstruct gpgme-user-id + "A user ID from a key." + (next gpgme-user-id-t) + (bitfield gpgme-user-id-bitfield) + (validity gpgme-validity-t) + (uid :string) + (name :string) + (email :string) + (comment :string) + (signatures gpgme-key-sig-t) + (-last-keysig gpgme-key-sig-t)) + + +(defctype gpgme-key-t :pointer + :documentation "A key from the keyring.") + +;; FIXME: Doesn't this depend on endianess? +(defbitfield (gpgme-key-bitfield :unsigned-int) + "The key bitfield." + (:revoked 1) + (:expired 2) + (:disabled 4) + (:invalid 8) + (:can-encrypt 16) + (:can-sign 32) + (:can-certify 64) + (:secret 128) + (:can-authenticate 256) + (:is-qualified 512)) + +(defcstruct gpgme-key + "A signature on a user ID." + (-refs :unsigned-int) + (bitfield gpgme-key-bitfield) + (protocol gpgme-protocol-t) + (issuer-serial :string) + (issuer-name :string) + (chain-id :string) + (owner-trust gpgme-validity-t) + (subkeys gpgme-subkey-t) + (uids gpgme-user-id-t) + (-last-subkey gpgme-subkey-t) + (-last-uid gpgme-user-id-t) + (keylist-mode gpgme-keylist-mode-t)) + +;;; + +;;; There is no support in CFFI to define callback C types and have +;;; automatic type checking with the callback definition. + +(defctype gpgme-passphrase-cb-t :pointer) + +(defctype gpgme-progress-cb-t :pointer) + +(defctype gpgme-edit-cb-t :pointer) + + +;;; +;;; Function Interface +;;; + +;;; Context management functions. + +(defcfun ("gpgme_new" c-gpgme-new) gpgme-error-t + (ctx :pointer)) + +(defcfun ("gpgme_release" c-gpgme-release) :void + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_set_protocol" c-gpgme-set-protocol) gpgme-error-t + (ctx gpgme-ctx-t) + (proto gpgme-protocol-t)) + +(defcfun ("gpgme_get_protocol" c-gpgme-get-protocol) gpgme-protocol-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_get_protocol_name" c-gpgme-get-protocol-name) :string + (proto gpgme-protocol-t)) + +(defcfun ("gpgme_set_armor" c-gpgme-set-armor) :void + (ctx gpgme-ctx-t) + (yes :boolean)) + +(defcfun ("gpgme_get_armor" c-gpgme-get-armor) :boolean + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_set_textmode" c-gpgme-set-textmode) :void + (ctx gpgme-ctx-t) + (yes :boolean)) + +(defcfun ("gpgme_get_textmode" c-gpgme-get-textmode) :boolean + (ctx gpgme-ctx-t)) + +(defconstant +include-certs-default+ -256) + +(defcfun ("gpgme_set_include_certs" c-gpgme-set-include-certs) :void + (ctx gpgme-ctx-t) + (nr-of-certs cert-int-t)) + +(defcfun ("gpgme_get_include_certs" c-gpgme-get-include-certs) cert-int-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_set_keylist_mode" c-gpgme-set-keylist-mode) gpgme-error-t + (ctx gpgme-ctx-t) + (mode gpgme-keylist-mode-t)) + +(defcfun ("gpgme_get_keylist_mode" c-gpgme-get-keylist-mode) + gpgme-keylist-mode-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_set_passphrase_cb" c-gpgme-set-passphrase-cb) :void + (ctx gpgme-ctx-t) + (cb gpgme-passphrase-cb-t) + (hook-value :pointer)) + +(defcfun ("gpgme_get_passphrase_cb" c-gpgme-get-passphrase-cb) :void + (ctx gpgme-ctx-t) + (cb-p :pointer) + (hook-value-p :pointer)) + +(defcfun ("gpgme_set_progress_cb" c-gpgme-set-progress-cb) :void + (ctx gpgme-ctx-t) + (cb gpgme-progress-cb-t) + (hook-value :pointer)) + +(defcfun ("gpgme_get_progress_cb" c-gpgme-get-progress-cb) :void + (ctx gpgme-ctx-t) + (cb-p :pointer) + (hook-value-p :pointer)) + +(defcfun ("gpgme_set_locale" c-gpgme-set-locale) gpgme-error-t + (ctx gpgme-ctx-t) + (category :int) + (value string-or-nil-t)) + +(defcfun ("gpgme_ctx_get_engine_info" c-gpgme-ctx-get-engine-info) + gpgme-engine-info-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_ctx_set_engine_info" c-gpgme-ctx-set-engine-info) + gpgme-error-t + (ctx gpgme-ctx-t) + (proto gpgme-protocol-t) + (file-name string-or-nil-t) + (home-dir string-or-nil-t)) + +;;; + +(defcfun ("gpgme_pubkey_algo_name" c-gpgme-pubkey-algo-name) :string + (algo gpgme-pubkey-algo-t)) + +(defcfun ("gpgme_hash_algo_name" c-gpgme-hash-algo-name) :string + (algo gpgme-hash-algo-t)) + +;;; + +(defcfun ("gpgme_signers_clear" c-gpgme-signers-clear) :void + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_signers_add" c-gpgme-signers-add) gpgme-error-t + (ctx gpgme-ctx-t) + (key gpgme-key-t)) + +(defcfun ("gpgme_signers_enum" c-gpgme-signers-enum) gpgme-key-t + (ctx gpgme-ctx-t) + (seq :int)) + +;;; + +(defcfun ("gpgme_sig_notation_clear" c-gpgme-sig-notation-clear) :void + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_sig_notation_add" c-gpgme-sig-notation-add) gpgme-error-t + (ctx gpgme-ctx-t) + (name :string) + (value string-or-nil-t) + (flags gpgme-sig-notation-flags-t)) + +(defcfun ("gpgme_sig_notation_get" c-gpgme-sig-notation-get) + gpgme-sig-notation-t + (ctx gpgme-ctx-t)) + +;;; Run Control. + +;;; There is no support in CFFI to define callback C types and have +;;; automatic type checking with the callback definition. + +(defctype gpgme-io-cb-t :pointer) + +(defctype gpgme-register-io-cb-t :pointer) + +(defctype gpgme-remove-io-cb-t :pointer) + +(defcenum gpgme-event-io-t + "The possible events on I/O event callbacks." + (:start 0) + (:done 1) + (:next-key 2) + (:next-trustitem 3)) + +(defctype gpgme-event-io-cb-t :pointer) + +(defcstruct gpgme-io-cbs + "I/O callbacks." + (add gpgme-register-io-cb-t) + (add-priv :pointer) + (remove gpgme-remove-io-cb-t) + (event gpgme-event-io-cb-t) + (event-priv :pointer)) + +(defctype gpgme-io-cbs-t :pointer) + +(defcfun ("gpgme_set_io_cbs" c-gpgme-set-io-cbs) :void + (ctx gpgme-ctx-t) + (io-cbs gpgme-io-cbs-t)) + +(defcfun ("gpgme_get_io_cbs" c-gpgme-get-io-cbs) :void + (ctx gpgme-ctx-t) + (io-cbs gpgme-io-cbs-t)) + +(defcfun ("gpgme_wait" c-gpgme-wait) gpgme-ctx-t + (ctx gpgme-ctx-t) + (status-p :pointer) + (hang :int)) + +;;; Functions to handle data objects. + +;;; There is no support in CFFI to define callback C types and have +;;; automatic type checking with the callback definition. + +(defctype gpgme-data-read-cb-t :pointer) +(defctype gpgme-data-write-cb-t :pointer) +(defctype gpgme-data-seek-cb-t :pointer) +(defctype gpgme-data-release-cb-t :pointer) + +(defcstruct gpgme-data-cbs + "Data callbacks." + (read gpgme-data-read-cb-t) + (write gpgme-data-write-cb-t) + (seek gpgme-data-seek-cb-t) + (release gpgme-data-release-cb-t)) + +(defctype gpgme-data-cbs-t :pointer + :documentation "Data callbacks pointer.") + +(defcfun ("gpgme_data_read" c-gpgme-data-read) ssize-t + (dh gpgme-data-t) + (buffer :pointer) + (size size-t)) + +(defcfun ("gpgme_data_write" c-gpgme-data-write) ssize-t + (dh gpgme-data-t) + (buffer :pointer) + (size size-t)) + +(defcfun ("gpgme_data_seek" c-gpgme-data-seek) off-t + (dh gpgme-data-t) + (offset off-t) + (whence :int)) + +(defcfun ("gpgme_data_new" c-gpgme-data-new) gpgme-error-t + (dh-p :pointer)) + +(defcfun ("gpgme_data_release" c-gpgme-data-release) :void + (dh gpgme-data-t)) + +(defcfun ("gpgme_data_new_from_mem" c-gpgme-data-new-from-mem) gpgme-error-t + (dh-p :pointer) + (buffer :pointer) + (size size-t) + (copy :int)) + +(defcfun ("gpgme_data_release_and_get_mem" c-gpgme-data-release-and-get-mem) + :pointer + (dh gpgme-data-t) + (len-p :pointer)) + +(defcfun ("gpgme_data_new_from_cbs" c-gpgme-data-new-from-cbs) gpgme-error-t + (dh-p :pointer) + (cbs gpgme-data-cbs-t) + (handle :pointer)) + +(defcfun ("gpgme_data_new_from_fd" c-gpgme-data-new-from-fd) gpgme-error-t + (dh-p :pointer) + (fd :int)) + +(defcfun ("gpgme_data_new_from_stream" c-gpgme-data-new-from-stream) + gpgme-error-t + (dh-p :pointer) + (stream :pointer)) + +(defcfun ("gpgme_data_get_encoding" c-gpgme-data-get-encoding) + gpgme-data-encoding-t + (dh gpgme-data-t)) + +(defcfun ("gpgme_data_set_encoding" c-gpgme-data-set-encoding) + gpgme-error-t + (dh gpgme-data-t) + (enc gpgme-data-encoding-t)) + +(defcfun ("gpgme_data_get_file_name" c-gpgme-data-get-file-name) :string + (dh gpgme-data-t)) + +(defcfun ("gpgme_data_set_file_name" c-gpgme-data-set-file-name) gpgme-error-t + (dh gpgme-data-t) + (file-name string-or-nil-t)) + +(defcfun ("gpgme_data_new_from_file" c-gpgme-data-new-from-file) gpgme-error-t + (dh-p :pointer) + (fname :string) + (copy :int)) + +(defcfun ("gpgme_data_new_from_filepart" c-gpgme-data-new-from-filepart) + gpgme-error-t + (dh-p :pointer) + (fname :string) + (fp :pointer) + (offset off-t) + (length size-t)) + +;;; Key and trust functions. + +(defcfun ("gpgme_get_key" c-gpgme-get-key) gpgme-error-t + (ctx gpgme-ctx-t) + (fpr :string) + (key-p :pointer) + (secret :boolean)) + +(defcfun ("gpgme_key_ref" c-gpgme-key-ref) :void + (key gpgme-key-t)) + +(defcfun ("gpgme_key_unref" c-gpgme-key-unref) :void + (key gpgme-key-t)) + +;;; Crypto operations. + +(defcfun ("gpgme_cancel" c-gpgme-cancel) gpgme-error-t + (ctx gpgme-ctx-t)) + +;;; + +(defctype gpgme-invalid-key-t :pointer + :documentation "An invalid key structure.") + +(defcstruct gpgme-invalid-key + "An invalid key structure." + (next gpgme-invalid-key-t) + (fpr :string) + (reason gpgme-error-no-signal-t)) + +;;; Encryption. + +(defcstruct gpgme-op-encrypt-result + "Encryption result structure." + (invalid-recipients gpgme-invalid-key-t)) + +(defctype gpgme-op-encrypt-result-t :pointer + :documentation "An encryption result structure.") + +(defcfun ("gpgme_op_encrypt_result" c-gpgme-op-encrypt-result) + gpgme-op-encrypt-result-t + (ctx gpgme-ctx-t)) + +(defbitfield gpgme-encrypt-flags-t + (:always-trust 1)) + +(defcfun ("gpgme_op_encrypt_start" c-gpgme-op-encrypt-start) gpgme-error-t + (ctx gpgme-ctx-t) + (recp :pointer) ; Key array. + (flags gpgme-encrypt-flags-t) + (plain gpgme-data-t) + (cipher gpgme-data-t)) + +(defcfun ("gpgme_op_encrypt" c-gpgme-op-encrypt) gpgme-error-t + (ctx gpgme-ctx-t) + (recp :pointer) ; Key array. + (flags gpgme-encrypt-flags-t) + (plain gpgme-data-t) + (cipher gpgme-data-t)) + +(defcfun ("gpgme_op_encrypt_sign_start" c-gpgme-op-encrypt-sign-start) + gpgme-error-t + (ctx gpgme-ctx-t) + (recp :pointer) ; Key array. + (flags gpgme-encrypt-flags-t) + (plain gpgme-data-t) + (cipher gpgme-data-t)) + +(defcfun ("gpgme_op_encrypt_sign" c-gpgme-op-encrypt-sign) gpgme-error-t + (ctx gpgme-ctx-t) + (recp :pointer) ; Key array. + (flags gpgme-encrypt-flags-t) + (plain gpgme-data-t) + (cipher gpgme-data-t)) + +;;; Decryption. + +(defctype gpgme-recipient-t :pointer + :documentation "A recipient structure.") + +(defcstruct gpgme-recipient + "Recipient structure." + (next gpgme-recipient-t) + (keyid :string) + (-keyid :char :count 17) + (pubkey-algo gpgme-pubkey-algo-t) + (status gpgme-error-no-signal-t)) + +(defbitfield gpgme-op-decrypt-result-bitfield + "Decryption result structure bitfield." + (:wrong-key-usage 1)) + +(defcstruct gpgme-op-decrypt-result + "Decryption result structure." + (unsupported-algorithm :string) + (bitfield gpgme-op-decrypt-result-bitfield) + (recipients gpgme-recipient-t) + (file-name :string)) + +(defctype gpgme-op-decrypt-result-t :pointer + :documentation "A decryption result structure.") + +(defcfun ("gpgme_op_decrypt_result" c-gpgme-op-decrypt-result) + gpgme-op-decrypt-result-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_op_decrypt_start" c-gpgme-op-decrypt-start) gpgme-error-t + (ctx gpgme-ctx-t) + (cipher gpgme-data-t) + (plain gpgme-data-t)) + +(defcfun ("gpgme_op_decrypt" c-gpgme-op-decrypt) gpgme-error-t + (ctx gpgme-ctx-t) + (cipher gpgme-data-t) + (plain gpgme-data-t)) + +(defcfun ("gpgme_op_decrypt_verify_start" c-gpgme-op-decrypt-verify-start) + gpgme-error-t + (ctx gpgme-ctx-t) + (cipher gpgme-data-t) + (plain gpgme-data-t)) + +(defcfun ("gpgme_op_decrypt_verify" c-gpgme-op-decrypt-verify) gpgme-error-t + (ctx gpgme-ctx-t) + (cipher gpgme-data-t) + (plain gpgme-data-t)) + +;;; Signing. + +(defctype gpgme-new-signature-t :pointer + :documentation "A new signature structure.") + +(defcstruct gpgme-new-signature + "New signature structure." + (next gpgme-new-signature-t) + (type gpgme-sig-mode-t) + (pubkey-algo gpgme-pubkey-algo-t) + (hash-algo gpgme-hash-algo-t) + (-obsolete-class :unsigned-long) + (timestamp :long) + (fpr :string) + (-obsolete-class-2 :unsigned-int) + (sig-class :unsigned-int)) + +(defcstruct gpgme-op-sign-result + "Signing result structure." + (invalid-signers gpgme-invalid-key-t) + (signatures gpgme-new-signature-t)) + +(defctype gpgme-op-sign-result-t :pointer + :documentation "A signing result structure.") + +(defcfun ("gpgme_op_sign_result" c-gpgme-op-sign-result) + gpgme-op-sign-result-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_op_sign_start" c-gpgme-op-sign-start) gpgme-error-t + (ctx gpgme-ctx-t) + (plain gpgme-data-t) + (sig gpgme-data-t) + (mode gpgme-sig-mode-t)) + +(defcfun ("gpgme_op_sign" c-gpgme-op-sign) gpgme-error-t + (ctx gpgme-ctx-t) + (plain gpgme-data-t) + (sig gpgme-data-t) + (mode gpgme-sig-mode-t)) + +;;; Verify. + +(defbitfield (gpgme-sigsum-t :unsigned-int) + "Flags used for the summary field in a gpgme-signature-t." + (:valid #x0001) + (:green #x0002) + (:red #x0004) + (:key-revoked #x0010) + (:key-expired #x0020) + (:sig-expired #x0040) + (:key-missing #x0080) + (:crl-missing #x0100) + (:crl-too-old #x0200) + (:bad-policy #x0400) + (:sys-error #x0800)) + +(defctype gpgme-signature-t :pointer + :documentation "A signature structure.") + +;; FIXME: Doesn't this depend on endianess? +(defbitfield (gpgme-signature-bitfield :unsigned-int) + "The signature bitfield." + (:wrong-key-usage 1)) + +(defcstruct gpgme-signature + "Signature structure." + (next gpgme-signature-t) + (summary gpgme-sigsum-t) + (fpr :string) + (status gpgme-error-no-signal-t) + (notations gpgme-sig-notation-t) + (timestamp :unsigned-long) + (exp-timestamp :unsigned-long) + (bitfield gpgme-signature-bitfield) + (validity gpgme-validity-t) + (validity-reason gpgme-error-no-signal-t) + (pubkey-algo gpgme-pubkey-algo-t) + (hash-algo gpgme-hash-algo-t)) + +(defcstruct gpgme-op-verify-result + "Verify result structure." + (signatures gpgme-signature-t) + (file-name :string)) + +(defctype gpgme-op-verify-result-t :pointer + :documentation "A verify result structure.") + +(defcfun ("gpgme_op_verify_result" c-gpgme-op-verify-result) + gpgme-op-verify-result-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_op_verify_start" c-gpgme-op-verify-start) gpgme-error-t + (ctx gpgme-ctx-t) + (sig gpgme-data-t) + (signed-text gpgme-data-t) + (plaintext gpgme-data-t)) + +(defcfun ("gpgme_op_verify" c-gpgme-op-verify) gpgme-error-t + (ctx gpgme-ctx-t) + (sig gpgme-data-t) + (signed-text gpgme-data-t) + (plaintext gpgme-data-t)) + +;;; Import. + +(defbitfield (gpgme-import-flags-t :unsigned-int) + "Flags used for the import status field." + (:new #x0001) + (:uid #x0002) + (:sig #x0004) + (:subkey #x0008) + (:secret #x0010)) + +(defctype gpgme-import-status-t :pointer + :documentation "An import status structure.") + +(defcstruct gpgme-import-status + "New import status structure." + (next gpgme-import-status-t) + (fpr :string) + (result gpgme-error-no-signal-t) + (status :unsigned-int)) + +(defcstruct gpgme-op-import-result + "Import result structure." + (considered :int) + (no-user-id :int) + (imported :int) + (imported-rsa :int) + (unchanged :int) + (new-user-ids :int) + (new-sub-keys :int) + (new-signatures :int) + (new-revocations :int) + (secret-read :int) + (secret-imported :int) + (secret-unchanged :int) + (skipped-new-keys :int) + (not-imported :int) + (imports gpgme-import-status-t)) + +(defctype gpgme-op-import-result-t :pointer + :documentation "An import status result structure.") + +(defcfun ("gpgme_op_import_result" c-gpgme-op-import-result) + gpgme-op-import-result-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_op_import_start" c-gpgme-op-import-start) gpgme-error-t + (ctx gpgme-ctx-t) + (keydata gpgme-data-t)) + +(defcfun ("gpgme_op_import" c-gpgme-op-import) gpgme-error-t + (ctx gpgme-ctx-t) + (keydata gpgme-data-t)) + +;;; Export. + +(defcfun ("gpgme_op_export_start" c-gpgme-op-export-start) gpgme-error-t + (ctx gpgme-ctx-t) + (pattern :string) + (reserved :unsigned-int) + (keydata gpgme-data-t)) + +(defcfun ("gpgme_op_export" c-gpgme-op-export) gpgme-error-t + (ctx gpgme-ctx-t) + (pattern :string) + (reserved :unsigned-int) + (keydata gpgme-data-t)) + +;;; FIXME: Extended export interfaces require array handling. + +;;; Key generation. + +(defbitfield (gpgme-genkey-flags-t :unsigned-int) + "Flags used for the key generation result bitfield." + (:primary #x0001) + (:sub #x0002)) + +(defcstruct gpgme-op-genkey-result + "Key generation result structure." + (bitfield gpgme-genkey-flags-t) + (fpr :string)) + +(defctype gpgme-op-genkey-result-t :pointer + :documentation "A key generation result structure.") + +(defcfun ("gpgme_op_genkey_result" c-gpgme-op-genkey-result) + gpgme-op-genkey-result-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_op_genkey_start" c-gpgme-op-genkey-start) gpgme-error-t + (ctx gpgme-ctx-t) + (parms :string) + (pubkey gpgme-data-t) + (seckey gpgme-data-t)) + +(defcfun ("gpgme_op_genkey" c-gpgme-op-genkey) gpgme-error-t + (ctx gpgme-ctx-t) + (parms :string) + (pubkey gpgme-data-t) + (seckey gpgme-data-t)) + +;;; Key deletion. + +(defcfun ("gpgme_op_delete_start" c-gpgme-op-delete-start) gpgme-error-t + (ctx gpgme-ctx-t) + (key gpgme-key-t) + (allow-secret :int)) + +(defcfun ("gpgme_op_delete" c-gpgme-op-delete) gpgme-error-t + (ctx gpgme-ctx-t) + (key gpgme-key-t) + (allow-secret :int)) + +;;; FIXME: Add edit interfaces. + +;;; Keylist interface. + +(defbitfield (gpgme-keylist-flags-t :unsigned-int) + "Flags used for the key listing result bitfield." + (:truncated #x0001)) + +(defcstruct gpgme-op-keylist-result + "Key listing result structure." + (bitfield gpgme-keylist-flags-t)) + +(defctype gpgme-op-keylist-result-t :pointer + :documentation "A key listing result structure.") + +(defcfun ("gpgme_op_keylist_result" c-gpgme-op-keylist-result) + gpgme-op-keylist-result-t + (ctx gpgme-ctx-t)) + +(defcfun ("gpgme_op_keylist_start" c-gpgme-op-keylist-start) gpgme-error-t + (ctx gpgme-ctx-t) + (pattern :string) + (secret_only :boolean)) + +;;; FIXME: Extended keylisting requires array handling. + +(defcfun ("gpgme_op_keylist_next" c-gpgme-op-keylist-next) gpgme-error-t + (ctx gpgme-ctx-t) + (r-key :pointer)) + +(defcfun ("gpgme_op_keylist_end" c-gpgme-op-keylist-end) gpgme-error-t + (ctx gpgme-ctx-t)) + +;;; Various functions. + +(defcfun ("gpgme_check_version" c-gpgme-check-version) :string + (req-version string-or-nil-t)) + +(defcfun ("gpgme_get_engine_info" c-gpgme-get-engine-info) gpgme-error-t + (engine-info-p :pointer)) + +(defcfun ("gpgme_set_engine_info" c-gpgme-set-engine-info) gpgme-error-t + (proto gpgme-protocol-t) + (file-name string-or-nil-t) + (home-dir string-or-nil-t)) + +(defcfun ("gpgme_engine_check_version" c-gpgme-engine-check-verson) + gpgme-error-t + (proto gpgme-protocol-t)) + +;;; +;;; L I S P I N T E R F A C E +;;; + +;;; +;;; Lisp type translators. +;;; + +;;; Both directions. + +;;; 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))) + (cond + ((eql value +include-certs-default+) nil) + (t value))) + +(defmethod translate-to-foreign (value (type (eql 'cert-int-t))) + (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))) + (cond + (value value) + (t (null-pointer)))) + +;;; Output only. + +;;; These type translators only convert from foreign type, because we +;;; never use these types in the other direction. + +;;; Convert gpgme-engine-info-t linked lists into a list of property +;;; lists. Note that this converter will automatically be invoked +;;; recursively. +;;; +;;; 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))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((next protocol file-name version req-version home-dir) + value gpgme-engine-info) + (append (list protocol (list + :file-name file-name + :version version + :req-version req-version + :home-dir home-dir)) + next))))) + +(defmethod translate-from-foreign (value (type (eql 'gpgme-invalid-key-t))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((next fpr reason) + value gpgme-invalid-key) + (append (list (list :fpr fpr + :reason reason)) + next))))) + +(defmethod translate-from-foreign (value + (type (eql 'gpgme-op-encrypt-result-t))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((invalid-recipients) + value gpgme-op-encrypt-result) + (list :encrypt + (list :invalid-recipients invalid-recipients)))))) + +(defmethod translate-from-foreign (value (type (eql 'gpgme-recipient-t))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((next keyid pubkey-algo status) + value 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))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((unsupported-algorithm bitfield recipients file-name) + value 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))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((next type pubkey-algo hash-algo timestamp fpr sig-class) + value gpgme-new-signature) + (append (list (list :type type + :pubkey-algo pubkey-algo + :hash-algo hash-algo + :timestamp timestamp + :fpr fpr + :sig-class sig-class)) + next))))) + +(defmethod translate-from-foreign (value + (type (eql 'gpgme-op-sign-result-t))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((invalid-signers signatures) + value gpgme-op-sign-result) + (list :sign (list :invalid-signers invalid-signers + :signatures signatures)))))) + +(defmethod translate-from-foreign (value (type (eql 'gpgme-signature-t))) + (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) + (append (list (list :summary summary + :fpr fpr + :status status + :notations notations + :timestamp timestamp + :exp-timestamp exp-timestamp + :bitfield bitfield + :validity validity + :validity-reason validity-reason + :pubkey-algo pubkey-algo)) + next))))) + +(defmethod translate-from-foreign (value + (type (eql 'gpgme-op-verify-result-t))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((signatures file-name) + value gpgme-op-verify-result) + (list :verify (list :signatures signatures + :file-name file-name)))))) + +(defmethod translate-from-foreign (value (type (eql 'gpgme-import-status-t))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((next fpr result status) + value 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))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((considered no-user-id imported imported-rsa unchanged + new-user-ids new-sub-keys new-signatures + new-revocations secret-read secret-imported + secret-unchanged skipped-new-keys not-imported + imports) + value gpgme-op-import-result) + (list :verify (list :considered considered + :no-user-id no-user-id + :imported imported + :imported-rsa imported-rsa + :unchanged unchanged + :new-user-ids new-user-ids + :new-sub-keys new-sub-keys + :new-signatures new-signatures + :new-revocations new-revocations + :secret-read secret-read + :secret-imported secret-imported + :secret-unchanged secret-unchanged + :skipped-new-keys skipped-new-keys + :not-imported not-imported + :imports imports)))))) + +;;; Error handling. + +;;; Use gpgme-error-no-signal-t to suppress automatic error handling +;;; at translation time. +;;; +;;; FIXME: Part of this probably should be in gpg-error! + +(define-condition gpgme-error (error) + ((value :initarg :gpgme-error :reader gpgme-error-value)) + (:report (lambda (c stream) + (format stream "GPGME returned error: ~A (~A)" + (gpgme-strerror (gpgme-error-value c)) + (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))) + "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))) + "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))) + "Canonicalize the error value." + (gpg-err-canonicalize value)) + + +;;; *INTERNAL* Lispy Function Interface that is still close to the C +;;; interface. + +;;; Passphrase callback management. + +;;; Maybe: Instead, use subclassing, and provide a customizable +;;; default implementation for ease-of-use. + +(defvar *passphrase-handles* (make-hash-table) + "Hash table with GPGME context address as key and the corresponding + passphrase callback object as value.") + +(defcallback passphrase-cb gpgme-error-t ((handle :pointer) + (uid-hint :string) + (passphrase-info :string) + (prev-was-bad :boolean) + (fd :int)) + (handler-case + (let* ((passphrase-cb + (gethash (pointer-address handle) *passphrase-handles*)) + (passphrase + (cond + ((functionp passphrase-cb) + (concatenate 'string + (funcall passphrase-cb uid-hint passphrase-info + prev-was-bad) + '(#\Newline))) + (t (concatenate 'string passphrase-cb '(#\Newline))))) + (passphrase-len (length passphrase)) + ;; FIXME: Could be more robust. + (res (system-write fd passphrase passphrase-len))) + (cond + ((< res passphrase-len) ; FIXME: Blech. A weak attempt to be robust. + (gpgme-error :gpg-err-inval)) + (t (gpgme-error :gpg-err-no-error)))) + (gpgme-error (err) (gpgme-error-value err)) + (system-error (err) (gpgme-error-from-errno (system-error-errno err))) + ;; FIXME: The original error gets lost here. + (condition (err) (progn + (when *debug* + (format t "DEBUG: passphrase-cb: Unexpressable: ~A~%" + err)) + (gpgme-error :gpg-err-general))))) + +;;; CTX is a C-pointer to the context. +(defun gpgme-set-passphrase-cb (ctx cb) + "Set the passphrase callback for CTX." + (let ((handle (pointer-address ctx))) + (cond + (cb (setf (gethash handle *passphrase-handles*) cb) + (c-gpgme-set-passphrase-cb ctx (callback passphrase-cb) ctx)) + (t (c-gpgme-set-passphrase-cb ctx (null-pointer) (null-pointer)) + (remhash handle *passphrase-handles*))))) + +;;; Progress callback management. + +;;; Maybe: Instead, use subclassing, and provide a customizable +;;; default implementation for ease-of-use. + +(defvar *progress-handles* (make-hash-table) + "Hash table with GPGME context address as key and the corresponding + progress callback object as value.") + +(defcallback progress-cb :void ((handle :pointer) + (what :string) + (type :int) + (current :int) + (total :int)) + (handler-case + (let* ((progress-cb + (gethash (pointer-address handle) *progress-handles*))) + (funcall progress-cb what type current total)) + ;; FIXME: The original error gets lost here. + (condition (err) (when *debug* + (format t "DEBUG: progress-cb: Unexpressable: ~A~%" + err))))) + +;;; CTX is a C-pointer to the context. +(defun gpgme-set-progress-cb (ctx cb) + "Set the progress callback for CTX." + (let ((handle (pointer-address ctx))) + (cond + (cb (setf (gethash handle *progress-handles*) cb) + (c-gpgme-set-progress-cb ctx (callback progress-cb) ctx)) + (t (c-gpgme-set-progress-cb ctx (null-pointer) (null-pointer)) + (remhash handle *progress-handles*))))) + +;;; Context management. + +(defun gpgme-new (&key (protocol :openpgp) armor textmode include-certs + keylist-mode passphrase progress file-name home-dir) + "Allocate a new GPGME context." + (with-foreign-object (ctx-p 'gpgme-ctx-t) + (c-gpgme-new ctx-p) + (let ((ctx (mem-ref ctx-p 'gpgme-ctx-t))) + ;;; Set locale? + (gpgme-set-protocol ctx protocol) + (gpgme-set-armor ctx armor) + (gpgme-set-textmode ctx textmode) + (when include-certs (gpgme-set-include-certs ctx include-certs)) + (when keylist-mode (gpgme-set-keylist-mode ctx keylist-mode)) + (gpgme-set-passphrase-cb ctx passphrase) + (gpgme-set-progress-cb ctx progress) + (gpgme-set-engine-info ctx protocol + :file-name file-name :home-dir home-dir) + (when *debug* (format t "DEBUG: gpgme-new: ~A~%" ctx)) + ctx))) + +(defun gpgme-release (ctx) + "Release a GPGME context." + (when *debug* (format t "DEBUG: gpgme-release: ~A~%" ctx)) + (c-gpgme-release ctx)) + +(defun gpgme-set-protocol (ctx proto) + "Set the protocol to be used by CTX to PROTO." + (c-gpgme-set-protocol ctx proto)) + +(defun gpgme-get-protocol (ctx) + "Get the protocol used with CTX." + (c-gpgme-get-protocol ctx)) + +;;; FIXME: How to do pretty printing? +;;; +;;; gpgme-get-protocol-name + +(defun gpgme-set-armor (ctx armor) + "If ARMOR is true, enable armor mode in CTX, disable it otherwise." + (c-gpgme-set-armor ctx armor)) + +(defun gpgme-armor-p (ctx) + "Return true if armor mode is set for CTX." + (c-gpgme-get-armor ctx)) + +(defun gpgme-set-textmode (ctx textmode) + "If TEXTMODE is true, enable text mode mode in CTX, disable it otherwise." + (c-gpgme-set-textmode ctx textmode)) + +(defun gpgme-textmode-p (ctx) + "Return true if text mode mode is set for CTX." + (c-gpgme-get-textmode ctx)) + +(defun gpgme-set-include-certs (ctx &optional certs) + "Include up to CERTS certificates in an S/MIME message." + (c-gpgme-set-include-certs ctx certs)) + +(defun gpgme-get-include-certs (ctx) + "Return the number of certs to include in an S/MIME message, + or NIL if the default is used." + (c-gpgme-get-include-certs ctx)) + +(defun gpgme-get-keylist-mode (ctx) + "Get the keylist mode in CTX." + (c-gpgme-get-keylist-mode ctx)) + +(defun gpgme-set-keylist-mode (ctx mode) + "Set the keylist mode in CTX." + (c-gpgme-set-keylist-mode ctx mode)) + + +;;; FIXME: How to handle locale? cffi-grovel? + +(defun gpgme-get-engine-info (&optional ctx) + "Retrieve the engine info for CTX, or the default if CTX is omitted." + (cond + (ctx (c-gpgme-ctx-get-engine-info ctx)) + (t (with-foreign-object (info-p 'gpgme-engine-info-t) + (c-gpgme-get-engine-info info-p) + (mem-ref info-p 'gpgme-engine-info-t))))) + +(defun gpgme-set-engine-info (ctx proto &key file-name home-dir) + "Set the engine info for CTX, or the default if CTX is NIL." + (cond + (ctx (c-gpgme-ctx-set-engine-info ctx proto file-name home-dir)) + (t (c-gpgme-set-engine-info proto file-name home-dir)))) + +;;; FIXME: How to do pretty printing? +;;; +;;; gpgme_pubkey_algo_name, gpgme_hash_algo_name + +(defun gpgme-set-signers (ctx keys) + "Set the signers for the context CTX." + (c-gpgme-signers-clear ctx) + (dolist (key keys) (c-gpgme-signers-add ctx key))) + +;;; + +(defun gpgme-set-sig-notation (ctx notations) + "Set the sig notation for the context CTX." + (c-gpgme-sig-notation-clear ctx) + (dolist (notation notations) + (c-gpgme-sig-notation-add + ctx (first notation) (second notation) (third notation)))) + +(defun gpgme-get-sig-notation (ctx) + "Get the signature notation data for the context CTX." + (c-gpgme-sig-notation-get ctx)) + +;;; FIXME: Add I/O callback interface, for integration with clg. + +;;; FIXME: Add gpgme_wait? + +;;; Streams +;;; ------- +;;; +;;; GPGME uses standard streams. You can define your own streams, or +;;; use the existing file or string streams. +;;; +;;; A stream-spec is either a stream, or a list with a stream as its +;;; first argument followed by keyword parameters: encoding, +;;; file-name. +;;; +;;; FIXME: Eventually, we should provide a class that can be mixed +;;; into stream classes and which provides accessors for encoding and +;;; file-names. This interface should be provided in addition to the +;;; above sleazy interface, because the sleazy interface is easier to +;;; use (less typing), and is quite sufficient in a number of cases. +;;; +;;; For best results, streams with element type (unsigned-byte 8) +;;; should be used. Character streams may work if armor mode is used. + +;;; Do we need to provide access to GPGME data objects through streams +;;; as well? It seems to me that specific optimizations, like +;;; directly writing to file descriptors, is better done by extending +;;; the sleazy syntax (stream-spec) instead of customized streams. +;;; Customized streams do buffering, and this may mess up things. Mmh. + +(defvar *data-handles* (make-hash-table) + "Hash table with GPGME data user callback handle address as key + and the corresponding stream as value.") + +;;; The release callback removes the stream from the *data-handles* +;;; hash and releases the CBS structure that is used as the key in +;;; that hash. It is implicitely invoked (through GPGME) by +;;; gpgme-data-release. +(defcallback data-release-cb :void ((handle :pointer)) + (unwind-protect (remhash (pointer-address handle) *data-handles*) + (when (not (null-pointer-p handle)) (foreign-free handle)))) + +(defcallback data-read-cb ssize-t ((handle :pointer) (buffer :pointer) + (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)))) + +(defcallback data-write-cb ssize-t ((handle :pointer) (buffer :pointer) + (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)))) + +;;; 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))) + (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) + ;;; We allocate one CBS structure for each stream we wrap in a + ;;; data object. Although we could also share all these + ;;; structures, as they contain the very same callbacks, we need a + ;;; 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)) + (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 file-name (gpgme-data-set-file-name dh file-name)) + ;;; Install the stream into the hash table and swallow the cbs + ;;; structure while protecting against any errors. + (unwind-protect + (progn + (setf (gethash (pointer-address cbs) *data-handles*) stream) + (setf cbs (null-pointer))) + (when (not (null-pointer-p cbs)) (c-gpgme-data-release dh))) + (when *debug* (format t "DEBUG: gpgme-data-new: ~A~%" dh)) + dh)))) + +;;; This function releases a GPGME data object. It implicitely +;;; invokes the data-release-cb function to clean up associated junk. +(defun gpgme-data-release (dh) + "Release a GPGME data object." + (when *debug* (format t "DEBUG: gpgme-data-release: ~A~%" dh)) + (c-gpgme-data-release dh)) + +(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))))) + +(defun gpgme-data-get-encoding (dh) + "Get the encoding associated with the data object DH." + (c-gpgme-data-get-encoding dh)) + +(defun gpgme-data-set-encoding (dh encoding) + "Set the encoding associated with the data object DH to ENCODING." + (c-gpgme-data-set-encoding dh encoding)) + +(defun gpgme-data-get-file-name (dh) + "Get the file name associated with the data object DH." + (c-gpgme-data-get-file-name dh)) + +(defun gpgme-data-set-file-name (dh file-name) + "Set the file name associated with the data object DH to FILE-NAME." + (c-gpgme-data-set-file-name dh file-name)) + +;;; FIXME: Add key accessor interfaces. + +(defun gpgme-get-key (ctx fpr &optional secret) + "Get the key with the fingerprint FPR from the context CTX." + (with-foreign-object (key-p 'gpgme-key-t) + (c-gpgme-get-key ctx fpr key-p secret) + (mem-ref key-p 'gpgme-key-t))) + +(defun gpgme-key-ref (key) + "Acquire an additional reference to the key KEY." + (when *debug* (format t "DEBUG: gpgme-key-ref: ~A~%" key)) + (c-gpgme-key-ref key)) + +(defun gpgme-key-unref (key) + "Release a reference to the key KEY." + (when *debug* (format t "DEBUG: gpgme-key-unref: ~A~%" key)) + (c-gpgme-key-unref key)) + +;;; FIXME: We REALLY need pretty printing for keys and all the other +;;; big structs. + +;;; Various interfaces. + +(defun gpgme-check-version (&optional req-version) + (c-gpgme-check-version req-version)) + +;;; +;;; The *EXPORTED* CLOS interface. +;;; + +;;; The context type. + +;;; We wrap the C context pointer into a class object to be able to +;;; stick a finalizer on it. + +(defclass context () + (c-ctx ; The C context object pointer. + signers ; The list of signers. + sig-notation) ; The list of signers. + (:documentation "The GPGME context type.")) + +(defmethod initialize-instance :after ((ctx context) &rest rest + &key &allow-other-keys) + (let ((c-ctx (apply #'gpgme-new rest)) + (cleanup t)) + (unwind-protect + (progn (setf (slot-value ctx 'c-ctx) c-ctx) + (finalize ctx (lambda () (gpgme-release c-ctx))) + (setf cleanup nil)) + (if cleanup (gpgme-release c-ctx))))) + +(defmethod translate-to-foreign (value (type (eql 'gpgme-ctx-t))) + ;; Allow a pointer to be passed directly for the finalizer to work. + (if (pointerp value) value (slot-value value 'c-ctx))) + +(defmacro context (&rest rest) + "Create a new GPGME context." + `(make-instance 'context ,@rest)) + +;;; The context type: Accessor functions. + +;;; The context type: Accessor functions: Protocol. + +(defgeneric protocol (ctx) + (:documentation "Get the protocol of CONTEXT.")) + +(defmethod protocol ((ctx context)) + (gpgme-get-protocol ctx)) + +(defgeneric (setf protocol) (protocol ctx) + (:documentation "Set the protocol of CONTEXT to PROTOCOL.")) + +;;; FIXME: Adjust translator to reject invalid protocols. Currently, +;;; specifing an invalid protocol throws a "NIL is not 32 signed int" +;;; error. This is suboptimal. +(defmethod (setf protocol) (protocol (ctx context)) + (gpgme-set-protocol ctx protocol)) + +;;; The context type: Accessor functions: Armor. +;;; FIXME: Is it good style to make foop setf-able? Or should it be +;;; foo/foop for set/get? + +(defgeneric armorp (ctx) + (:documentation "Get the armor flag of CONTEXT.")) + +(defmethod armorp ((ctx context)) + (gpgme-armor-p ctx)) + +(defgeneric (setf armorp) (armor ctx) + (:documentation "Set the armor flag of CONTEXT to ARMOR.")) + +(defmethod (setf armorp) (armor (ctx context)) + (gpgme-set-armor ctx armor)) + +;;; The context type: Accessor functions: Textmode. +;;; FIXME: Is it good style to make foop setf-able? Or should it be +;;; foo/foop for set/get? + +(defgeneric textmodep (ctx) + (:documentation "Get the text mode flag of CONTEXT.")) + +(defmethod textmodep ((ctx context)) + (gpgme-textmode-p ctx)) + +(defgeneric (setf textmodep) (textmode ctx) + (:documentation "Set the text mode flag of CONTEXT to TEXTMODE.")) + +(defmethod (setf textmodep) (textmode (ctx context)) + (gpgme-set-textmode ctx textmode)) + +;;; The context type: Accessor functions: Include Certs. + +(defgeneric include-certs (ctx) + (:documentation "Get the number of included certificates in an + S/MIME message, or NIL if the default is used.")) + +(defmethod include-certs ((ctx context)) + (gpgme-get-include-certs ctx)) + +(defgeneric (setf include-certs) (certs ctx) + (:documentation "Return the number of certificates to include in an + S/MIME message, or NIL if the default is used.")) + +(defmethod (setf include-certs) (certs (ctx context)) + (gpgme-set-include-certs ctx certs)) + +;;; The context type: Accessor functions: Engine info. + +(defgeneric engine-info (ctx) + (:documentation "Retrieve the engine info for CTX.")) + +(defmethod engine-info ((ctx context)) + (gpgme-get-engine-info ctx)) + +(defgeneric (setf engine-info) (info ctx) + (:documentation "Set the engine info for CTX.")) + +(defmethod (setf engine-info) (info (ctx context)) + (dolist (proto '(:openpgp :cms)) + (let ((pinfo (getf info proto))) + (when pinfo + (gpgme-set-engine-info ctx proto :file-name (getf pinfo :file-name) + :home-dir (getf pinfo :home-dir)))))) + +;;; The context type: Accessor functions: Keylist mode. + +(defgeneric keylist-mode (ctx) + (:documentation "Get the keylist mode of CTX.")) + +(defmethod keylist-mode ((ctx context)) + (gpgme-get-keylist-mode ctx)) + +(defgeneric (setf keylist-mode) (mode ctx) + (:documentation "Set the keylist mode of CTX to MODE.")) + +(defmethod (setf keylist-mode) (mode (ctx context)) + (gpgme-set-keylist-mode ctx mode)) + +;;; The context type: Accessor functions: Signers. + +(defgeneric signers (ctx) + (:documentation "Get the signers of CTX.")) + +(defmethod signers ((ctx context)) + (slot-value ctx 'signers)) + +(defgeneric (setf signers) (signers ctx) + (:documentation "Set the signers of CTX to SIGNERS.")) + +(defmethod (setf keylist-mode) (signers (ctx context)) + (gpgme-set-signers ctx signers) + (setf (slot-value ctx 'signers) signers)) + +;;; The context type: Accessor functions: Sig notations. + +(defgeneric sig-notations (ctx) + (:documentation "Get the signature notations of CTX.")) + +(defmethod sig-notations ((ctx context)) + (slot-value ctx 'signers)) + +(defgeneric (setf sig-notations) (notations ctx) + (:documentation "Set the signatire notations of CTX to NOTATIONS.")) + +(defmethod (setf sig-notations) (notations (ctx context)) + (gpgme-set-signers ctx notations) + (setf (slot-value ctx 'notations) notations)) + +;;; The context type: Support macros. + +(defmacro with-context ((ctx &rest rest) &body body) + `(let ((,ctx (make-instance 'context ,@rest))) + ,@body)) + +;;; The key type. + +(defclass key () + (c-key) ; The C key object pointer. + (:documentation "The GPGME key type.")) + +;;; In the initializer, we swallow the c-key argument. +(defmethod initialize-instance :after ((key key) &key c-key + &allow-other-keys) + (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))) + (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))) + ;; Allow a pointer to be passed directly for the finalizer to work. + (if (pointerp value) value (slot-value value 'c-key))) + +(defmethod print-object ((key key) stream) + (print-unreadable-object (key stream :type t :identity t) + (format stream "~s" (fpr key)))) + +;;; The key type: Accessor functions. + +;;; FIXME: The bitfield and flags contain redundant information at +;;; this point. FIXME: Deal nicer with zero-length name (policy url) +;;; 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))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((next name value name-len value-len flags bitfield) + value gpgme-sig-notation) + (append (list (list + :name name + :value value + :name-len name-len + :value-len value-len + :flags flags + :bitfield bitfield)) + next))))) + +;;; FIXME: Deal nicer with timestamps. bitfield field name? +(defmethod translate-from-foreign (value (type (eql 'gpgme-subkey-t))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((next bitfield pubkey-algo length keyid fpr timestamp expires) + value gpgme-subkey) + (append (list (list + :bitfield bitfield + :pubkey-algo pubkey-algo + :length length + :keyid keyid + :fpr fpr + :timestamp timestamp + :expires expires)) + next))))) + +(defmethod translate-from-foreign (value (type (eql 'gpgme-key-sig-t))) + (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) + (append (list (list + :bitfield bitfield + :pubkey-algo pubkey-algo + :keyid keyid + :timestamp timestamp + :expires expires + :status status + :uid uid + :name name + :email email + :comment comment + :sig-class sig-class)) + next))))) + +(defmethod translate-from-foreign (value (type (eql 'gpgme-user-id-t))) + (cond + ((null-pointer-p value) nil) + (t (with-foreign-slots + ((next bitfield validity uid name email comment signatures) + value gpgme-user-id) + (append (list (list + :bitfield bitfield + :validity validity + :uid uid + :name name + :email email + :comment comment + :signatures signatures)) + next))))) + +(defun key-data (key) + (with-slots (c-key) key + (with-foreign-slots + ((bitfield protocol issuer-serial issuer-name chain-id + owner-trust subkeys uids keylist-mode) + c-key gpgme-key) + (list + :bitfield bitfield + :protocol protocol + :issuer-serial issuer-serial + :issuer-name issuer-name + :chain-id chain-id + :owner-trust owner-trust + :subkeys subkeys + :uids uids + :keylist-mode keylist-mode)) + )) + + +(defgeneric fpr (key) + (:documentation "Get the primary fingerprint of the key.")) + +(defmethod fpr ((key key)) + (getf (car (getf (key-data key) :subkeys)) :fpr)) + + +;;; The context type: Crypto-Operations. + +(defgeneric get-key (ctx fpr &optional secret) + (:documentation "Get the (secret) key FPR from CTX.")) + +(defmethod get-key ((ctx context) fpr &optional secret) + (gpgme-get-key ctx fpr secret)) + +;;; Encrypt. + +(defgeneric op-encrypt (ctx recp plain cipher &key always-trust sign) + (:documentation "Encrypt.")) + +(defmethod op-encrypt ((ctx context) recp plain cipher + &key always-trust sign) + (with-foreign-object (c-recp :pointer (+ 1 (length recp))) + (dotimes (i (length recp)) + (setf (mem-aref c-recp 'gpgme-key-t i) (elt recp i))) + (setf (mem-aref c-recp :pointer (length recp)) (null-pointer)) + (with-gpgme-data (in plain) + (with-gpgme-data (out cipher) + (let ((flags)) + (if always-trust (push :always-trust flags)) + (cond + (sign + (c-gpgme-op-encrypt-sign ctx c-recp flags in out) + (append (c-gpgme-op-encrypt-result ctx) + (c-gpgme-op-sign-result ctx))) + (t + (c-gpgme-op-encrypt ctx c-recp flags in out) + (c-gpgme-op-encrypt-result ctx)))))))) + +;;; Decrypt. + +(defgeneric op-decrypt (ctx cipher plain &key verify) + (:documentation "Decrypt.")) + +(defmethod op-decrypt ((ctx context) cipher plain &key verify) + (with-gpgme-data (in cipher) + (with-gpgme-data (out plain) + (cond + (verify + (c-gpgme-op-decrypt-verify ctx in out) + (append (c-gpgme-op-decrypt-result ctx) + (c-gpgme-op-verify-result ctx))) + (t + (c-gpgme-op-decrypt ctx in out) + (c-gpgme-op-decrypt-result ctx)))))) + +;;; Signing. + +(defgeneric op-sign (ctx plain sig &optional mode) + (:documentation "Sign.")) + +(defmethod op-sign ((ctx context) plain sig &optional (mode :none)) + (with-gpgme-data (in plain) + (with-gpgme-data (out sig) + (c-gpgme-op-sign ctx in out mode) + (c-gpgme-op-sign-result ctx)))) + +;;; Verify. + +(defgeneric op-verify (ctx sig text &key detached) + (:documentation "Verify.")) + +(defmethod op-verify ((ctx context) sig text &key detached) + (with-gpgme-data (in sig) + (with-gpgme-data (on text) + (c-gpgme-op-verify ctx in (if detached on nil) + (if detached nil on)) + (c-gpgme-op-verify-result ctx)))) + +;;; Import. + +(defgeneric op-import (ctx keydata) + (:documentation "Import.")) + +(defmethod op-import ((ctx context) keydata) + (with-gpgme-data (in keydata) + (c-gpgme-op-import ctx in) + (c-gpgme-op-import-result ctx))) + +;;; Export. + +(defgeneric op-export (ctx pattern keydata) + (:documentation "Export public key data matching PATTERN to the + stream KEYDATA.")) + +(defmethod op-export ((ctx context) pattern keydata) + (with-gpgme-data (dh keydata) + (c-gpgme-op-export ctx pattern 0 dh))) + +;;; Key generation. + + +;;; +;;; Initialization +;;; + +(defun check-version (&optional req-version) + "Check that the GPGME version requirement is satisfied." + (gpgme-check-version req-version)) + +(defparameter *version* (check-version) + "The version number of GPGME used.") |