scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

* 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]
This commit is contained in:
interp 2002-04-25 09:35:18 +00:00
parent 49ac945af4
commit 2fccbe9b3e
4 changed files with 64 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
cgi-server.scm
View File

@ -86,53 +86,63 @@
;;; The path handler for CGI scripts. (car path) is the script to run. ;;; 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))
(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)) (filename (or (dotdot-check bin-dir (list prog))
(http-error http-reply/bad-request req (http-error http-reply/bad-request req
(format #f "CGI scripts may not contain \"..\" elements.")))) (format #f "CGI scripts may not contain \"..\" elements."))))
(nph? (string-prefix? "nph-" prog)) ; PROG starts with "nph-" ? (nph? (string-prefix? "nph-" prog)) ; PROG starts with "nph-" ?
; why did we had (string-suffix? "-nph" prog) here? ; why did we had (string-suffix? "-nph" prog) here?
(search (http-url:search (request:url req))) ; Compute the (search (http-url:search (request:url req))) ; Compute the
(argv (if (and search (not (string-index search #\=))) ; argv list. (argv (if (and search (not (string-index search #\=))) ; argv list.
(split-and-decode-search-spec search) (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 () (doit (lambda ()
(dup->inport (current-input-port) 0) (dup->inport (current-input-port) 0)
(dup->outport (current-output-port) 1) (dup->outport (current-output-port) 1)
(apply exec/env filename env argv)))) (apply exec/env filename env argv))))
(http-syslog (syslog-level debug) "[cgi-server] search: ~s, argv: ~s~%" search argv) (http-syslog (syslog-level debug) "[cgi-server] search: ~s, argv: ~s~%" search argv)
(let ((request-method (request:method req))) (let ((request-method (request:method req)))
(cond (cond
((or (string=? request-method "GET") ((or (string=? request-method "GET")
(string=? request-method "POST")) ; Could do others also. (string=? request-method "POST")) ; Could do others also.
(if nph? (if nph?
(let ((stat (wait (fork doit)))) (let ((stat (wait (fork doit))))
(if (not (zero? stat)) (if (not (zero? stat))
(http-error http-reply/bad-request req (http-error http-reply/bad-request req
(format #f "Could not execute CGI script ~a." (format #f "Could not execute CGI script ~a."
filename)) filename))
stat)) stat))
(cgi-send-reply (run/port* doit) req))) (cgi-send-reply (run/port* doit) req)))
(else (http-error http-reply/method-not-allowed req))))) (else (http-error http-reply/method-not-allowed req)))))
(http-error http-reply/bad-request req "Empty CGI script")))) (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) ((string-index s #\+ i) => (lambda (j) (cons (unescape-uri s i j)
(recur (+ j 1))))) (recur (+ j 1)))))
(else (list (unescape-uri s i (string-length s))))))) (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 ;;; 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. ;;; 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)) (let* ((sock (request:socket req))
(raddr (socket-remote-address sock)) (raddr (socket-remote-address sock))
@ -173,9 +183,6 @@
url-path)) url-path))
(script-name (uri-path-list->path script-path))) (script-name (uri-path-list->path script-path)))
(if (not request-invariant-cgi-env)
(initialise-request-invariant-cgi-env))
(receive (rhost rport) (receive (rhost rport)
(socket-address->internet-address raddr) (socket-address->internet-address raddr)
(receive (lhost lport) (receive (lhost lport)
@ -196,7 +203,7 @@
;; ("REMOTE_USER" . xx) ; features I don't understand. ;; ("REMOTE_USER" . xx) ; features I don't understand.
;; ("REMOTE_IDENT" . xx) ;; ("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)) => ,@(cond ((http-url:search (request:url req)) =>
(lambda (srch) `(("QUERY_STRING" . ,srch)))) (lambda (srch) `(("QUERY_STRING" . ,srch))))
@ -220,14 +227,6 @@
. ,(env->alist)))))) . ,(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) (define (take n lis)
(if (zero? n) '() (if (zero? n) '()

31
doc/latex/cgi-server.tex
View File

@ -5,23 +5,20 @@
\item[Name of the package:] cgi-server \item[Name of the package:] cgi-server
\end{description} \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} \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 Returns a path handler (see \ref{httpd:path-handlers} for details
about path handlers) for cgi-scripts located in 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 \ex{http://hoohoo.ncsa.uiuc.edu/cgi/interface.html} for a sort of
specification.}. specification.}.
\begin{itemize} \begin{itemize}
\item Various environment variables are set (like \item Various environment variables are set (like
@ -42,12 +39,4 @@ specification.}.
\end{itemize} \end{itemize}
\end{itemize} \end{itemize}
\end{defundesc} \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}

3
ftpd.scm
View File

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

4
modules.scm
View File

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