htdocs-dir, cgi-bin-dir, port and logfile-name now configurable by command line arguments
This commit is contained in:
parent
fd2d2bc79c
commit
b08f418d77
111
start-web-server
111
start-web-server
|
@ -1,5 +1,5 @@
|
|||
#!/bin/sh
|
||||
echo "Starting scsh..."
|
||||
echo "Loading..."
|
||||
exec scsh -lm packages.scm -dm -o http-test -e main -s "$0" "$@"
|
||||
!#
|
||||
|
||||
|
@ -8,6 +8,7 @@ exec scsh -lm packages.scm -dm -o http-test -e main -s "$0" "$@"
|
|||
(open httpd-core
|
||||
httpd-make-options
|
||||
httpd-basic-handlers
|
||||
httpd-file-directory-handlers
|
||||
cgi-server
|
||||
let-opt
|
||||
scsh
|
||||
|
@ -15,30 +16,106 @@ exec scsh -lm packages.scm -dm -o http-test -e main -s "$0" "$@"
|
|||
|
||||
(begin
|
||||
|
||||
(define (main args)
|
||||
(let ((port (string->number (:optional (cdr args) "8080"))))
|
||||
(if port
|
||||
(begin
|
||||
(format #t "Web-Server is now running on port ~d...~%" port)
|
||||
(http port))
|
||||
(format #t "Usage: ~a [port]~%~a~%" (car args) args))))
|
||||
(define (usage)
|
||||
(format #f
|
||||
"Usage: start-web-server [-h htdocs-dir] [-c cgi-bin-dir] [-p port]
|
||||
[-l log-file-name] [--help]
|
||||
|
||||
(define (http port)
|
||||
with
|
||||
htdocs-dir directory of html files (default: web-server/root/htdocs)
|
||||
cgi-bin-dir directory of cgi files (default: web-server/root/cgi-bin)
|
||||
port port server is listening to (default: 8080)
|
||||
log-file-name directory where to store the logfile in CLF
|
||||
(default: web-server/httpd.log)
|
||||
--help show this help
|
||||
"
|
||||
))
|
||||
|
||||
(define htdocs-dir "web-server/root/htdocs")
|
||||
(define cgi-bin-dir "web-server/root/cgi-bin")
|
||||
(define port "8080")
|
||||
(define log-file-name "web-server/httpd.log")
|
||||
(define root "web-server/root")
|
||||
|
||||
(define get-options
|
||||
(let* ((unknown-option-error
|
||||
(lambda (option)
|
||||
(format (error-output-port)
|
||||
"unknown option `~A'~%try `start-web-server --help'~%"
|
||||
option)
|
||||
(exit 1)))
|
||||
(missing-argument-error
|
||||
(lambda (option)
|
||||
(format (error-output-port)
|
||||
"option `~A' requires an argument~%try `start-web-server --help'~%"
|
||||
option)
|
||||
(exit 1))))
|
||||
(lambda (options)
|
||||
(let loop ((options options))
|
||||
(if (null? options)
|
||||
(begin
|
||||
(set! htdocs-dir (absolute-file-name htdocs-dir))
|
||||
(set! log-file-name (absolute-file-name log-file-name))
|
||||
(set! cgi-bin-dir (absolute-file-name cgi-bin-dir))
|
||||
(set! port (string->number port)))
|
||||
(cond
|
||||
((string=? (car options) "-h")
|
||||
(if (null? (cdr options))
|
||||
(missing-argument-error (car options))
|
||||
(set! htdocs-dir (cadr options)))
|
||||
(loop (cddr options)))
|
||||
((string=? (car options) "-c")
|
||||
(if (null? (cdr options))
|
||||
(missing-argument-error (car options))
|
||||
(set! cgi-bin-dir (cadr options)))
|
||||
(loop (cddr options)))
|
||||
((string=? (car options) "-p")
|
||||
(if (null? (cdr options))
|
||||
(missing-argument-error (car options))
|
||||
(set! port (cadr options)))
|
||||
(loop (cddr options)))
|
||||
((string=? (car options) "-l")
|
||||
(if (null? (cdr options))
|
||||
(missing-argument-error (car options))
|
||||
(set! log-file-name (cadr options)))
|
||||
(loop (cddr options)))
|
||||
((string=? (car options) "--help")
|
||||
(display (usage))
|
||||
(exit 0))
|
||||
(else
|
||||
(unknown-option-error (car options)))))))))
|
||||
|
||||
|
||||
(define (main args)
|
||||
(get-options (cdr args))
|
||||
(format #t "options read~%")
|
||||
(cond ((zero? (user-uid))
|
||||
(set-gid -2) ; Should be (set-uid (->uid "nobody"))
|
||||
(set-uid -2))) ; but NeXTSTEP loses.
|
||||
|
||||
(format #t "Going to run Webserver with:
|
||||
htdocs-dir: ~a
|
||||
cgi-bin-dir: ~a
|
||||
port: ~a
|
||||
log-file-name: ~a
|
||||
a maximum of ~a simultaneous requests, syslogging activated,
|
||||
and home-dir-handler (public_html) activated.
|
||||
"
|
||||
htdocs-dir
|
||||
cgi-bin-dir
|
||||
port
|
||||
log-file-name
|
||||
5)
|
||||
|
||||
(httpd (with-port port
|
||||
(with-root-directory (absolute-file-name "./web-server/root")
|
||||
(with-simultaneous-requests 23
|
||||
; (with-root-directory (absolute-file-name "./web-server/root")
|
||||
(with-simultaneous-requests 5
|
||||
(with-syslog? #t
|
||||
(with-logfile (absolute-file-name "./web-server/httpd.log")
|
||||
(with-logfile log-file-name
|
||||
(with-path-handler
|
||||
(alist-path-dispatcher
|
||||
(list (cons "h" (home-dir-handler "public_html"))
|
||||
(cons "cgi-bin"
|
||||
(cgi-handler (absolute-file-name
|
||||
"./web-server/root/cgi-bin"))))
|
||||
(rooted-file-or-directory-handler
|
||||
(absolute-file-name "./web-server/root/htdocs") ""))))))))))
|
||||
(cons "cgi-bin" (cgi-handler cgi-bin-dir)))
|
||||
(rooted-file-or-directory-handler htdocs-dir)))))))))
|
||||
))
|
||||
;; EOF
|
||||
|
|
Loading…
Reference in New Issue