From: Chris Hanson Date: Tue, 17 May 2005 05:22:51 +0000 (+0000) Subject: Fix implementation of alphabetic character sets for URL parsing. X-Git-Tag: 20090517-FFI~1314 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1a838593cc878adc9c730487dc7d8fda0b1bdf13;p=mit-scheme.git Fix implementation of alphabetic character sets for URL parsing. --- diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index d81829855..24798e4a6 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.541 2005/04/28 04:33:50 cph Exp $ +$Id: runtime.pkg,v 14.542 2005/05/17 05:22:44 cph Exp $ Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology @@ -4727,8 +4727,12 @@ USA. (files "url") (parent (runtime)) (export () + url:char-set:alpha + url:char-set:alphadigit + url:char-set:digit url:char-set:escaped url:char-set:extra + url:char-set:lowalpha url:char-set:national url:char-set:punctuation url:char-set:reserved diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm index 6891e2eab..00024a0f1 100644 --- a/v7/src/runtime/url.scm +++ b/v7/src/runtime/url.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: url.scm,v 1.15 2004/02/23 20:51:47 cph Exp $ +$Id: url.scm,v 1.16 2005/05/17 05:22:51 cph Exp $ -Copyright 2000,2001,2003,2004 Massachusetts Institute of Technology +Copyright 2000,2001,2003,2004,2005 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -26,7 +26,11 @@ USA. ;;;; URL Encoding (declare (usual-integrations)) - + +(define url:char-set:lowalpha) +(define url:char-set:alpha) +(define url:char-set:digit) +(define url:char-set:alphadigit) (define url:char-set:safe) (define url:char-set:extra) (define url:char-set:national) @@ -38,6 +42,13 @@ USA. (define url:char-set:escaped) (define (initialize-package!) + (set! url:char-set:lowalpha (string->char-set "abcdefghijklmnopqrstuvwxyz")) + (set! url:char-set:alpha + (char-set-union url:char-set:lowalpha + (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) + (set! url:char-set:digit (string->char-set "0123456789")) + (set! url:char-set:alphadigit + (char-set-union url:char-set:alpha url:char-set:digit)) (set! url:char-set:safe (string->char-set "$-_.+")) (set! url:char-set:extra (string->char-set "!*'(),")) (set! url:char-set:national (string->char-set "{}|\\^~[]`")) @@ -45,7 +56,7 @@ USA. (set! url:char-set:reserved (string->char-set ";/?:@&=")) (set! url:char-set:hex (string->char-set "0123456789abcdefABCDEF")) (set! url:char-set:unreserved - (char-set-union char-set:alphanumeric + (char-set-union url:char-set:alphadigit url:char-set:safe url:char-set:extra)) (set! url:char-set:unescaped @@ -54,7 +65,7 @@ USA. (set! url:char-set:escaped (char-set-invert url:char-set:unescaped)) unspecific) - + (define url:match:escape (*matcher (seq "%" @@ -76,7 +87,7 @@ USA. (seq (match url:match:host) (alt (map string->number (seq (noise ":") - (match (+ (char-set char-set:numeric))))) + (match (+ (char-set url:char-set:digit))))) (values #f))))) (define url:match:host @@ -85,25 +96,25 @@ USA. (define url:match:hostname (let ((match-tail (*matcher - (* (alt (char-set char-set:alphanumeric) + (* (alt (char-set url:char-set:alphadigit) (seq (+ #\-) - (char-set char-set:alphanumeric))))))) + (char-set url:char-set:alphadigit))))))) (*matcher - (seq (* (seq (char-set char-set:alphanumeric) + (seq (* (seq (char-set url:char-set:alphadigit) match-tail ".")) - (char-set char-set:alphabetic) + (char-set url:char-set:alpha) match-tail)))) (define url:match:hostnumber (*matcher - (seq (+ (char-set char-set:numeric)) + (seq (+ (char-set url:char-set:digit)) "." - (+ (char-set char-set:numeric)) + (+ (char-set url:char-set:digit)) "." - (+ (char-set char-set:numeric)) + (+ (char-set url:char-set:digit)) "." - (+ (char-set char-set:numeric))))) + (+ (char-set url:char-set:digit))))) (define (url:string-encoded? string) (url:substring-encoded? string 0 (string-length string)))