scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

*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
This commit is contained in:
vibr 2005-04-04 15:35:50 +00:00
parent ba78eba433
commit cf747a97b4
1 changed files with 19 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
scheme/lib/url.scm
View File

@ -55,7 +55,7 @@
;;; (see copy of Appendix A of RFC 2396 below) ;;; (see copy of Appendix A of RFC 2396 below)
;;; ;;;
;;; we implement Request_URIs of the form ;;; 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)) (define digit (rx numeric))
@ -126,8 +126,7 @@
(define http_URL (rx (: (define http_URL (rx (:
"http://" "http://"
(submatch (submatch ,host)
,host)
(? (?
(: ":" (submatch ,port))) (: ":" (submatch ,port)))
(? (?
@ -135,9 +134,17 @@
(? (?
(: "?" (submatch ,query)))))))) (: "?" (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))) (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; ;;; return matches of regexps host, port, abs_path, query;
;;; ;;;
;;; If request-uri is a relative URI, host, port and query are #f; ;;; If request-uri is a relative URI, host and port are #f;
;;; port and query are also #f if they are not given in an absolute URI. ;;; 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; ;;; 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. ;;; otherwise it is a list containing the path's segments.
;;; ;;;
@ -159,7 +166,9 @@
((regexp-search abs_path_with_frag request-uri) ((regexp-search abs_path_with_frag request-uri)
=> (lambda (match) => (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) ((regexp-search http_URL_with_frag request-uri)
=>(lambda (match) =>(lambda (match)
@ -232,7 +241,7 @@
;;; parse a HTTP 1.1. Request_URI into a http-url record ;;; 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 (call-with-values
(lambda () (parse-uri uri-string)) (lambda () (parse-uri uri-string))
parsed-uri->http-url)) parsed-uri->http-url))
@ -287,7 +296,7 @@
;;; encode 'abs_path' portion of a URI: ;;; encode 'abs_path' portion of a URI:
;;; use SPLIT-PATH to split abs_path into its segments, ;;; 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) (define (escape-segment segment)
(escape segment segment-reserved-and-excluded)) (escape segment segment-reserved-and-excluded))