2010年11月20日土曜日

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)))

0 件のコメント:

コメントを投稿