From a66cd239c9b4f95a301de879a8756a37a0200608 Mon Sep 17 00:00:00 2001 From: interp Date: Fri, 20 Sep 2002 19:23:17 +0000 Subject: [PATCH] * slim example web-server * create an example web-server using servlets in httpd/servlets (the servlet files from the example web-server moved there) --- scheme/httpd/surflets/start-surflet-server | 172 ++++++++++++++++++ scheme/httpd/surflets/web-server/.gitignore | 1 + .../web-server/root/htdocs/index.html | 27 +++ .../web-server}/root/surflets/news.scm | 1 - .../web-server}/root/surflets/news.txt | 0 .../web-server}/root/surflets/test.scm | 0 start-web-server | 51 +----- web-server/root/htdocs/index2.html | 4 +- 8 files changed, 211 insertions(+), 45 deletions(-) create mode 100755 scheme/httpd/surflets/start-surflet-server create mode 100644 scheme/httpd/surflets/web-server/.gitignore create mode 100644 scheme/httpd/surflets/web-server/root/htdocs/index.html rename {web-server => scheme/httpd/surflets/web-server}/root/surflets/news.scm (98%) rename {web-server => scheme/httpd/surflets/web-server}/root/surflets/news.txt (100%) rename {web-server => scheme/httpd/surflets/web-server}/root/surflets/test.scm (100%) diff --git a/scheme/httpd/surflets/start-surflet-server b/scheme/httpd/surflets/start-surflet-server new file mode 100755 index 0000000..d8e977c --- /dev/null +++ b/scheme/httpd/surflets/start-surflet-server @@ -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: \ No newline at end of file diff --git a/scheme/httpd/surflets/web-server/.gitignore b/scheme/httpd/surflets/web-server/.gitignore new file mode 100644 index 0000000..d2341ad --- /dev/null +++ b/scheme/httpd/surflets/web-server/.gitignore @@ -0,0 +1 @@ +httpd.log diff --git a/scheme/httpd/surflets/web-server/root/htdocs/index.html b/scheme/httpd/surflets/web-server/root/htdocs/index.html new file mode 100644 index 0000000..58ee6f4 --- /dev/null +++ b/scheme/httpd/surflets/web-server/root/htdocs/index.html @@ -0,0 +1,27 @@ + + + Scheme Unterground + +

+

Hello Unterground!

+ + Following files are available from here: + +
+ And nothing else... + +
+ + +Last modified: Thu Sep 19 13:58:31 CEST 2002 + + + + +

+ + diff --git a/web-server/root/surflets/news.scm b/scheme/httpd/surflets/web-server/root/surflets/news.scm similarity index 98% rename from web-server/root/surflets/news.scm rename to scheme/httpd/surflets/web-server/root/surflets/news.scm index 0a732cc..73b1e6e 100644 --- a/web-server/root/surflets/news.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/news.scm @@ -2,7 +2,6 @@ (open scsh scheme plugin-utilities - httpd-responses crlf-io) (begin (define *data* '()) diff --git a/web-server/root/surflets/news.txt b/scheme/httpd/surflets/web-server/root/surflets/news.txt similarity index 100% rename from web-server/root/surflets/news.txt rename to scheme/httpd/surflets/web-server/root/surflets/news.txt diff --git a/web-server/root/surflets/test.scm b/scheme/httpd/surflets/web-server/root/surflets/test.scm similarity index 100% rename from web-server/root/surflets/test.scm rename to scheme/httpd/surflets/web-server/root/surflets/test.scm diff --git a/start-web-server b/start-web-server index 17a5676..0645d66 100755 --- a/start-web-server +++ b/start-web-server @@ -1,6 +1,6 @@ #!/bin/sh 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 @@ -10,11 +10,6 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX} httpd-basic-handlers httpd-file-directory-handlers cgi-server - seval-handler - rman-gateway - info-gateway - servlet-handler - let-opt scsh scheme) @@ -23,7 +18,7 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX} (define (usage) (format #f "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 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) 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 " )) @@ -41,16 +35,13 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX} (define port #f) (define log-file-name #f) (define root #f) - (define servlet-dir #f) - (define simultaneous-requests "5") (define (init) (set! htdocs-dir "web-server/root/htdocs") (set! cgi-bin-dir "web-server/root/cgi-bin") (set! port "8080") (set! log-file-name "web-server/httpd.log") - (set! root "web-server/root") - (set! servlet-dir "web-server/root/servlets")) + (set! root "web-server/root")) (define get-options (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! 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))) + (set! port (string->number port))) (cond ((string=? (car options) "-h") (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)) (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)) - "server" + "web-server" (cadr options)))) (dump-scsh-program main image-name)) (exit 0)) @@ -132,30 +111,20 @@ exec scsh -lm packages.scm -lm httpd/servlets/packages.scm -lm ${SSAXPATH:-SSAX} 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. + syslogging activated. " htdocs-dir cgi-bin-dir port - log-file-name - simultaneous-requests) + log-file-name) (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))) + (tilde-home-dir-handler "public_html" + (alist-path-dispatcher + (list (cons "cgi" (cgi-handler cgi-bin-dir))) (rooted-file-or-directory-handler htdocs-dir))))))))) )) ;; EOF diff --git a/web-server/root/htdocs/index2.html b/web-server/root/htdocs/index2.html index 2ed5c55..862d8c7 100644 --- a/web-server/root/htdocs/index2.html +++ b/web-server/root/htdocs/index2.html @@ -16,8 +16,6 @@
  • Get the dir info page
    (needs a matching info page installation;
     among others, we need non-gzipped info pages)
    • -
  • A test servlet
    • -
  • News
  • Text file
  • Directory
  • Compressed File
    • @@ -30,7 +28,7 @@
    -Last modified: Thu Sep 12 17:06:32 CEST 2002 +Last modified: Thu Sep 19 13:56:18 CEST 2002