〜Gauche on Railsへの道〜 3. ActiveController 風のものを作る。その1 〜

Gauche

ActiveRecord はめどが付いたので、次は ActiveController ですが、まずはWEBRick のような小型のhttpサーバーを作る事にします。

小型httpサーバー

やはり、Gauche(Scheme)を使うのだからコントローラーは継続を使えるようにした。そこで独自の簡単なhttpサーバーを作る事にします。サーバーのコードとしては、近日発売の「プログラミングGauche」*1の26章にあった http サーバーを改造する事にしました。

追加したのは：

  1. POSTメソッドへの対応
  2. アプリ処理部分をモジュールにし変更をサーバーのリスタート無しに反映できるようにする
#!/usr/bin/env gosh
;;;
;;;  小型httpサーバー
;;;
(use gauche.reload)
(use gauche.net) 
(use util.match) 
(use rfc.822) 
(use rfc.uri) 
(use www.cgi) 

(define (run-server) 
  (add-load-path ".")
  (let1 server-sock (make-server-socket 'inet 8080 :reuse-addr? #t) 
    (guard (e (else (socket-close server-sock) (raise e))) 
      (let loop ((client (socket-accept server-sock))) 
        (guard (e (else (socket-close client) (raise e))) 
	       (handle-request (get-request (socket-input-port client)) 
			       (socket-output-port client)) 
	       (socket-close client)) 
        (loop (socket-accept server-sock)))))) 

(define (get-request iport) 
  (rxmatch-case (read-line iport) 
    [test eof-object? 'bad-request] 
    [#/^(GET|HEAD)\s+(\S+)\s+HTTP\/\d+\.\d+$/ (_ method abs-path) 
     (list* method abs-path #f (rfc822-header->list iport))] 
    [#/^(POST)\s+(\S+)\s+HTTP\/\d+\.\d+$/ (_ method abs-path) 
     (let* ((headers (rfc822-header->list iport))
            (post-data (string-incomplete->complete (read-block 
                               (x->integer (rfc822-header-ref headers "content-length")) iport))))
         (list* method abs-path post-data headers))] 
    [#/^[A-Z]+/ () 'not-implemented] 
    [else 'bad-request])) 

(define (handle-request request oport) 
  (match request 
    ['bad-request     (display "HTTP/1.1 400 Bad Request\r\n\r\n" oport)] 
    ['not-implemented (display "HTTP/1.1 501 Not Implemented\r\n\r\n" oport)] 
    [(method abs-path post-data . headers) 
     (receive (auth path q frag) (uri-decompose-hierarchical abs-path) 
       (let1 content 
           (render-content method path 
			   (cgi-parse-parameters :query-string (or post-data q "")) headers)
         (display "HTTP/1.1 200 OK\r\n" oport) 
         (display "Content-Type: text/html; charset=utf-8\r\n" oport) 
         (display #`"Content-Length: ,(string-size content)\r\n" oport) 
         (display "\r\n" oport) 
         (when (not (equal? method "HEAD")) (display content oport))))])) 

(define (render-content method path params headers)
  (reload-modified-modules)
  (use web-appl)
  (do-method method path params headers))

(define (main args)
  (run-server)
  0)

開発時にアプリのコードを変更する度にサーバーをリスタートするのではたまりません。Ruby on Railsのようにコードを変更したら直ぐに変更が確認できるようにする為に、Gaucheには gauche.reloadというモジュールがあります。 このモジュールの(reload-modified-modules)を呼ぶと、変更の在ったモジュールが再読込されます。 素晴らしい！！ 

;;;
;;; Webアプリ処理部分
;;;
(define-module web-appl
  (use text.tree) 
  (use text.html-lite) 
  (export do-method))
(select-module web-appl)

(define (do-method meth path params headers) 
  (tree->string 
   (html:html 
    (html:head (html:title "simple httpd")) 
    (html:body (html:h1 "Simple web server") 
               (html:p "Method : " (html-escape-string meth)) 
               (html:p "Path : " (html-escape-string path)) 
               (html:p "headers : " (html-escape-string headers)) 
               (map (lambda (p) 
                      (html:p (html-escape-string (car p)) " : " 
                              (html-escape-string (cdr p)))) 
                    params))))) 

(provide "web-appl")

*1:査読を少しお手伝いしたので原稿が手元にあります