sunet/start-web-server

141 lines
3.9 KiB
Plaintext
Raw Normal View History

#!/bin/sh
echo "Loading..."
exec scsh -lel sunet-2.1/load.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
httpd-cgi-handlers
httpd-seval-handlers
scheme-with-scsh)
(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 #f)
(define cgi-bin-dir #f)
(define port #f)
(define log-file-name #f)
(define root #f)
(define (init)
(set! htdocs-dir "web-server/root/htdocs")
(set! cgi-bin-dir "web-server/root/cgi-bin")
(set! port "8080")
(set! log-file-name "web-server/httpd.log")
(set! 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))
2002-08-28 11:42:15 -04:00
((string=? (car options) "--dump")
(let ((image-name (if (null? (cdr options))
"web-server"
2002-08-28 11:42:15 -04:00
(cadr options))))
(dump-scsh-program main image-name))
(exit 0))
(else
(unknown-option-error (car options)))))))))
(define (become-nobody-if-root)
(cond ((zero? (user-uid))
(set-gid (->gid "nobody"))
(set-uid (->uid "nobody")))))
(define (main args)
(init)
(format #t "reading options: ~s~%" (cdr args))
(get-options (cdr args))
(format #t "Going to run Webserver with:
htdocs-dir: ~a
cgi-bin-dir: ~a
port: ~a
log-file-name: ~a
syslogging activated.
"
htdocs-dir
cgi-bin-dir
port
log-file-name)
(httpd (make-httpd-options
with-port port
with-root-directory (cwd)
with-syslog? #t
with-log-file log-file-name
with-post-bind-thunk become-nobody-if-root
with-request-handler
(alist-path-dispatcher
(list (cons "cgi-bin" (cgi-handler cgi-bin-dir))
(cons "seval" seval-handler))
(tilde-home-dir-handler "public_html"
(rooted-file-or-directory-handler
htdocs-dir))))))
))
;; EOF
;;; Local Variables:
;;; mode:scheme
;;; End: