QuickLispをBasic認証に対応させてみようと思っています。
proxy authenticationに対応させるには、最初のGETを投げたときのレスポンスを見てしかるべき値をヘッダに入れてもう一度投げれば良いはずです。
解析
GETを投げている部分はこの関数。ステータスが300番台の場合はリトライして
いるので、400番台の場合を作ればよさそうと当たりをつけます。
https://github.com/quicklisp/quicklisp-bootstrap/blob/master/quicklisp.lisp
1361行目～コメントを適宜入れています。
(defun fetch (url file &key (follow-redirects t) quietly
(maximum-redirects *maximum-redirects*))
"Request URL and write the body of the response to FILE."
(setf url (merge-urls url *default-url-defaults*))
(setf file (merge-pathnames file))
(let ((redirect-count 0)
(original-url url)
(connect-url (or (url *proxy-url*) url))
(stream (if quietly
(make-broadcast-stream)
*trace-output*)))
(loop
(when (<= maximum-redirects redirect-count)
(error "Too many redirects for ~A" original-url))
(with-connection (connection (hostname connect-url) (port connect-url))
(let ((cbuf (make-instance 'cbuf :connection connection))
;; cbuf : コネクションバッファ
(request (request-buffer "GET" url)))
;; request : リクエストバッファ
;; request-buffer で proxy-url を使っています
;; ここでリクエストを投げます
(write-octets request connection)
(let ((header (read-http-header cbuf)))
;; header : レスポンスヘッダ
(loop while (= (status header) 100)
do (setf header (read-http-header cbuf)))
(cond ((= (status header) 200)
;; 200 OK
(let ((size (content-length header)))
(format stream "~&; Fetching ~A~%" url)
(if (and (numberp size)
(plusp size))
(format stream "; ~$KB~%" (/ size 1024))
(format stream "; Unknown size~%"))
(if quietly
(save-response file header cbuf)
(call-with-progress-bar (content-length header)
(lambda ()
(save-response file header cbuf))))))
;; 300番台以外はエラー
((not (<= 300 (status header) 399))
(error "Unexpected status for ~A: ~A"
url (status header))))
(if (and follow-redirects (<= 300 (status header) 399))
;; 300番台の場合は location で示された URL を読み込みし直し
(let ((new-urlstring (ascii-header-value "location" header)))
(when (not new-urlstring)
(error "Redirect code ~D received, but no Location: header"
(status header)))
(incf redirect-count)
(setf url (merge-urls new-urlstring
url))
(format stream "~&; Redirecting to ~A~%" url))
;; 200 の場合は正常に戻る
(return (values header (and file (probe-file file)))))))))))
動作の確認
proxy authentication 環境下で何も設定しないと "Unexpected status for"とか言ってデバッガに落ちるので、そこで各種値を確認していきます。
SLIMEのデバッガに落ちたら、フレームにある値を使って確認していきます。
Backtrace:
0: ((:INTERNAL QLQS-HTTP:FETCH) #<BASIC-TCP-STREAM ISO-8859-1 (SOCKET/1752) #x2100D1737D>)
1: (#<STANDARD-METHOD QLQS-NETWORK::%CALL-WITH-CONNECTION (T T T T)> #<QLQS-IMPL:CCL #x2100B71EBD> "beta.quicklisp.org" 80 #<COMPILED-LEXICAL-CLOSURE (:INTERNAL QLQS-HTTP:FETCH) #x2100D176AF>)
2: (QLQS-HTTP:FETCH #<URL "http://proxyserver...."> #P"/tmp/fetch.dat" :FOLLOW-RED..
0の行にカーソルを合わせてeを押して式を入力します。
Eval in frame (QLQS-HTTP)> (headers-alist header)
=> (("cache-control" . "no-cache") ("pragma" . "no-cache") ("www-authenticate" . "NEGOTIATE") ("www-authenticate" . "NEGOTIATE") ("www-authenticate" . "NEGOTICATE") ...)
www-authenticate と NEGOTIATE が繰り返されています。ヘッダフィールドに同名の項目があった場合、うまくパースできないようです。今回、Basic認証に対応させたいのですが、これだとProxyサーバがBasic認証に対応しているのかどうか判別がつきません。
さらに動作の確認
ヘッダフィールドに同名の項目があったときにうまくいかない原因は、header-value-indexesでフィールド名をもとにそのValueが設定されている位置を取得しているのですが、この関数が同名のフィールドが存在しないことを前提に書かれているためです。
実際のフィールド値を見るために、all-field-namesという関数を元に書いた以下の関数をデバッガ上で実行してみます。
(map 'list (lambda (start end)
(ascii-subseq (data header) start end))
(value-starts header)
(value-ends header))
=> (("no-cache" "no-cache" "NEGOTIATE" "NTLM" "BASIC realm=\"proxy\"" ...)
うまく、フィールド値が取得できました。この関数をall-field-valuesと定義し、すべてのフィールド名／フィールド値を取得する関数を作ります。
(defun all-field-values (header)
(map 'list (lambda (start end)
(ascii-subseq (data header) start end))
(value-starts header)
(value-ends header)))
(defun all-fields (header)
(mapcar #'cons (all-field-names header)
(all-field-values header)))
また、これを使って指定したフィールド名の値（複数）を取得する関数、およびBasic認証かどうかをチェックする関数を定義します。
(defun get-fields-by-name (field-name header)
(let ((fields-list (all-fields header)))
(loop for field in fields-list
if (string= (car field) field-name)
collect field)))
(defun basic-authenticate-p (header)
(let ((auth-fields (get-fields-by-name header)))
(loop for field in auth-fields
if (search "BASIC realm=" (cdr field))
return t)))
デバッガに落ちたあと、(basic-authenticate-p header)をすると、Basic認証が可能かどうかを取得できます。
まずは、Basic認証に対応しているかどうかまでチェックすることができました。
次はID/PASSWORDをBase64エンコードする関数を作ります。
とりあえずここまで。