Update of /project/cxml/cvsroot/cxml/xml In directory common-lisp.net:/tmp/cvs-serv30430/xml Modified Files: xml-parse.lisp Log Message: [WFC: No External Entity References] Date: Sun Nov 27 17:09:19 2005 Author: dlichteblau Index: cxml/xml/xml-parse.lisp diff -u cxml/xml/xml-parse.lisp:1.29 cxml/xml/xml-parse.lisp:1.30 --- cxml/xml/xml-parse.lisp:1.29 Sun Nov 27 14:03:01 2005 +++ cxml/xml/xml-parse.lisp Sun Nov 27 17:09:19 2005 @@ -642,9 +642,13 @@ (define-condition xml-parse-error (simple-error) ()) (define-condition well-formedness-violation (xml-parse-error) ()) -(define-condition end-of-xstream (well-formedness-violation) ()) (define-condition validity-error (xml-parse-error) ()) +;; We make some effort to signal end of file as a special condition, but we +;; don't actually try very hard. Not sure whether we should. Right now I +;; would prefer not to document this class. +(define-condition end-of-xstream (well-formedness-violation) ()) + (defun validity-error (x &rest args) (error 'validity-error :format-control "Document not valid: ~?" @@ -901,13 +905,11 @@ (rod-string entity-name))) def)) -(defun entity->xstream (entity-name kind &optional zstream) +(defun entity->xstream (zstream entity-name kind &optional internalp) ;; `zstream' is for error messages (let ((def (get-entity-definition entity-name kind (dtd *ctx*)))) (unless def - (if zstream - (perror zstream "Entity '~A' is not defined." (rod-string entity-name)) - (wf-error "Entity '~A' is not defined." (rod-string entity-name)))) + (perror zstream "Entity '~A' is not defined." (rod-string entity-name))) (let (r) (etypecase def (internal-entdef @@ -917,6 +919,8 @@ :entity-kind kind :uri nil))) (external-entdef + (when internalp + (wf-error "entity not internal: ~A" (rod-string entity-name))) (setf r (xstream-open-extid (extid-using-catalog (entdef-extid def)))) (setf (stream-name-entity-name (xstream-name r)) entity-name (stream-name-entity-kind (xstream-name r)) kind))) @@ -941,9 +945,9 @@ :name (make-stream-name :uri sysid) :initial-speed 1))) -(defun call-with-entity-expansion-as-stream (zstream cont name kind) - ;; `zstream' is for error messages -- we need something better! - (let ((in (entity->xstream name kind zstream))) +(defun call-with-entity-expansion-as-stream (zstream cont name kind internalp) + ;; `zstream' is for error messages + (let ((in (entity->xstream zstream name kind internalp))) (unwind-protect (funcall cont in) (close-xstream in)))) @@ -1234,7 +1238,7 @@ (check-rune input #/\; (read-rune input)) (cond (*expand-pe-p* ;; no external entities here! - (let ((i2 (entity->xstream nam :parameter))) + (let ((i2 (entity->xstream zinput nam :parameter))) (zstream-push i2 zinput)) (values :S nil) ;space before inserted PE expansion. ) @@ -1443,7 +1447,8 @@ zinput name :general (lambda (zinput) (muffle (car (zstream-input-stack zinput)) - :eof)))) + :eof)) + t)) (:ENT ;; bypass, but never the less we ;; need to check for legal @@ -3052,10 +3057,8 @@ (push new-xstream (zstream-input-stack zstream)) zstream) -(defun recurse-on-entity (zstream name kind continuation) +(defun recurse-on-entity (zstream name kind continuation &optional internalp) (assert (not (zstream-token-category zstream))) - ;;(sleep .2) - ;;(warn "~S / ~S[~S]." (zstream-input-stack zstream) (mu name) kind) (call-with-entity-expansion-as-stream zstream (lambda (new-xstream) @@ -3069,7 +3072,9 @@ (assert (eq (pop (zstream-input-stack zstream)) :stop)) (setf (zstream-token-category zstream) nil) '(consume-token zstream)) ) - name kind)) + name + kind + internalp)) #|| (defmacro read-data-until* ((predicate input res res-start res-end) &body body)