[lispy-cvs] CVS lispy

[mkennedy]

Update of /project/lispy/cvsroot/lispy
In directory cl-net:/tmp/cvs-serv30943

Modified Files:
	utils.lisp specials.lisp packages.lisp logging.lisp lispy.lisp 
	lispy.asd 
Added Files:
	verify.lisp 
Log Message:
Add support for three feature flags:

   :lispy-insecure  - Bypass map signature verification completely
   :lispy-gpg       - Use command line GnuPG tools (default)
   :lispy-pgpme     - CFFI interface to GPGME (currently broken with latest CFFI)


--- /project/lispy/cvsroot/lispy/utils.lisp	2008/04/12 17:16:57	1.8
+++ /project/lispy/cvsroot/lispy/utils.lisp	2009/08/16 17:33:00	1.9
@@ -66,11 +66,3 @@
 					:if-exists :supersede)
 	   (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))
-    (declare (ignore output))
-    (values (zerop status)
-	    error)))
--- /project/lispy/cvsroot/lispy/specials.lisp	2008/01/27 19:54:07	1.6
+++ /project/lispy/cvsroot/lispy/specials.lisp	2009/08/16 17:33:00	1.7
@@ -24,3 +24,5 @@
 (defvar *lispy-log-stream* t
   "A stream Lispy should use to write log messages.")
 
+(defvar *lispy-offline* nil
+  "If non-nil then online operations such as map and library downloads are skipped.")
\ No newline at end of file
--- /project/lispy/cvsroot/lispy/packages.lisp	2009/03/07 07:38:21	1.7
+++ /project/lispy/cvsroot/lispy/packages.lisp	2009/08/16 17:33:00	1.8
@@ -7,6 +7,7 @@
            #:*lispy-asdf-config-pathname*
            #:*lispy-distfiles-pathname*
            #:*lispy-log-stream*
+	   #:*lisp-offline*
            #:+lispy-default-map-url+
            #:initialize
            #:install
--- /project/lispy/cvsroot/lispy/logging.lisp	2008/02/04 15:15:08	1.2
+++ /project/lispy/cvsroot/lispy/logging.lisp	2009/08/16 17:33:00	1.3
@@ -9,15 +9,18 @@
 (log5:defcategory installation)
 (log5:defcategory asdf)
 (log5:defcategory fetch)
+(log5:defcategory verify)
 
-(log5:defcategory all-categories (install uninstall upgrade extract map installation asdf fetch))
+(log5:defcategory all-categories (install uninstall upgrade extract map installation asdf fetch verify))
 
 (log5:defoutput newline (format nil "~%"))
 
+;; 2009-08-06 01:13:00
+
 (log5:defoutput time-hms
     (multiple-value-bind (second minute hour day month year)
-	(decode-universal-time (get-universal-time))
-      (format nil "~D:~2,'0D:~2,'0D" hour minute second)))
+	 (decode-universal-time (get-universal-time))
+       (format nil "~D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day hour minute second)))
 
 (log5:start-sender 'debug
 	      (log5:stream-sender :location *error-output*)
--- /project/lispy/cvsroot/lispy/lispy.lisp	2009/03/07 07:38:21	1.16
+++ /project/lispy/cvsroot/lispy/lispy.lisp	2009/08/16 17:33:00	1.17
@@ -118,17 +118,6 @@
     (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*."
--- /project/lispy/cvsroot/lispy/lispy.asd	2009/03/07 07:37:32	1.10
+++ /project/lispy/cvsroot/lispy/lispy.asd	2009/08/16 17:33:00	1.11
@@ -5,6 +5,16 @@
 
 (in-package #:lispy-system)
 
+;; *features* documentation:
+;; 
+;;   lispy-gnupg     - signature verification via GnuPG command-line tools (default)
+;;   lispy-gpgme     - signature verification via GPGME CFFI interface
+;;   lispy-insecure  - ignore signatures entirely
+
+#-(or lispy-gnupg lispy-gpgme lispy-insecure)
+(pushnew :lispy-gnupg *features*)
+  
+
 (defsystem #:lispy
   :description "Common Lisp library management in Common Lisp"
   :author "Matthew Kennedy"
@@ -13,7 +23,7 @@
 	       (:file "logging")
                (:file "utils")
                (:file "specials")
-	       (:file "gpgme")
+	       (:file "verify")
                (:file "lispy"))
   :serial t
   :depends-on (#:drakma
@@ -23,7 +33,8 @@
                #:ironclad
                #:cl-fad
  	       #:log5
-	       #:gpgme
+	       #+lispy-gpgme #:gpgme
+	       #+lispy-gnupg #:trivial-shell
 	       #:cffi
                #:cl-ppcre))
 

--- /project/lispy/cvsroot/lispy/verify.lisp	2009/08/16 17:33:00	NONE
+++ /project/lispy/cvsroot/lispy/verify.lisp	2009/08/16 17:33:00	1.1

(in-package #:lispy)

#+(and lispy-gnupg (not sbcl))
(defun verify-signature (signature-pathname plain-pathname)
  (multiple-value-bind (output error status)
      (trivial-shell:shell-command (format nil "gpg --verify ~A ~A" signature-pathname plain-pathname))
    (declare (ignore output))
    (values (zerop status)
	    error)))

#+(and lispy-gnupg sbcl)
(defun verify-signature (signature-pathname plain-pathname)
  (let ((process (sb-ext:run-program "gpg" `("--verify" ,(namestring signature-pathname) ,(namestring plain-pathname))
				     :wait t
				     :error :stream
				     :search t)))

    (unwind-protect
	 (let ((status (zerop (sb-ext:process-exit-code process)))
	       (error-text (with-output-to-string (output)
			     (with-open-stream (stream (sb-ext:process-error process))
			       (do ((line (read-line stream nil nil) (read-line stream nil nil)))
				   ((null line))
				 (write-line line output))))))
	   (write-string error-text *standard-output*)
	   (values status error-text))
      (sb-ext:process-close process))))

#+lispy-gnupg
(defun verify-map (map-signature map map-signature-url)
  (multiple-value-bind (success error)
      (verify-signature map-signature map)
    (if success
	(log5:log-for verify "GPG validation success ~A" (uri-to-string map-signature-url))
	(error "GPG verification of map ~A with signature ~A failed: ~S"
	       map
	       map-signature
	       error)))
  (values))

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

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

#+lispy-gpgme
(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)))))

#+lispy-gpgme
(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 verify "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))

#+(or lispy-insecure (not (or lispy-gnupg lispy-gpgme)))
(defun verify-map (map-signature map map-signature-url)
  (log5:log-for verify "WARNING: GPG verification of map ~A with signature ~A has will be bypassed." map map-signature)
  (values))