[lispy-cvs] CVS lispy

[mkennedy]

Update of /p/lispy/cvsroot/lispy
In directory clnet:/tmp/cvs-serv12527

Modified Files:
	lispy.asd lispy.lisp utils.lisp 
Log Message:
Automatic GPG signature verification.


--- /p/lispy/cvsroot/lispy/lispy.asd	2008/02/04 14:42:42	1.6
+++ /p/lispy/cvsroot/lispy/lispy.asd	2008/04/02 05:25:39	1.7
@@ -18,7 +18,8 @@
                #:archive
                #:ironclad
                #:cl-fad
- 	       #:log5))
+ 	       #:log5
+	       #:trivial-shell))
 
 (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/02/04 15:15:08	1.13
+++ /p/lispy/cvsroot/lispy/lispy.lisp	2008/04/02 05:25:39	1.14
@@ -91,25 +91,49 @@
   "Returns the instance of MODULE described by NAME."
   (gethash name *lispy-map*))
 
-(defun read-map (map-url)
-  "Read the map at MAP-URL and merge the modules into *LISPY-MAP*."
-  (log5:log-for map "Reading ~A" (uri-to-string map-url))
-  (multiple-value-bind (stream status-code headers uri http-stream must-close)
-      (drakma:http-request map-url :want-stream t)
-    (declare (ignore status-code headers uri http-stream must-close))
-    (unwind-protect
-         (dolist (module (mapcar #'(lambda (m)
-                                     (parse-module m map-url))
-                                 (read-stream stream)))
-           (setf (gethash (name module) *lispy-map*)
-                 module))
-      (close stream))))
+(defun read-map (map-url map-pathname)
+  "Read the map at MAP-PATHNAME and merge the modules into *LISPY-MAP*."
+  (log5:log-for map "Reading ~A" map-pathname)
+  (with-open-file (stream map-pathname :direction :input)
+    (dolist (module (mapcar #'(lambda (m)
+				(parse-module m map-url))
+			    (read-stream stream)))
+      (setf (gethash (name module) *lispy-map*)
+	    module))))
+
+(defun download-map (map-url)
+  (log5:log-for map "Fetching ~A" (uri-to-string map-url))
+  (let* ((map-name (car (last (puri:uri-parsed-path map-url))))
+	 (map-pathname (merge-pathnames map-name
+					(merge-pathnames #p"maps/" *lispy-pathname*))))
+    (download-file map-url map-pathname)
+    map-pathname))
+
+(defun download-map-signature (map-url)
+  (let* ((map-signature-name (format nil "~A.asc" (car (last (puri:uri-parsed-path map-url)))))
+	 (map-signature-url (puri:merge-uris (puri:parse-uri map-signature-name) map-url))
+	 (map-signature-pathname (merge-pathnames map-signature-name
+						  (merge-pathnames #p"maps/" *lispy-pathname*))))
+    (log5:log-for map "Fetching ~A" (uri-to-string map-signature-url))
+    (download-file map-signature-url map-signature-pathname)
+    map-signature-pathname))
 
 (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)
-    (read-map map-url))
+    (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)))
+      (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/02/04 15:15:08	1.6
+++ /p/lispy/cvsroot/lispy/utils.lisp	2008/04/02 05:25:39	1.7
@@ -53,3 +53,23 @@
 (defun read-stream (stream &rest args)
   (let ((*read-eval* nil))
     (apply #'read stream args)))
+
+(defun download-file (url destination-pathname)
+  (ensure-directories-exist destination-pathname)
+  (multiple-value-bind (stream status-code headers uri http-stream must-close)
+      (drakma:http-request url :want-stream t)
+    (declare (ignore status-code headers uri http-stream must-close))
+    (unwind-protect
+	 (with-open-file (output-stream destination-pathname
+					:direction :output
+					:element-type '(unsigned-byte 8)
+					:if-exists :supersede)
+	   (copy-stream stream output-stream))
+      (close stream))))
+
+(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)))