ASDF-INSTALLでhttpsからのインストールを行う

asdf-installはURLを指定するとそこからパッケージをダウンロードしてインストールしてくれますが、httpsには対応していません(たぶん)

GitHubがいつの間にかhttpsのみのサポートに切り替わっていたので、 URLを指定してプロジェクトをインストールすることができなくなりました。

とりあえず、CL+SSLを利用してhttpsでも動かせるようなコードを書いてみました。

パッケージ名が文字列かつ"https://"から始まっている場合の動きを若干追加しています。

(asdf:oos 'asdf:load-op :cl+ssl)

(in-package :asdf-install)

(setf (symbol-function 'make-stream-from-url-old)
      #'make-stream-from-url)
(setf (symbol-function 'url-host-old)
      #'url-host)
(setf (symbol-function 'url-port-old)
      #'url-port)
(setf (symbol-function 'request-uri-old)
      #'request-uri)

(defun make-stream-from-url (connect-to-url)
  (let ((sock (make-stream-from-url-old connect-to-url)))
    (if *proxy*
	sock
	(cl+ssl:make-ssl-client-stream sock))))

(defun url-host (url)
  (if (string= url "https://" :end1 8)
      (let* ((port-start (position #\: url :start 8))
	     (host-end (min (or (position #\/ url :start 8) (length url))
			    (or port-start (length url)))))
	(subseq url 8 host-end))
      (url-host-old url)))

(defun url-port (url)
  (if (string= url "https://" :end1 8)
      (let ((port-start (position #\: url :start 8)))
	(if port-start
	    (parse-integer url :start (1+ port-start) :junk-allowed t)
	    443))
      (url-port-old url)))

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