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.

scheme/httpd/surflets/load-surflet-server.scm

@@ -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)
+(define *ASSUMED-SUNET-HOME*
-(load "/home/andreas/hiwi/sunet/packages.scm")
+  (in 'scsh '(run (match:substring 
-(load "/home/andreas/hiwi/sunet/SSAX/lib/packages.scm")
+		   (regexp-search (rx (submatch (* any) "sunet")) (cwd))
-(load "/home/andreas/hiwi/sunet/httpd/servlets/packages.scm")
+		   1))))
-(load "/home/andreas/hiwi/sunet/httpd/servlets/start-servlet-server")
+(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)
+(batch 'off)
+(in 'scsh '(run (display "type (server) to start the server\n")))
+

scheme/httpd/surflets/start-surflet-server

@@ -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)
+ htdocs-dir     directory of html files (default: ./web-server/root/htdocs)
- cgi-bin-dir    directory of cgi files  (default: web-server/root/cgi-bin)
+ 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! 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 "8088")
-      (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")
+      (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
+		(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)))
 		(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
 

scheme/httpd/surflets/surflet-handler.scm

@@ -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
+	     (if (resume-url? path-string)
-	     servlet-path
+		 (resume-url path-string servlet-path req)
-	     (if (resume-url? full-path)
+		 (launch-new-instance path-string servlet-path req)))
-		 (resume-url full-path req)
-		 (launch-new-instance full-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)
+(define (launch-new-instance path-string servlet-path req)
-  (if (file-not-exists? full-path)
+  (if (file-not-exists? (absolute-file-name path-string servlet-path))
-      (make-http-error-response http-status/not-found req full-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-names-from-rt-structure 
+	       (with-cwd
-		plugin plugin-interface 
+		servlet-path
-		(main req)))))))))
+		(with-names-from-rt-structure 
+		 plugin plugin-interface 
+		 (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
-		    (reset
+		    (with-cwd
-		     (begin
+		     servlet-path
-		       (register-session! instance-id 'no-return)
+		     (reset
-;		       (error "This may never return." ; for debugging
+		      (begin
-			      (resume req)))
+			(register-session! instance-id 'no-return)
-		    (bad-request full-path req)))
+			(resume req))))
-	      (bad-request full-path req)))
+		    (bad-request path-string req)))
+	      (bad-request path-string req)))
 	))))
     
 
@@ -182,35 +183,37 @@ 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)
+(define (get-plugin-rt-structure plugin-name directory)
-  (let ((load-plugin 
+  (let* ((full-plugin-name (absolute-file-name plugin-name directory))
-	 (lambda ()
+	 (load-plugin 
-	   (with-fatal-error-handler*
+	  (lambda ()
-	    (lambda (condition decline)
+	    (with-fatal-error-handler*
-	      (release-lock *plugin-table-lock*)
+	     (lambda (condition decline)
-	      (decline))
+	       (release-lock *plugin-table-lock*)
-	    (lambda ()
+	       (decline))
-	      ;; load-config-file does not care about cwd(?)
+	     (lambda ()
-	      ;; --> absolute file name needed
+	       ;; load-config-file does not care about cwd(?)
-	      (load-config-file (absolute-file-name plugin-name))
+	       ;; --> absolute file name needed
-	      ;; plugin-structure to load must be named "plugin"
+	       (load-config-file full-plugin-name)
-	      (let ((plugin-structure (reify-structure 'plugin)))
+	       ;; plugin-structure to load must be named "plugin"
-		(load-structure plugin-structure)
+	       (let ((plugin-structure (reify-structure 'plugin)))
-		(table-set! *plugin-table* plugin-name 
+		 (format #t "cwd: ~s~%" (cwd))
-			    (cons plugin-structure
+		 (load-structure plugin-structure)
-				  (file-last-mod plugin-name)))
+		 (table-set! *plugin-table* full-plugin-name 
-		;; only now the lock may be released
+			     (cons plugin-structure
-		(release-lock *plugin-table-lock*)
+				   (file-last-mod full-plugin-name)))
-		plugin-structure))))))
+		 ;; 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)
+(define (make-resume-url path-string instance-id continuation-counter continuation-id)
-  (string-append full-path
+  (string-append path-string
 		 ";k" (number->string (session-instance-id)) 
 		 ";c" (number->string continuation-counter)
 		 "-" (number->string continuation-id)))

start-extended-web-server

@@ -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:

start-web-server

@@ -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