Added cgi.ss and cgi-errors-to-browser.ss to the lib directory.

lib/cgi-errors-to-browser.ss

@@ -0,0 +1,12 @@
+(module ()
+  #| set the error handler to output an error page should
+     an error occur |#
+  (error-handler
+    (lambda (who msg . args)
+      (display "Content-type: text/html\n\n")
+      (display "<font color=\"red\"><pre>")
+      (if who
+          (printf "Error: ~a.\n" (apply format msg args))
+          (printf "Error in ~a: ~a.\n" who (apply format msg args)))
+      (display "</pre></font>")
+      (exit 0))))

lib/cgi.ss

@@ -0,0 +1,86 @@
+
+#| http://tools.ietf.org/html/rfc3986
+
+   query         = *( pchar / "/" / "?" )
+   pchar         = unreserved / pct-encoded / sub-delims / ":" / "@"
+
+   pct-encoded   = "%" HEXDIG HEXDIG
+
+   unreserved    = ALPHA / DIGIT / "-" / "." / "_" / "~"
+   sub-delims    = "!" / "$" / "&" / "'" / "(" / ")"
+                 / "*" / "+" / "," / ";" / "="
+|#
+
+
+
+(module cgi (params param)
+  (define (parse-query-string str)
+    ; parse string as (key=value) separated by &s:
+    (define (hex->integer c err)
+      (let ([n (char->integer c)])
+        (cond
+          [(fx<= (char->integer #\0) n (char->integer #\9))
+           (fx- n (char->integer #\0))]
+          [(fx<= (char->integer #\A) n (char->integer #\F))
+           (fx+ 10 (fx- n (char->integer #\A)))]
+          [(fx<= (char->integer #\a) n (char->integer #\f))
+           (fx+ 10 (fx- n (char->integer #\a)))]
+          [else (err)])))
+    (define (f str i n ac key err)
+      (cond
+        [(fx= i n)
+         (if key
+             (list (cons key (list->string (reverse ac))))
+             (if (null? ac)
+                 '()
+                 (err)))]
+        [else
+         (let ([c (string-ref str i)])
+           (cond
+             [(char=? c #\&)
+              (if key
+                  (cons (cons key (list->string (reverse ac)))
+                        (f str (fxadd1 i) n '() #f err))
+                  (if (null? ac)
+                      (f str (fxadd1 i) n '() #f err)
+                      (err)))]
+             [(char=? c #\=)
+              (if key
+                  (f str (fxadd1 i) n (cons c ac) key err)
+                  (f str (fxadd1 i) n '() (list->string (reverse ac)) err))]
+             [(char=? c #\%)
+              (if (fx< (fx+ i 2) n)
+                  (f str (fx+ i 3) 
+                     (cons (integer->char
+                             (let ([n0 (hex->integer
+                                         (string-ref str (fx+ i 1))
+                                         err)]
+                                   [n1 (hex->integer
+                                         (string-ref str (fx+ i 2))
+                                         err)])
+                               (fxlogor (fxsll n0 8) n1)))
+                           ac)
+                     n key err)
+                  (err))]
+             [(char=? c #\+)
+              (f str (fxadd1 i) n (cons #\space ac) key err)]
+             [(or (char<=? #\a c #\z)
+                  (char<=? #\A c #\Z)
+                  (char<=? #\0 c #\9)
+                  (memq c '(#\- #\. #\_ #\~ #\! #\$ #\& #\' 
+                            #\( #\) #\* #\, #\; #\= #\: #\@)))
+              (f str (fx+ i 1) n (cons c ac) key err)]
+             [else (err)]))]))
+    (f str 0 (string-length str) '() #f
+       (lambda () 
+         (error 'parse-query-string "invalid query string ~s" str))))
+  (define (params)
+    (map car cgi-env))
+  (define (param x)
+    (cond
+      [(assoc x cgi-env) => cdr]
+      [else #f]))
+  (define cgi-env
+     (parse-query-string (env "QUERY_STRING")))
+  #|cgi-module|#)
+