CGI を作る


Tags: R6RS, Web, FIXME

HTTP ヘッダを出力する

;; 必要最小限
(display "Content-Type: text/html\r\n\r\n")
;; 文字コードを指定する場合
(display "Content-Type: text/html;charset=UTF-8\r\n\r\n")

HTML 特殊文字をエスケープする

(define (html-escape str)
  (call-with-string-output-port
    (lambda (out)
      (string-for-each
        (lambda (c)
          (cond
            ((char=? #\& c) (put-string out "&"))
            ((char=? #\< c) (put-string out "&lt;"))
            ((char=? #\> c) (put-string out "&gt;"))
            ((char=? #\" c) (put-string out "&quot;"))
            (else (put-char out c))))
        str))))

HTML を出力する

HTML を文字列で記述しても良いが、 SXML 形式で記述し文字列に変換して出力する方法がよく用いられる。処理系がSXMLライブラリを持っていない場合は以下のような手続きを作ると良い。

(define (put-sxml out sxml)
  (and (pair? sxml) (symbol? (car sxml))
    (let ((tag (symbol->string (car sxml))))
      (let loop ((ls (cdr sxml)) (attrs '()) (vals '()))
        (if (pair? ls)
          (if (and (pair? (car ls)) (eq? '$ (caar ls)))
            (loop (cdr ls) (append attrs (cdar ls)) vals)
            (loop (cdr ls) attrs (cons (car ls) vals)))
          (begin
            (put-char out #\<)
            (put-string out tag)
            (for-each
              (lambda (attr)
                (put-char out #\space)
                (put-string out
                  (string-append
                    (symbol->string (car attr))
                    "=\"" (html-escape (cadr attr)) "\"")))
              attrs)
            (if (pair? vals)
              (begin
                (put-char out #\>)
                (for-each
                  (lambda (val)
                    (cond
                      ((pair? val) (put-sxml out val))
                      ((string? val) (put-string out val))
                      ((symbol? val) (put-string out (symbol->string val)))))
                  (reverse vals))
                (put-string out (string-append "</" tag ">\n")))
              (put-string out " />\n"))))))))

※ この例では SXML の @ の代わりに $ を用いています。

(put-sxml (current-output-port)
  `(html
    (head (title "Hello, 逆引きScheme!")
    (body
      (h1 "Hello, 逆引きScheme!")
      (p (a ($ (href "http://tips.lisp-users.org/")) "逆引きScheme"))))))

フォームから送信されたデータをパースする

HTMLフォームからの送信方法には GET と POST の二種類がある。送信方法は環境変数 "REQUEST_METHOD" に格納され CGI に渡される。

送信データは、
GET の場合、環境変数 "QUERY_STRING" から取り出し、
POST の場合、標準入力から読み込む。

(define (get-cgi-params)
  (let ((params (make-hashtable string-hash string=?))
    (method (get-environment-variable "REQUEST_METHOD")))
    (for-each
      (lambda (query)
        (let ((ql (string-split query #\=)))
          (and (pair? ql) (<= 2 (length ql))
            (hashtable-set! params (car ql) (uri-decode (cadr ql))))))
      (string-split
        (if (and method (string=? method "GET"))
          (or (get-environment-variable "QUERY_STRING") "")
          (get-string-n (current-input-port) 65536)) #\&))
    params))

環境変数の取得方法は 環境変数を取得する を参考にしてください。
string-split は 文字列を分割する を参考にしてください。
uri-decode は 文字列を URI エンコードする を参考にしてください。

※ POST の場合、読み込むデータ量に制限を加えたほうが良い。この例では 65536 文字まで読み込むようにしています。