From: Andreas Fuchs Date: Thu, 12 Jan 2006 13:26:41 +0000 (+0000) Subject: 0.9.7.37: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d8ff33b902ee966fd772389a9f1f827a4b9576bc;p=sbcl.git 0.9.7.37: Make asdf-install use bivalent streams * Fix warnings and style-warnings when compiling a-i/installer.lisp: remove undefined variables / exported symbols *verify-gpg-signatures* and *safe-url-prefixes*, add a few ignored declarations. * Add :element-type :default to stream opening forms that need it * Allow sb-executable's copy-stream to deal with bivalent streams: Add an element-type &key argument that should be passed when copying bivalent streams --- diff --git a/contrib/asdf-install/defpackage.lisp b/contrib/asdf-install/defpackage.lisp index bc85bad..166e0e1 100644 --- a/contrib/asdf-install/defpackage.lisp +++ b/contrib/asdf-install/defpackage.lisp @@ -4,8 +4,7 @@ (:export ;; customizable variables #:*proxy* #:*cclan-mirror* #:*sbcl-home* - #:*verify-gpg-signatures* #:*locations* - #:*safe-url-prefixes* + #:*locations* ;; external entry points #:uninstall #:install)) diff --git a/contrib/asdf-install/installer.lisp b/contrib/asdf-install/installer.lisp index 3672523..e66ea19 100644 --- a/contrib/asdf-install/installer.lisp +++ b/contrib/asdf-install/installer.lisp @@ -23,19 +23,6 @@ (defparameter *trusted-uids* nil) - -(defun verify-gpg-signatures-p (url) - (labels ((prefixp (prefix string) - (let ((m (mismatch prefix string))) - (or (not m) (>= m (length prefix)))))) - (case *verify-gpg-signatures* - (nil nil) - (:unknown-locations - (notany - (lambda (x) (prefixp x url)) - (cons *cclan-mirror* *safe-url-prefixes*))) - (t t)))) - (defvar *locations* `((,(merge-pathnames "site/" *sbcl-home*) ,(merge-pathnames "site-systems/" *sbcl-home*) @@ -66,7 +53,7 @@ (define-condition gpg-error (error) ((message :initarg :message :reader gpg-error-message)) (:report (lambda (c s) - (format t "GPG failed with error status:~%~S" + (format s "GPG failed with error status:~%~S" (gpg-error-message c))))) (define-condition no-signature (gpg-error) ()) @@ -119,7 +106,8 @@ (socket-connect s (car (host-ent-addresses (get-host-by-name (url-host (or *proxy* url))))) (url-port (or *proxy* url))) - (let ((stream (socket-make-stream s :input t :output t :buffering :full :external-format :iso-8859-1))) + (let ((stream (socket-make-stream s :input t :output t :buffering :full + :element-type :default :external-format :iso-8859-1))) ;; we are exceedingly unportable about proper line-endings here. ;; Anyone wishing to run this under non-SBCL should take especial care (format stream "GET ~A HTTP/1.0~c~%~ @@ -168,19 +156,19 @@ (format t "Downloading ~A bytes from ~A ..." (if length length "some unknown number of") url) (force-output) - (with-open-file (o file-name :direction :output :external-format :iso-8859-1) + (with-open-file (o file-name :direction :output :element-type '(unsigned-byte 8)) (if length (let ((buf (make-array length :element-type - (stream-element-type stream)))) + '(unsigned-byte 8)))) (read-sequence buf stream) (write-sequence buf o)) - (sb-executable:copy-stream stream o)))) + (sb-executable:copy-stream stream o :element-type '(unsigned-byte 8))))) (close stream) (terpri) (restart-case (verify-gpg-signature/url url file-name) - (skip-gpg-check (&rest rest) + (skip-gpg-check () :report "Don't check GPG signature for this package" nil))))) @@ -197,13 +185,13 @@ (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) + (declare (ignore _)) (pushnew (cons (intern tag :keyword) data) tags))) ;; test for obvious key/sig problems @@ -228,7 +216,7 @@ (error 'author-not-trusted :key-user-name name :key-id id :gpg-err nil)) - (add-key (&rest rest) + (add-key () :report "Add to package supplier list" (pushnew (list id name) *trusted-uids*))) (return)))))) @@ -313,6 +301,7 @@ (with-open-file (f p) (read f)))))) (unwind-protect (destructuring-bind (source system name) (where) + (declare (ignore name)) (labels ((one-iter (packages) (dolist (asd (loop for p in (mapcar 'string packages) @@ -342,6 +331,7 @@ (with-simple-restart (retry "Retry installation") (asdf:operate 'asdf:load-op asd)) + (declare (ignore ret)) (unless restart-p (return)))))))) (one-iter packages))) (let ((p (merge-pathnames "trusted-uids.lisp" *dot-sbcl*))) diff --git a/contrib/sb-executable/sb-executable.lisp b/contrib/sb-executable/sb-executable.lisp index ee0d3ed..a2be573 100644 --- a/contrib/sb-executable/sb-executable.lisp +++ b/contrib/sb-executable/sb-executable.lisp @@ -7,17 +7,28 @@ (cl:in-package :sb-executable) (defvar *stream-buffer-size* 8192) -(defun copy-stream (from to) +(defun copy-stream (from to &key (element-type (stream-element-type from) element-type-passed-p)) "Copy into TO from FROM until end of the input stream, in blocks of -*stream-buffer-size*. The streams should have the same element type." - (unless (subtypep (stream-element-type to) (stream-element-type from)) - (error "Incompatible streams ~A and ~A." from to)) +*stream-buffer-size*. The streams should have the same element type. + +The argument :element-type indicates the element type of the +buffer used to copy data from FROM to TO. + +If one of the streams has an element type that is different from +what (stream-element-type stream) reports, that is, if it was +opened with :element-type :default, the argument :element-type is +required in order to select the correct stream decoding/encoding +strategy." + (unless (or element-type-passed-p + (subtypep (stream-element-type to) element-type)) + (error "Incompatible streams ~A and ~A:" from to)) (let ((buf (make-array *stream-buffer-size* - :element-type (stream-element-type from)))) + :element-type element-type))) (loop - (let ((pos (read-sequence buf from))) - (when (zerop pos) (return)) - (write-sequence buf to :end pos))))) + (let ((pos (read-sequence buf from))) + (when (zerop pos) (return)) + (write-sequence buf to :end pos))))) + (defvar *exec-header* "#!/bin/sh -- diff --git a/version.lisp-expr b/version.lisp-expr index 4015c26..8636ab2 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.8.36" +"0.9.8.37"