From mkennedy at common-lisp.net Sun Aug 16 17:33:00 2009 From: mkennedy at common-lisp.net (mkennedy) Date: Sun, 16 Aug 2009 13:33:00 -0400 Subject: [lispy-cvs] CVS lispy Message-ID: 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)) From mkennedy at common-lisp.net Sun Aug 16 17:34:09 2009 From: mkennedy at common-lisp.net (mkennedy) Date: Sun, 16 Aug 2009 13:34:09 -0400 Subject: [lispy-cvs] CVS lispy Message-ID: Update of /project/lispy/cvsroot/lispy In directory cl-net:/tmp/cvs-serv31163 Removed Files: gpgme.lisp Log Message: Merged into verify.lisp