add possibility to serve non-Scheme files

scheme/httpd/surflets/packages.scm

@@ -121,6 +121,7 @@
 	thread-fluids			;FORK-THREAD
 	sxml-to-html			;SXML->HTML
 	scsh				;regexp et al.
+;	httpd-file-directory-handlers	;send-file-response
 	scheme
 	)
   (files servlet-handler))

scheme/httpd/surflets/surflet-handler.scm

@@ -107,39 +107,52 @@
 				  (format #f "Bad path: ~s" path)))))
 
 (define (launch-new-instance path-string servlet-path req)
-  (if (file-not-exists? (absolute-file-name path-string servlet-path))
+  (cond 
-      (make-http-error-response http-status/not-found req path-string)
+   ((file-not-exists? (absolute-file-name path-string servlet-path))
-      (begin
+    (make-http-error-response http-status/not-found req path-string))
-	(obtain-lock *instance-table-lock*)
+   ((string=? (file-name-extension path-string) ".scm")
-	;; no access to instance table until new instance-id is saved
+    (obtain-lock *instance-table-lock*)
-	(let ((instance-id (generate-new-table-id *instance-table*))
+    ;; no access to instance table until new instance-id is saved
-	      (memo (make-memo)))
+    (let ((instance-id (generate-new-table-id *instance-table*))
-	  (table-set! *instance-table* instance-id
+	  (memo (make-memo)))
-		      (make-instance path-string    ; used to make
+      (table-set! *instance-table* instance-id
-						  ; redirections to origin
+		  (make-instance path-string    ; used to make
-				     memo
+					; redirections to origin
-				     (make-integer-table) ; continuation table
+				 memo
-				     (make-lock)          ; continuation table lock
+				 (make-integer-table) ; continuation table
-				     (make-thread-safe-counter))) ; continuation counter
+				 (make-lock)          ; continuation table lock
-	  (release-lock *instance-table-lock*)
+				 (make-thread-safe-counter))) ; continuation counter
-	  (register-session! instance-id 'no-return)
+      (release-lock *instance-table-lock*)
-	  (let ((servlet (with-fatal-error-handler*
+      (register-session! instance-id 'no-return)
-			 (lambda (condition decline)
+      (let ((servlet 
-			   (delete-instance! instance-id)
+	     (with-fatal-error-handler
-			   (decline)) 
+	      (lambda (condition decline)
-			 (lambda () 
+		(delete-instance! instance-id)
-			   (get-servlet-rt-structure path-string servlet-path)))))
+		(decline)) 
-	    (fork-thread (instance-surveillance instance-id
+	      (get-servlet-rt-structure path-string servlet-path))))
-						(+ (time)
+	(fork-thread (instance-surveillance instance-id
-						   (options-instance-lifetime))
+					    (+ (time)
-						memo))
+					       (options-instance-lifetime))
-	    (reset
+					    memo))
-	     (begin
+	(reset
-	       (with-cwd
+	 (begin
-		servlet-path
+	   (with-cwd
-		(with-names-from-rt-structure 
+	       servlet-path
-		 servlet servlet-interface 
+	       (with-names-from-rt-structure 
-		 (main req))))))))))
+		servlet servlet-interface 
+		(main req))))))))
+   (else				; We'll serve every non-scm file.
+    ;; We need access to SEND-FILE-RESPONSE of
+    ;; HTTPD-FILE-DIR-HANDLERS. In the official SUnet release, we
+    ;; don't have it, so we disable this feature here.
+;    (let ((full-file-name (absolute-file-name path-string servlet-path)))
+;      (send-file-response full-file-name
+;			  (file-info full-file-name)
+;			  req))
+    (make-http-error-response http-status/forbidden req
+			      "Can't serve other than Scheme files."
+			      path-string))
+   ))
 
 (define (instance-surveillance instance-id time-to-die memo)
   (lambda ()