sunet/scheme/httpd/surflets/start-surflet-server

#!/bin/sh
echo "Loading..."
fullpath=`which $0`
# $sunet is either $SUNETHOME or created out of fullpath
# Kind of a hack, I know.
sunet=${SUNETHOME:-`dirname $fullpath`/../..}
ssax=${SSAXPATH:-$sunet/SSAX}                    # path to SSAX

exec scsh -lm $sunet/packages.scm -lm $ssax/lib/packages.scm -lm $sunet/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
	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: 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

 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 "8088")
      (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-logfile		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"
						 (make-file-directory-options)))
;		     (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))
		     ;; Browsers cannot handle .SCM files: Opera shows
		     ;; it as HTML, Netscape asks for a program to
		     ;; view it. ROOTED-FILE-OR-DIRECTORY-HANDLER
		     ;; should serve .SCM files as text/plain (I did
		     ;; not want to write a handler just for this file
		     ;; type.)
		     (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
						      (make-file-directory-options)))
		     (cons "surflet" (surflet-handler surflet-dir)))
	       (rooted-file-or-directory-handler htdocs-dir
						 (make-file-directory-options)))))
      )
))
;; EOF

;;; Local Variables:
;;; mode:scheme
;;; End: