sunet/start-extended-web-server

165 lines
4.8 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
httpd-cgi-handlers
httpd-seval-handlers
httpd-rman-gateway
httpd-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] [-r requests] [--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)
requests maximal amount of simultaneous requests (default 5)
--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 simultaneous-requests #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")
(set! simultaneous-requests "5"))
(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))
(set! simultaneous-requests (string->number simultaneous-requests)))
(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) "-r")
(if (null? (cdr options))
(missing-argument-error (car options))
(set! simultaneous-requests (cadr options)))
(loop (cddr options)))
((string=? (car options) "--help")
(display (usage))
(exit 0))
((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)
(format #t "reading options: ~s~%" (cdr args))
(get-options (cdr args))
(cond ((zero? (user-uid))
(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
simultaneous-requests)
(httpd (make-httpd-options
with-port port
with-root-directory (cwd)
with-simultaneous-requests simultaneous-requests
with-syslog? #t
with-log-file log-file-name
with-request-handler
(alist-path-dispatcher
(list (cons "h" (home-dir-handler "public_html"
(make-file-directory-options)))
(cons "seval" seval-handler)
;; You may want to adapt this to your site.
(cons "man" (rman-handler 'man
'nroff
"/usr/bin/rman"
"/usr/bin/zcat"
#f "man?%s(%s)"
"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
(make-file-directory-options))))))
))
;; EOF
;;; Local Variables:
;;; mode:scheme
;;; End: