* removed global cgi-default-bin-path - now optional parameter

to cgi-handler defaulting to previous value
* remove initialise-request-invariant-cgi-env - now part of
  cgi-handler (is called on procedure call).
  side effect: every cgi-handler has completely its own environment
* docu accordingly updated
* [no change to ftpd.scm; only blank line inserted]

cgi-server.scm

@@ -86,53 +86,63 @@
 
 
 ;;; The path handler for CGI scripts. (car path) is the script to run.
+;;; cgi-bin-path is used, if no PATH-variable isn't defined
 
-(define (cgi-handler bin-dir)
+(define (cgi-handler bin-dir . maybe-cgi-bin-path)
-  (lambda (path req)
+  (let-optionals
-    (if (pair? path)	; Got to have at least one elt.
+   maybe-cgi-bin-path
-        (let* ((prog (car path))
+   ((cgi-bin-path cgi-default-bin-path))
 	    
-	       (filename (or (dotdot-check bin-dir (list prog))
+   (let ((request-invariant-cgi-env    ; environment variables that never change
-			     (http-error http-reply/bad-request req
+	  `(("PATH"              . ,(and (getenv "PATH") cgi-bin-path))
-					 (format #f "CGI scripts may not contain \"..\" elements."))))
+	    ("SERVER_SOFTWARE"   . ,server/version)
+	    ("SERVER_NAME"       . ,(host-info:name (host-info (system-name))))
+	    ("GATEWAY_INTERFACE" . "CGI/1.1"))))
+     (lambda (path req)
+       (if (pair? path)	; Got to have at least one elt.
+	   (let* ((prog (car path))
 
-	       (nph? (string-prefix? "nph-" prog))	; PROG starts with "nph-" ? 
+		  (filename (or (dotdot-check bin-dir (list prog))
-	       ; why did we had (string-suffix? "-nph" prog) here?
+				(http-error http-reply/bad-request req
+					    (format #f "CGI scripts may not contain \"..\" elements."))))
 
-	       (search (http-url:search (request:url req)))	; Compute the
+		  (nph? (string-prefix? "nph-" prog))	; PROG starts with "nph-" ? 
-	       (argv (if (and search (not (string-index search #\=)))	; argv list.
+					; why did we had (string-suffix? "-nph" prog) here?
-		         (split-and-decode-search-spec search)
-		         '()))
 
-	       (env (cgi-env req bin-dir (cdr path)))
+		  (search (http-url:search (request:url req)))	; Compute the
+		  (argv (if (and search (not (string-index search #\=)))	; argv list.
+			    (split-and-decode-search-spec search)
+			    '()))
 
-	       (doit (lambda ()
+		  (env (cgi-env req bin-dir (cdr path) request-invariant-cgi-env))
-		       (dup->inport  (current-input-port) 0)
-		       (dup->outport (current-output-port) 1)
-		       (apply exec/env filename env argv))))
 
-	  (http-syslog (syslog-level debug) "[cgi-server] search: ~s, argv: ~s~%" search argv)
+		  (doit (lambda ()
-	  (let ((request-method (request:method req)))
+			  (dup->inport  (current-input-port) 0)
-	    (cond 
+			  (dup->outport (current-output-port) 1)
-	     ((or (string=? request-method "GET")
+			  (apply exec/env filename env argv))))
-		  (string=? request-method "POST"))	; Could do others also.
-	      (if nph?
-		  (let ((stat (wait (fork doit))))
-		    (if (not (zero? stat))
-			(http-error http-reply/bad-request req
-				    (format #f "Could not execute CGI script ~a."
-					    filename))
-			stat))
-		  (cgi-send-reply (run/port* doit) req)))
 
-	     (else (http-error http-reply/method-not-allowed req)))))
+	     (http-syslog (syslog-level debug) "[cgi-server] search: ~s, argv: ~s~%" search argv)
+	     (let ((request-method (request:method req)))
+	       (cond 
+		((or (string=? request-method "GET")
+		     (string=? request-method "POST"))	; Could do others also.
+		 (if nph?
+		     (let ((stat (wait (fork doit))))
+		       (if (not (zero? stat))
+			   (http-error http-reply/bad-request req
+				       (format #f "Could not execute CGI script ~a."
+					       filename))
+			   stat))
+		     (cgi-send-reply (run/port* doit) req)))
 		
-	(http-error http-reply/bad-request req "Empty CGI script"))))
+		(else (http-error http-reply/method-not-allowed req)))))
+	   
+	   (http-error http-reply/bad-request req "Empty CGI script"))))))
 
 
-(define (split-and-decode-search-spec s)
+  (define (split-and-decode-search-spec s)
-  (let recur ((i 0))
+    (let recur ((i 0))
-    (cond
+      (cond
      ((string-index s #\+ i) => (lambda (j) (cons (unescape-uri s i j)
 					     (recur (+ j 1)))))
      (else (list (unescape-uri s i (string-length s)))))))
@@ -157,7 +167,7 @@
 ;;; The first three of these vars are *not* encoded, so information is lost
 ;;; if the URL's path elements contain encoded /'s (%2F). CGI loses.
 
-(define (cgi-env req bin-dir path-suffix)
+(define (cgi-env req bin-dir path-suffix request-invariant-cgi-env)
   (let* ((sock (request:socket req))
 	 (raddr (socket-remote-address sock))
 
@@ -173,9 +183,6 @@
 			    url-path))
 	 (script-name (uri-path-list->path script-path)))
 
-    (if (not request-invariant-cgi-env)
-	(initialise-request-invariant-cgi-env))
-
     (receive (rhost rport)
 	     (socket-address->internet-address raddr)
       (receive (lhost lport)
@@ -196,7 +203,7 @@
 	  ;; ("REMOTE_USER" . xx)		; features I don't understand.
 	  ;; ("REMOTE_IDENT" . xx)
 
-	  ,@request-invariant-cgi-env	; Stuff that never changes (see below).
+	  ,@request-invariant-cgi-env	; Stuff that never changes (see cgi-handler).
 
 	  ,@(cond ((http-url:search (request:url req)) =>
 		   (lambda (srch) `(("QUERY_STRING" . ,srch))))
@@ -220,14 +227,6 @@
 	  
 	  . ,(env->alist))))))
 
-(define request-invariant-cgi-env #f)
-(define (initialise-request-invariant-cgi-env)
-  (set! request-invariant-cgi-env
-	`(("PATH"              . ,(and (getenv "PATH") cgi-default-bin-path))
-	  ("SERVER_SOFTWARE"   . ,server/version)
-	  ("SERVER_NAME"       . ,(host-info:name (host-info (system-name))))
-	  ("GATEWAY_INTERFACE" . "CGI/1.1"))))
-	  
 
 (define (take n lis)
   (if (zero? n) '()

doc/latex/cgi-server.tex

@@ -5,21 +5,18 @@
 \item[Name of the package:] cgi-server
 \end{description}
 %
-\subsection{Variables}
-
-\defvar{cgi-default-bin-path}{string}
-\begin{desc}
-  This variable contains the path for scripts. Its value is
-  \codex{/bin:/usr/bin:/usr/ucb:/usr/bsd:/usr/local/bin}
-\end{desc}
-
 \subsection{Procedures}
 
-\begin{defundesc}{cgi-handler}{bin-dir}{path-handler}
+\begin{defundesc}{cgi-handler}{bin-dir \ovar{cgi-bin-dir}}{path-handler}
   Returns a path handler (see \ref{httpd:path-handlers} for details
   about path handlers) for cgi-scripts located in
-  \semvar{bin-dir}. The scripts are called as specified by
+  \semvar{bin-dir}. \semvar{cgi-bin-dir} specifies the value of the
-  CGI/1.1\footnote{see
+\ex{PATH} variable of the environment the cgi-scripts run in. It defaults
+to
+``\ex{/bin:\ob{}/usr/bin:\ob{}/usr/ucb:\ob{}/usr/bsd:\ob{}/usr/local/bin}''
+but is overwritten by the current \ex{PATH} environment variable at
+the time \ex{cgi-handler} ist called. The cgi-scripts are called as
+specified by CGI/1.1\footnote{see
 \ex{http://hoohoo.ncsa.uiuc.edu/cgi/interface.html} for a sort of
 specification.}. 
 
@@ -43,11 +40,3 @@ specification.}.
 \end{itemize}
 \end{itemize}
 \end{defundesc}
-
-\begin{defundesc}{initialise-request-invariant-cgi-env}{}{\noreturn}
-  Initializes the environment variables that are invariant from
-  cgi-call to cgi-call in order to save calculation time. Call this
-  procedure before you start your httpd. You have to do this, if you
-  use cgi-scripts, that read out the environment variables \ex{PATH},
-  \ex{SERVER\_SOFTWARE}, \ex{SERVER\_NAME} or \ex{GATEWAY\_INTERFACE}.
-\end{defundesc}

ftpd.scm

@@ -189,6 +189,7 @@
    maybe-args
    ((port 21)
     (logfile #f))
+
    (if logfile 
        (set! *logfile* (open-output-file logfile (bitwise-ior open/create open/append))))
    (with-syslog-destination 
@@ -1217,7 +1218,7 @@
 
 ; Version
 
-(define *ftpd-version* "$Revision: 1.36 $")
+(define *ftpd-version* "$Revision: 1.37 $")
 
 (define (copy-port->port-binary input-port output-port)
   (let ((buffer (make-string *window-size*)))

modules.scm

@@ -344,8 +344,7 @@
 ;;; Provides the server interface to CGI scripts.
 (define-interface cgi-server-interface 
   (export cgi-default-bin-path
-	  cgi-handler
+	  cgi-handler))
-	  initialise-request-invariant-cgi-env))
 
 (define-structure cgi-server cgi-server-interface
   (open	string-lib
@@ -362,6 +361,7 @@
 	formats			; format
 	format-net              ; FORMAT-INTERNET-HOST-ADDRESS
 	sunet-utilities         ; host-name-or-empty
+	let-opt                 ; let-optionals
 	scheme)
   (files cgi-server))