gemma:継続サーバ

gemmaによる継続サーバの実装です。Apache+cgi(gosh)で動きます。

cgiはリクエスト毎に終了してしまい、これでは継続を保存できないので、各セッションにひとつプロセスをforkしてそこに保存する形をとっています。ゾンビプロセスだらけになるのが欠点です。

ソース

• http://www.geocities.jp/teruakigemma/gaup/gaup00.tar.gz
• 内容物
  • gaup.scm ライブラリモジュール
  • cont.cgi CGI
  • sum.scm サンプルプログラム
  • counter.scm サンプルプログラム
  • guess.scm サンプルプログラム

インストール方法

• gaup.scmはモジュールです。*load-path*にあるディレクトリのいずれかに置いて、(use gaup) で使えるようにしてください。
• cont.cgiをCGIとして実行できるように、Apache、パーミッションなどを設定してください。
• cont.cgiと同じディレクトリに、サンプルプログラムである sum.scm, counter.scm, guess.scmを置いてください。cont.cgiがこれらのプログラムをforkできるようにしてください。

実行方法

• Apacheを起動して、ブラウザでcont.cgiにアクセスしてください。

ヒント

• 端末から gosh sum.scm と起動すると、見慣れたscanf,printfのような動作をするようになっています。デバッグに使ってください。

