diff options
Diffstat (limited to 'lang/cl')
| -rw-r--r-- | lang/cl/ChangeLog-2011 | 50 | ||||
| -rw-r--r-- | lang/cl/Makefile.am | 27 | ||||
| -rw-r--r-- | lang/cl/Makefile.in | 475 | ||||
| -rw-r--r-- | lang/cl/README | 40 | ||||
| -rw-r--r-- | lang/cl/gpgme-package.lisp | 49 | ||||
| -rw-r--r-- | lang/cl/gpgme.asd | 35 | ||||
| -rw-r--r-- | lang/cl/gpgme.asd.in | 35 | ||||
| -rw-r--r-- | lang/cl/gpgme.lisp | 2069 |
8 files changed, 2780 insertions, 0 deletions
diff --git a/lang/cl/ChangeLog-2011 b/lang/cl/ChangeLog-2011 new file mode 100644 index 0000000..cbd21be --- /dev/null +++ b/lang/cl/ChangeLog-2011 @@ -0,0 +1,50 @@ +2011-12-02 Werner Koch <wk@g10code.com> + + NB: ChangeLog files are no longer manually maintained. Starting + on December 1st, 2011 we put change information only in the GIT + commit log, and generate a top-level ChangeLog file from logs at + "make dist". See doc/HACKING for details. + +2008-11-08 Moritz <moritz@gnu.org> + + * gpgme.lisp (size-t): Wrong call to defctype: function accepts + optional, not keyword argument. + (ssize-t): Likewise. + (off-t): Likewise. + (gpgme-data-t, gpgme-ctx-t): Likewise. + (gpgme-error-t): Likewise. + (gpgme-error-no-signal-t): Likewise. + (gpgme-err-code-t): Likewise. + (gpgme-err-source-t): Likewise. + (gpgme-sig-notation-t, gpgme-engine-info-t): Likewise. + (gpgme-subkey-t): Likewise. + (gpgme-key-sig-t): Likewise. + (gpgme-user-id-t): Likewise. + (gpgme-key-t): Likewise. + (gpgme-data-cbs-t): Likewise. + (gpgme-invalid-key-t): Likewise. + (gpgme-op-encrypt-result-t): Likewise. + (gpgme-recipient-t): Likewise. + (gpgme-op-decrypt-result-t): Likewise. + (gpgme-new-signature-t): Likewise. + (gpgme-op-sign-result-t): Likewise. + (gpgme-signature-t): Likewise. + (gpgme-op-verify-result-t): Likewise. + (gpgme-import-status-t): Likewise. + (gpgme-op-import-result-t): Likewise. + (gpgme-op-genkey-result-t): Likewise. + (gpgme-op-keylist-result-t): Likewise. + +2006-07-06 Marcus Brinkmann <marcus@g10code.de> + + * Initial release. + + Copyright (C) 2006, 2008 g10 Code GmbH + + This file is free software; as a special exception the author gives + unlimited permission to copy and/or distribute it, with or without + modifications, as long as this notice is preserved. + + This file is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY, to the extent permitted by law; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. diff --git a/lang/cl/Makefile.am b/lang/cl/Makefile.am new file mode 100644 index 0000000..553926e --- /dev/null +++ b/lang/cl/Makefile.am @@ -0,0 +1,27 @@ +# 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 ChangeLog-2011 diff --git a/lang/cl/Makefile.in b/lang/cl/Makefile.in new file mode 100644 index 0000000..91b364b --- /dev/null +++ b/lang/cl/Makefile.in @@ -0,0 +1,475 @@ +# Makefile.in generated by automake 1.11.1 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, +# Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# 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 + +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = lang/cl +DIST_COMMON = README $(dist_clfiles_DATA) $(srcdir)/Makefile.am \ + $(srcdir)/Makefile.in $(srcdir)/gpgme.asd.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/glib-2.0.m4 \ + $(top_srcdir)/m4/glibc21.m4 $(top_srcdir)/m4/gnupg-ttyname.m4 \ + $(top_srcdir)/m4/gpg-error.m4 $(top_srcdir)/m4/libassuan.m4 \ + $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ + $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ + $(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = gpgme.asd +CONFIG_CLEAN_VPATH_FILES = +SOURCES = +DIST_SOURCES = +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__installdirs = "$(DESTDIR)$(clfilesdir)" +DATA = $(dist_clfiles_DATA) +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AR = @AR@ +AS = @AS@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BUILD_FILEVERSION = @BUILD_FILEVERSION@ +BUILD_NUMBER = @BUILD_NUMBER@ +BUILD_TIMESTAMP = @BUILD_TIMESTAMP@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +FGREP = @FGREP@ +G13 = @G13@ +GITLOG_TO_CHANGELOG = @GITLOG_TO_CHANGELOG@ +GLIBC21 = @GLIBC21@ +GLIB_CFLAGS = @GLIB_CFLAGS@ +GLIB_GENMARSHAL = @GLIB_GENMARSHAL@ +GLIB_LIBS = @GLIB_LIBS@ +GLIB_MKENUMS = @GLIB_MKENUMS@ +GOBJECT_QUERY = @GOBJECT_QUERY@ +GPG = @GPG@ +GPGCONF = @GPGCONF@ +GPGME_CONFIG_API_VERSION = @GPGME_CONFIG_API_VERSION@ +GPGME_CONFIG_CFLAGS = @GPGME_CONFIG_CFLAGS@ +GPGME_CONFIG_HOST = @GPGME_CONFIG_HOST@ +GPGME_CONFIG_LIBS = @GPGME_CONFIG_LIBS@ +GPGSM = @GPGSM@ +GPG_ERROR_CFLAGS = @GPG_ERROR_CFLAGS@ +GPG_ERROR_CONFIG = @GPG_ERROR_CONFIG@ +GPG_ERROR_LIBS = @GPG_ERROR_LIBS@ +GPG_PATH = @GPG_PATH@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBASSUAN_CFLAGS = @LIBASSUAN_CFLAGS@ +LIBASSUAN_CONFIG = @LIBASSUAN_CONFIG@ +LIBASSUAN_LIBS = @LIBASSUAN_LIBS@ +LIBGPGME_LT_AGE = @LIBGPGME_LT_AGE@ +LIBGPGME_LT_CURRENT = @LIBGPGME_LT_CURRENT@ +LIBGPGME_LT_REVISION = @LIBGPGME_LT_REVISION@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NEED__FILE_OFFSET_BITS = @NEED__FILE_OFFSET_BITS@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PKG_CONFIG = @PKG_CONFIG@ +QT4_CORE_CFLAGS = @QT4_CORE_CFLAGS@ +QT4_CORE_LIBS = @QT4_CORE_LIBS@ +RANLIB = @RANLIB@ +RC = @RC@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +emacs_local_vars_begin = @emacs_local_vars_begin@ +emacs_local_vars_end = @emacs_local_vars_end@ +emacs_local_vars_read_only = @emacs_local_vars_read_only@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +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 ChangeLog-2011 +all: all-am + +.SUFFIXES: +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu lang/cl/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu lang/cl/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): +gpgme.asd: $(top_builddir)/config.status $(srcdir)/gpgme.asd.in + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs +install-dist_clfilesDATA: $(dist_clfiles_DATA) + @$(NORMAL_INSTALL) + test -z "$(clfilesdir)" || $(MKDIR_P) "$(DESTDIR)$(clfilesdir)" + @list='$(dist_clfiles_DATA)'; test -n "$(clfilesdir)" || list=; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(clfilesdir)'"; \ + $(INSTALL_DATA) $$files "$(DESTDIR)$(clfilesdir)" || exit $$?; \ + done + +uninstall-dist_clfilesDATA: + @$(NORMAL_UNINSTALL) + @list='$(dist_clfiles_DATA)'; test -n "$(clfilesdir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + test -n "$$files" || exit 0; \ + echo " ( cd '$(DESTDIR)$(clfilesdir)' && rm -f" $$files ")"; \ + cd "$(DESTDIR)$(clfilesdir)" && rm -f $$files +tags: TAGS +TAGS: + +ctags: CTAGS +CTAGS: + + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(DATA) +installdirs: + for dir in "$(DESTDIR)$(clfilesdir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool mostlyclean-am + +distclean: distclean-am + -rm -f Makefile +distclean-am: clean-am distclean-generic + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: install-dist_clfilesDATA + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-generic mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-dist_clfilesDATA + +.MAKE: install-am install-strip + +.PHONY: all all-am check check-am clean clean-generic clean-libtool \ + distclean distclean-generic distclean-libtool distdir dvi \ + dvi-am html html-am info info-am install install-am \ + install-data install-data-am install-dist_clfilesDATA \ + install-dvi install-dvi-am install-exec install-exec-am \ + install-html install-html-am install-info install-info-am \ + install-man install-pdf install-pdf-am install-ps \ + install-ps-am install-strip installcheck installcheck-am \ + installdirs maintainer-clean maintainer-clean-generic \ + mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \ + ps ps-am uninstall uninstall-am uninstall-dist_clfilesDATA + + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/lang/cl/README b/lang/cl/README new file mode 100644 index 0000000..b4a3c81 --- /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 0000000..239d57f --- /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 b/lang/cl/gpgme.asd new file mode 100644 index 0000000..d859136 --- /dev/null +++ b/lang/cl/gpgme.asd @@ -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 "1.3.2" + :licence "GPL" + :depends-on ("cffi" "gpg-error") + :components ((:file "gpgme-package") + (:file "gpgme" + :depends-on ("gpgme-package")))) diff --git a/lang/cl/gpgme.asd.in b/lang/cl/gpgme.asd.in new file mode 100644 index 0000000..86e8d51 --- /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 0000000..74cb9ed --- /dev/null +++ b/lang/cl/gpgme.lisp @@ -0,0 +1,2069 @@ +;;;; 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 "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.") + +(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 "The GPGME context type.") + +(defctype gpgme-data-t :pointer "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-no-signal-t gpg-error::gpg-error-t + "The GPGME error type (this version does not signal conditions in translation.") + +(defctype gpgme-err-code-t gpg-error::gpg-err-code-t + "The GPGME error code type.") + +(defctype gpgme-err-source-t gpg-error::gpg-err-source-t + "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 + "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 + "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 "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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 + "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.") |