From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 23 Nov 2004 17:20:38 +0000 (+0000)
Subject: Finish implementing subtree authentication.
X-Git-Tag: 20090517-FFI~1442
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9f8d7784d4326d761c2760d7bb42240cde229e6e;p=mit-scheme.git

Finish implementing subtree authentication.
---

diff --git a/v7/src/ssp/mod-lisp.scm b/v7/src/ssp/mod-lisp.scm
index 923b51733..ac100290f 100644
--- a/v7/src/ssp/mod-lisp.scm
+++ b/v7/src/ssp/mod-lisp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: mod-lisp.scm,v 1.16 2004/11/23 16:34:24 cph Exp $
+$Id: mod-lisp.scm,v 1.17 2004/11/23 17:20:34 cph Exp $
 
 Copyright 2003,2004 Massachusetts Institute of Technology
 
@@ -290,7 +290,6 @@ USA.
   '("index.html" "index.xhtml" "index.ssp" "index.xml"))
 
 (define (mod-lisp-expander request response pathname expander authenticator)
-  (run-hooks-in-list mod-lisp-before-expander-hooks request)
   (call-with-output-string
     (lambda (port)
       (fluid-let ((*in-mod-lisp?* #t)
@@ -303,8 +302,9 @@ USA.
 		     (with-repl-eval-boundary (nearest-repl)
 		       (lambda ()
 			 (eval expression environment))))))
-	(expander pathname port))
-      (run-hooks-in-list mod-lisp-after-expander-hooks request response))))
+	(run-hooks-in-list mod-lisp-before-expander-hooks request)
+	(expander pathname port)
+	(run-hooks-in-list mod-lisp-after-expander-hooks request response)))))
 
 (define mod-lisp-before-expander-hooks (make-hook-list))
 (define mod-lisp-after-expander-hooks (make-hook-list))
@@ -816,9 +816,11 @@ USA.
 (define subtree-authenticators '())
 
 (define (http-request-user-name)
-  (http-message-user-name *current-request*))
+  (if *current-authenticator*
+      (*current-authenticator* *current-request*)
+      (http-authenticator:basic *current-request*)))
 
-(define (http-message-user-name message)
+(define (http-authenticator:basic message)
   (let ((auth (http-message-header message 'authorization)))
     (and auth
 	 (cond ((string-prefix? "Basic " auth)
@@ -889,7 +891,7 @@ USA.
 	(write-line (list (get-universal-time)
 			  (http-message-method request)
 			  (http-message-url request)
-			  (http-message-user-name request)
+			  (http-request-user-name)
 			  (http-message-post-parameters request))
 		    request-log-port)
 	(flush-output request-log-port))))
diff --git a/v7/src/ssp/ssp.pkg b/v7/src/ssp/ssp.pkg
index 31ea66691..1d639254b 100644
--- a/v7/src/ssp/ssp.pkg
+++ b/v7/src/ssp/ssp.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ssp.pkg,v 1.14 2004/11/23 16:34:28 cph Exp $
+$Id: ssp.pkg,v 1.15 2004/11/23 17:20:38 cph Exp $
 
 Copyright 2003,2004 Massachusetts Institute of Technology
 
@@ -51,6 +51,7 @@ USA.
 	  define-mime-handler
 	  define-subtree-authenticator
 	  define-subtree-handler
+	  http-authenticator:basic
 	  http-browser-type
 	  html-content-type
 	  http-request-cookie
@@ -77,6 +78,7 @@ USA.
 	  trace-i/o-filename
 	  trace-requests?)
   (export (runtime ssp-expander-environment)
+	  http-authenticator:basic
 	  http-browser-type
 	  html-content-type
 	  http-request-cookie