• gaup.scm

  (define-module gaup
    (use text.tree)
    (use text.html-lite)
    (use gauche.net)
    (use gauche.selector)
    (use www.cgi)
    (use srfi-13)
    (use gauche.parseopt)
    (export gaup-pid gaup-cont show gaup-init))
  
  (select-module gaup)
  
  (define gaup-debug #t)
  (define gaup-pid (sys-getpid))
  (define gaup-cont 0)
  (define selector (make <selector>))
  
  ;;debug時は、print-pageは標準出力へのwrite-treeに、read-inputは標準入力からのread-lineになる。
  
  (define (print-page page)
    (if gaup-debug
        (write-tree page)
        (call-with-client-socket (make-client-socket 'unix (format #f "/tmp/gaup~a" gaup-pid))
                                 (lambda (in out)
                                   (write-tree page out)))))
  
  (define (read-input)
    (if gaup-debug
        (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 (return)
           (let* ((path (format #f "/tmp/gaup~a-~a" gaup-pid gaup-cont))
                  (server (make-server-socket 'unix path)))
             (sys-chmod path #o777)
             ;;継続サーバの肝である"継続"は、このselector-add!のクロージャに保存しておく。
             (selector-add! selector
                            (socket-fd server)
                            (lambda (fd flag)
                              (let* ((client (socket-accept server))
                                     (input (socket-input-port client))
                                     (params (read input)))
                                (socket-close client)
                                (return params)))
                            '(r)))
           (inc! gaup-cont)
           (do () (#f) (selector-select selector))))))
  
  (define (show page)
    (print-page page)
    (read-input))
  
  (define (gaup-init args)
    ;;debug時には、gosh sum.scm と実行してもらい、継続サーバからの呼出し時には、gosh sum.scm -x と実行することにしてある。
   (let-args (cdr args)
             ((#f "x" => (lambda () (set! gaup-debug #f)))))
   (set-signal-handler! SIGINT (lambda (n) (print `"Received SIGINT") (exit 0)))
   (unless gaup-debug
     ;;標準ポートを閉じる。ブラウザが、いつページ読み込みが完了するのかと混乱するのを、防ぐため。
     (close-input-port (standard-input-port))
     (close-output-port (standard-output-port))
     (close-output-port (standard-error-port))))
  
  (provide "gaup")
  

• cont.cgi

  #!/usr/local/bin/gosh
  (use gauche.net)
  (use gauche.process)
  (use www.cgi)
  (use text.html-lite)
  
  (define (run-cont gaup-pid gaup-cont params)
    ;;path に unixドメインソケットをはり、sum.scmなどからの書き込みを待つ。
    ;;☆出力がきたらそのままブラウザに返してこのCGIは終了。
    (let* ((path (format #f "/tmp/gaup~a" gaup-pid))
           (server (make-server-socket 'unix path)))
      ;;sum.scmなどが書き込めるようにパーミッションをゆるくする。
      (sys-chmod path #o777)
      (cgi-add-temporary-file path)
      (unless (eq? gaup-cont #f)
        ;;継続サーバとしての動作を行う。このとき、sum.scmなどは、"/tmp/gaup-3192-1"ソケットにサーバをはって、このCGIからの書き込みを待っている。
        (call-with-client-socket (make-client-socket 'unix (format #f "/tmp/gaup~a-~a" gaup-pid gaup-cont))
                                 (lambda (in out)
                                   ;;CGIにあたえられたパラメータをそっくりそのままwriteする。
                                   (write params out))))
      ;;☆の部分。出力がきたらそのままブラウザに返してこのCGIは終了。
      (let* ((client (socket-accept server))
             (input (socket-input-port client)))
        (begin0 (port->string input)
                (socket-close client)))))
  
  (define (main args)
    ;;インデックス、プログラムファイル名、プログラムの説明、を対にしたリスト。
    (define sample-program-list '(("0" "counter.scm" "counter")
                                  ("1" "sum.scm" "?+?=?")
                                  ("2" "guess.scm" "guess number game")))
    ;;どのプログラムを起動するかを選択するページ。
    (define (default-page)
      (html:html
       (html:body
        (map (lambda (li)
               (list
                (html:h1
                 (html:a :href (string-append "./cont.cgi?boot=" (car li)) (caddr li)))
                (html:br)))
             sample-program-list))))
  
    (cgi-main
     (lambda (params)
       (list (cgi-header)
             (html-doctype)
             (let ((boot (cgi-get-parameter "boot" params :default #f :convert x->number))
                   (gaup-pid (cgi-get-parameter "gaup-pid" params :default #f))
                   (gaup-cont (cgi-get-parameter "gaup-cont" params :default #f)))
               (cond
                ;;cont.cgi?boot=1 なら gosh sum.scm -x をforkするといった具合。
                ((boolean boot)
                 (run-cont (process-pid (run-process "gosh" (cadr (list-ref sample-program-list boot)) "-x")) #f '()))
                ;;cont.cgi?gaup-pid=3192&gaup-cont=1 なら継続サーバとしての動作を行う。
                ((and (boolean gaup-pid) (boolean gaup-cont))
                 (run-cont gaup-pid gaup-cont params))
                ;;cont.cgiなどなら、デフォルトのページをだす。
                (else (default-page))))))))
  
  ;; Local variables:
  ;; mode: gauche
  ;; end:
  

• sum.scm

  (use text.html-lite)
  (use www.cgi)
  (use gaup)
  
  (define (main args)
    (gaup-init args)
    (let* ((a (cgi-get-parameter "value"
                                 (show (html:html
                                        (html:body
                                         (html:p "? + ? = ?")
                                         (html:p "input number")
                                         (html:form
                                          :method "GET" :action "./cont.cgi"
                                          (html:input :type "hidden" :name "gaup-pid" :value gaup-pid)
                                          (html:input :type "hidden" :name "gaup-cont" :value gaup-cont)
                                          (html:input :type "text" :name "value")
                                          (html:input :type "submit")))))
                                 :convert x->number))
           (b  (cgi-get-parameter "value"
                                  (show (html:html
                                         (html:body
                                          (html:p (format #f "~a + ? = ?" a))
                                          (html:p "input number")
                                          (html:form
                                           :method "GET" :action "./cont.cgi"
                                           (html:input :type "hidden" :name "gaup-pid" :value gaup-pid)
                                           (html:input :type "hidden" :name "gaup-cont" :value gaup-cont)
                                           (html:input :type "text" :name "value")
                                           (html:input :type "submit")))))
                                  :convert x->number)))
      (show (html:html
             (html:body
              (html:p (format #f "~a + ~a = ~a" a b (+ a b))))))))
  

• counter.scm

  (use text.html-lite)
  (use www.cgi)
  (use gaup)
  
  (define (main args)
    (gaup-init args)
    (let loop ((counter 0))
      (let1 action (cgi-get-parameter "action"
                                      (show (html:html
                                             (html:body
                                              (html:h1 counter)
                                              (html:br)
                                              (html:a
                                               :href (format #f "./cont.cgi?gaup-pid=~a&gaup-cont=~a&action=inc" gaup-pid gaup-cont)
                                               "++")
                                              "&nbsp"
                                              (html:a
                                               :href (format #f "./cont.cgi?gaup-pid=~a&gaup-cont=~a&action=dec" gaup-pid gaup-cont)
                                               "--")))))
        (cond
         ((equal? action "inc") (loop (+ counter 1)))
         ((equal? action "dec") (loop (- counter 1)))
         (else (loop counter))))))
  

• guess.scm

  (use text.html-lite)
  (use www.cgi)
  (use gaup)
  (use math.mt-random)
  
  (define answer (let1 m (make <mersenne-twister> :seed (sys-time))
                   (mt-random-integer m 100)))
  
  (define (main args)
    (gaup-init args)
    (let loop ((count 1)
               (guess 0))
      (if (= guess answer)
          (show
           (html:html
            (html:head
             (html:meta :http-equiv "Content-Type" :content "text/html; charset=utf-8"))
            (html:body
             (html:p (format #f "~a 回目で正解です! 答えは ~a" (- count 1) answer)))))
          (let1 req (show (html:html
                           (html:head
                            (html:meta
                             :http-equiv "Content-Type"
                             :content "text/html; charset=utf-8"))
                           (html:body
                            (html:p
                             (format #f "~a 回目の挑戦です。" count))
                            (html:p
                             (cond
                              ((= count 1)
                               (format #f "数当てゲームです。答えは 0 から 99 の間の数です。さて、いくつ?"))
                              ((> guess answer)
                               (format #f "いいえ。 ~a より小さな数です。さて、いくつ?" guess))
                              ((< guess answer)
                               (format #f "いいえ。 ~a より大きな数です。さて、いくつ?" guess))))
                            (html:form
                             :method "GET" :action "./cont.cgi"
                             (html:input :type "hidden" :name "gaup-pid" :value gaup-pid)
                             (html:input :type "hidden" :name "gaup-cont" :value gaup-cont)
                             (html:input :type "text" :name "value")
                             (html:input :type "submit")))))
            (loop (+ count 1)
                  (cgi-get-parameter "value" req :convert x->integer))))))
  
  

  rio orange