Scheme でつくるプロキシ・サーバー
私は Winamp という mp3 プレイヤーを愛用しています。特に、ウェブ上の mp3 ファイルをストリーミングのようにイン・メモリーで再生できるのが便利で (キャッシュファイルを作りません)、ポッドキャストなどはダウンロードせず直接 URL を入力して聴くことが多いです。
ただ、この方法で聴けない場合も当然あります。認証が必要であったり、動的に URL が生成されたりするような、シェアリング/ホスティング系のサービスなどです。
それを無理やり聴けるようにしてみました。
Icy Scheme と表示されているのがそうです (括弧内は URL の最後のスラッシュ以降の部分 (ここではファイル ID) です)。
以下、このサーバーの作り方を解説していきます。
まずは、以前文字列連結の話題でご紹介した関数を再掲します:
;; Adapted from: ;; http://srfi.schemers.org/srfi-13/mail-archive/msg00073.html (define send-reply (opt-lambda ((out (current-output-port))) (lambda fragments (let loop ((fragments fragments)) (cond ((null? fragments) out) ((or (not (car fragments)) (null? (car fragments))) (loop (cdr fragments))) ((pair? (car fragments)) (loop (car fragments)) (loop (cdr fragments))) ((procedure? (car fragments)) ((car fragments) (send-reply out)) (loop (cdr fragments))) ((port? (car fragments)) ; <= NEW! (copy-port (car fragments) out) (loop (cdr fragments))) (else (display (car fragments) out) (loop (cdr fragments))))))))
mp3 データの転送に用います。
サーバーの大枠はこんな感じです:
(define (serve port) (let ((cust (make-custodian))) (parameterize ((current-custodian cust)) (define listener (tcp-listen port 5 #t)) (define (loop) (accept listener) (loop)) (thread loop)) (lambda () (custodian-shutdown-all cust)))) (define (accept listener) (let ((cust (make-custodian))) (parameterize ((current-custodian cust)) (define-values (in out) (tcp-accept listener)) (thread (lambda () (handle in out) (custodian-shutdown-all cust))))))
MzScheme の custodian という機構を使っています。これはスレッド、ポート、ソケット等のリソースを一手に管理するオブジェクトで、プログラマをリソース毎に終了処理をする面倒から開放してくれます。
serve は戻り値としてサーバ全体をシャットダウンする thunk を返しています。
中身に入っていきましょう。
(define (read-request in k) (cond ((regexp-match #rx"^([^ ]+) (.+) HTTP/([0-9]+)\\.([0-9]+)" (read-line in)) => (match-lambda ((list _ method url major minor) (k method url (string->number major) (string->number minor))))))) (define (read-headers in) (define (read) (read-line in 'any)) (let lp ((l (read)) (r '())) (cond ((or (eof-object? l) (zero? (string-length l))) r) ((regexp-match #rx"^(.+?): *(.+)$" l) => (match-lambda ((list _ k v) (lp (read) (cons (list k v) r))))) (else (lp (read) r))))) ;XXX: raise error?
クライアント (Winamp) のリクエスト・ヘッダを受け取る関数です。match-lambda という構文を使って、リスト (正規表現のマッチ結果) を分解して受け取っています。caddr とかややこしい関数を使わなくて済むので便利です。"plt-match.ss" という標準ライブラリに入っています。
read-request にて得られる url が Winamp が再生しようとしているリソースです。これが直接ダウンロード可能なものでなければ、直リンク取得の処理を行うことになります。
ここで問題が生じるんですが、その取得処理中、Winamp のタイムアウトの時間が早すぎて、認証やらリダイレクトやらキャプチャ入力やらをする間に勝手に接続が切れてしまうことがあるんですね。
そこで、接続を繋ぎ止めるための工夫が必要になります:
(define (icy-header url out) (define send (flushy-send out)) (define (line . l) (list l #\return #\newline)) (define (dummy) (let lp ((dummy (line "Dummy-Header: 1"))) (send dummy) (sleep 0.5) (lp dummy))) (let ((t #f)) (send (line "ICY 200 OK") (line "icy-name:" (regexp-match1 #rx"^.+/(.+)$" url))) (set! t (thread dummy)) (lambda () (kill-thread t) out))) (define (flushy-send out) (let ((send (send-reply out))) (lambda args (send args) (flush-output out))))
Winamp にダミーのヘッダを送り続けるわけです。
出力の度に flush-output するのがポイントです。また、"ICY 200 OK" の一行を返すだけで簡易 icecast (ストリーミング) サーバーが作れることにもご注目ください。
戻り値として Winamp への出力ポートを返す関数を返しています。ダミー・ヘッダの出力を停止するおまけ付きです。
Winamp との通信部分はこんな感じになります。
(define (handle in out) (with-handlers ((exn:fail:network? void)) (read-request in (lambda (method url major minor) (let ((hdrs (read-headers in)) (out (icy-header url out)) (url (resolve url))) ; takes time here (icy-stream url out hdrs)))))) (define (icy-stream url out hdrs) (set! url (string->url url)) (call/input-url url (getter url) (lambda (in) ((send-reply (out)) in)) (build-headers hdrs))) (define (getter url) (if (https? url) ssl:get-impure-port get-impure-port)) (define (https? url) (or (string=? (url-scheme url) "https") (equal? (url-port url) 443)))
いちおう SSL 通信にも対応できるようになっています。ssl:get-impure-port の実装についてはこちらを参照してください。
get-impure-port によって mp3 データをヘッダを残したまま流すのがポイントです。icy-header では空行を送らないようにして、icy-stream でヘッダの続きを送るんです。Content-Length ヘッダが Winamp に渡ることで duration が計算できるようになり、シークも可能になります。
ヘッダといえば、mp3 取得時に送信するリクエスト・ヘッダのことも考えなければいけません。クッキー認証が必要な場合もあったりするからです。ここで、パラメータというものを導入します。
(define current-headers (make-parameter '()))
ログインやリンクの取得を行うタイミングで
(current-headers (list "Cookie: ..."))
のようにすることで、そのリソースに必要なヘッダを一時的に (カレント・スレッド下のみで有効、ということです) 設定することができます。これを、Winamp が送ろうとするヘッダと合成して相手のサーバに送ります。
(define (build-headers hdrs) (append (map (lambda (h) (apply format "~a: ~a" h)) (filter (lambda (h) (regexp-match #rx"^(?i:accept|icy-metadata|range)$" (car h))) hdrs)) (current-headers)))
最後に肝心の部分が残りました。サイト毎のリンク取得処理を行うディスパッチ関数です。
(define-values (resolve resolver) (let ((db (hash 'equal))) (values (lambda (url) (cond ((db (url-host (string->url url))) => (cut <> url)) (else url))) db)))
ホスト名ごとに関数を定義しておいて、あればそれを呼び出す、なければ url をそのまま返す、という分岐処理をわずか3行のラムダ式で行っています。
ここで利用しているのは、Arc のハッシュ表のように、リストの第一要素に置けるハッシュ表です。
他の処理系でも可能なのか知らないんですが、MzScheme では関数として適用可能な構造体を作ることができるんですね。非常に便利なのでお勧めです。
ただ、私は便宜のためちょっとだけ定義を弄って使っています:
(define (hash . args) (define h (apply make-hash-table args)) (make-hash h (case-lambda [(key) (hash-table-get h key #f)] [(key value) (hash-table-put! h key value) value])))
hash-table-get の時にキーが存在しなければ #f を返すように、put の時は put した値を返すようにしています。
というわけで、サイト毎の処理内容は次のようにして登録していくことができます。
(resolver "a-service.com" (let ((db (hash 'equal))) (lambda (url) (current-headers (list (or (db 'cookie) (db 'cookie ;; Get "Cookie:" header (a-login "user" "pass"))))) (or (db url) (db url (a-get-direct-link url)))))) (resolver "b-service.com" (lambda (url) ...
以上により、
(serve 8081)
と、適当なポート番号を指定することでサーバーが立ち上がります。
あとは Winamp のプロキシの設定を localhost:8081 にするだけです。
