Gaucheの仮想ポートの使用例

gauche.vportで提供される仮想ポートを使うと、ポートのように振る舞うオブジェクト(=ポート)を自分でカスタマイズして作ることができる。仮想ポートの使用例として、HTTPのレスポンスで送られてくるメッセージ本体を仮想ポートを使って読み込んでみる。

HTTPレスポンスの転送長さの表現法

HTTPレスポンスのメッセージ本体の長さの表し方は複数ある(RFC 2616 section 4.4)。

ステータスコードが1xx、204、304。リクエストメソッドがHEAD: 本体なし。
Transfer-Encodingヘッダを持ち、値がchunked: チャンク形式によって長さを伝えながら本体が送られる。
Content-Lengthヘッダを持っている: Content-Lengthの値が本体の長さを表す。
Content-Typeヘッダを持ち、値がmultipart/byteranges(かつ転送長さを示す他のヘッダが無い): 省略。
長さを指定するものがない: 送信側が接続を閉じることで本体の終端を示す。

このため、HTTP通信のメッセージ本体を読み込む場合、単純にEOFに達するまでソケットポートを読むというわけにはいかない。そこで、メッセージ本体の読み込みに仮想ポートを利用してみる。

チャンク形式に対する入力ポート

とりあえずチャンク形式を扱ってみる。

チャンク形式(chunked transfer coding)では

後続するデータのバイト数を16進数で表した行(行末はCRLF)
指定したバイト数の本体データ
空行(=CRLF)

を繰り返してデータを送信する。後続バイト数の値を0にすることでデータの終了が示される。その行の後にヘッダ行が0行以上続いて(たいていは0行?)、空行(CRLF)がきて全体の終わりになる(RFC 2616 section 3.6.1)。
このようなチャンク形式で符号化されたデータを直接読む代わりに、本体データだけを吐き出してデータの終端までいくとEOFを返すような仮想ポートを作る。仮想入力ポートにはvirtual-input-portとbuffered-input-portがあるけど、ここではbuffered-input-portを使う。buffered-input-portではポートからデータを読むとき内部バッファからデータの読み込みをおこなう。そして「内部バッファが空になったときにどうバッファにデータを詰めるか」の部分をカスタマイズする。
u8vectorのバッファを引数として受け取りそのバッファにデータを詰めてバッファに詰めたデータのバイト数を返す関数をキーワード引数fillで渡してbuffered-input-portオブジェクトを生成する。

(make <buffered-input-port>
      :fill 
      (lambda (buf)
        ; bufにデータを詰める(bufの最後までデータを埋めなくてもかまわない)。
        ; 詰めたデータのバイト数を返す。
        ; ポートの終端を示す場合、0またはeof-objectを返す。
      ))

buffered-input-portを使ってチャンク形式用のポートを作ると例えば次のように書ける。

(use gauche.vport)
(use gauche.parameter)
(use gauche.uvector)
(use rfc.822)

