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