gemma:継続CGI
- 通常、CGIはリクエストｰレスポンスごとに終了してしまうため、継続を保存しておくことができません。しかし、fastCGIを使えば話は別です。
- fastCGIは、リクエスト-レスポンスごとに終了せず、そのまま常駐して、次のリクエストを待ちます。リクエストのたびにかかっていたインタプリタの起動やプログラムのロードの時間を省くことで、高速なCGI動作を実現しています。
- このfastcgiの特徴を活かすことで、gemma:継続サーバをよりエレガントに実装できました。
ソース
インストール方法
- fastcgiを使えるようにHTTPサーバの設定をする。
- Gauche-fastcgiをインストールする。
- ライブラリモジュールであるcontcgi.scmを、(use www.contcgi)で使えるようにインストールする。
ヒント
- 端末から gosh sum.fcgi と起動すると、見慣れたscanf,printfのような動作をするようになっています。デバッグに使ってください。
(define-module www.contcgi
(use srfi-13)
(use gauche.parameter)
(use text.tree)
(use text.html-lite)
(use www.cgi)
(use www.fastcgi)
(export show cont-count contcgi-main))
(select-module www.contcgi)
;;Kimura Fuyuki氏の、Gauche-fastcgi<http://d.tir.jp/pw?Gauche-fastcgi>のコードが参考になりました。ありがとうございます。
;;www.fastcgiモジュールでexportされていない関数で、必要なものがいくつかあるから、取り出す。
(define fcgx-is-cgi (with-module www.fastcgi fcgx-is-cgi))
(define fcgx-accept (with-module www.fastcgi fcgx-accept))
(define fcgx-stream->port (with-module www.fastcgi fcgx-stream->port))
(define fcgx-finish (with-module www.fastcgi fcgx-finish))
;;継続サーバの肝である継続を保存するハッシュテーブル。
(define cont-table (make-hash-table 'eq?))
;;継続を保存するたびに増やすカウンタ
(define cont-count 0)
;;大域脱出用
(define return #f)
;;デバッグフラグ。showの動作が変わる。
(define debug-flag #f)
(define (error? obj) (is-a? obj <error>))
(define (error->string obj)
(and (is-a? obj <error>) (ref obj 'message)))
(define (call-with-contcgi proc)
(cond ((fcgx-is-cgi)
;;端末からの実行の場合、debugフラグをセットする。
(set! debug-flag #t)
(proc '()))
(else
;; rush into the infinity..
(let loop ()
;; leave these signals to libfcgi
(set-signal-handler! SIGTERM #t)
(set-signal-handler! SIGHUP #t)
(set-signal-handler! SIGUSR1 #t)
;; mod_fastcgi requires this!
(set-signal-handler! SIGPIPE (lambda (k) (loop)))
(receive (in out err env) (fcgx-accept)
(let ((iport (fcgx-stream->port in))
(oport (fcgx-stream->port out))
(eport (fcgx-stream->port err))
(mvs (map (lambda (s)
(receive r (string-scan s #\= 'both) r))
env)))
(with-error-handler
(lambda (e)
(display (if (error? e) (error->string e) e) eport)
(newline eport)
(close-input-port iport)
(close-output-port oport)
(close-output-port eport)
(fcgx-finish)
(raise e))
(lambda ()
(parameterize ((cgi-metavariables mvs))
(write-tree (proc (cgi-parse-parameters)) oport))
(close-input-port iport)
(close-output-port oport)
(close-output-port eport)))))
(loop)))))
;;cont-tableハッシュテーブルに見つからないkeyが、CGIパラメータcont-countで指定された場合の、エラーページ
(define (error-page params)
`(,(cgi-header)
,(html-doctype)
,(html:html
(html:head (html:title "error"))
(html:body
(html:p "Error. A invalid value on the parameter 'cont-count'")
(html:p (html:b (format "pid = ~a" (sys-getpid))))
;;CGIにあたえられたパラメータをhtml:tableの一覧にして表示。
(html:table
:border 1
(html:tr (html:th "Name") (html:th "Value"))
(map (lambda (p)
(html:tr
(html:td (html-escape-string (car p)))
(html:td (html-escape-string (x->string (cdr p))))))
params))))))
;;show は、debug時には標準出力へのwrite-treeと標準入力からのread-lineになる。
(define (show page)
(if debug-flag
(begin
(write-tree page)
(let1 query (begin
(display "Enter parameters (name=value). ^D to stop.\n")
(flush)
(let loop ((line (read-line))
(params '()))
(if (eof-object? line)
(string-join (reverse params) "&")
(loop (read-line)
(if (string-null? line)
params
(cons line params))))))
(cgi-parse-parameters :query-string query)))
(call/cc
(lambda (cc)
;;継続サーバの肝である継続をcont-tableに保存する
(hash-table-put! cont-table cont-count cc)
;;保存している継続の番号をカウントする。
(inc! cont-count)
;;ここで大域脱出returnで返したものが、CGIの出力結果になる。
(return page)))))
(define (contcgi-main proc)
(call-with-contcgi
(lambda (params)
(call/cc
(lambda (cc)
;;大域脱出用にreturnをセット。
(set! return cc)
(let ((cont-count (cgi-get-parameter "cont-count" params :default #f :convert x->number)))
(if (boolean cont-count)
;;foo.fcgi?cont-count=1などなら、継続を呼び出す。
((hash-table-get cont-table cont-count error-page) params)
;;foo.fcgiなら、メインロジックであるprocを呼び出す。
(proc params))))))))
(provide "www/contcgi")
#! /usr/local/bin/gosh
(use www.cgi)
(use www.contcgi)
(use text.html-lite)
(define (main args)
(contcgi-main
(lambda (params)
(let* ((a (cgi-get-parameter "value"
(show `(,(cgi-header)
,(html-doctype)
,(html:html
(html:body
(html:p (html:b (format "pid = ~a" (sys-getpid))))
(html:p "? + ? = ?")
(html:p "input number")
(html:form
:method "GET" :action "./sum.fcgi"
(html:input :type "hidden" :name "cont-count" :value cont-count)
(html:input :type "text" :name "value")
(html:input :type "submit"))))))
:convert x->number))
(b (cgi-get-parameter "value"
(show `(,(cgi-header)
,(html-doctype)
,(html:html
(html:body
(html:p (html:b (format "pid = ~a" (sys-getpid))))
(html:p (format #f "~a + ? = ?" a))
(html:p "input number")
(html:form
:method "GET" :action "./sum.fcgi"
(html:input :type "hidden" :name "cont-count" :value cont-count)
(html:input :type "text" :name "value")
(html:input :type "submit"))))))
:convert x->number)))
(show `(,(cgi-header)
,(html-doctype)
,(html:html
(html:body
(html:p (html:b (format "pid = ~a" (sys-getpid))))
(html:p (format #f "~a + ~a = ~a" a b (+ a b)))))))))))
;; Local variables:
;; mode: scheme
;; end:
#! /usr/local/bin/gosh
(use text.html-lite)
(use www.cgi)
(use www.contcgi)
(define (main args)
(contcgi-main
(lambda (params)
(let loop ((counter 0))
(let1 action (cgi-get-parameter "action"
(show `(,(cgi-header)
,(html-doctype)
,(html:html
(html:body
(html:p (html:b (format "pid = ~a" (sys-getpid))))
(html:h1 counter)
(html:br)
(html:a
:href (format #f "./counter.fcgi?cont-count=~a&action=inc" cont-count)
"++")
" "
(html:a
:href (format #f "./counter.fcgi?cont-count=~a&action=dec" cont-count)
"--"))))))
(cond
((equal? action "inc") (loop (+ counter 1)))
((equal? action "dec") (loop (- counter 1)))
(else (loop counter))))))))
;; Local variables:
;; mode: scheme
;; end:
#! /usr/local/bin/gosh
(use text.html-lite)
(use www.cgi)
(use www.contcgi)
(define (main args)
(contcgi-main
(lambda (params)
(let loop ((counter 0))
(let1 action (cgi-get-parameter "action"
(show `(,(cgi-header)
,(html-doctype)
,(html:html
(html:body
(html:p (html:b (format "pid = ~a" (sys-getpid))))
(html:h1 counter)
(html:br)
(html:a
:href (format #f "./counter.fcgi?cont-count=~a&action=inc" cont-count)
"++")
" "
(html:a
:href (format #f "./counter.fcgi?cont-count=~a&action=dec" cont-count)
"--"))))))
(cond
((equal? action "inc") (loop (+ counter 1)))
((equal? action "dec") (loop (- counter 1)))
(else (loop counter))))))))
;; Local variables:
;; mode: scheme
;; end:
rio rio orange
Last modified : 2012/01/23 14:39:23 UTC