From 46645ccd583b6e8d0b324ee2271810696faf528f Mon Sep 17 00:00:00 2001
From: vibr <vibr>
Date: Mon, 4 Apr 2005 21:07:55 +0000
Subject: [PATCH] *remove definition of PARSE-REQUEST-URI (relict of Olin's old
 URL parser) *use URI-STRING->HTTP-URL instead

---
 scheme/httpd/core.scm | 39 ++++-----------------------------------
 1 file changed, 4 insertions(+), 35 deletions(-)

diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm
index 862b9f4..f4eedc3 100644
--- a/scheme/httpd/core.scm
+++ b/scheme/httpd/core.scm
@@ -193,6 +193,9 @@
 			    options)
 	)))))
 
+
+;;; REDIRECT-REQUEST relies on that nothing is read out from SOCKET.
+
 (define (redirect-request req response socket options)
   (let* ((new-location-uri (redirect-body-location (response-body response)))
 	 (url (with-fatal-error-handler*
@@ -251,46 +254,12 @@
 			  (else (fatal-syntax-error "Bad Request Line."))))
 	       (meth (car elts))
 	       (request-uri (cadr elts))
-	       (url (parse-request-uri request-uri sock options))
+	       (url (uri-string->http-url request-uri))
 	       (headers (if (equal? version '(0 . 9))
 			    '()
 			    (read-rfc822-headers (socket:inport sock)))))
 	  (make-request meth request-uri url version headers sock)))))
 
-;;; Parse the URI, but if it begins without the "http://host:port"
-;;; prefix, interpolate one from SOCKET. It would be sleazier but
-;;; faster if we just computed the default host and port at
-;;; server-startup time, instead of on every request.
-;;; REDIRECT-REQUEST relys on that nothing is read out from SOCKET.
-
-(define (parse-request-uri request-uri socket options)
-  (receive (scheme path search frag-id) (parse-uri request-uri)
-    (if frag-id				; Can't have a #frag part.
-	(fatal-syntax-error "HTTP URL contains illegal #<fragment> suffix."
-			    request-uri)
-
-	(if scheme
-	    (if (string-ci=? scheme "http") ; Better be an http url.
-		(parse-http-url path search #f)
-		(fatal-syntax-error "Non-HTTP URL" request-uri))
-
-	    ;; Interpolate the server struct from our net connection.
-	    (if (and (pair? path) (string=? (car path) ""))
-		(let* ((addr (socket-local-address socket))
-		       (local-name (or (httpd-options-fqdn options)
-				       (socket-address->fqdn addr)))
-		       (portnum (or (httpd-options-reported-port options)
-				    (my-reported-port addr))))
-		  (make-http-url (make-server #f #f
-						local-name
-						(number->string portnum))
-				 (map unescape-uri (cdr path)) ; Skip initial /.
-				 search
-				 #f))
-
-		(fatal-syntax-error "Path fragment must begin with slash"
-				    request-uri))))))
-
 
 (define parse-http-version
   (let ((re (make-regexp "^HTTP/([0-9]+)\\.([0-9]+)$"))