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,9 +107,10 @@
 				  (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))
-      (make-http-error-response http-status/not-found req path-string)
-      (begin
+  (cond 
+   ((file-not-exists? (absolute-file-name path-string servlet-path))
+    (make-http-error-response http-status/not-found req path-string))
+   ((string=? (file-name-extension path-string) ".scm")
     (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*))
@@ -123,12 +124,12 @@
 				 (make-thread-safe-counter))) ; continuation counter
       (release-lock *instance-table-lock*)
       (register-session! instance-id 'no-return)
-	  (let ((servlet (with-fatal-error-handler*
+      (let ((servlet 
+	     (with-fatal-error-handler
 	      (lambda (condition decline)
 		(delete-instance! instance-id)
 		(decline)) 
-			 (lambda () 
-			   (get-servlet-rt-structure path-string servlet-path)))))
+	      (get-servlet-rt-structure path-string servlet-path))))
 	(fork-thread (instance-surveillance instance-id
 					    (+ (time)
 					       (options-instance-lifetime))
@@ -139,7 +140,19 @@
 	       servlet-path
 	       (with-names-from-rt-structure 
 		servlet servlet-interface 
-		 (main req))))))))))
+		(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 ()