From 2fccbe9b3e5bafc12bea6b796eb2a2191f26f765 Mon Sep 17 00:00:00 2001 From: interp Date: Thu, 25 Apr 2002 09:35:18 +0000 Subject: [PATCH] * 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 | 101 +++++++++++++++++++-------------------- doc/latex/cgi-server.tex | 31 ++++-------- ftpd.scm | 3 +- modules.scm | 4 +- 4 files changed, 64 insertions(+), 75 deletions(-) diff --git a/cgi-server.scm b/cgi-server.scm index d10e4c1..d8e7746 100644 --- a/cgi-server.scm +++ b/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) - (lambda (path req) - (if (pair? path) ; Got to have at least one elt. - (let* ((prog (car path)) +(define (cgi-handler bin-dir . maybe-cgi-bin-path) + (let-optionals + maybe-cgi-bin-path + ((cgi-bin-path cgi-default-bin-path)) + + (let ((request-invariant-cgi-env ; environment variables that never change + `(("PATH" . ,(and (getenv "PATH") cgi-bin-path)) + ("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)) - (filename (or (dotdot-check bin-dir (list prog)) - (http-error http-reply/bad-request req - (format #f "CGI scripts may not contain \"..\" elements.")))) + (filename (or (dotdot-check bin-dir (list prog)) + (http-error http-reply/bad-request req + (format #f "CGI scripts may not contain \"..\" elements.")))) - (nph? (string-prefix? "nph-" prog)) ; PROG starts with "nph-" ? - ; why did we had (string-suffix? "-nph" prog) here? + (nph? (string-prefix? "nph-" prog)) ; PROG starts with "nph-" ? + ; why did we had (string-suffix? "-nph" prog) here? - (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) - '())) + (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) + '())) - (env (cgi-env req bin-dir (cdr path))) + (env (cgi-env req bin-dir (cdr path) request-invariant-cgi-env)) - (doit (lambda () - (dup->inport (current-input-port) 0) - (dup->outport (current-output-port) 1) - (apply exec/env filename env argv)))) + (doit (lambda () + (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) - (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))) - - (else (http-error http-reply/method-not-allowed req))))) - - (http-error http-reply/bad-request req "Empty CGI script")))) + (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))) + + (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) - (let recur ((i 0)) - (cond + (define (split-and-decode-search-spec s) + (let recur ((i 0)) + (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) '() diff --git a/doc/latex/cgi-server.tex b/doc/latex/cgi-server.tex index d73441b..f4a9f10 100644 --- a/doc/latex/cgi-server.tex +++ b/doc/latex/cgi-server.tex @@ -5,23 +5,20 @@ \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 - CGI/1.1\footnote{see + \semvar{bin-dir}. \semvar{cgi-bin-dir} specifies the value of the +\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.}. +specification.}. \begin{itemize} \item Various environment variables are set (like @@ -42,12 +39,4 @@ 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} +\end{defundesc} \ No newline at end of file diff --git a/ftpd.scm b/ftpd.scm index 7a3f370..48a9b15 100644 --- a/ftpd.scm +++ b/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*))) diff --git a/modules.scm b/modules.scm index 6bd7b2b..8ff0f94 100644 --- a/modules.scm +++ b/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 - initialise-request-invariant-cgi-env)) + cgi-handler)) (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))