From 5426be858dbeffbed9bed0c85f10db15f75870c0 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 12 Jan 2006 15:25:21 +0000 Subject: [PATCH] better url decoding svn: r1814 --- collects/web-server/util.ss | 41 +++++++++++++------------------------ 1 file changed, 14 insertions(+), 27 deletions(-) diff --git a/collects/web-server/util.ss b/collects/web-server/util.ss index c67f4400bd..64643b35aa 100644 --- a/collects/web-server/util.ss +++ b/collects/web-server/util.ss @@ -5,7 +5,8 @@ (lib "url.ss" "net") (lib "xml.ss" "xml") (lib "plt-match.ss") - (lib "errortrace-lib.ss" "errortrace")) + (lib "errortrace-lib.ss" "errortrace") + (lib "uri-codec.ss" "net")) (require "response-structs.ss" "request-structs.ss") @@ -283,29 +284,15 @@ (define-struct (invalid-%-suffix servlet-error) (chars)) (define-struct (incomplete-%-suffix invalid-%-suffix) ()) (define (translate-escapes raw) - (list->string - (let loop ((chars (string->list raw))) - (if (null? chars) null - (let ((first (car chars)) - (rest (cdr chars))) - (let-values (((this rest) - (cond - ((char=? first #\+) - (values #\space rest)) - ((char=? first #\%) - ; MF: I rewrote this code so that Spidey could eliminate all checks. - ; I am more confident this way that this hairy expression doesn't barf. - (if (pair? rest) - (let ([rest-rest (cdr rest)]) - (if (pair? rest-rest) - (values (integer->char - (or (string->number (string (car rest) (car rest-rest)) 16) - (raise (make-invalid-%-suffix - (if (string->number (string (car rest)) 16) - (car rest-rest) - (car rest)))))) - (cdr rest-rest)) - (raise (make-incomplete-%-suffix rest)))) - (raise (make-incomplete-%-suffix rest)))) - (else (values first rest))))) - (cons this (loop rest))))))))) + (let ([raw (uri-decode raw)]) + (list->string + (let loop ((chars (string->list raw))) + (if (null? chars) null + (let ((first (car chars)) + (rest (cdr chars))) + (let-values (((this rest) + (cond + ((char=? first #\+) + (values #\space rest)) + (else (values first rest))))) + (cons this (loop rest))))))))))