sunet/start-web-server

122 lines
3.5 KiB
Plaintext
Executable File

#!/bin/sh
echo "Loading..."
exec scsh -lm packages.scm -dm -o http-test -e main -s "$0" "$@"
!#
(define-structure http-test
(export main)
(open httpd-core
httpd-make-options
httpd-basic-handlers
httpd-file-directory-handlers
cgi-server
let-opt
scsh
scheme)
(begin
(define (usage)
(format #f
"Usage: start-web-server [-h htdocs-dir] [-c cgi-bin-dir] [-p port]
[-l log-file-name] [--help]
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 5
(with-syslog? #t
(with-logfile log-file-name
(with-path-handler
(alist-path-dispatcher
(list (cons "h" (home-dir-handler "public_html"))
(cons "cgi-bin" (cgi-handler cgi-bin-dir)))
(rooted-file-or-directory-handler htdocs-dir)))))))))
))
;; EOF