Scheme/Lisp CGI通讯，将访问的页面写入文本文件中

;;首先启动服务器
;;加载TCP协议模块
;; The lib we need
(require scheme/tcp)
;;监听90端口
;; Set a port for listening
(define tcp-port-listener (tcp-listen 90))

;;监听客户机发送的请求和消息，将客户机浏览的页面写入一个server.info文件里面。

(define listening (lambda ()
            (define-values (client->me me->client)
              (tcp-accept tcp-port-listener)) ;;监听90端口的信息

           ;;重新定义打开一个server.info文件
            (set! output-file (open-output-file "server.info" #:exists 'truncate))
                    (let loop((me (read client->me))) ;;读取将客户机发送的消息保存到me
                      (cond
               ((eof-object? me) '()) ;;判断读取文件是否到了最后eof
               ((list? me) ;;判断是否是一个列表
                        (begin
                        (display "running")
            ;;将me的参数传个新定义的ls，进行判断是不是为空，然后写入server.info文件里面去。每写完一句，换行继续写。写完后关闭输入输出和监控 端口的流。
            (let loop2((ls me))
                          (if (null? (cdr ls)) (write (car ls) output-file)                              
                             (begin
                               (display (car ls))
                               (newline)
                               (write (car ls) output-file)
                               (newline output-file)
                               (loop2 (cdr ls)))))))
                         (else
                          (begin
                           (display me)
                           (newline)
                           (loop (read client->me))))))
                               (close-output-port output-file)
                               (close-input-port client->me)
                               (close-output-port me->client)
                    (listening)))

;;CGI程序如下：
;;前面这段应该都知道是加载SCHEME解释器和文件类型
#!/bin/sh
":"; exec /usr/local/plt/bin/mzscheme -rq $0 "$@"
(display "content-type: text/plain")
(newline)
(newline)

;;定义一个输出列表，将打开一个文件server.info，将CGI变量写入该文件中
(define output-list (lambda (output-file list-name)
                      (let loop((out list-name))
            (if (null? (cdr out)) (write (car out) output-file)
                  (begin
                (write (car out) output-file)
                (newline output-file)
                (loop (cdr out)))))
(close-output-port output-file))) ;;关闭输出流
;;定义一个打开文件函数
(define output-port (open-output-file "server.info" #:exists 'truncate))
;;定义一个返回自身函数
(define new-display (lambda (n)
              (begin
            (display n)
            (newline))))
(display "The following environment variables are not request-specific and are set for all requests:SERVER_SOFTWARE,SERVER_NAME,GATEWAY_INTERFACE")
(newline)
;;取CGI变量的值
(define non-request (cons (getenv "SERVER_SOFTWARE")
            (cons (getenv "SERVER_NAME")
                (cons (getenv "GATEWAY_INTERFACE") '()))))
(for-each new-display non-request)

(newline)
(display "The following environment variables are specific to the request being fulfilled by the gateway
program: SERVER_PROTOCOL,SERVER_PORT,SERVER_METHOD,PATH_INFO,PATH_TRANSLATED,SCRIPT_NAME,QUERY_STRING,
REMOTE_HOST,REMOTE_ADDR,AUTH_TYPE,REMOTE_USER_REMOTE_INDENT,CONTENT_TYPE,CONTENT_LENGTH")
(newline)
;;取CGI变量的值
(define request (cons (getenv "SERVER_PROTOCOL")
              (cons (getenv "SERVER_PORT")
              (cons (getenv "SERVER_METH0D")
              (cons (getenv "PATH_INFO")
              (cons (getenv "PATH_TRANSLATED")
              (cons (getenv "SCRIPT_NAME")
              (cons (getenv "QUERY_STRING")
              (cons (getenv "REMOTE_HOST")
              (cons (getenv "REMOTE_ADDR")
              (cons (getenv "AUTH_TYPE")
              (cons (getenv "REMOTE_USER")
              (cons (getenv "REMOTE_INDENT")
              (cons (getenv "CONTENT_TYPE")
              (cons (getenv "CONTENT_LENGTH") '())))))))))))))))
(for-each new-display request)
;;取CGI变量HTTP_的值
(define HTTP-spec (cons (getenv "HTTP_ACCEPT")
           (cons "HTTP_USER_AGENT" '())))
(for-each new-display HTTP-spec)

;(output-list output-port (append non-request (append request HTTP-spec)))

;; Client will try to connect the server,and port is 5566.
;;链接服务器，跟服务器取得联系。
(define-values (server->me me->server)
        (tcp-connect "localhost" 90))

;; Send the server infos to tcp server
;;将 CGI的值传给server。
(write (append non-request (append request HTTP-spec)) me->server)

;; remember that if you are not going to close the port,your infos still
;; in buffers that will not send
;;关闭输出流
(close-output-port me->server)