From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 27 Aug 2008 04:58:09 +0000 (+0000)
Subject: httpio.scm, runtime.pkg: Rename HTTP-URI to HTTP-REQUEST-URI for
X-Git-Tag: 20090517-FFI~214
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=40e1886e97126afdf533b1a397547f5526899b83;p=mit-scheme.git

httpio.scm, runtime.pkg: Rename HTTP-URI to HTTP-REQUEST-URI for
clarification.  Change definition of HTTP-REQUEST-URI to match RFC
2616.

url.scm, runtime.pkg: Eliminate PARSE-URI-NO-AUTHORITY, create and
export PARSE-URI-AUTHORITY and PARSE-URI-PATH-ABSOLUTE for use in
"httpio.scm".
---

diff --git a/v7/src/runtime/httpio.scm b/v7/src/runtime/httpio.scm
index 425be85ed..33842692a 100644
--- a/v7/src/runtime/httpio.scm
+++ b/v7/src/runtime/httpio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: httpio.scm,v 14.5 2008/08/27 03:59:47 cph Exp $
+$Id: httpio.scm,v 14.6 2008/08/27 04:58:09 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -46,7 +46,7 @@ USA.
 
 (define (make-http-request method uri version headers body)
   (guarantee-http-token method 'MAKE-HTTP-REQUEST)
-  (guarantee-http-uri uri 'MAKE-HTTP-REQUEST)
+  (guarantee-http-request-uri uri 'MAKE-HTTP-REQUEST)
   (guarantee-http-version version 'MAKE-HTTP-REQUEST)
   (receive (headers body)
       (guarantee-headers&body headers body 'MAKE-HTTP-REQUEST)
@@ -115,7 +115,7 @@ USA.
 (define-guarantee simple-http-request "simple HTTP request")
 
 (define (make-simple-http-request uri)
-  (guarantee-simple-http-uri uri 'MAKE-HTTP-REQUEST)
+  (guarantee-simple-http-request-uri uri 'MAKE-HTTP-REQUEST)
   (%make-http-request '|GET| uri #f '() ""))
 
 (define (simple-http-response? object)
@@ -151,18 +151,22 @@ USA.
 
 (define-guarantee http-token "HTTP token")
 
-(define (http-uri? object)
-  (or (absolute-uri? object)
-      (simple-http-uri? object)))
+(define (http-request-uri? object)
+  (or (simple-http-request-uri? object)
+      (absolute-uri? object)
+      (and (string? object)
+	   (string=? object "*"))
+      (uri-authority? object)))
 
-(define-guarantee http-uri "HTTP URI")
+(define-guarantee http-request-uri "HTTP URI")
 
-(define (simple-http-uri? object)
-  (and (relative-uri? object)
+(define (simple-http-request-uri? object)
+  (and (uri? object)
+       (not (uri-scheme object))
        (not (uri-authority object))
        (uri-path-absolute? (uri-path object))))
 
-(define-guarantee simple-http-uri "simple HTTP URI")
+(define-guarantee simple-http-request-uri "simple HTTP URI")
 
 (define (http-version? object)
   (and (pair? object)
@@ -322,17 +326,23 @@ USA.
   (*parser
    (seq "GET"
 	(noise match-wsp)
-	parse-uri-no-authority)))
+	parse-uri-path-absolute)))
 
 (define parse-request-line
   (*parser
    (seq (map string->symbol
-	     (match (+ (char-set char-set:http-token))))
+	     parse-http-token)
 	(noise match-wsp)
-	parse-uri-no-authority
+	(alt (match "*")
+	     parse-absolute-uri
+	     parse-uri-path-absolute
+	     parse-uri-authority)
 	(noise match-wsp)
 	parse-version)))
 
+(define parse-http-token
+  (*parser (match (+ (char-set char-set:http-token)))))
+
 (define parse-response-line
   (*parser
    (seq parse-version
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 0b638267a..7d50e7979 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.665 2008/08/26 08:33:35 cph Exp $
+$Id: runtime.pkg,v 14.666 2008/08/27 04:58:09 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -5068,7 +5068,8 @@ USA.
 	  parse-partial-uri
 	  parse-relative-uri
 	  parse-uri
-	  parse-uri-no-authority
+	  parse-uri-authority
+	  parse-uri-path-absolute
 	  partial-uri->string
 	  partial-uri-authority
 	  partial-uri-extra
@@ -5180,28 +5181,28 @@ USA.
 	  error:not-http-message
 	  error:not-http-header
 	  error:not-http-request
+	  error:not-http-request-uri
 	  error:not-http-response
 	  error:not-http-status
 	  error:not-http-text
 	  error:not-http-token
-	  error:not-http-uri
 	  error:not-http-version
 	  error:not-simple-http-request
+	  error:not-simple-http-request-uri
 	  error:not-simple-http-response
-	  error:not-simple-http-uri
 	  first-http-header
 	  guarantee-http-message
 	  guarantee-http-header
 	  guarantee-http-request
+	  guarantee-http-request-uri
 	  guarantee-http-response
 	  guarantee-http-status
 	  guarantee-http-text
 	  guarantee-http-token
-	  guarantee-http-uri
 	  guarantee-http-version
 	  guarantee-simple-http-request
+	  guarantee-simple-http-request-uri
 	  guarantee-simple-http-response
-	  guarantee-simple-http-uri
 	  http-content-length
 	  http-content-type
 	  http-message-body
@@ -5225,7 +5226,7 @@ USA.
 	  http-status?
 	  http-text?
 	  http-token?
-	  http-uri?
+	  http-request-uri?
 	  http-version-major
 	  http-version-minor
 	  http-version:1.0
@@ -5243,9 +5244,9 @@ USA.
 	  read-http-response
 	  read-simple-http-request
 	  read-simple-http-response
+	  simple-http-request-uri?
 	  simple-http-request?
 	  simple-http-response?
-	  simple-http-uri?
 	  write-http-request
 	  write-http-response)
   (initialization (initialize-package!)))
diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
index 80c103a52..730ef6115 100644
--- a/v7/src/runtime/url.scm
+++ b/v7/src/runtime/url.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: url.scm,v 1.55 2008/08/24 07:20:12 cph Exp $
+$Id: url.scm,v 1.56 2008/08/27 04:58:09 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -396,11 +396,11 @@ USA.
 	     (vector-ref v 3)
 	     (vector-ref v 4)))
 
-(define parse-uri-no-authority
+(define parse-uri-path-absolute
   (*parser
    (encapsulate encapsulate-uri
      (seq (values #f #f)
-	  parser:path-only))))
+	  parser:path-absolute))))
 
 (define parser:uri
   (*parser
@@ -414,10 +414,11 @@ USA.
 
 (define parser:hier-part
   (*parser
-   (alt (seq "//" parser:authority parser:path-abempty)
-	(seq (values #f) parser:path-absolute)
-	(seq (values #f) parser:path-rootless)
-	(seq (values #f) parser:path-empty))))
+   (alt (seq "//" parse-uri-authority parser:path-abempty)
+	(seq (values #f)
+	     (alt parser:path-absolute
+		  parser:path-rootless
+		  parser:path-empty)))))
 
 (define parser:uri-reference
   (*parser
@@ -435,14 +436,11 @@ USA.
 
 (define parser:relative-part
   (*parser
-   (alt (seq "//" parser:authority parser:path-abempty)
-	(seq (values #f) parser:path-only))))
-
-(define parser:path-only
-  (*parser
-   (alt parser:path-absolute
-	parser:path-noscheme
-	parser:path-empty)))
+   (alt (seq "//" parse-uri-authority parser:path-abempty)
+	(seq (values #f)
+	     (alt parser:path-absolute
+		  parser:path-noscheme
+		  parser:path-empty)))))
 
 (define parser:scheme
   (*parser
@@ -453,7 +451,7 @@ USA.
    (seq (char-set char-set:uri-alpha)
 	(* (char-set char-set:uri-scheme)))))
 
-(define parser:authority
+(define parse-uri-authority
   (*parser
    (encapsulate (lambda (v)
 		  (%make-uri-authority (vector-ref v 0)