sunet/start-surflet-server

215 lines
6.7 KiB
Bash
Executable File

#!/bin/sh
echo "Loading..."
# $sunetscheme is either $SUNET/scheme or $PWD/scheme
# Kind of a hack, I know. We're still waiting for this library
#installing system.
sunetscheme=${SUNET:-$PWD}/scheme
ssaxhome=${SSAX:-../SSAX} # path to SSAX
exec scsh -lm $sunetscheme/packages.scm -lm $ssaxhome/lib/packages.scm -lm $sunetscheme/httpd/surflets/packages.scm -dm -o surflet-server -e main -s "$0" "$@"
!#
(define-structure surflet-server
(export main ; sh jump entry point
server) ; scsh entry point
(open httpd-core
httpd-make-options
httpd-basic-handlers
httpd-file-directory-handlers
; cgi-server
; seval-handler
; rman-gateway
; info-gateway
surflet-handler
surflet-handler/options
let-opt
scsh
scheme)
(begin
(define (usage)
(format #f
"Usage: start-surflet-server [-h htdocs-dir] [-s surflet-dir] [-i images-dir]
[-p port] [-l log-file-name]
[-r requests] [--help]
with
htdocs-dir directory of html files (default: ./web-server/root/htdocs)
surflet-dir directory of SUrflet files (default: ./web-server/root/surflets)
images-dir directory of images files (default: ./web-server/root/img)
port port server is listening to (default: 8008)
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
NOTE: This is the SUrflet-server. It does not support cgi-bin.
"
))
(define htdocs-dir #f)
(define images-dir #f)
; (define cgi-bin-dir #f)
(define port #f)
(define log-file-name #f)
(define root #f)
(define surflet-dir #f)
(define simultaneous-requests #f)
(define (init)
(set! htdocs-dir "./web-server/root/htdocs")
(set! images-dir "./web-server/root/img")
; (set! cgi-bin-dir "./web-server/root/cgi-bin")
(set! port "8008")
(set! log-file-name "./web-server/httpd.log")
(set! root "./web-server/root")
(set! surflet-dir "./web-server/root/surflets")
(set! simultaneous-requests "5"))
(define (normalize-options)
(set! htdocs-dir (absolute-file-name htdocs-dir))
(set! images-dir (absolute-file-name images-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! surflet-dir (absolute-file-name surflet-dir))
(set! simultaneous-requests (string->number simultaneous-requests)))
(define get-options
(let* ((unknown-option-error
(lambda (option)
(format (error-output-port)
"unknown option `~A'~%try `surflet-server --help'~%"
option)
(exit 1)))
(missing-argument-error
(lambda (option)
(format (error-output-port)
"option `~A' requires an argument~%try `surflet-server --help'~%"
option)
(exit 1))))
(lambda (options)
(let loop ((options options))
(if (null? options)
(normalize-options)
(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) "-i")
(if (null? (cdr options))
(missing-argument-error (car options))
(set! images-dir (cadr options)))
(loop (cddr options)))
((string=? (car options) "-c")
(format (error-output-port)
"This is the SUrflet server. It does not support cgi.~%")
; (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) "-s")
(if (null? (cdr options))
(missing-argument-error (car options))
(set! surflet-dir (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))
"surflet-server"
(cadr options))))
(dump-scsh-program main image-name))
(exit 0))
(else
(unknown-option-error (car options)))))))))
(define (server . args)
(if (pair? args)
(main `(main ,@(car args)))
(main '(main))))
(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 SUrflet server with:
htdocs-dir: ~a
surflet-dir: ~a
images-dir: ~a
port: ~a
log-file-name: ~a
a maximum of ~a simultaneous requests, syslogging activated,
and home-dir-handler (public_html) activated.
NOTE: This is the SUrflet server. It does not support cgi.
"
htdocs-dir
surflet-dir
images-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
;; The following settings are made to avoid dns lookups.
with-reported-port port
with-fqdn "localhost"
with-resolve-ips? #f
with-request-handler
(alist-path-dispatcher
(list (cons "h" (home-dir-handler "public_html"))
; (cons "seval" seval-handler)
; (cons "man" (rman-handler #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))
(cons "source" (rooted-file-or-directory-handler
surflet-dir
(with-file-name->content-type
(lambda (file-name)
(if (string-ci=? (file-name-extension file-name)
".scm")
"text/plain"))
(make-file-directory-options))))
(cons "img" (rooted-file-handler images-dir))
(cons "surflet" (surflet-handler
(with-surflet-path surflet-dir))))
(rooted-file-or-directory-handler htdocs-dir))))
)
))
;; EOF
;;; Local Variables:
;;; mode:scheme
;;; End: