Update of /p/lispy/cvsroot/lispy In directory clnet:/tmp/cvs-serv10499

Modified Files: lispy.asd lispy.lisp utils.lisp Added Files: TODO gpgme.lisp Log Message: Replace GPG support via trivial-shell with GPGME-CL CFFI binding.

--- /p/lispy/cvsroot/lispy/lispy.asd 2008/04/08 13:47:33 1.8 +++ /p/lispy/cvsroot/lispy/lispy.asd 2008/04/12 17:16:57 1.9 @@ -13,6 +13,7 @@ (:file "logging") (:file "utils") (:file "specials") + (:file "gpgme") (:file "lispy")) :serial t :depends-on (#:drakma @@ -22,7 +23,8 @@ #:ironclad #:cl-fad #:log5 - #:trivial-shell)) + #:gpgme + #:cffi))

(defmethod perform :after ((o load-op) (c (eql (find-system 'lispy)))) (let ((lispy-config (merge-pathnames #p".lispy.lisp"(user-homedir-pathname)))) --- /p/lispy/cvsroot/lispy/lispy.lisp 2008/04/02 05:25:39 1.14 +++ /p/lispy/cvsroot/lispy/lispy.lisp 2008/04/12 17:16:57 1.15 @@ -118,21 +118,24 @@ (download-file map-signature-url map-signature-pathname) map-signature-pathname))

+(defun verify-map (map-signature map map-signature-url) + (let ((result (verify-signature map-signature map))) + (dolist (signature (getf (cadr result) :signatures)) + (if (member :green (getf signature :summary)) + (log5:log-for map "GPG validation success ~A" (uri-to-string map-signature-url)) + (error "GPG verification of map ~A with signature ~A failed: ~S" + map + map-signature + signature)))) + (values)) + (defun read-maps (&optional (map-urls *lispy-map-urls*)) "Read all maps in the list MAP-URLS, merging each map into *LISPY-MAPS*. Returns the mutated *LISPY-MAPS*." (dolist (map-url map-urls) (let ((map (download-map map-url)) (map-signature (download-map-signature map-url))) - (multiple-value-bind (success message) - (verify-signature map map-signature) - (dolist (line (split-sequence:split-sequence #\Newline message :remove-empty-subseqs t)) - (log5:log-for map line)) - (unless success - (error "GPG verification of map ~A with signature ~A failed: ~A" - map - map-signature - message))) + (verify-map map-signature map map-url) (read-map map-url map))) (log5:log-for map "Maps contain contains ~A entr~:@p" (hash-table-count *lispy-map*)) *lispy-map*) --- /p/lispy/cvsroot/lispy/utils.lisp 2008/04/02 05:25:39 1.7 +++ /p/lispy/cvsroot/lispy/utils.lisp 2008/04/12 17:16:57 1.8 @@ -67,6 +67,7 @@ (copy-stream stream output-stream)) (close stream))))

+#+nil (defun verify-signature (text-pathname signature-pathname) (multiple-value-bind (output error status) (trivial-shell:shell-command (format nil "gpg --verify ~A ~A" signature-pathname text-pathname))

--- /p/lispy/cvsroot/lispy/TODO 2008/04/12 17:16:57 NONE +++ /p/lispy/cvsroot/lispy/TODO 2008/04/12 17:16:57 1.1

* GPGME-CL

Had to define gpgme::translate-to-foreign (value (type (eql 'gpgme::gpgme-data-t). Need to figure out why and suggest a patch.

* GPGME-CL

The GPGME source archive includes lang/cl for a Common Lisp ASDF system. It is not directly usable by Lispy since it depends on an AWK script for converting C error code files to a Common Lisp source file. It looks like it was designed for installation into /usr/share/common-lisp/source which is a Debian/Gentoo Common Lisp Controller path.

A (hopefully) short-lived fork of GPGME-CL is used by Lispy which includes the C error files but parses them at compile time (all in Lisp, not AWK) to create the necessary bindings. Need to figure out how to integrate that with GPGME upstream so that both approaches can work.

http://common-lisp.net/project/lispy/repository/distfiles/lispy-gpgme.tar.gz --- /p/lispy/cvsroot/lispy/gpgme.lisp 2008/04/12 17:16:57 NONE +++ /p/lispy/cvsroot/lispy/gpgme.lisp 2008/04/12 17:16:57 1.1

(in-package #:lispy)

;;; FIXME: Even though gpgme-data-t is an alias for :string, the ;;; specializer does not seem to dispatch on it.

(defmethod gpgme::translate-to-foreign (value (type (eql 'gpgme::gpgme-data-t))) (cond (value value) (t (cffi:null-pointer))))

(defun verify-signature (signature-pathname plain-pathname) (with-open-file (plain plain-pathname) (with-open-file (signature signature-pathname) (gpgme:with-context (ctx) (gpgme:op-verify ctx signature plain :detached t)))))