* slim example web-server
* create an example web-server using servlets in httpd/servlets (the servlet files from the example web-server moved there)
This commit is contained in:
parent
abd747a49b
commit
a66cd239c9
|
@ -0,0 +1,172 @@
|
||||||
|
#!/bin/sh
|
||||||
|
echo "Loading..."
|
||||||
|
exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/servlets/packages.scm -lm ${SSAXPATH:-${SUNETHOME:-../..}/SSAX}/lib/packages.scm -dm -o servlet-server -e main -s "$0" "$@"
|
||||||
|
!#
|
||||||
|
|
||||||
|
(define-structure servlet-server
|
||||||
|
(export main)
|
||||||
|
(open httpd-core
|
||||||
|
httpd-make-options
|
||||||
|
httpd-basic-handlers
|
||||||
|
httpd-file-directory-handlers
|
||||||
|
; cgi-server
|
||||||
|
; seval-handler
|
||||||
|
; rman-gateway
|
||||||
|
; info-gateway
|
||||||
|
servlet-handler
|
||||||
|
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
|
||||||
|
|
||||||
|
NOTE: This is the servlet-server. It does not support cgi-bin.
|
||||||
|
"
|
||||||
|
))
|
||||||
|
|
||||||
|
(define htdocs-dir #f)
|
||||||
|
(define cgi-bin-dir #f)
|
||||||
|
(define port #f)
|
||||||
|
(define log-file-name #f)
|
||||||
|
(define root #f)
|
||||||
|
(define servlet-dir #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 "8088")
|
||||||
|
(set! log-file-name "web-server/httpd.log")
|
||||||
|
(set! root "web-server/root")
|
||||||
|
(set! servlet-dir "web-server/root/servlets")
|
||||||
|
(set! simultaneous-requests "5"))
|
||||||
|
|
||||||
|
(define get-options
|
||||||
|
(let* ((unknown-option-error
|
||||||
|
(lambda (option)
|
||||||
|
(format (error-output-port)
|
||||||
|
"unknown option `~A'~%try `servlet-server --help'~%"
|
||||||
|
option)
|
||||||
|
(exit 1)))
|
||||||
|
(missing-argument-error
|
||||||
|
(lambda (option)
|
||||||
|
(format (error-output-port)
|
||||||
|
"option `~A' requires an argument~%try `servlet-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! servlet-dir (absolute-file-name servlet-dir))
|
||||||
|
(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")
|
||||||
|
(format (error-output-port)
|
||||||
|
"This is the servlet 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! servlet-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))
|
||||||
|
"servlet-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 Servlet server 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.
|
||||||
|
|
||||||
|
NOTE: This is the Servlet server. It does not support cgi.
|
||||||
|
"
|
||||||
|
htdocs-dir
|
||||||
|
cgi-bin-dir
|
||||||
|
port
|
||||||
|
log-file-name
|
||||||
|
simultaneous-requests)
|
||||||
|
|
||||||
|
(httpd (with-port port
|
||||||
|
; (with-root-directory (absolute-file-name "./web-server/root")
|
||||||
|
(with-simultaneous-requests simultaneous-requests
|
||||||
|
(with-syslog? #t
|
||||||
|
(with-logfile log-file-name
|
||||||
|
(with-path-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 "servlet" (servlet-handler servlet-dir)))
|
||||||
|
(rooted-file-or-directory-handler htdocs-dir)))))))))
|
||||||
|
))
|
||||||
|
;; EOF
|
||||||
|
|
||||||
|
;;; Local Variables:
|
||||||
|
;;; mode:scheme
|
||||||
|
;;; End:
|
|
@ -0,0 +1 @@
|
||||||
|
httpd.log
|
|
@ -0,0 +1,27 @@
|
||||||
|
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
|
||||||
|
<html>
|
||||||
|
<head><title>Scheme Unterground</title></head>
|
||||||
|
<body>
|
||||||
|
<p>
|
||||||
|
<h1>Hello Unterground!</h1>
|
||||||
|
|
||||||
|
Following files are available from here:
|
||||||
|
<ul>
|
||||||
|
<li><a href=/servlet/news.scm>News</a></li>
|
||||||
|
<li><a href=/servlet/test.scm>A test servlet</a></li>
|
||||||
|
<li><a href=index.html>This file</a></li>
|
||||||
|
</ul>
|
||||||
|
<br>
|
||||||
|
And nothing else...
|
||||||
|
|
||||||
|
<hr>
|
||||||
|
<!-- Created: Thu Aug 22 16:44:16 CEST 2002 -->
|
||||||
|
<!-- hhmts start -->
|
||||||
|
Last modified: Thu Sep 19 13:58:31 CEST 2002
|
||||||
|
<!-- hhmts end -->
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
||||||
|
</p>
|
||||||
|
</body>
|
||||||
|
</html>
|
|
@ -2,7 +2,6 @@
|
||||||
(open scsh
|
(open scsh
|
||||||
scheme
|
scheme
|
||||||
plugin-utilities
|
plugin-utilities
|
||||||
httpd-responses
|
|
||||||
crlf-io)
|
crlf-io)
|
||||||
(begin
|
(begin
|
||||||
(define *data* '())
|
(define *data* '())
|
|
@ -1,6 +1,6 @@
|
||||||
#!/bin/sh
|
#!/bin/sh
|
||||||
echo "Loading..."
|
echo "Loading..."
|
||||||
exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX}/lib/packages.scm -dm -o http-test -e main -s "$0" "$@"
|
exec scsh -lm packages.scm -dm -o http-test -e main -s "$0" "$@"
|
||||||
!#
|
!#
|
||||||
|
|
||||||
(define-structure http-test
|
(define-structure http-test
|
||||||
|
@ -10,11 +10,6 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX}
|
||||||
httpd-basic-handlers
|
httpd-basic-handlers
|
||||||
httpd-file-directory-handlers
|
httpd-file-directory-handlers
|
||||||
cgi-server
|
cgi-server
|
||||||
seval-handler
|
|
||||||
rman-gateway
|
|
||||||
info-gateway
|
|
||||||
servlet-handler
|
|
||||||
let-opt
|
|
||||||
scsh
|
scsh
|
||||||
scheme)
|
scheme)
|
||||||
|
|
||||||
|
@ -23,7 +18,7 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX}
|
||||||
(define (usage)
|
(define (usage)
|
||||||
(format #f
|
(format #f
|
||||||
"Usage: start-web-server [-h htdocs-dir] [-c cgi-bin-dir] [-p port]
|
"Usage: start-web-server [-h htdocs-dir] [-c cgi-bin-dir] [-p port]
|
||||||
[-l log-file-name] [-r requests] [--help]
|
[-l log-file-name] [--help]
|
||||||
|
|
||||||
with
|
with
|
||||||
htdocs-dir directory of html files (default: web-server/root/htdocs)
|
htdocs-dir directory of html files (default: web-server/root/htdocs)
|
||||||
|
@ -31,7 +26,6 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX}
|
||||||
port port server is listening to (default: 8080)
|
port port server is listening to (default: 8080)
|
||||||
log-file-name directory where to store the logfile in CLF
|
log-file-name directory where to store the logfile in CLF
|
||||||
(default: web-server/httpd.log)
|
(default: web-server/httpd.log)
|
||||||
requests maximal amount of simultaneous requests (default 5)
|
|
||||||
--help show this help
|
--help show this help
|
||||||
"
|
"
|
||||||
))
|
))
|
||||||
|
@ -41,16 +35,13 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX}
|
||||||
(define port #f)
|
(define port #f)
|
||||||
(define log-file-name #f)
|
(define log-file-name #f)
|
||||||
(define root #f)
|
(define root #f)
|
||||||
(define servlet-dir #f)
|
|
||||||
(define simultaneous-requests "5")
|
|
||||||
|
|
||||||
(define (init)
|
(define (init)
|
||||||
(set! htdocs-dir "web-server/root/htdocs")
|
(set! htdocs-dir "web-server/root/htdocs")
|
||||||
(set! cgi-bin-dir "web-server/root/cgi-bin")
|
(set! cgi-bin-dir "web-server/root/cgi-bin")
|
||||||
(set! port "8080")
|
(set! port "8080")
|
||||||
(set! log-file-name "web-server/httpd.log")
|
(set! log-file-name "web-server/httpd.log")
|
||||||
(set! root "web-server/root")
|
(set! root "web-server/root"))
|
||||||
(set! servlet-dir "web-server/root/servlets"))
|
|
||||||
|
|
||||||
(define get-options
|
(define get-options
|
||||||
(let* ((unknown-option-error
|
(let* ((unknown-option-error
|
||||||
|
@ -72,9 +63,7 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX}
|
||||||
(set! htdocs-dir (absolute-file-name htdocs-dir))
|
(set! htdocs-dir (absolute-file-name htdocs-dir))
|
||||||
(set! log-file-name (absolute-file-name log-file-name))
|
(set! log-file-name (absolute-file-name log-file-name))
|
||||||
(set! cgi-bin-dir (absolute-file-name cgi-bin-dir))
|
(set! cgi-bin-dir (absolute-file-name cgi-bin-dir))
|
||||||
(set! port (string->number port))
|
(set! port (string->number port)))
|
||||||
(set! servlet-dir (absolute-file-name servlet-dir))
|
|
||||||
(set! simultaneous-requests (string->number simultaneous-requests)))
|
|
||||||
(cond
|
(cond
|
||||||
((string=? (car options) "-h")
|
((string=? (car options) "-h")
|
||||||
(if (null? (cdr options))
|
(if (null? (cdr options))
|
||||||
|
@ -96,22 +85,12 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX}
|
||||||
(missing-argument-error (car options))
|
(missing-argument-error (car options))
|
||||||
(set! log-file-name (cadr options)))
|
(set! log-file-name (cadr options)))
|
||||||
(loop (cddr options)))
|
(loop (cddr options)))
|
||||||
((string=? (car options) "-s")
|
|
||||||
(if (null? (cdr options))
|
|
||||||
(missing-argument-error (car options))
|
|
||||||
(set! servlet-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")
|
((string=? (car options) "--help")
|
||||||
(display (usage))
|
(display (usage))
|
||||||
(exit 0))
|
(exit 0))
|
||||||
((string=? (car options) "--dump")
|
((string=? (car options) "--dump")
|
||||||
(let ((image-name (if (null? (cdr options))
|
(let ((image-name (if (null? (cdr options))
|
||||||
"server"
|
"web-server"
|
||||||
(cadr options))))
|
(cadr options))))
|
||||||
(dump-scsh-program main image-name))
|
(dump-scsh-program main image-name))
|
||||||
(exit 0))
|
(exit 0))
|
||||||
|
@ -132,30 +111,20 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX}
|
||||||
cgi-bin-dir: ~a
|
cgi-bin-dir: ~a
|
||||||
port: ~a
|
port: ~a
|
||||||
log-file-name: ~a
|
log-file-name: ~a
|
||||||
a maximum of ~a simultaneous requests, syslogging activated,
|
syslogging activated.
|
||||||
and home-dir-handler (public_html) activated.
|
|
||||||
"
|
"
|
||||||
htdocs-dir
|
htdocs-dir
|
||||||
cgi-bin-dir
|
cgi-bin-dir
|
||||||
port
|
port
|
||||||
log-file-name
|
log-file-name)
|
||||||
simultaneous-requests)
|
|
||||||
|
|
||||||
(httpd (with-port port
|
(httpd (with-port port
|
||||||
; (with-root-directory (absolute-file-name "./web-server/root")
|
|
||||||
(with-simultaneous-requests simultaneous-requests
|
|
||||||
(with-syslog? #t
|
(with-syslog? #t
|
||||||
(with-logfile log-file-name
|
(with-logfile log-file-name
|
||||||
(with-path-handler
|
(with-path-handler
|
||||||
|
(tilde-home-dir-handler "public_html"
|
||||||
(alist-path-dispatcher
|
(alist-path-dispatcher
|
||||||
(list (cons "h" (home-dir-handler "public_html"))
|
(list (cons "cgi" (cgi-handler cgi-bin-dir)))
|
||||||
(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 "servlet" (servlet-handler servlet-dir)))
|
|
||||||
(rooted-file-or-directory-handler htdocs-dir)))))))))
|
(rooted-file-or-directory-handler htdocs-dir)))))))))
|
||||||
))
|
))
|
||||||
;; EOF
|
;; EOF
|
||||||
|
|
|
@ -16,8 +16,6 @@
|
||||||
<li><a href=info?(dir)Top>Get the dir info page</a><br>
|
<li><a href=info?(dir)Top>Get the dir info page</a><br>
|
||||||
(needs a matching info page installation;<br>
|
(needs a matching info page installation;<br>
|
||||||
among others, we need non-gzipped info pages)</li>
|
among others, we need non-gzipped info pages)</li>
|
||||||
<li><a href=/servlet/test.scm>A test servlet</a></li>
|
|
||||||
<li><a href=/servlet/news.scm>News</a></li>
|
|
||||||
<li><a href=files/text.txt>Text file</a></li>
|
<li><a href=files/text.txt>Text file</a></li>
|
||||||
<li><a href=files>Directory</a></li>
|
<li><a href=files>Directory</a></li>
|
||||||
<li><a href=files/zipped.gz>Compressed File</a></li>
|
<li><a href=files/zipped.gz>Compressed File</a></li>
|
||||||
|
@ -30,7 +28,7 @@
|
||||||
<hr>
|
<hr>
|
||||||
<!-- Created: Thu Aug 22 16:44:16 CEST 2002 -->
|
<!-- Created: Thu Aug 22 16:44:16 CEST 2002 -->
|
||||||
<!-- hhmts start -->
|
<!-- hhmts start -->
|
||||||
Last modified: Thu Sep 12 17:06:32 CEST 2002
|
Last modified: Thu Sep 19 13:56:18 CEST 2002
|
||||||
<!-- hhmts end -->
|
<!-- hhmts end -->
|
||||||
</body>
|
</body>
|
||||||
</html>
|
</html>
|
||||||
|
|
Loading…
Reference in New Issue