From jdzerins at common-lisp.net Tue Jun 29 10:49:02 2010 From: jdzerins at common-lisp.net (jdzerins) Date: Tue, 29 Jun 2010 06:49:02 -0400 Subject: [rfc2388-cvs] CVS rfc2388 Message-ID: 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 - #+(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 + #+(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)))