216 lines
6.8 KiB
Bash
Executable File
216 lines
6.8 KiB
Bash
Executable File
#!/bin/sh
|
|
echo "Loading..."
|
|
fullpath=`which $0`
|
|
# $sunet is either $SUNET or created out of fullpath
|
|
# Kind of a hack, I know. We're still waiting for this library
|
|
#installing system.
|
|
sunethome=${SUNET:-`dirname $fullpath`/../..}
|
|
ssaxhome=${SSAX:-`dirname $fullpath`/../../../SSAX} # path to SSAX
|
|
|
|
exec scsh -lm $sunethome/packages.scm -lm $ssaxhome/lib/packages.scm -lm $sunethome/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:
|