[rfc2388-cvs] CVS rfc2388
jdzerins
jdzerins at common-lisp.net
Tue Jun 29 10:49:02 UTC 2010
Update of /project/rfc2388/cvsroot/rfc2388
In directory cl-net:/tmp/cvs-serv10454
Modified Files:
rfc2388.lisp
Log Message:
Removed unused (and buggy) code from PARSE-MIME
RECURSIVE-P keyword argument to PARSE-MIME was never used (the original
intention of it might have been to give PARSE-MIME the whole content of HTTP
request). To my knowledge this functionality is not used by anyone.
Additionally, this code contained a bug (pointed out by Thomas Bakketun):
every field was expected to have a content-type header, which of course is not
true for most [non-file] fields.
--- /project/rfc2388/cvsroot/rfc2388/rfc2388.lisp 2009/10/23 06:35:20 1.11
+++ /project/rfc2388/cvsroot/rfc2388/rfc2388.lisp 2010/06/29 10:49:02 1.12
@@ -364,7 +364,7 @@
;;; _The_ MIME parsing
-(defgeneric parse-mime (source boundary &key recursive-p write-content-to-file)
+(defgeneric parse-mime (source boundary &key write-content-to-file)
(:documentation
"Parses MIME entities, returning them as a list. Each element in the
list is of form: (body headers), where BODY is the contents of MIME
@@ -407,12 +407,12 @@
headers)
-(defmethod parse-mime ((input string) separator &key (recursive-p t) (write-content-to-file t))
+(defmethod parse-mime ((input string) separator &key (write-content-to-file t))
(with-input-from-string (stream input)
- (parse-mime stream separator :recursive-p recursive-p :write-content-to-file write-content-to-file)))
+ (parse-mime stream separator :write-content-to-file write-content-to-file)))
-(defmethod parse-mime ((input stream) boundary &key (recursive-p t) (write-content-to-file t))
+(defmethod parse-mime ((input stream) boundary &key (write-content-to-file t))
;; Find the first boundary. Return immediately if it is also the last
;; one.
(unless (nth-value 1 (read-until-next-boundary input boundary t))
@@ -428,37 +428,33 @@
do (setf content-type-header header
(header-value header) (parse-content-type (header-value header)))
collect header)))
- (if (and recursive-p
- (string-equal "MULTIPART" (content-type-super (header-value content-type-header))))
- (let ((boundary (cdr (find-parameter "BOUNDARY" (header-parameters content-type-header)))))
- (push (make-mime-part (parse-mime input boundary) headers) result))
- (let ((file-name (get-file-name headers)))
- (cond ((and write-content-to-file
- file-name)
- (let ((temp-file (make-tmp-file-name)))
- (multiple-value-bind (text more)
- (with-open-file (out-file (ensure-directories-exist temp-file)
- :direction :output
- ;; external format for faithful I/O
- ;; see <http://cl-cookbook.sourceforge.net/io.html#faith>
- #+(or :sbcl :lispworks :allegro)
- :external-format
- #+sbcl :latin-1
- #+:lispworks '(:latin-1 :eol-style :lf)
- #+:allegro (excl:crlf-base-ef :latin1))
- (read-until-next-boundary input boundary nil out-file))
- (declare (ignore text))
- (when (and (stringp file-name)
- (plusp (length file-name)))
- (push (make-mime-part temp-file headers) result))
- (when (not more)
- (return)))))
- (t
- (multiple-value-bind (text more)
- (read-until-next-boundary input boundary)
- (push (make-mime-part text headers) result)
- (when (not more)
- (return)))))))))
+ (let ((file-name (get-file-name headers)))
+ (cond ((and write-content-to-file
+ file-name)
+ (let ((temp-file (make-tmp-file-name)))
+ (multiple-value-bind (text more)
+ (with-open-file (out-file (ensure-directories-exist temp-file)
+ :direction :output
+ ;; external format for faithful I/O
+ ;; see <http://cl-cookbook.sourceforge.net/io.html#faith>
+ #+(or :sbcl :lispworks :allegro)
+ :external-format
+ #+sbcl :latin-1
+ #+:lispworks '(:latin-1 :eol-style :lf)
+ #+:allegro (excl:crlf-base-ef :latin1))
+ (read-until-next-boundary input boundary nil out-file))
+ (declare (ignore text))
+ (when (and (stringp file-name)
+ (plusp (length file-name)))
+ (push (make-mime-part temp-file headers) result))
+ (when (not more)
+ (return)))))
+ (t
+ (multiple-value-bind (text more)
+ (read-until-next-boundary input boundary)
+ (push (make-mime-part text headers) result)
+ (when (not more)
+ (return))))))))
(nreverse result)))
More information about the rfc2388-cvs
mailing list