From f5b7f76bd6e19a03bf7bfca854da96bfd095bf5c Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Tue, 27 Aug 2002 09:32:12 +0000
Subject: [PATCH] Fix HOME-DIR-HANDLER and TILDE-HOME-DIR-HANDLER.

---
 scheme/httpd/file-dir-handler.scm | 45 ++++++++++++++++---------------
 scheme/packages.scm               |  2 +-
 2 files changed, 24 insertions(+), 23 deletions(-)

diff --git a/scheme/httpd/file-dir-handler.scm b/scheme/httpd/file-dir-handler.scm
index daf9685..fb2a3ed 100644
--- a/scheme/httpd/file-dir-handler.scm
+++ b/scheme/httpd/file-dir-handler.scm
@@ -24,40 +24,41 @@
 
 (define (home-dir-handler user-public-dir)
   (lambda (path req)		
-    (if (pair? path)
+    (if (null? path)
+	(make-http-error-response http-status/bad-request
+				  req
+				  "Path contains no home directory.")
 	(make-rooted-file-path-response (string-append (http-homedir (car path) req)
 						       "/"
 						       user-public-dir)
 					(cdr path)
 					file-serve-response
-					req)
-	(make-http-error-response http-status/bad-request
-				  req
-				  "Path contains no home directory."))))
+					req))))
 
-;;; (tilde-home-dir-handler-predicate path)
-;;; (tilde-home-dir-handler user-public-dir)
+;;; (tilde-home-dir-handler user-public-dir default-path-handler)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; If the car of the path is a tilde-marked home directory (e.g., "~kgk"),
 ;;; do home-directory service as in HOME-DIR-HANDLER, otherwise punt to the
 ;;; default handler.
 
-(define (tilde-home-dir-handler-predicate path)
-  (lambda (path)
-    (and (pair? path)			; Is it a ~foo/...
-	 (let ((head (car path)))	; home-directory path?
-	   (and (> (string-length head) 0)
-		(char=? (string-ref head 0) #\~))))))
+(define (tilde-home-dir? path req)
+  (and (not (null? path))
+       (let ((head (car path)))		; home-directory path?
+	 (and (> (string-length head) 0)
+	      (char=? (string-ref head 0) #\~)))))
 
-(define (tilde-home-dir-handler user-public-dir)
-  (lambda (path req)
-    (let* ((tilde-home (car path))	; Yes.
-	   (slen (string-length tilde-home))
-	   (subdir (string-append
-		    (http-homedir (substring tilde-home 1 slen) req)
-		    "/"
-		    user-public-dir)))
-      (make-rooted-file-path-response subdir (cdr path) file-serve-response req))))
+(define (tilde-home-dir-handler user-public-dir default-ph)
+  (make-request-handler
+   tilde-home-dir?
+   (lambda (path req)
+     (let* ((tilde-home (car path))	; Yes.
+	    (slen (string-length tilde-home))
+	    (subdir (string-append
+		     (http-homedir (substring tilde-home 1 slen) req)
+		     "/"
+		     user-public-dir)))
+       (make-rooted-file-path-response subdir (cdr path) file-serve-response req)))
+   default-ph))
 
 
 ;;; Make a handler that serves files relative to a particular root
diff --git a/scheme/packages.scm b/scheme/packages.scm
index 764a269..048521a 100644
--- a/scheme/packages.scm
+++ b/scheme/packages.scm
@@ -374,7 +374,6 @@
 (define-interface httpd-file-directory-handlers-interface
   (export home-dir-handler
 	  tilde-home-dir-handler
-	  tilde-home-dir-handler-predicate
 	  rooted-file-handler
 	  rooted-file-or-directory-handler
 	  null-path-handler))
@@ -771,6 +770,7 @@
 	httpd-request
 	httpd-responses
 	httpd-error
+	httpd-basic-handlers
 	httpd-read-options
 	url
 	htmlout