redefine asdf-install and cl+ssl for 'asdf-install:install' via https

redefine-asdf-install.lisp

(in-package :asdf-install)
(defun make-ssl-stream (sock-stream)
  (let ((pkg (find-package 'CL+SSL)))
    (when pkg
      (funcall (find-symbol "MAKE-SSL-CLIENT-STREAM" pkg)
               sock-stream))))

(defun ssl-library-loaded? ()
  (find-package 'CL+SSL))

(defun make-stream-from-url (url)
  (let ((sock-stream
         #+(or :sbcl :ecl)
         (let ((s (make-instance 'sb-bsd-sockets:inet-socket
                                 :type :stream
                                 :protocol :tcp)))
           (sb-bsd-sockets:socket-connect
            s (car (sb-bsd-sockets:host-ent-addresses
                    (sb-bsd-sockets:get-host-by-name (url-host url))))
            (url-port url))
           (sb-bsd-sockets:socket-make-stream 
            s
            :input t 
            :output t
            :buffering :full
            :external-format :iso-8859-1))
         #+:cmu
         (sys:make-fd-stream (ext:connect-to-inet-socket (url-host url) (url-port url))
                             :input t :output t :buffering :full)
         #+:scl
         (sys:make-fd-stream (ext:connect-to-inet-socket (url-host url) (url-port url))
                             :input t :output t :buffering :full
                             :external-format :iso-8859-1)
         #+:lispworks
         (comm:open-tcp-stream (url-host url) (url-port url)
                               #+(and :lispworks :win32) :element-type
                               #+(and :lispworks :win32) '(unsigned-byte 8))
         #+:allegro
         (socket:make-socket :remote-host (url-host url)
                             :remote-port (url-port url))
         #+:clisp
         (socket:socket-connect (url-port url) (url-host url)
                                :external-format
                                (ext:make-encoding :charset 'charset:iso-8859-1 :line-terminator :unix))
         #+:openmcl
         (ccl:make-socket :remote-host (url-host url)
                          :remote-port (url-port url))
         #+:digitool
         (ccl::open-tcp-stream (url-host url) (url-port url)
                               :element-type 'unsigned-byte)))
    (if *proxy*
        sock-stream
        (if (and (url-host-https? url)
                 (ssl-library-loaded?))
            (make-ssl-stream sock-stream)
            sock-stream))))

(defun url-host-https? (url)
  (and (>= (length url) 8)
       (string-equal url "https://" :end1 8)))

(defun url-host (url)
  (assert (or (string-equal url "http://" :end1 7)
              (url-host-https? url)))
  (let* ((protocol-end (if (url-host-https? url) 8 7))
         (port-start (position #\: url :start protocol-end))
         (host-end (min (or (position #\/ url :start protocol-end) (length url))
                        (or port-start (length url)))))
    (subseq url protocol-end host-end)))

(defun url-port (url)
  (assert (or (string-equal url "http://" :end1 7)
              (url-host-https? url)))
  (let* ((protocol-end (if (url-host-https? url) 8 7))
         (port-start (position #\: url :start protocol-end))
         (default-port (if (url-host-https? url) 443 80)))
    (if port-start 
        (parse-integer url :start (1+ port-start) :junk-allowed t) default-port)))

(defun request-uri (url)
  (assert (or (string-equal url "http://" :end1 7)
              (url-host-https? url)))
  (if *proxy*
      url
      (let* ((protocol-end (if (url-host-https? url) 8 7))
             (path-start (position #\/ url :start protocol-end)))
        (assert (and path-start) nil "url does not specify a file.")
        (subseq url path-start))))

(defun open-file-arguments ()
  (append 
   #+sbcl
   '(:external-format :latin1)
   #+:scl
   '(:external-format :iso-8859-1)
   #+(or :clisp :digitool (and :lispworks :win32))
   '(:element-type (unsigned-byte 8))
   #+(or :openmcl)
   '(:element-type (unsigned-byte 8))))

(defun download-link-for-package (package-name-or-url)
  (if (or (= (mismatch package-name-or-url "http://") 7)
	  (= (mismatch package-name-or-url "https://") 8))
    package-name-or-url
    (format nil "http://www.cliki.net/~A?download"
            package-name-or-url)))

(defun looks-like-url-p (string)
  (or (= (mismatch string "http://") 7)
      (= (mismatch string "https://") 8)))

(in-package :cl+ssl)
(defmethod stream-write-sequence ((stream ssl-stream)
				  (thing string)
				  start end
				  &key)
  (let ((arr (make-array (length thing) :element-type '(unsigned-byte 8))))
    (loop :for c across thing
       :for i from 0
       :do (setf (aref arr i) (char-code c)))
    (stream-write-sequence stream arr start end)))

(defmethod stream-write-byte ((stream ssl-stream) (ch character))
  (stream-write-byte stream (char-code ch)))

(defmethod stream-write-char ((stream ssl-stream) (ch character))
  (stream-write-byte stream (char-code ch)))

(defmethod stream-line-column ((stream ssl-stream))
  nil)

(defmethod stream-read-line ((stream ssl-stream))
  (coerce
   (butlast 
    (loop
       :for old = nil then ch
       :for ch = (code-char (read-byte stream))
       :until (and (eq old #\Return)
		   (eq ch #\Linefeed))
       :collect ch))
   'string))