From 562020fdf80823b5825ad901e208b10a4d3b058b Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sat, 15 Jan 2011 04:36:39 +0000 Subject: [PATCH] Check URI record arguments more carefully in ->MUMBLE-URI. ->ABSOLUTE-URI would formerly accept URI records representing relative references, even though it would reject their string representations. Now it rejects both. --- src/runtime/url.scm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/runtime/url.scm b/src/runtime/url.scm index 667907a0d..a5d1f79c9 100644 --- a/src/runtime/url.scm +++ b/src/runtime/url.scm @@ -317,15 +317,15 @@ USA. ;;;; Parser (define (->uri object #!optional caller) - (%->uri object parse-uri caller)) + (%->uri object parse-uri (lambda (uri) uri #t) caller)) (define (->absolute-uri object #!optional caller) - (%->uri object parse-absolute-uri caller)) + (%->uri object parse-absolute-uri uri-absolute? caller)) (define (->relative-uri object #!optional caller) - (%->uri object parse-relative-uri caller)) + (%->uri object parse-relative-uri uri-relative? caller)) -(define (%->uri object parser caller) +(define (%->uri object parser predicate caller) ;; Kludge: take advantage of fact that (NOT (NOT #!DEFAULT)). (let* ((do-parse (lambda (string) @@ -340,7 +340,11 @@ USA. (or (hash-table/get interned-uris string #f) (do-parse (utf8-string->wide-string string)))))) (cond ((uri? object) - object) + (if (predicate object) + object + (begin + (if caller (error:bad-range-argument object caller)) + #f))) ((string? object) (do-string object)) ((symbol? object) @@ -352,7 +356,7 @@ USA. (else (if caller (error:not-uri object caller)) #f)))) - + (define (string->uri string #!optional start end) (%string->uri parse-uri string start end 'STRING->URI)) -- 2.25.1