#!/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: