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