;; net/cgi.scm - CGI support routines
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

;; This module provides a simple library for dealing with CGI scripts.
;;
;; If you want to use it, you have to 
;; 1. Include this module with
;;      (use-modules (net cgi))
;; 2. Initialize the module with a call to
;;      (cgi:setup)
;; 3. Query a list of keys used in the query strings with a call to
;;      (cgi:query-keys)
;; 4. Retrieve the value list for a given key with a call to
;;      (cgi:query-values "keyword")
;; 5. You can use the 
;;      (cgi:print-header)
;;    procedure to print the string `Content-type: text/html\r\n\r\n' 
;;    to standard output.

(define-module (net cgi))

(export cgi:setup cgi:query-keys cgi:query-values cgi:print-header)


;; Global variable section ===========================================

;; The last parsed query string is stored in this variable.  The
;; variable's value is only valid if it is a list, otherwise it has
;; not yet been initialized.

(define *request-alist* #f)


;; Utility procedures ================================================

;; Return a string which is a copy of `str', except that any `%dd'
;; sequence, where `d' is a hexadecimal number, is replaced with its
;; character value.

(define (url-unquote str)
  (let ((str-len (string-length str)))
    (let loop ((pos 0) (accu '()))
      (if (< pos str-len)
	  (begin
	    (if (and (char=? #\% (string-ref str pos)) (< pos (- str-len 2)))
		(let ((value (string->number (string (string-ref str (+ pos 1))
						     (string-ref str (+ pos 2)))
					     16)))
		  (loop (+ pos 3) (cons (integer->char value) accu)))
		(loop (1+ pos) (cons (string-ref str pos) accu))))
	  (list->string (reverse! accu))))))


;; Take a list of query strings and split the string at `='
;; characters, forming an association list from the strings.  Any one
;; key can appear more than once in the input, the resulting
;; association list will associate the keys with lists of values.

(define (process-request-list lst)
  (let loop ((lst lst) (accu '()))
    (if (pair? lst)
	(if (string-null? (car lst))
	    (loop (cdr lst) accu)
	    (let* ((index (string-index (car lst) #\=)))
	      (if index
		  (let* ((key (substring (car lst)
					 0
					 index))
			 (value (substring (car lst)
					   (1+ index)
					   (string-length (car lst)))))
		    (let ((entry (assoc key accu)))
		      (if entry
			  (begin
			    (append! (cdr entry) (list value))
			    (loop (cdr lst) accu))
			  (loop (cdr lst)
				(cons (cons key (list value)) accu)))))
		  (loop (cdr lst) (cons (cons (car lst) '()) accu)))))
	accu)))


;; Parse the CGI query string `str' and store the result of the parse
;; in the global variable `*request-alist*'

(define (parse-cgi-input str)
  (let* ((pairs (string-split #\& str))
	 (unquoted-list (map url-unquote pairs))
	 (unquoted-alist (process-request-list unquoted-list)))
    (set! *request-alist* unquoted-alist)))


;; Exported procedures ===============================================

;; Initialize the module from the CGI environment variables.  You have
;; to call this procedure before any of the other procedures.

(define (cgi:setup)
  (set! *request-alist* #f)
  (let ((request-method (getenv "REQUEST_METHOD")))
    (if (string? request-method)
	(cond ((string=? request-method "GET")
	       (let ((query-string (getenv "QUERY_STRING")))
		 (if query-string
		     (parse-cgi-input query-string))))
	      ((string=? request-method "POST")
	       (let* ((content-len (string->number (getenv "CONTENT_LENGTH")))
		      (query-string (make-string content-len)))
		 (let loop ((ch (read-char)) (pos 0))
		   (if (< pos content-len)
		       (begin
			 (string-set! query-string pos ch)
			 (loop (read-char) (1+ pos)))
		       (parse-cgi-input query-string)))))
	      (else
	       (error "cgi:setup: environment variable `REQUEST_METHOD' not 
correctly set")))
	(error "cgi:setup: environment variable `REQUEST_METHOD' not set"))))
	

;; Get the list of query values for the key `key'.

(define (cgi:query-values key)
  (let ((pair (assoc key *request-alist*)))
    (and pair (cdr pair))))


;; Get a list of defined query keys.

(define (cgi:query-keys)
  (and *request-alist* (map car *request-alist*)))


;; Print the `Content-type:' header to standard output.

(define (cgi:print-header)
  (display "Content-type: text/html\r\n\r\n"))

