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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"