From d4e910b9a2851d52117c4c7fd9f847e5b54414a0 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sun, 21 Sep 2003 00:52:00 +0000 Subject: [PATCH] 0.8.3.82 asdf-install gets a good deal smarter about GPG signatures: it's now usable for installing CLiki package even from non-CCLAN places NEWS file updates for GC changes Minor changes to 'Beyond ANSI' chapter in manual --- NEWS | 8 ++ contrib/asdf-install/installer.lisp | 139 ++++++++++++++++++++++++----------- doc/beyond-ansi.sgml | 6 +- 3 files changed, 110 insertions(+), 43 deletions(-) diff --git a/NEWS b/NEWS index 30e4b50..6032c17 100644 --- a/NEWS +++ b/NEWS @@ -2060,6 +2060,14 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: is improved. * bug fix: FILE-POSITION works much better on string input and output streams. (thanks to Nikodemus Siivola) + * bug fix: many threading/garbage collection symptoms sorted. + SB-THREAD:INTERRUPT-THREAD now safe to call on a thread that might + be pseudo-atomic + * internal change: Stopping for GC is now done with signals not ptrace. + GC is now done in whichever thread wanted it, instead of in the parent. + This permits a + * bug fix: GC hooks (missing since 0.8) reinstated, so finalizers + work again. * bug fix: result form in DO is not contained in the implicit TAGBODY. * incompatible change: ICR structure is changed; the value part of diff --git a/contrib/asdf-install/installer.lisp b/contrib/asdf-install/installer.lisp index 7be959d..639fcdc 100644 --- a/contrib/asdf-install/installer.lisp +++ b/contrib/asdf-install/installer.lisp @@ -4,7 +4,7 @@ (defvar *cclan-mirror* (or (posix-getenv "CCLAN_MIRROR") "http://ftp.linux.org.uk/pub/lisp/cclan/")) - + (defun directorify (name) ;; input name may or may not have a training #\/, but we know we ;; want a directory @@ -21,13 +21,8 @@ (merge-pathnames (make-pathname :directory '(:relative ".sbcl")) (user-homedir-pathname))) -(defvar *verify-gpg-signatures* :unknown-locations - "Should we get detached GPG signatures for the packages and verify them? -NIL - no, T - yes, :UNKNOWN-LOCATIONS - for any URL which isn't in CCLAN -and doesn't begin with one of the prefixes in *SAFE-URL-PREFIXES*") -(defvar *safe-url-prefixes* - (list "http://ftp.linux.org.uk/pub/lisp/" - "http://files.b9.com/")) +(defparameter *trusted-uids* nil) + (defun verify-gpg-signatures-p (url) (labels ((prefixp (prefix string) @@ -67,7 +62,33 @@ and doesn't begin with one of the prefixes in *SAFE-URL-PREFIXES*") (:report (lambda (c s) (format s "Cannot verify package signature: ~A" (signature-error-cause c))))) - + +(define-condition gpg-error (error) + ((message :initarg :message :reader gpg-error-message)) + (:report (lambda (c s) + (format t "GPG failed with error status:~%~S" + (gpg-error-message c))))) + +(define-condition no-signature (gpg-error) ()) +(define-condition key-not-found (gpg-error) + ((key-id :initarg :key-id :reader key-id)) + (:report (lambda (c s) + (format s "No key found for key id 0x~A. Try some command like ~% gpg --recv-keys 0x~A" + (key-id c) (key-id c))))) + +(define-condition key-not-trusted (gpg-error) + ((key-id :initarg :key-id :reader key-id) + (key-user-name :initarg :key-user-name :reader key-user-name)) + (:report (lambda (c s) + (format s "GPG warns that the key id 0x~A (~A) is not fully trusted" + (key-id c) (key-user-name c))))) +(define-condition author-not-trusted (gpg-error) + ((key-id :initarg :key-id :reader key-id) + (key-user-name :initarg :key-user-name :reader key-user-name)) + (:report (lambda (c s) + (format s "~A (key id ~A) is not on your package supplier list" + (key-user-name c) (key-id c))))) + (defun url-host (url) (assert (string-equal url "http://" :end1 7)) (let* ((port-start (position #\: url :start 7)) @@ -139,47 +160,75 @@ and doesn't begin with one of the prefixes in *SAFE-URL-PREFIXES*") (sb-executable:copy-stream stream o)))) (close stream) (terpri) - ;; seems to have worked. let's try for a detached gpg signature too - (when (verify-gpg-signatures-p url) - (verify-gpg-signature url file-name))))) + (restart-case + (verify-gpg-signature/url url file-name) + (skip-gpg-check (&rest rest) + :report "Don't ckeck GPG signature for this package" + nil))))) -(defun verify-gpg-signature (url file-name) +(defun read-until-eof (stream) + (with-output-to-string (o) + (sb-executable:copy-stream stream o))) + +(defun verify-gpg-signature/string (string file-name) + (let* ((proc + (sb-ext:run-program + "gpg" + (list + "--status-fd" "1" "--verify" "-" + (namestring file-name)) + :output :stream :error :stream :search t + :input (make-string-input-stream string) :wait t)) + (ret (process-exit-code proc)) + (err (read-until-eof (process-error proc))) + tags) + (loop for l = (read-line (process-output proc) nil nil) + while l + when (> (mismatch l "[GNUPG:]") 6) + do (destructuring-bind (_ tag &rest data) (asdf::split l) + (pushnew (cons (intern tag :keyword) + data) tags))) + ;; test for obvious key/sig problems + (let ((errsig (assoc :errsig tags))) + (and errsig (error 'key-not-found :key-id (second errsig) :gpg-err err))) + (let ((badsig (assoc :badsig tags))) + (and badsig (error 'key-not-found :key-id (second badsig) :gpg-err err))) + (let* ((good (assoc :goodsig tags)) + (id (second good)) + (name (format nil "~{~A~^ ~}" (nthcdr 2 good)))) + ;; good signature, but perhaps not trusted + (unless (or (assoc :trust_ultimate tags) + (assoc :trust_fully tags)) + (cerror "Install the package anyway" + 'key-not-trusted + :key-user-name name + :key-id id :gpg-err err)) + (loop + (when + (restart-case + (or (assoc id *trusted-uids* :test #'equal) + (error 'author-not-trusted + :key-user-name name + :key-id id :gpg-err nil)) + (add-key (&rest rest) + :report "Add to package supplier list" + (pushnew (list id name) *trusted-uids*))) + (return)))))) + + +(defun verify-gpg-signature/url (url file-name) (destructuring-bind (response headers stream) (url-connection (concatenate 'string url ".asc")) (unwind-protect (if (= response 200) - ;; sadly, we can't pass the stream directly to run-program, - ;; because (at least in sbcl 0.8) that ignores existing buffered - ;; data and only reads new fresh data direct from the file - ;; descriptor (let ((data (make-string (parse-integer (cdr (assoc :content-length headers)) :junk-allowed t)))) (read-sequence data stream) - (let ((ret - (process-exit-code - (sb-ext:run-program "gpg" - (list "--verify" "-" - (namestring file-name)) - :output t - :search t - :input (make-string-input-stream data) - :wait t)))) - (unless (zerop ret) - (error 'signature-error - :cause (make-condition - 'simple-error - :format-control "GPG returned exit status ~A" - :format-arguments (list ret)))))) - (error 'signature-error - :cause - (make-condition - 'download-error :url (concatenate 'string url ".asc") - :response response))) + (verify-gpg-signature/string data file-name)) + (error 'download-error :url (concatenate 'string url ".asc") + :response response)) (close stream)))) - - - (defun where () (format t "Install where?~%") @@ -237,7 +286,11 @@ and doesn't begin with one of the prefixes in *SAFE-URL-PREFIXES*") ;; this is the external entry point (defun install (&rest packages) - (let ((*temporary-files* nil)) + (let ((*temporary-files* nil) + (*trusted-uids* + (let ((p (merge-pathnames "trusted-uids.lisp" *dot-sbcl*))) + (when (probe-file p) + (with-open-file (f p) (read f)))))) (unwind-protect (destructuring-bind (source system name) (where) (labels ((one-iter (packages) @@ -271,5 +324,9 @@ and doesn't begin with one of the prefixes in *SAFE-URL-PREFIXES*") (asdf:operate 'asdf:load-op asd)) (unless restart-p (return)))))))) (one-iter packages))) + (let ((p (merge-pathnames "trusted-uids.lisp" *dot-sbcl*))) + (with-open-file (out p :direction :output) + (with-standard-io-syntax + (prin1 *trusted-uids* out)))) (dolist (l *temporary-files*) (when (probe-file l) (delete-file l)))))) diff --git a/doc/beyond-ansi.sgml b/doc/beyond-ansi.sgml index 9138489..afc3962 100644 --- a/doc/beyond-ansi.sgml +++ b/doc/beyond-ansi.sgml @@ -114,12 +114,14 @@ calling external C code, described &SBCL; provides additional garbage collection functionality not specified by &ANSI;. Weak pointers allow references to objects to be maintained without keeping them from being GCed. And "finalization" -hooks are available to cause code to be executed when an object is +hooks are available to cause code to be executed when an object has been GCed. &SBCL; supports Gray streams, user-overloadable CLOS classes whose instances can be used as Lisp streams (e.g. passed as the -first argument to format). +first argument to format). Additionally, the +bundled contrib module sb-simple-streams +implements a subset of the Franz Allegro simple-streams proposal. &SBCL; supports a MetaObject Protocol which is intended to be compatible with &AMOP;; present exceptions to this (as distinct from -- 1.7.10.4