[lispy-cvs] CVS lispy

[mkennedy]

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)))))