(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-log "----------------------------------------~%")
	       (http-log "  Programmname : ~s~%" prog)
	       (http-log "  search       : ~s~%" search)
	       (http-log "  Argumente    : ~s~%" arglist)
	       (http-log "----------------------------------------~%")

	       (switch string=? (request:method req)
		       (("GET" "POST")		; Could do others also.
			(wait (fork doit)))
		       (else (http-error http-reply/method-not-allowed req)))))

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

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

(define (split-and-decode-search-spec s)
  (let recur ((i 0))
    (? ((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))))