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