OSCL/PURI
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

r11030: changes from franz

Browse Source
This commit is contained in:
Kevin M. Rosenberg
2006-08-15 00:57:31 +00:00
parent 9166baaa6c
commit 1321c88e7a
1 changed files with 28 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

62
src.lisp
View File

@ -1,26 +1,26 @@
;; -*- mode: common-lisp; package: puri -*- ;; -*- mode: common-lisp; package: puri -*-
;; Support for URIs in Allegro. ;; Support for URIs
;; For general URI information see RFC2396. ;; For general URI information see RFC2396.
;; ;;
;; copyright (c) 1999-2001 Franz Inc, Berkeley, CA - All rights reserved. ;; copyright (c) 1999-2002 Franz Inc, Berkeley, CA - All rights reserved.
;; copyright (c) 2003 Kevin Rosenberg (porting changes) ;; copyright (c) 2002-2005 Franz Inc, Oakland, CA - All rights reserved.
;; copyright (c) 2003-2006 Kevin Rosenberg (porting changes)
;; ;;
;; The software, data and information contained herein are proprietary ;; This code is free software; you can redistribute it and/or
;; to, and comprise valuable trade secrets of, Franz, Inc. They are ;; modify it under the terms of the version 2.1 of
;; given in confidence by Franz, Inc. pursuant to a written license ;; the GNU Lesser General Public License as published by
;; agreement, and may be stored and used only in accordance with the terms ;; the Free Software Foundation, as clarified by the
;; of such license. ;; preamble found here:
;; http://opensource.franz.com/preamble.html
;; ;;
;; Restricted Rights Legend ;; Versions ported from Franz's opensource release
;; ------------------------
;; Use, duplication, and disclosure of the software, data and information
;; contained herein by any agency, department or entity of the U.S.
;; Government are subject to restrictions of Restricted Rights for
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;
;; Original version from ACL 6.1:
;; uri.cl,v 2.3.6.4.2.1 2001/08/09 17:42:39 layer ;; uri.cl,v 2.3.6.4.2.1 2001/08/09 17:42:39 layer
;; uri.cl,v 2.9.84.1 2005/08/11 18:38:52 layer
;; This code is distributed in the hope that it will be useful,
;; but without any warranty; without even the implied warranty of
;; merchantability or fitness for a particular purpose. See the GNU
;; Lesser General Public License for more details.
;; ;;
;; $Id$ ;; $Id$
@ -383,19 +383,7 @@
;;;;The rfc says this should be here, but it doesn't make sense. ;;;;The rfc says this should be here, but it doesn't make sense.
;; #\= ;; #\=
#\/ #\?)))) #\/ #\?))))
(defparameter *reserved-path-characters2*
;; These are the same characters that are in
;; *reserved-path-characters*, minus #\/. Why? Because the parsed
;; representation of the path can contain the %2f converted into a /.
;; That's the whole point of having the parsed representation, so that
;; lisp programs can deal with the path element data in the most
;; convenient form.
(reserved-char-vector
(append *excluded-characters*
'(#\;
;;;;The rfc says this should be here, but it doesn't make sense.
;; #\=
#\?))))
(defparameter *reserved-fragment-characters* (defparameter *reserved-fragment-characters*
(reserved-char-vector (remove #\# *excluded-characters*))) (reserved-char-vector (remove #\# *excluded-characters*)))
@ -656,7 +644,13 @@ URI ~s contains illegal character ~s at position ~d."
(:colon (failure)) (:colon (failure))
(:question (failure)) (:question (failure))
(:hash (failure)) (:hash (failure))
(:slash (failure)) (:slash
(if* (and (equalp "file" scheme)
(null host))
then ;; file:///...
(push "/" path-components)
(setq state 6)
else (failure)))
(:string (setq host tokval) (:string (setq host tokval)
(setq state 11)) (setq state 11))
(:end (failure)))) (:end (failure))))
@ -811,8 +805,8 @@ URI ~s contains illegal character ~s at position ~d."
"Non-hexidecimal digits after %: %c%c." ch ch2)) "Non-hexidecimal digits after %: %c%c." ch ch2))
(let ((ci (+ (* 16 chc) chc2))) (let ((ci (+ (* 16 chc) chc2)))
(if* (or (null reserved-chars) (if* (or (null reserved-chars)
(and (< ci (length reserved-chars)) (> ci 127) ; bug11527
(= 0 (sbit reserved-chars ci)))) (= 0 (sbit reserved-chars ci)))
then ;; ok as is then ;; ok as is
(setf (char new-string new-i) (setf (char new-string new-i)
(code-char ci)) (code-char ci))
@ -842,7 +836,7 @@ URI ~s contains illegal character ~s at position ~d."
(symbol-name scheme)) (symbol-name scheme))
*reserved-characters* escape)) *reserved-characters* escape))
(when scheme ":") (when scheme ":")
(when host "//") (when (or host (eq :file scheme)) "//")
(when host (when host
(encode-escaped-encoding (encode-escaped-encoding
host *reserved-authority-characters* escape)) host *reserved-authority-characters* escape))