X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src.lisp;h=da6d9fd2af08c1a8812a6c428678e79c2c4a6971;hb=b537e93ccfdcbefd8bab075809e4d41b2df779c7;hp=6ba041700a3980191f81c9390027cd7bb1767aa8;hpb=feebbfdc402097d14c9a4cd27bf1a7a12120f7c9;p=puri.git diff --git a/src.lisp b/src.lisp index 6ba0417..da6d9fd 100644 --- a/src.lisp +++ b/src.lisp @@ -4,7 +4,7 @@ ;; ;; copyright (c) 1999-2002 Franz Inc, Berkeley, CA - All rights reserved. ;; copyright (c) 2002-2005 Franz Inc, Oakland, CA - All rights reserved. -;; copyright (c) 2003-2006 Kevin Rosenberg (porting changes) +;; copyright (c) 2003-2010 Kevin Rosenberg ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of @@ -355,13 +355,19 @@ ;; Parsing (defparameter *excluded-characters* - '(;; `delims' (except #\%, because it's handled specially): + (append + ;; exclude control characters + (loop for i from 0 to #x1f + collect (code-char i)) + '(;; `delims' (except #\%, because it's handled specially): #\< #\> #\" #\space #\# + #\Rubout ;; (code-char #x7f) ;; `unwise': #\{ #\} #\| #\\ #\^ #\[ #\] #\`)) + "Excluded charcters from RFC2369 (http://www.ietf.org/rfc/rfc2396.txt 2.4.3)") (defun reserved-char-vector (chars &key except) - (do* ((a (make-array 127 :element-type 'bit :initial-element 0)) + (do* ((a (make-array 128 :element-type 'bit :initial-element 0)) (chars chars (cdr chars)) (c (car chars) (car chars))) ((null chars) a) @@ -379,7 +385,7 @@ (defparameter *reserved-path-characters* (reserved-char-vector (append *excluded-characters* - '(#\; + '(#\; #\% ;;;;The rfc says this should be here, but it doesn't make sense. ;; #\= #\/ #\?)))) @@ -846,11 +852,10 @@ URI ~s contains illegal character ~s at position ~d." #+allegro (with-output-to-string (s) (excl::maybe-print-fast s port)) ) - (when path - (encode-escaped-encoding path - nil - ;;*reserved-path-characters* - escape)) + (encode-escaped-encoding (or path "/") + nil + ;;*reserved-path-characters* + escape) (when query "?") (when query (encode-escaped-encoding query nil escape)) (when fragment "#") @@ -1315,13 +1320,6 @@ Executes the forms once for each uri with var bound to the current uri" "#u takes a string or list argument: ~s" arg))))) -#+allegro -excl:: -#+allegro -(locally (declare (special std-lisp-readtable)) - (let ((*readtable* std-lisp-readtable)) - (set-dispatch-macro-character #\# #\u #'puri::sharp-u))) -#-allegro (set-dispatch-macro-character #\# #\u #'puri::sharp-u) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;