[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