Quicklispをproxy authenticationに対応させたい - その3

quicklisp.lispはProxy Authentication(Basic認証)に対応できました。
ソースはこちらです。
https://github.com/tamurashingo/quicklisp-bootstrap/blob/ProxyAuth/quicklisp.lisp


結論から言いますと、```(quicklisp-quickstar:install)```を実行することでダウンロードされるファイルも修正が必要なので、まだ完全ではありません。こんな感じで、quicklisp.lispが行うダウンロードが終わると止まります。

```cl:
CL-USER> (quicklisp-quickstart:install :proxy "http://proxyserver/" :user "admin" :pass "password")
; Fetching #<URL "http://beta.quicklisp.org/quickstart/asdf.lisp">
; 194.07KB
==================================================
198,729 bytes in 1.32 seconds (146.58KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/quickstart/quicklisp.tar">
; 210.00KB
==================================================
215,040 bytes in 1.49 seconds (141.13KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/quickstart/setup.lisp">
; 4.96KB
==================================================
5,078 bytes in 0.00 seconds (4958.98KB/sec); Evaluation aborted on #<QL-HTTP:UNEXPECTED-HTTP-STATUS #x21015886BD>.
CL-USER> 
```

## 方針

 - Proxyの設定をしているんであれば、最初からProxy-Authorizationヘッダを送ってしまう。

当初は401や407が返ってきたらProxy-Authorizationを付与しようと考えていましたが、本当に動くかどうかを早く確かめたかったのでリクエストヘッダを生成するところに実装してしまいました。


## プロキシ接続に必要な情報の定義

まず、```*proxy-url*```が定義されているので、同じ場所に```*proxy-user*```および```*proxy-pass*```を定義します。

```cl:
(defvar *proxy-url* nil)
(defvar *proxy-user* nil)  ; 追加
(defvar *proxy-pass* nil)  ; 追加
```


## リクエストヘッダの編集

リクエストヘッダを生成しているところに、```Proxy-Authorization```を付与します。```*proxy-url*```、```*proxy-user*```、```*proxy-pass*```が定義されているときのみ付与するように制御しておきます。


```cl:
(defun make-request-buffer (host port path &key (method "GET"))
  (setf method (string method))
  (when *proxy-url*
    (setf path (full-proxy-path host port path)))
  (let ((sink (make-instance 'octet-sink)))
    (flet ((add-line (&rest strings)
             (apply #'add-strings sink strings)
             (add-newline sink)))
      (add-line method " " path " HTTP/1.1")
      (add-line "Host: " host (if (= port 80) ""
                                  (format nil ":~D" port)))

      ;; 今回の追加部分
      (when (and *proxy-url* *proxy-user* *proxy-pass*)
        (add-line "Proxy-Authorization: Basic " (make-basic-authentication *proxy-user* *proxy-pass*)))

      (add-line "Connection: close")
      ;; FIXME: get this version string from somewhere else.
      (add-line "User-Agent: quicklisp-bootstrap/2012112500")
      (add-newline sink)
      (sink-buffer sink))))
```

proxyサーバへの接続は既存のままで問題ありません。


## 起動パラメータへの追加

次に、installのkeyを追加します。keyの追加のみです。

```cl:
(defun install (&key ((:path *home*) *home*)
                     ((:proxy *proxy-url*) *proxy-url*)
                     ((:user *proxy-user*) *proxy-user*)  ; 追加
                     ((:pass *proxy-pass*) *proxy-pass*)) ; 追加
  (setf *home* (merge-pathnames *home*))
  (let ((setup-file (qmerge "setup.lisp")))
    (when (probe-file setup-file)
      (multiple-value-bind (result proceed)
          (with-simple-restart (load-setup "Load ~S" setup-file)
            (error "Quicklisp has already been installed. Load ~S instead."
                   setup-file))
        (declare (ignore result))
        (when proceed
          (return-from install (load setup-file))))))
  (if (find-package '#:ql)
      (progn
        (write-line "!!! Quicklisp has already been set up. !!!")
        (write-string *after-initial-setup-message*)
        t)
      (call-with-quiet-compilation #'initial-install)))
```


## 整合性をとる

最後に、パッケージの定義を修正して完了です。

```cl:
(defpackage #:qlqs-http
  (:use #:cl #:qlqs-network #:qlqs-progress)
  (:export #:fetch
           #:*proxy-url*
           #:*proxy-user*  ; 追加
           #:*proxy-pass*  ; 追加
           #:*maximum-redirects*
           #:*default-url-defaults*))

(defpackage #:quicklisp-quickstart
  (:use #:cl #:qlqs-impl #:qlqs-impl-util #:qlqs-http #:qlqs-minitar)
  (:export #:install
           #:help
           #:*proxy-url*
           #:*proxy-user*  ; 追加
           #:*proxy-pass*  ; 追加
           #:*asdf-url*
           #:*quicklisp-tar-url*
           #:*setup-url*
           #:*help-message*
           #:*after-load-message*
           #:*after-initial-setup-message*))
```


# 使い方

```cl:
(quicklisp-quickstart:install :proxy "http://proxyserver/" :user "admin" :pass "password")
```

このソースはquicklisp-bootstrapとしてgithubに登録されています。次はquicklisp-clientの修正ですが、似たような修正でいけるはずです。