From cf747a97b48e4efec5cb2bf780bc13eb594687f3 Mon Sep 17 00:00:00 2001
From: vibr <vibr>
Date: Mon, 4 Apr 2005 15:35:50 +0000
Subject: [PATCH] *add solution for mistake in RFC 2616 (where query part of
 Request-URIs is only allowed for absoluteURIs) *rename PARSE-HTTP-URL to
 URI-STRING->HTTP-URL

---
 scheme/lib/url.scm | 29 +++++++++++++++++++----------
 1 file changed, 19 insertions(+), 10 deletions(-)

diff --git a/scheme/lib/url.scm b/scheme/lib/url.scm
index 6de4130..a3b2b8d 100644
--- a/scheme/lib/url.scm
+++ b/scheme/lib/url.scm
@@ -55,7 +55,7 @@
 ;;; (see copy of Appendix A of RFC 2396 below)
 ;;;
 ;;; we implement Request_URIs of the form
-;;; Request-URI    = ( http_URL | abs_path) ["#" fragment]
+;;; Request-URI    = ( http_URL | abs_path ["?" query] ) ["#" fragment]
 
 (define digit (rx numeric))
 
@@ -126,8 +126,7 @@
 
 (define http_URL (rx (:
 		      "http://" 
-		      (submatch 
-		       ,host)
+		      (submatch ,host)
 		      (? 
 		       (: ":" (submatch ,port)))
 		      (? 
@@ -135,9 +134,17 @@
 			  (? 
 			   (: "?" (submatch ,query))))))))
 
-(define http_URL_with_frag (rx (: bos ,@http_URL (? "#" ,fragment) eos)))
+(define http_URL_with_frag (rx (: bos
+				  ,@http_URL 
+				  (? (: "#" ,fragment))
+				  eos)))
 
-(define abs_path_with_frag (rx (: bos (submatch ,abs_path) (? "#" ,fragment) eos)))
+
+(define abs_path_with_frag (rx (: bos 
+				(submatch ,abs_path) 
+				(? (: "?" (submatch ,query)))
+				(? (: "#" ,fragment))
+				eos)))
 
 (define Request-URI (rx (| ,@http_URL_with_frag ,@abs_path_with_frag)))
 
@@ -147,8 +154,8 @@
 ;;; 
 ;;; return matches of regexps host, port, abs_path, query;
 ;;;
-;;; If request-uri is a relative URI, host, port and query are #f;
-;;; port and query are also #f if they are not given in an absolute URI.
+;;; If request-uri is a relative URI, host and port are #f;
+;;; port and query are also #f if they are not given.
 ;;; If there's no abs_path given, or abs_path is "/", path is the empty list;
 ;;; otherwise it is a list containing the path's segments.
 ;;;
@@ -159,7 +166,9 @@
 
     ((regexp-search abs_path_with_frag request-uri)
      => (lambda (match)
-	  (values #f #f (split-abs-path (match:substring match 1)) #f)))
+	  (let ((path (split-abs-path (match:substring match 1)))
+		(query (match:substring match 2)))
+	    (values #f #f path query))))
 
     ((regexp-search http_URL_with_frag request-uri)
      =>(lambda (match)
@@ -232,7 +241,7 @@
 
 ;;; parse a HTTP 1.1. Request_URI into a http-url record
 
-(define (parse-http-url uri-string)
+(define (uri-string->http-url uri-string)
   (call-with-values
    (lambda () (parse-uri uri-string))
    parsed-uri->http-url))
@@ -287,7 +296,7 @@
 
 ;;; encode 'abs_path' portion of a URI:
 ;;; use SPLIT-PATH to split abs_path into its segments,
-;;; then apply UNESCAPE-SEGMENT to the segments. 
+;;; then apply ESCAPE-SEGMENT to the segments. 
 (define (escape-segment segment)
   (escape segment segment-reserved-and-excluded))