(define scheme-program-handler
  (lambda (path req)
    (if (pair? path)	; Got to have at least one elt.
        (let* ((prog (car path))
	      
	       (search (http-url:search (request:url req)))	; Compute the
	       (arglist (if (and search (not (index search #\=)))	; argv list.
		         (split-and-decode-search-spec search)
		         '()))
	       (env (exec-env req (cdr path))) ; set global environment vars
	       (doit (lambda ()
		       ((runprogram prog) arglist))))

	  (and (http-syslog (syslog-level debug) 
			    "scheme-program-handler:~%  Programmname : ~s~%  search       : ~s~%  Argumente    : ~s~%" prog search arglist)

	       (let ((request-method (request:method req)))
		 (if (or (string=? request-method "GET")
			 (string=? request-method "POST")) ; Could do others also.
			(wait (fork doit))
		        (http-error http-status/method-not-allowed req))))

	  (http-error http-status/bad-request req "Error "))))

(define (runprogram progstring)
    (let* ( (progsymbol (read (make-string-input-port progstring)))
	    (progsymbol1 (string->symbol progstring)))
      (and (http-syslog (syslog-level debug)
			"[]run-program ~s ~s ~s~%" progstring progsymbol progsymbol1)
	   (eval progsymbol (interaction-environment)))))

(define (split-and-decode-search-spec s)
  (let recur ((i 0))
    (cond ((index s #\+ i) => (lambda (j) (cons (unescape-uri s i j)
						(recur (+ j 1)))))
	  (else (list (unescape-uri s i (string-length s)))))))

(define url-path)
(define script-path)
(define script-name)
(define (exec-env req  path-suffix)
  (let* (;; Compute the $SCRIPT_PATH string.
         (url-path1 (http-url:path (request:url req)))
         (script-path1 (take (- (length url-path1) (length path-suffix))
                            url-path1))
         (script-name1 (uri-path-list->path script-path1)))
    (and (set! url-path url-path1)
	 (set! script-path script-path1)
	 (set! script-name script-name1))))

(define (take n lis)
  (if (zero? n) '()
      (cons (car lis) (take (- n 1) (cdr lis)))))

(define (drop n lis)
  (if (zero? n) lis
      (drop (- n 1) (cdr lis))))