Be more flexible with paths; use $SUNETHOME and $SSAXPATH if set or

reasonable default values if not.
In particular, work around the dependency of config on cwd.
This commit is contained in:
interp 2002-09-26 12:13:01 +00:00
parent 1abbed29f0
commit 7dde62cd1a
5 changed files with 129 additions and 85 deletions

View File

@ -1,11 +1,37 @@
; reads package description in the right order
; in the end, the server can be started via (main '())
; in the end, the server can be started via (server)
(batch 'on)
(config)
(load "/home/andreas/hiwi/sunet/packages.scm")
(load "/home/andreas/hiwi/sunet/SSAX/lib/packages.scm")
(load "/home/andreas/hiwi/sunet/httpd/servlets/packages.scm")
(load "/home/andreas/hiwi/sunet/httpd/servlets/start-servlet-server")
(define *ASSUMED-SUNET-HOME*
(in 'scsh '(run (match:substring
(regexp-search (rx (submatch (* any) "sunet")) (cwd))
1))))
(define *SUNET-PACKAGE*
(in 'scsh `(run (string-append
(or (getenv "SUNETHOME")
,*ASSUMED-SUNET-HOME*)
"/packages.scm"))))
(define *SSAX-PACKAGE*
(in 'scsh `(run (string-append
(or (getenv "SSAXPATH")
(string-append ,*ASSUMED-SUNET-HOME* "/SSAX"))
"/lib/packages.scm"))))
(define *SERLVET-PACKAGE*
(in 'scsh `(run (string-append
(or (getenv "SUNETHOME")
,*ASSUMED-SUNET-HOME*)
"/httpd/servlets/packages.scm"))))
(define *SERVLET-SERVER*
(in 'scsh `(run (string-append
(or (getenv "SUNETHOME")
,*ASSUMED-SUNET-HOME*)
"/httpd/servlets/start-servlet-server"))))
(config `(load ,*SUNET-PACKAGE*))
(config `(load ,*SSAX-PACKAGE*))
(config `(load ,*SERLVET-PACKAGE*))
(config `(load ,*SERVLET-SERVER*))
(user)
(open 'servlet-server)
(batch 'off)
(in 'scsh '(run (display "type (server) to start the server\n")))

View File

@ -1,10 +1,17 @@
#!/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" "$@"
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/servlets/packages.scm -dm -o servlet-server -e main -s "$0" "$@"
!#
(define-structure servlet-server
(export main)
(export main ; sh jump entry point
server) ; scsh entry point
(open httpd-core
httpd-make-options
httpd-basic-handlers
@ -22,15 +29,15 @@ exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/ser
(define (usage)
(format #f
"Usage: start-web-server [-h htdocs-dir] [-c cgi-bin-dir] [-p port]
"Usage: start-web-server [-h htdocs-dir] [-s servlet-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)
htdocs-dir directory of html files (default: ./web-server/root/htdocs)
servlet-dir directory of servlet files (default: ./web-server/root/servlets)
port port server is listening to (default: 8080)
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
@ -39,7 +46,7 @@ exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/ser
))
(define htdocs-dir #f)
(define cgi-bin-dir #f)
; (define cgi-bin-dir #f)
(define port #f)
(define log-file-name #f)
(define root #f)
@ -47,14 +54,22 @@ exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/ser
(define simultaneous-requests #f)
(define (init)
(set! htdocs-dir "web-server/root/htdocs")
(set! cgi-bin-dir "web-server/root/cgi-bin")
(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! log-file-name "./web-server/httpd.log")
(set! root "./web-server/root")
(set! servlet-dir "./web-server/root/servlets")
(set! simultaneous-requests "5"))
(define (normalize-options)
(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)))
(define get-options
(let* ((unknown-option-error
(lambda (option)
@ -71,13 +86,7 @@ exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/ser
(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)))
(normalize-options)
(cond
((string=? (car options) "-h")
(if (null? (cdr options))
@ -123,6 +132,10 @@ exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/ser
(else
(unknown-option-error (car options)))))))))
(define (server . args)
(if (pair? args)
(main `(main ,@(car args)))
(main '(main))))
(define (main args)
(init)
@ -134,7 +147,7 @@ exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/ser
(format #t "Going to run Servlet server with:
htdocs-dir: ~a
cgi-bin-dir: ~a
servlet-dir: ~a
port: ~a
log-file-name: ~a
a maximum of ~a simultaneous requests, syslogging activated,
@ -143,13 +156,13 @@ exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/ser
NOTE: This is the Servlet server. It does not support cgi.
"
htdocs-dir
cgi-bin-dir
servlet-dir
port
log-file-name
simultaneous-requests)
(httpd (with-port port
; (with-root-directory (absolute-file-name "./web-server/root")
(with-root-directory (cwd)
(with-simultaneous-requests simultaneous-requests
(with-syslog? #t
(with-logfile log-file-name
@ -163,7 +176,7 @@ exec scsh -lm ${SUNETHOME:-../..}/packages.scm -lm ${SUNETHOME:-../..}/httpd/ser
; "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

View File

@ -34,14 +34,14 @@
(lambda (path req)
(if (pair? path) ; need at least one element
(let ((request-method (request:method req))
(full-path (uri-path-list->path path)))
(path-string (uri-path-list->path path)))
(cond
((string=? full-path "profile") ; triggers profiling
((string=? path-string "profile") ; triggers profiling
(http-syslog (syslog-level debug)
"profiling: triggered in servlet-handler [~a]"
(profile-space)) ; PROFILE
(make-http-error-response http-status/accepted req "profiled"))
((string=? full-path "reset") ; triggers cache clearing
((string=? path-string "reset") ; triggers cache clearing
(http-syslog (syslog-level debug)
"servlet-handler: clearing plugin cache")
(reset-plugin-cache!)
@ -52,26 +52,24 @@
((or (string=? request-method "GET")
; (string=? request-method "POST")) ; do this at later time
)
(with-cwd
servlet-path
(if (resume-url? full-path)
(resume-url full-path req)
(launch-new-instance full-path req))))
(if (resume-url? path-string)
(resume-url path-string servlet-path req)
(launch-new-instance path-string servlet-path req)))
(else
(make-http-error-response http-status/method-not-allowed req
request-method))))
(make-http-error-response http-status/bad-request req
(format #f "Bad path: ~s" path)))))
(define (launch-new-instance full-path req)
(if (file-not-exists? full-path)
(make-http-error-response http-status/not-found req full-path)
(define (launch-new-instance path-string servlet-path req)
(if (file-not-exists? (absolute-file-name path-string servlet-path))
(make-http-error-response http-status/not-found req path-string)
(begin
(obtain-lock *instance-table-lock*)
;; no access to instance table until new instance-id is saved
(let ((instance-id (generate-new-table-id *instance-table*)))
(table-set! *instance-table* instance-id
(make-instance full-path ; used to make
(make-instance path-string ; used to make
; redirections to origin
(make-integer-table) ; continuation table
(make-lock) ; continuation table lock
@ -82,23 +80,25 @@
(instance-delete! instance-id)
(decline))
(lambda ()
(get-plugin-rt-structure full-path)))))
(get-plugin-rt-structure path-string servlet-path)))))
(reset
(begin
(register-session! instance-id 'no-return)
(with-cwd
servlet-path
(with-names-from-rt-structure
plugin plugin-interface
(main req)))))))))
(main req))))))))))
;; try to get continuation-table and then the continuation
(define resume-url
(let ((bad-request
(lambda (full-path req)
(lambda (path-string req)
(make-http-error-response
http-status/bad-request req
(format #f "The servlet does not accept any requests any more or your URL is illformed.<BR>
You can try starting at the <A HREF=~a>beginning</a>."
(resume-url-servlet-name full-path)))))
(resume-url-servlet-name path-string)))))
(lookup-continuation-table
(lambda (instance continuation-table continuation-id)
(let ((continuation-table-lock (instance-continuation-table-lock instance)))
@ -107,22 +107,23 @@ You can try starting at the <A HREF=~a>beginning</a>."
(release-lock continuation-table-lock)
result)))))
(lambda (full-path req)
(lambda (path-string servlet-path req)
(receive (instance-id continuation-id)
(resume-url-ids full-path)
(resume-url-ids path-string)
(let ((instance (instance-lookup instance-id)))
(if instance
(let* ((continuation-table (instance-continuation-table instance))
(resume (lookup-continuation-table instance continuation-table
continuation-id)))
(if resume
(with-cwd
servlet-path
(reset
(begin
(register-session! instance-id 'no-return)
; (error "This may never return." ; for debugging
(resume req)))
(bad-request full-path req)))
(bad-request full-path req)))
(resume req))))
(bad-request path-string req)))
(bad-request path-string req)))
))))
@ -182,12 +183,13 @@ You can try starting at the <A HREF=~a>beginning</a>."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PLUGINs CACHE
(define *plugin-table* (make-string-table)) ; full-path is index
(define *plugin-table* (make-string-table)) ; path-string is index
(define *plugin-table-lock* (make-lock))
;; PLUGIN-NAME is like "news-dir/latest-news.scm"
(define (get-plugin-rt-structure plugin-name)
(let ((load-plugin
(define (get-plugin-rt-structure plugin-name directory)
(let* ((full-plugin-name (absolute-file-name plugin-name directory))
(load-plugin
(lambda ()
(with-fatal-error-handler*
(lambda (condition decline)
@ -196,21 +198,22 @@ You can try starting at the <A HREF=~a>beginning</a>."
(lambda ()
;; load-config-file does not care about cwd(?)
;; --> absolute file name needed
(load-config-file (absolute-file-name plugin-name))
(load-config-file full-plugin-name)
;; plugin-structure to load must be named "plugin"
(let ((plugin-structure (reify-structure 'plugin)))
(format #t "cwd: ~s~%" (cwd))
(load-structure plugin-structure)
(table-set! *plugin-table* plugin-name
(table-set! *plugin-table* full-plugin-name
(cons plugin-structure
(file-last-mod plugin-name)))
(file-last-mod full-plugin-name)))
;; only now the lock may be released
(release-lock *plugin-table-lock*)
plugin-structure))))))
(obtain-lock *plugin-table-lock*)
(let ((plugin (table-ref *plugin-table* plugin-name)))
(let ((plugin (table-ref *plugin-table* full-plugin-name)))
(if plugin
(if (equal? (file-last-mod plugin-name)
(if (equal? (file-last-mod full-plugin-name)
(cdr plugin))
(begin
(release-lock *plugin-table-lock*)
@ -263,8 +266,8 @@ You can try starting at the <A HREF=~a>beginning</a>."
";k" (submatch (* digit)) ; Instance-ID
";c" (+ digit) "-" (submatch (* digit)))) ; Continuation-ID
(define (make-resume-url full-path instance-id continuation-counter continuation-id)
(string-append full-path
(define (make-resume-url path-string instance-id continuation-counter continuation-id)
(string-append path-string
";k" (number->string (session-instance-id))
";c" (number->string continuation-counter)
"-" (number->string continuation-id)))

View File

@ -134,7 +134,7 @@ exec scsh -lm packages.scm -dm -o http-test -e main -s "$0" "$@"
simultaneous-requests)
(httpd (with-port port
; (with-root-directory (absolute-file-name "./web-server/root")
(with-root-directory (cwd)
(with-simultaneous-requests simultaneous-requests
(with-syslog? #t
(with-logfile log-file-name
@ -147,8 +147,9 @@ exec scsh -lm packages.scm -dm -o http-test -e main -s "$0" "$@"
(cons "info" (info-handler #f #f #f
"Generated by info-gateway"))
(cons "cgi-bin" (cgi-handler cgi-bin-dir)))
(rooted-file-or-directory-handler htdocs-dir)))))))))
(rooted-file-or-directory-handler htdocs-dir))))))))))
))
;; EOF
;;; Local Variables:

View File

@ -119,13 +119,14 @@ exec scsh -lm packages.scm -dm -o http-test -e main -s "$0" "$@"
log-file-name)
(httpd (with-port port
(with-root-directory (cwd)
(with-syslog? #t
(with-logfile log-file-name
(with-request-handler
(tilde-home-dir-handler "public_html"
(alist-path-dispatcher
(list (cons "cgi" (cgi-handler cgi-bin-dir)))
(rooted-file-or-directory-handler htdocs-dir)))))))))
(rooted-file-or-directory-handler htdocs-dir))))))))))
))
;; EOF