[asdf-install-devel] ASDF-Install patch to allow installation of unsigned packages
Gary King
gwking at metabang.com
Wed May 23 20:52:26 UTC 2007
The following patch splits download-files-for-package into download-
source-for-package and download-signature-for-package; alters install
and verify-gpg-signature so that the latter now calls download-
signature-for-package. Added a restart-case in download-signature-for-
package so that we can still install unsigned packages.'
I'd like to push this out sometime this week unless someone sees a
problem...
[misterx:~/darcs/asdf-install] gwking% darcs diff -u asdf-install/
installer.lisp
--- old-asdf-install/asdf-install/installer.lisp 2007-05-23
16:28:17.000000000 -0400
+++ new-asdf-install/asdf-install/installer.lisp 2007-05-23
16:28:17.000000000 -0400
@@ -152,63 +152,76 @@
(defun download-link-for-signature (url)
(concatenate 'string url ".asc"))
-(defun download-files-for-package (package-name-or-url)
+(defun download-source-for-package (package-name-or-url)
(multiple-value-bind (package-url package-file)
(download-url-to-temporary-file
(download-link-for-package package-name-or-url))
- (if (verify-gpg-signatures-p package-name-or-url)
- (multiple-value-bind (signature-url signature-file)
- (download-url-to-temporary-file
- (download-link-for-signature package-url))
- (declare (ignore signature-url))
- (values package-file signature-file))
- (values package-file nil))))
+ (values package-file package-url)))
-(defun verify-gpg-signature (file-name signature-name)
- (block verify
- (loop
- (restart-case
- (let ((tags (gpg-results file-name signature-name)))
- ;; test that command returned something
- (unless tags
- (error 'gpg-shell-error))
- ;; test for obvious key/sig problems
- (let ((errsig (header-value :errsig tags)))
- (and errsig (error 'key-not-found :key-id errsig)))
- (let ((badsig (header-value :badsig tags)))
- (and badsig (error 'key-not-found :key-id badsig)))
- (let* ((good (header-value :goodsig tags))
- (id (first good))
- (name (format nil "~{~A~^ ~}" (rest good))))
- ;; good signature, but perhaps not trusted
+(defun download-signature-for-package (package-url)
+ "Try to download the detached GPG signature of the package that we
found at package-url. Returns the name of the file and t if it
succeeds or nil and nil if it fails (as multiple values)"
+ (restart-case
+ (multiple-value-bind (signature-url signature-file)
+ (download-url-to-temporary-file
+ (download-link-for-signature package-url))
+ (declare (ignore signature-url))
+ (values signature-file t))
+ (install-anyways
+ (&rest rest)
+ :report "Don't check GPG signature for this package"
+ (declare (ignore rest))
+ (values nil nil))))
+
+(defun verify-gpg-signature (file-name package-url)
+ (multiple-value-bind (signature-name ok?)
+ (download-signature-for-package package-url)
+ (and ok?
+ (block verify
+ (loop
(restart-case
- (let ((trusted? (or (header-pair :trust_ultimate tags)
- (header-pair :trust_fully tags)))
- (in-list? (assoc id *trusted-uids* :test
#'equal)))
- (cond ((or trusted? in-list?)
- ;; ok
- )
- ((not trusted?)
- (error 'key-not-trusted
- :key-user-name name :key-id id))
- ((not in-list?)
- (error 'author-not-trusted
- :key-user-name name :key-id id))))
- (add-key (&rest rest)
- :report "Add to package supplier list"
+ (let ((tags (gpg-results file-name signature-name)))
+ ;; test that command returned something
+ (unless tags
+ (error 'gpg-shell-error))
+ ;; test for obvious key/sig problems
+ (let ((errsig (header-value :errsig tags)))
+ (and errsig (error 'key-not-found :key-id
errsig)))
+ (let ((badsig (header-value :badsig tags)))
+ (and badsig (error 'key-not-found :key-id
badsig)))
+ (let* ((good (header-value :goodsig tags))
+ (id (first good))
+ (name (format nil "~{~A~^ ~}" (rest good))))
+ ;; good signature, but perhaps not trusted
+ (restart-case
+ (let ((trusted? (or (header-
pair :trust_ultimate tags)
+ (header-
pair :trust_fully tags)))
+ (in-list? (assoc id *trusted-uids*
+ :test #'equal)))
+ (cond ((or trusted? in-list?)
+ ;; ok
+ )
+ ((not trusted?)
+ (error 'key-not-trusted
+ :key-user-name name :key-id
id))
+ ;; FIXME - can't get here, remove
or rework?
+ ((not in-list?)
+ (error 'author-not-trusted
+ :key-user-name name :key-id
id))))
+ (add-key (&rest rest)
+ :report "Add to package supplier list"
+ (declare (ignore rest))
+ (pushnew (list id name) *trusted-uids*))))
+ (return-from verify t))
+ (install-anyways
+ (&rest rest)
+ :report "Don't check GPG signature for this package"
(declare (ignore rest))
- (pushnew (list id name) *trusted-uids*))))
- (return-from verify t))
- (install-anyways
- (&rest rest)
- :report "Don't check GPG signature for this package"
- (declare (ignore rest))
- (return-from verify t))
- (retry-gpg-check
- (&rest args)
- :report "Retry GPG check \(e.g., after downloading the key\)"
- (declare (ignore args))
- nil)))))
+ (return-from verify t))
+ (retry-gpg-check
+ (&rest args)
+ :report "Retry GPG check \(e.g., after downloading
the key\)"
+ (declare (ignore args))
+ nil)))))))
(defun header-value (name headers)
"Searchers headers for name _without_ case sensitivity. Headers
should be an alist mapping symbols to values; name a symbol. Returns
the value if name is found or nil if it is not."
@@ -391,10 +404,10 @@
(append packages-to-install
(install-package source
system p))))
(t
- (multiple-value-bind (package signature)
- (download-files-for-package p)
+ (multiple-value-bind (package url)
+ (download-source-for-package p)
(when (verify-gpg-signatures-p p)
- (verify-gpg-signature package
signature))
+ (verify-gpg-signature package url))
(installer-msg t "Installing ~A in
~A, ~A"
p source system)
(install-package source system package))
--
Gary Warren King, metabang.com
Cell: (413) 885 9127
Fax: (206) 338-4052
gwkkwg on Skype * garethsan on AIM
More information about the asdf-install-devel
mailing list