(define (input-port-for-http-chunked-body iport)
  (define param-rest-len (make-parameter 'start))
  (define (read-chunk-size iport)
    (let1 line (read-line iport)
      (when (eof-object? line)
        (error "chunked body bad format" line))
      (cond
        ((#/^([[:xdigit:]]+)/ line)
         => (lambda (rxm) (string->number (rxm 1) 16)))
        (error "chunked body bad format" line))))

  (make <buffered-input-port>
        :fill
        (lambda (u8vec)
          (if (eof-object? (param-rest-len))
            (eof-object)
            (begin
              (cond
                ((eq? (param-rest-len) 'start)
                 (param-rest-len (read-chunk-size iport)))
                ((= (param-rest-len) 0)
                 (read-line iport) ; skip CRLF
                 (param-rest-len (read-chunk-size iport)))
                (else 'nop))
              (if (= (param-rest-len) 0)
                (begin
                  (rfc822-read-headers iport) ; read trailer CRLF
                  (param-rest-len (eof-object)))
                (read-body! u8vec iport param-rest-len)))))))

(define (read-body! u8vec iport  param-rest-len)
  (let* ((len (min (u8vector-length u8vec)
                   (param-rest-len)))
         (read-len (read-block! u8vec iport 0 len)))
    (param-rest-len (- (param-rest-len) read-len))
    read-len))

読み込む長さがあらかじめ決まっている場合についても同様に書ける。

(define (input-port-for-limited-length iport len)
  (define param-rest-len (make-parameter len))
  (make <buffered-input-port>
        :fill
        (lambda (u8vec)
          (if (= (param-rest-len) 0)
            (eof-object)
            (read-body! u8vec iport param-rest-len)))))

ステータスコードとヘッダを見て生成するポートを選択するようにしてみる。

(define (input-port-for-http-body iport status headers . opts)
  (define method (get-optional opts 'GET))
  (define (no-body-status? status)
    (or (#/^1..$/ status) (#/^204$/ status) (#/^304$/ status)))
  (define (chunked-body? headers)
    (and-let* ((pair (assoc "transfer-encoding" headers)))
      (#/chunked/ (cadr pair))))
  (define (get-content-length headers)
    (and-let* ((pair (assoc "content-length" headers)))
      (string->number (cadr pair))))

  (cond
    ((or (equal? method 'HEAD)
         (no-body-status? status))
     (input-port-for-limited-length iport 0))
    ((chunked-body? headers)
     (input-port-for-http-chunked-body iport))
    ((get-content-length headers)
     => (lambda (len) (input-port-for-limited-length iport len)))
    (else iport)))

使用例

テスト用のサーバ

メッセージの本体をいろいろな形式で送ってくるサーバをRubyのWEBrickライブラリで書いてみる。ただし前に書いたように WEBrickではメッセージ本体の終わりを通信の切断で示すやり方は使えないみたいなので、このサーバでは扱っていない(訂正: 切断で示すやり方も使えた)。

「http://localhost:12345/chunked/ファイル名」ならチャンク形式で、「http://localhost:12345/content-length/ファイル名」ならContent-Lengthヘッダを使ったやり方で応答を返してくる。

「http://localhost:12345/closing/ファイル名」の場合は、切断でメッセージの終了を示す。

test-server.rb

require 'webrick'

server = WEBrick::HTTPServer.new({:BindAddress => '127.0.0.1', :Port => 12345})

server.mount_proc('/chunked') do |req, res|
  file = File.open( File.join(Dir.pwd, req.path_info))
  res.chunked = true
  res.body = file
end

server.mount('/content-length', WEBrick::HTTPServlet::FileHandler, Dir.pwd)

server.mount_proc('/closing') do |req, res|
  file = File.open( File.join(Dir.pwd, req.path_info))
  res.chunked = false
  res.keep_alive = false
  res.body = file
end

# 特殊なステータスを返す場合の例
server.mount_proc('/no-content') do |req, res|
  res.status = 204
end

server.mount_proc('/found') do |req, res|
  res.status = 302
  res["location"]= File.join('/content-length', req.path_info)
end

server.mount_proc('/see-other') do |req, res|
  res.status = 303
  res["location"]= File.join('/content-length', req.path_info)
end


trap(:INT){server.shutdown}
server.start

このサーバと通信するプログラムの例。

(use gauche.net)

(define (make-client-socket-for-http server)
  (cond
    ((#/([^:]+):(\d+)/ server)
     => (lambda (rxm) (make-client-socket 'inet (rxm 1) (string->number (rxm 2)))))
    (else (make-client-socket 'inet server 80))))

(define (simple-request oport server request)
  (format oport "GET ~a HTTP/1.1\r\n" request)
  (format oport "Host: ~a\r\n" server)
  (format oport "User-Agent: SimpleRequestAgent/0.0.1\r\n")
  (format oport "\r\n"))

(define (read-http-status-line iport)
  (let1 line (read-line iport)
    (cond
      ((eof-object? line) (error "response no data"))
      ((#/\w+\s+(\d\d\d)\s/ line) => (lambda (rxm) (rxm 1)))
      (else (error "http status line bad format" line)))))

;;; ここからHTTP通信のやりとりの例
(let ((server "localhost:12345")
      (request "/chunked/test-server.rb"))
  (call-with-client-socket (make-client-socket-for-http server)
    (lambda (iport oport)
      (simple-request oport server request)
      (let* ((status (read-http-status-line iport))
             (headers (rfc822-read-headers iport))
             (http-iport (input-port-for-http-body iport status headers)))
        (copy-port http-iport (current-output-port))))))