sunet/start-web-server

147 lines
4.1 KiB
Plaintext
Raw Normal View History

#!/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
2002-08-28 11:42:15 -04:00
seval-handler
rman-gateway
2002-08-29 10:34:57 -04:00
info-gateway
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 #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))
"server"
(cadr options))))
(dump-scsh-program main image-name))
(exit 0))
(else
(unknown-option-error (car options)))))))))
(define (main args)
(init)
(get-options (cdr args))
(format #t "options read~%")
(cond ((zero? (user-uid))
2002-09-05 04:55:58 -04:00
(set-gid (->gid "nobody"))
(set-uid (->uid "nobody"))))
(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 "seval" seval-handler)
(cons "man" (rman-handler #f "man?%s(%s)"
2002-08-29 10:34:57 -04:00
"Generated by rman-gateway"))
(cons "info" (info-handler #f #f #f
"Generated by info-gateway"))
(cons "cgi-bin" (cgi-handler cgi-bin-dir)))
(rooted-file-or-directory-handler htdocs-dir)))))))))
))
;; EOF
;;; Local Variables:
;;; mode:scheme
;;; End: