chore(3p/lisp): import mime4cl source tarball

Used http://wcp.sdf-eu.org/software/mime4cl-20150207T211851.tbz (sha256 5a914669bba7561efe59a4fd0817204c07ad2add98b03ae206ef185ac04affb3). Importing seems sensible since there's no upstream repo nor has their been a release since 2015. This is just an import commit, so the changes made to make it build are more discoverable as their own commit. Change-Id: I2ff28c3c7433abdf7857204bc89eaf9edc0b1cbc Reviewed-on: https://cl.tvl.fyi/c/depot/+/3378 Tested-by: BuildkiteCI Reviewed-by: grfn <grfn@gws.fyi>
2021-08-21 15:29:43 +02:00 · 2021-08-21 15:29:43 +02:00 · 901364869c
commit 901364869c
parent de0f0164d2
13 changed files with 3313 additions and 0 deletions
--- a/third_party/lisp/mime4cl/address.lisp
+++ b/third_party/lisp/mime4cl/address.lisp
@ -0,0 +1,301 @@
+;;;  address.lisp --- e-mail address parser
+
+;;;  Copyright (C) 2007, 2008, 2009 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+#+cmu (ext:file-comment "$Module: address.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+;;;  Although not MIME specific, this parser is often useful together
+;;;  with the MIME primitives.  It should be able to parse the address
+;;;  syntax described in RFC2822 excluding the obsolete syntax (see
+;;;  RFC822).  Have a look at the test suite to get an idea of what
+;;;  kind of addresses it can parse.
+
+(in-package :mime4cl)
+
+(defstruct (mailbox (:conc-name mbx-))
+  description
+  user
+  host
+  domain)
+
+(defstruct (mailbox-group (:conc-name mbxg-))
+  name
+  mailboxes)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun write-mailbox-domain-name (addr &optional (stream *standard-output*))
+  (when (eq :internet (mbx-domain addr))
+    (write-char #\[ stream))
+  (write-string (mbx-host addr) stream)
+  (when (eq :internet (mbx-domain addr))
+    (write-char #\] stream))
+  (when (stringp (mbx-domain addr))
+    (write-char #\. stream)
+    (write-string (mbx-domain addr) stream)))
+
+(defun write-mailbox-address (addr &optional (stream *standard-output*))
+  (write-string (mbx-user addr) stream)
+  (when (mbx-host addr)
+    (write-char #\@ stream)
+    (write-mailbox-domain-name addr stream)))
+
+(defmethod mbx-domain-name ((MBX mailbox))
+  "Return the complete domain name string of MBX, in the form
+\"host.domain\"."
+  (with-output-to-string (out)
+    (write-mailbox-domain-name mbx out)))
+
+(defmethod mbx-address ((mbx mailbox))
+  "Return the e-mail address string of MBX, in the form
+\"user@host.domain\"."
+  (with-output-to-string (out)
+    (write-mailbox-address mbx out)))
+
+(defun write-mailbox (addr &optional (stream *standard-output*))
+  (awhen (mbx-description addr)
+    (write it :stream stream :readably t)
+    (write-string " <" stream))
+  (write-mailbox-address addr stream)
+  (awhen (mbx-description addr)
+    (write-char #\> stream)))
+
+(defun write-mailbox-group (grp &optional (stream *standard-output*))
+  (write-string (mbxg-name grp) stream)
+  (write-string ": " stream)
+  (loop
+     for mailboxes on (mbxg-mailboxes grp)
+     for mailbox = (car mailboxes)
+     do (write-mailbox mailbox stream)
+     unless (endp (cdr mailboxes))
+     do (write-string ", " stream))
+  (write-char #\; stream))
+
+(defmethod print-object ((mbx mailbox) stream)
+  (if (or *print-readably* *print-escape*)
+      (call-next-method)
+      (write-mailbox mbx stream)))
+
+(defmethod print-object ((grp mailbox-group) stream)
+  (if (or *print-readably* *print-escape*)
+      (call-next-method)
+      (write-mailbox-group grp stream)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun parser-make-mailbox (description address-list)
+  (make-mailbox :description description
+		:user (car address-list)
+		:host (cadr address-list)
+		:domain (when (cddr address-list)
+			  (string-concat (cddr address-list) "."))))
+
+
+(defun populate-grammar ()
+  (defrule address-list
+      := (+ address ","))
+
+  (defrule address
+      := mailbox
+      := group)
+
+  (defrule mailbox
+      := display-name? angle-addr comment?
+      :reduce (parser-make-mailbox (or display-name comment) angle-addr)
+      := addr-spec comment?
+      :reduce (parser-make-mailbox comment addr-spec))
+
+  (defrule angle-addr
+      := "<" addr-spec ">")
+
+  (defrule group
+      := display-name ":" mailbox-list ";"
+      :reduce (make-mailbox-group :name display-name :mailboxes mailbox-list))
+
+  (defrule display-name
+      := phrase
+      :reduce (string-concat phrase " "))
+
+  (defrule phrase
+      := word+)
+
+  (defrule word
+      := atext
+      := string)
+
+  (defrule mailbox-list
+      := (+ mailbox ","))
+
+  (defrule addr-spec
+      := local-part "@" domain :reduce (cons local-part domain))
+
+  (defrule local-part
+      := dot-atom :reduce (string-concat dot-atom ".")
+      := string)
+
+  (defrule domain
+      := dot-atom
+      := domain-literal :reduce (list domain-literal :internet))
+
+  ;; actually, according to the RFC, dot-atoms don't allow spaces in
+  ;; between but these rules do
+  (defrule dot-atom
+      := (+ atom "."))
+
+  (defrule atom
+      := atext+
+      :reduce (apply #'concatenate 'string atext)))
+
+(deflazy define-grammar
+  (let ((*package* #.*package*)
+	(*compile-print* (when npg::*debug* t)))
+    (reset-grammar)
+    (format t "~&creating e-mail address grammar...~%")
+    (populate-grammar)
+    (let ((grammar (npg:generate-grammar #'string=)))
+      (reset-grammar)
+      (npg:print-grammar-figures grammar)
+      grammar)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; The lexical analyser
+
+(defstruct cursor
+  stream
+  (position 0))
+
+(defun read-delimited-string (stream end-char &key nesting-start-char (escape-char #\\))
+  (labels ((collect ()
+	     (with-output-to-string (out)
+	       (loop
+		  for c = (read-char stream nil)
+		  while (and c (not (char= c end-char)))
+		  do (cond ((char= c escape-char)
+			    (awhen (read-char stream nil)
+			      (write-char it out)))
+			   ((and nesting-start-char
+				 (char= c nesting-start-char))
+			    (write-char nesting-start-char out)
+			    (write-string (collect) out)
+			    (write-char end-char out))
+			   (t (write-char c out)))))))
+    (collect)))
+
+
+(defun read-string (cursor)
+  (make-token :type 'string
+	      :value (read-delimited-string (cursor-stream cursor) #\")
+	      :position (incf (cursor-position cursor))))
+
+(defun read-domain-literal (cursor)
+  (make-token :type 'domain-literal
+	      :value (read-delimited-string (cursor-stream cursor) #\])
+	      :position (incf (cursor-position cursor))))
+
+(defun read-comment (cursor)
+  (make-token :type 'comment
+	      :value (read-delimited-string (cursor-stream cursor) #\) :nesting-start-char #\()
+	      :position (incf (cursor-position cursor))))
+
+(declaim (inline atom-component-p))
+(defun atom-component-p (c)
+  (declare (type character c))
+  (not (find c " ()\"[]@.<>:;,")))
+
+(defun read-atext (first-character cursor)
+  (be string (with-output-to-string (out)
+	       (write-char first-character out)
+	       (loop
+		  for c = (read-char (cursor-stream cursor) nil)
+		  while (and c (atom-component-p c))
+		  do (write-char c out)
+		  finally (when c
+			    (unread-char c (cursor-stream cursor)))))
+    (make-token :type 'atext
+		:value string
+		:position (incf (cursor-position cursor)))))
+
+(defmethod read-next-tokens ((cursor cursor))
+  (flet ((make-keyword (c)
+	   (make-token :type 'keyword
+		       :value (string c)
+		       :position (incf (cursor-position cursor)))))
+    (be in (cursor-stream cursor)
+      (loop
+	 for c = (read-char in nil)
+	 while c
+	 unless (whitespace-p c)
+	 return (list
+		 (cond ((char= #\( c)
+			(read-comment cursor))
+		       ((char= #\" c)
+			(read-string cursor))
+		       ((char= #\[ c)
+			(read-domain-literal cursor))
+		       ((find c "@.<>:;,")
+			(make-keyword c))
+		       (t
+			;; anything else is considered a text atom even
+			;; though it's just a single character
+			(read-atext c cursor))))))))
+
+(defun analyse-string (string)
+  "Return the list of tokens produced by a lexical analysis of
+STRING.  These are the tokens that would be seen by the parser."
+  (with-input-from-string (stream string)
+    (be cursor (make-cursor :stream stream)
+      (loop
+	 for tokens = (read-next-tokens cursor)
+	 until (endp tokens)
+	 append tokens))))
+
+(defun mailboxes-only (list-of-mailboxes-and-groups)
+  "Return a flat list of MAILBOX-ADDRESSes from
+LIST-OF-MAILBOXES-AND-GROUPS, which is the kind of list returned
+by PARSE-ADDRESSES.  This turns out to be useful when your
+program is not interested in mailbox groups and expects the user
+addresses only."
+  (mapcan #'(lambda (mbx)
+	      (if (typep mbx 'mailbox-group)
+		  (mbxg-mailboxes mbx)
+		  (list mbx)))
+	  list-of-mailboxes-and-groups))
+
+(defun parse-addresses (string &key no-groups)
+  "Parse STRING and return a list of MAILBOX-ADDRESSes or
+MAILBOX-GROUPs.  If STRING is unparsable return NIL.  If
+NO-GROUPS is true, return a flat list of mailboxes throwing away
+the group containers, if any."
+  (be grammar (force define-grammar)
+    (with-input-from-string (stream string)
+      (be* cursor (make-cursor :stream stream)
+	   mailboxes (ignore-errors	; ignore parsing errors
+		       (parse grammar 'address-list cursor))
+	(if no-groups
+	    (mailboxes-only mailboxes)
+	    mailboxes)))))
+
+(defun debug-addresses (string)
+  "More or less like PARSE-ADDRESSES, but don't ignore parsing errors."
+  (be grammar (force define-grammar)
+    (with-input-from-string (stream string)
+      (be cursor (make-cursor :stream stream)
+	(parse grammar 'address-list cursor)))))
+
--- a/third_party/lisp/mime4cl/endec.lisp
+++ b/third_party/lisp/mime4cl/endec.lisp
@ -0,0 +1,683 @@
+;;;  endec.lisp --- encoder/decoder functions
+
+;;;  Copyright (C) 2005-2008, 2010 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+
+(in-package :mime4cl)
+
+
+;; Thank you SBCL for rendering constants totally useless!
+(defparameter +base64-encode-table+
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=")
+
+(defparameter +base64-decode-table+
+  (let ((da (make-array 256 :element-type '(unsigned-byte 8) :initial-element 65)))
+    (dotimes (i 64)
+      (setf (aref da (char-code (char +base64-encode-table+ i))) i))
+    da))
+
+(declaim (type (simple-array (unsigned-byte 8)) +base64-decode-table+)
+	 (type simple-string +base64-encode-table+))
+
+(defvar *base64-line-length* 76
+  "Maximum length of the encoded base64 line.  NIL means it can
+be of unlimited length \(no line breaks will be done by the
+encoding function).")
+
+(defvar *quoted-printable-line-length* 72
+  "Maximum length of the encoded quoted printable line.  NIL
+means it can be of unlimited length \(no line breaks will be done
+by the encoding function).")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass decoder ()
+  ((input-function :initarg :input-function
+		   :reader decoder-input-function
+		   :type function
+		   :documentation
+		   "Function is called repeatedly by the decoder methods to get the next character.
+It should return a character os NIL (indicating EOF)."))
+  (:documentation
+   "Abstract base class for decoders."))
+
+(defclass parsing-decoder (decoder)
+  ((parser-errors :initform nil
+		  :initarg :parser-errors
+		  :reader decoder-parser-errors
+		  :type boolean))
+  (:documentation
+   "Abstract base class for decoders that do parsing."))
+
+(defclass encoder ()
+  ((output-function :initarg :output-function
+		    :reader encoder-output-function
+		    :type function
+		    :documentation
+		    "Function is called repeatedly by the encoder methods to output a character.
+It should expect a character as its only argument."))
+  (:documentation
+   "Abstract base class for encoders."))
+
+(defclass line-encoder (encoder)
+  ((column :initform 0
+	   :type fixnum)
+   (line-length :initarg :line-length
+		:initform nil
+		:reader encoder-line-length
+		:type (or fixnum null)))
+  (:documentation
+   "Abstract base class for line encoders."))
+
+(defclass 8bit-decoder (decoder)
+  ()
+  (:documentation
+   "Class for decoders that do nothing."))
+
+(defclass 8bit-encoder (encoder)
+  ()
+  (:documentation
+   "Class for encoders that do nothing."))
+
+(defclass 7bit-decoder (decoder)
+  ()
+  (:documentation
+   "Class for decoders that do nothing."))
+
+(defclass 7bit-encoder (encoder)
+  ()
+  (:documentation
+   "Class for encoders that do nothing."))
+
+(defclass byte-decoder (decoder)
+  ()
+  (:documentation
+   "Class for decoders that turns chars to bytes."))
+
+(defclass byte-encoder (encoder)
+  ()
+  (:documentation
+   "Class for encoders that turns bytes to chars."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric encoder-write-byte (encoder byte))
+(defgeneric encoder-finish-output (encoder))
+(defgeneric decoder-read-byte (decoder))
+
+(defmethod encoder-finish-output ((encoder encoder))
+  (values))
+
+(defmethod encoder-write-byte ((encoder 8bit-encoder) byte)
+  (funcall (slot-value encoder 'output-function)
+	   (code-char byte))
+  (values))
+
+(defmethod decoder-read-byte ((decoder 8bit-decoder))
+  (awhen (funcall (slot-value decoder 'input-function))
+    (char-code it)))
+
+(defmethod encoder-write-byte ((encoder 7bit-encoder) byte)
+  (funcall (slot-value encoder 'output-function)
+	   (code-char (logand #x7F byte)))
+  (values))
+
+(defmethod decoder-read-byte ((decoder 7bit-decoder))
+  (awhen (funcall (slot-value decoder 'input-function))
+    (logand #x7F (char-code it))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun decoder-read-sequence (sequence decoder &key (start 0) (end (length sequence)))
+  (declare (optimize (speed 3) (safety 0) (debug 0))
+	   (type fixnum start end)
+	   (type vector sequence))
+  (loop
+     for i fixnum from start below end
+     for byte = (decoder-read-byte decoder)
+     while byte
+     do (setf (aref sequence i) byte)
+     finally (return i)))
+
+(defun decoder-read-line (decoder)
+  (with-output-to-string (str)
+    (loop
+       for byte = (decoder-read-byte decoder)
+       unless byte
+       do (return-from decoder-read-line nil)
+       do (be c (code-char byte)
+	    (cond ((char= c #\return)
+		   ;; skip the newline
+		   (decoder-read-byte decoder)
+		   (return nil))
+		  ((char= c #\newline)
+		   ;; the #\return was missing
+		   (return nil))
+		  (t (write-char c str)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declaim (inline parse-hex))
+(defun parse-hex (c1 c2)
+  "Parse two characters as hexadecimal and return their combined
+value."
+  (declare (optimize (speed 3) (safety 0) (debug 0))
+	   (type character c1 c2))
+  (flet ((digit-value (char)
+	   (or (position char "0123456789ABCDEF")
+	       (return-from parse-hex nil))))
+    (+ (* 16 (digit-value c1))
+       (digit-value c2))))
+
+(defclass quoted-printable-decoder (parsing-decoder)
+  ((saved-bytes :initform (make-queue))))
+
+(defmethod decoder-read-byte ((decoder quoted-printable-decoder))
+  (declare (optimize (speed 3) (safety 0) (debug 0)))
+  (with-slots (input-function saved-bytes parser-errors) decoder
+    (declare (type function input-function))
+    (labels ((saveb (b)
+	       (queue-append saved-bytes b)
+	       (values))
+	     (save (c)
+	       (saveb (char-code c)))
+	     (push-next ()
+	       (be c (funcall input-function)
+		 (declare (type (or null character) c))
+		 (cond ((not c))
+		       ((or (char= c #\space)
+			    (char= c #\tab))
+			(save c)
+			(push-next))
+		       ((char= c #\=)
+			(be c1 (funcall input-function)
+			  (cond ((not c1)
+				 (save #\=))
+				((char= c1 #\return)
+				 ;; soft line break: skip the next
+				 ;; character which we assume to be a
+				 ;; newline (pity if it isn't)
+				 (funcall input-function)
+				 (push-next))
+				((char= c1 #\newline)
+				 ;; soft line break: the #\return is
+				 ;; missing, but we are tolerant
+				 (push-next))
+				(t
+				 ;; hexadecimal sequence: get the 2nd digit
+				 (be c2 (funcall input-function)
+				   (if c2
+				       (aif (parse-hex c1 c2)
+					    (saveb it)
+					    (if parser-errors
+						(error "invalid hex sequence ~A~A" c1 c2)
+						(progn
+						  (save #\=)
+						  (save c1)
+						  (save c2))))
+				       (progn
+					 (save c)
+					 (save c1))))))))
+		       (t
+			(save c))))))
+      (or (queue-pop saved-bytes)
+	  (progn
+	    (push-next)
+	    (queue-pop saved-bytes))))))
+
+(defmacro make-encoder-loop (encoder-class input-form output-form)
+  (with-gensyms (encoder byte)
+    `(loop
+	with ,encoder = (make-instance ',encoder-class
+				       :output-function #'(lambda (char) ,output-form))
+	for ,byte = ,input-form
+	while ,byte
+	do (encoder-write-byte ,encoder ,byte)
+	finally (encoder-finish-output ,encoder))))
+
+(defmacro make-decoder-loop (decoder-class input-form output-form &key parser-errors)
+  (with-gensyms (decoder)
+    `(loop
+	with ,decoder = (make-instance ',decoder-class
+				       :input-function #'(lambda () ,input-form)
+				       :parser-errors ,parser-errors)
+	for byte = (decoder-read-byte ,decoder)
+	while byte
+	do ,output-form)))
+
+(defun decode-quoted-printable-stream (in out &key parser-errors)
+  "Read from stream IN a quoted printable text and write to
+binary output OUT the decoded stream of bytes."
+  (make-decoder-loop quoted-printable-decoder
+		     (read-byte in nil) (write-byte byte out)
+		     :parser-errors parser-errors))
+
+(defmacro make-stream-to-sequence-decoder (decoder-class input-form &key parser-errors)
+  "Decode the character stream STREAM and return a sequence of bytes."
+  (with-gensyms (output-sequence)
+    `(be ,output-sequence (make-array 0
+				      :element-type '(unsigned-byte 8)
+				      :fill-pointer 0
+				      :adjustable t)
+       (make-decoder-loop ,decoder-class ,input-form
+			  (vector-push-extend byte ,output-sequence)
+			  :parser-errors ,parser-errors)
+       ,output-sequence)))
+
+(defun decode-quoted-printable-stream-to-sequence (stream &key parser-errors)
+  "Read from STREAM a quoted printable text and return a vector of
+bytes."
+  (make-stream-to-sequence-decoder quoted-printable-decoder
+    (read-char stream nil)
+    :parser-errors parser-errors))
+
+(defun decode-quoted-printable-string (string &key (start 0) (end (length string)) parser-errors)
+  "Decode STRING as quoted printable sequence of characters and
+return a decoded sequence of bytes."
+  (with-input-from-string (in string :start start :end end)
+    (decode-quoted-printable-stream-to-sequence in :parser-errors parser-errors)))
+
+(defclass quoted-printable-encoder (line-encoder)
+  ((line-length :initform *quoted-printable-line-length*
+		:type (or fixnum null))
+   (pending-space :initform nil
+		  :type boolean)))
+
+(defmethod encoder-write-byte ((encoder quoted-printable-encoder) byte)
+  (declare (optimize (speed 3) (safety 0) (debug 0))
+	   (type (unsigned-byte 8) byte))
+  (with-slots (output-function column pending-space line-length) encoder
+    (declare (type function output-function)
+	     (type fixnum column)
+	     (type (or fixnum null) line-length)
+	     (type boolean pending-space))
+    (labels ((out (c)
+	       (funcall output-function c)
+	       (values))
+	     (outs (str)
+	       (declare (type simple-string str))
+	       (loop
+		  for c across str
+		  do (out c))
+	       (values))
+	     (out2hex (x)
+	       (declare (type fixnum x))
+	       (multiple-value-bind (a b) (truncate x 16)
+		 (out (digit-char a 16))
+		 (out (digit-char b 16)))))
+      (cond ((= byte #.(char-code #\newline))
+	     (when pending-space
+	       (outs "=20")
+	       (setf pending-space nil))
+	     (out #\newline)
+	     (setf column 0))
+	    ((= byte #.(char-code #\space))
+	     (if pending-space
+		 (progn
+		   (out #\space)
+		   (f++ column))
+		 (setf pending-space t)))
+	    (t
+	     (when pending-space
+	       (out #\space)
+	       (f++ column)
+	       (setf pending-space nil))
+	     (cond ((or (< byte 32)
+			(= byte #.(char-code #\=))
+			(> byte 126))
+		    (out #\=)
+		    (out2hex byte)
+		    (f++ column 3))
+		   (t
+		    (out (code-char byte))
+		    (f++ column)))))
+      (when (and line-length
+		 (>= column line-length))
+	;; soft line break
+	(outs #.(coerce '(#\= #\newline) 'string))
+	(setf column 0)))))
+
+(defmethod encoder-finish-output ((encoder quoted-printable-encoder))
+  (declare (optimize (speed 3) (safety 0) (debug 0)))
+  (with-slots (pending-space output-function) encoder
+    (declare (type boolean pending-space)
+	     (type function output-function))
+    (when pending-space
+      (flet ((outs (s)
+	       (declare (type simple-string s))
+	       (loop
+		  for c across s
+		  do (funcall output-function c))))
+	(setf pending-space nil)
+	(outs "=20")))))
+
+(defun encode-quoted-printable-stream (in out)
+  "Read from IN a stream of bytes and write to OUT a stream of
+characters quoted printables encoded."
+  (make-encoder-loop quoted-printable-encoder
+		     (read-byte in nil)
+		     (write-char char out)))
+
+(defun encode-quoted-printable-sequence-to-stream (sequence stream &key (start 0) (end (length sequence)))
+  "Encode the sequence of bytes SEQUENCE and write to STREAM a
+quoted printable sequence of characters."
+  (be i start
+    (make-encoder-loop quoted-printable-encoder
+     (when (< i end)
+       (prog1 (elt sequence i)
+	 (f++ i)))
+     (write-char char stream))))
+
+(defun encode-quoted-printable-sequence (sequence &key (start 0) (end (length sequence)))
+  "Encode the sequence of bytes SEQUENCE into a quoted printable
+string and return it."
+  (with-output-to-string (out)
+    (encode-quoted-printable-sequence-to-stream sequence out :start start :end end)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass base64-encoder (line-encoder)
+  ((line-length :initform *base64-line-length*)
+   (bitstore :initform 0
+	     :type fixnum)
+   (bytecount :initform 0
+	      :type fixnum))
+  (:documentation
+   "Class for Base64 encoder output streams."))
+
+
+(eval-when (:load-toplevel :compile-toplevel)
+  (unless (> most-positive-fixnum (expt 2 (* 8 3)))))
+
+(macrolet ((with-encoder (encoder &body forms)
+	     `(with-slots (bitstore line-length column bytecount output-function) ,encoder
+		(declare (type fixnum column)
+			 (type fixnum bitstore bytecount)
+			 (type (or fixnum null) line-length)
+			 (type function output-function))
+		(labels ((emitr (i b)
+			   (declare (type fixnum i b))
+			   (unless (zerop i)
+			     (emitr (1- i) (ash b -6)))
+			   (emitc
+			    (char +base64-encode-table+ (logand b #x3F)))
+			   (values))
+			 (out (c)
+			   (funcall output-function c))
+			 (eol ()
+			   (progn
+			     (out #\return)
+			     (out #\newline)))
+			 (emitc (char)
+			   (out char)
+			   (f++ column)
+			   (when (and line-length
+				      (>= column line-length))
+			     (setf column 0)
+			     (eol))))
+		  (declare (inline out eol emitc)
+			   (ignorable (function emitr) (function out) (function eol) (function emitc)))
+		  ,@forms))))
+  ;; For this function to work correctly, the FIXNUM must be at least
+  ;; 24 bits.
+  (defmethod encoder-write-byte ((encoder base64-encoder) byte)
+    (declare (optimize (speed 3) (safety 0) (debug 0))
+	     (type (unsigned-byte 8) byte))
+    (with-encoder encoder
+      (setf bitstore (logior byte (the fixnum (ash bitstore 8))))
+      (f++ bytecount)
+      (when (= 3 bytecount)
+	(emitr 3 bitstore)
+	(setf bitstore 0
+	      bytecount 0)))
+    (values))
+
+  (defmethod encoder-finish-output ((encoder base64-encoder))
+    (with-encoder encoder
+      (unless (zerop bytecount)
+	(multiple-value-bind (saved6 rest) (truncate (* bytecount 8) 6)
+	  (setf bitstore (ash bitstore (- 6 rest)))
+	  (emitr saved6 bitstore)
+	  (dotimes (x (- 3 saved6))
+	    (emitc #\=))))
+      (when (and line-length
+		 (not (zerop column)))
+	(eol)))
+    (values)))
+
+(defun encode-base64-stream (in out)
+  "Read a byte stream from IN and write to OUT the encoded Base64
+character stream."
+  (make-encoder-loop base64-encoder (read-byte in nil)
+		     (write-char char out)))
+
+(defun encode-base64-sequence-to-stream (sequence stream &key (start 0) (end (length sequence)))
+  "Encode the sequence of bytes SEQUENCE and write to STREAM the
+Base64 character sequence."
+  (be i start
+    (make-encoder-loop base64-encoder
+		       (when (< i end)
+			 (prog1 (elt sequence i)
+			   (incf i)))
+		       (write-char char stream))))
+
+(defun encode-base64-sequence (sequence &key (start 0) (end (length sequence)))
+  "Encode the sequence of bytes SEQUENCE into a Base64 string and
+return it."
+  (with-output-to-string (out)
+    (encode-base64-sequence-to-stream sequence out :start start :end end)))
+
+(defclass base64-decoder (parsing-decoder)
+  ((bitstore :initform 0
+	     :type fixnum)
+   (bytecount :initform 0 :type fixnum))
+  (:documentation
+   "Class for Base64 decoder input streams."))
+
+(defmethod decoder-read-byte ((decoder base64-decoder))
+  (declare (optimize (speed 3) (safety 0) (debug 0)))
+  (with-slots (bitstore bytecount input-function) decoder
+    (declare (type fixnum bitstore bytecount)
+	     (type function input-function))
+    (labels ((in6 ()
+	       (loop
+		  for c = (funcall input-function)
+		  when (or (not c) (char= #\= c))
+		  do (return-from decoder-read-byte nil)
+		  do (be sextet (aref +base64-decode-table+ (char-code c))
+		       (unless (= sextet 65) ; ignore unrecognised characters
+			 (return sextet)))))
+	     (push6 (sextet)
+	       (declare (type fixnum sextet))
+	       (setf bitstore
+		     (logior sextet (the fixnum (ash bitstore 6))))))
+      (case bytecount
+	(0
+	 (setf bitstore (in6))
+	 (push6 (in6))
+	 (setf bytecount 1)
+	 (ash bitstore -4))
+	(1
+	 (push6 (in6))
+	 (setf bytecount 2)
+	 (logand #xFF (ash bitstore -2)))
+	(2
+	 (push6 (in6))
+	 (setf bytecount 0)
+	 (logand #xFF bitstore))))))
+
+(defun decode-base64-stream (in out &key parser-errors)
+  "Read from IN a stream of characters Base64 encoded and write
+to OUT a stream of decoded bytes."
+  (make-decoder-loop base64-decoder
+		     (read-byte in nil) (write-byte byte out)
+		     :parser-errors parser-errors))
+
+(defun decode-base64-stream-to-sequence (stream &key parser-errors)
+  (make-stream-to-sequence-decoder base64-decoder
+				   (read-char stream nil)
+				   :parser-errors parser-errors))
+
+(defun decode-base64-string (string &key (start 0) (end (length string)) parser-errors)
+  (with-input-from-string (in string :start start :end end)
+    (decode-base64-stream-to-sequence in :parser-errors parser-errors)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun dump-stream-binary (in out)
+  "Write content of IN character stream to OUT binary stream."
+  (loop
+     for c = (read-char in nil)
+     while c
+     do (write-byte (char-code c) out)))
+
+(defun decode-stream (in out encoding &key parser-errors-p)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (decode-quoted-printable-stream in out
+				     :parser-errors parser-errors-p))
+    (:base64
+     (decode-base64-stream in out
+			   :parser-errors parser-errors-p))
+    (otherwise
+     (dump-stream-binary in out))))
+
+(defun decode-string (string encoding &key parser-errors-p)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (decode-quoted-printable-string string
+				     :parser-errors parser-errors-p))
+    (:base64
+     (decode-base64-string string
+			   :parser-errors parser-errors-p))
+    (otherwise
+     (map '(vector (unsigned-byte 8)) #'char-code string))))
+
+(defun decode-stream-to-sequence (stream encoding &key parser-errors-p)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (decode-quoted-printable-stream-to-sequence stream
+						 :parser-errors parser-errors-p))
+    (:base64
+     (decode-base64-stream-to-sequence stream
+				       :parser-errors parser-errors-p))
+    (otherwise
+     (loop
+	with output-sequence = (make-array 0 :fill-pointer 0
+					   :element-type '(unsigned-byte 8)
+					   :adjustable t)
+	for c = (read-char stream nil)
+	while c
+	do (vector-push-extend (char-code c) output-sequence)
+	finally (return output-sequence)))))
+
+(defun encode-stream (in out encoding)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (encode-quoted-printable-stream in out))
+    (:base64
+     (encode-base64-stream in out))
+    (otherwise
+     (loop
+	for byte = (read-byte in nil)
+	while byte
+	do (write-char (code-char byte) out)))))
+
+(defun encode-sequence-to-stream (sequence out encoding)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (encode-quoted-printable-sequence-to-stream sequence out))
+    (:base64
+     (encode-base64-sequence-to-stream sequence out))
+    (otherwise
+     (loop
+	for byte across sequence
+	do (write-char (code-char byte) out)))))
+
+(defun encode-sequence (sequence encoding)
+  (gcase (encoding string-equal)
+    (:quoted-printable
+     (encode-quoted-printable-sequence sequence))
+    (:base64
+     (encode-base64-sequence sequence))
+    (otherwise
+     (map 'string #'code-char sequence))))
+
+;; This is similar to decode-quoted-printable-string but #\_ is used
+;; instead of space
+(defun decode-quoted-printable-RFC2047-string (string &key (start 0) (end (length string)))
+  "Decode a string encoded according to the quoted printable
+method of RFC2047 and return a sequence of bytes."
+  (declare (optimize (speed 3) (debug 0) (safety 0))
+	   (type simple-string string))
+  (loop
+     with output-sequence = (make-array (length string)
+					:element-type '(unsigned-byte 8)
+					:fill-pointer 0)
+     for i fixnum from start by 1 below end
+     for c = (char string i)
+     do (case c
+	  (#\=
+	   (vector-push-extend (or (parse-hex (char string (1+ i)) (char string (+ 2 i)))
+				   ;; the char code was malformed
+				   #.(char-code #\?))
+			       output-sequence)
+	   (f++ i 2))
+	  (#\_ (vector-push-extend #.(char-code #\space) output-sequence))
+	  (otherwise
+	   (vector-push-extend (char-code c) output-sequence)))
+       finally (return output-sequence)))
+
+(defun decode-RFC2047-string (encoding string &key (start 0) (end (length string)))
+  "Decode STRING according to RFC2047 and return a sequence of
+bytes."
+  (gcase (encoding string-equal)
+    ("Q" (decode-quoted-printable-RFC2047-string string :start start :end end))
+    ("B" (decode-base64-string string :start start :end end))
+    (t string)))
+
+(defun parse-RFC2047-text (text)
+  "Parse the string TEXT according to RFC2047 rules and return a list
+of pairs and strings.  The strings are the bits interposed between the
+actually encoded text.  The pairs are composed of: a decoded byte
+sequence, a charset string indicating the original coding."
+  (loop
+     with result = '()
+     with previous-end = 0
+     for start = (search "=?" text :start2 previous-end)
+     while start
+     for first-? = (position #\? text :start (+ 2 start))
+     while first-?
+     for second-? = (position #\? text :start (1+ first-?))
+     while second-?
+     for end = (search "?=" text :start2 (1+ second-?))
+     while end
+     do (let ((charset (string-upcase (subseq text (+ 2 start) first-?)))
+	      (encoding (subseq text (1+ first-?) second-?)))
+	  (unless (= previous-end start)
+	    (push (subseq text previous-end start)
+		  result))
+	  (setf previous-end (+ end 2))
+	  (push (cons (decode-RFC2047-string encoding text :start (1+ second-?) :end end)
+		      charset)
+		result))
+     finally (unless (= previous-end (length text))
+	       (push (subseq text previous-end (length text))
+		     result))
+       (return (nreverse result))))
--- a/third_party/lisp/mime4cl/mime.lisp
+++ b/third_party/lisp/mime4cl/mime.lisp
--- a/third_party/lisp/mime4cl/mime4cl-tests.asd
+++ b/third_party/lisp/mime4cl/mime4cl-tests.asd
@ -0,0 +1,54 @@
+;;;  mime4cl-tests.asd --- system description for the regression tests
+
+;;;  Copyright (C) 2006, 2007, 2010 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+#-(or sbcl cmu)
+(warn "This code hasn't been tested on your Lisp system.")
+
+(defpackage :mime4cl-tests-system
+  (:use :common-lisp :asdf #+asdfa :asdfa)
+  (:export #:*base-directory*
+	   #:*compilation-epoch*))
+
+(in-package :mime4cl-tests-system)
+
+(defsystem mime4cl-tests
+    :name "MIME4CL-tests"
+    :author "Walter C. Pelissero <walter@pelissero.de>"
+    :maintainer "Walter C. Pelissero <walter@pelissero.de>"
+    :description "Test suite for the MIME4CL library"
+    :long-description
+    "These regression tests require rt.lisp from MIT.  It is included."
+    :licence "LGPL"
+    :depends-on (:mime4cl)
+    :components
+    ((:module test
+	      :components
+	      ((:file "rt")
+	       (:file "package" :depends-on ("rt"))
+	       (:file "endec" :depends-on ("rt" "package"))
+	       (:file "address" :depends-on ("rt" "package"))
+	       (:file "mime" :depends-on ("rt" "package"))))))
+
+;; when loading this form the regression-test, the package is yet to
+;; be loaded so we cannot use rt:do-tests directly or we would get a
+;; reader error (unknown package)
+(defmethod perform ((o test-op) (c (eql (find-system :mime4cl-tests))))
+  (or (funcall (intern "DO-TESTS" "REGRESSION-TEST"))
+      (error "test-op failed")))
--- a/third_party/lisp/mime4cl/mime4cl.asd
+++ b/third_party/lisp/mime4cl/mime4cl.asd
@ -0,0 +1,53 @@
+;;;  mime4cl.asd --- system definition
+
+;;;  Copyright (C) 2005-2007, 2010 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 2, or (at
+;;; your option) any later version.
+;;; This program 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
+;;; General Public License for more details.
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
+
+(in-package :cl-user)
+
+#+(and cmu (not gray-streams))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ext:without-package-locks
+    (load "library:subsystems/gray-streams-library")))
+
+(defpackage :mime4cl-system
+  (:use :common-lisp :asdf))
+
+(in-package :mime4cl-system)
+
+(defsystem mime4cl
+    :name "MIME4CL"
+    :author "Walter C. Pelissero <walter@pelissero.de>"
+    :maintainer "Walter C. Pelissero <walter@pelissero.de>"
+    ;; :version "0.0"
+    :description "MIME primitives for Common Lisp"
+    :long-description
+    "A collection of Common Lisp primitives to forge and handle
+MIME mail contents."
+    :licence "LGPL"
+    :depends-on (:npg :sclf)
+    :components
+    ((:file "package")
+     (:file "mime" :depends-on ("package" "endec" "streams"))
+     (:file "endec" :depends-on ("package"))
+     (:file "streams" :depends-on ("package" "endec"))
+     (:file "address" :depends-on ("package"))))
+
+(defmethod perform ((o test-op) (c (eql (find-system 'mime4cl))))
+  (oos 'load-op 'mime4cl-tests)
+  (oos 'test-op 'mime4cl-tests :force t))
--- a/third_party/lisp/mime4cl/package.lisp
+++ b/third_party/lisp/mime4cl/package.lisp
@ -0,0 +1,107 @@
+;;;  package.lisp --- package declaration
+
+;;;  Copyright (C) 2005-2007, 2010 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :cl-user)
+
+(defpackage :mime4cl
+  (:nicknames :mime)
+  (:use :common-lisp :npg :sclf
+	;; for Gray streams
+	#+cmu :extensions #+sbcl :sb-gray)
+  ;; this is stuff that comes from SCLF and clashes with CMUCL's EXT
+  ;; package
+  (:shadowing-import-from :sclf
+			  #:process-wait
+			  #:process-alive-p
+			  #:run-program)
+  (:export #:*lazy-mime-decode*
+	   #:print-mime-part
+	   #:read-mime-message
+	   #:mime-part
+	   #:mime-text
+	   #:mime-binary
+	   #:mime-id
+	   #:mime-image
+	   #:mime-message
+	   #:mime-multipart
+	   #:mime-audio
+	   #:mime-unknown-part
+	   #:get-mime-disposition-parameter
+	   #:get-mime-type-parameter
+	   #:mime-disposition
+	   #:mime-disposition-parameters
+	   #:mime-encoding
+	   #:mime-application
+	   #:mime-video
+	   #:mime-description
+	   #:mime-part-size
+	   #:mime-subtype
+	   #:mime-body
+	   #:mime-body-stream
+	   #:mime-body-length
+	   #:mime-parts
+	   #:mime-part-p
+	   #:mime-type
+	   #:mime-type-string
+	   #:mime-type-parameters
+	   #:mime-message-headers
+	   #:mime=
+	   #:find-mime-part-by-path
+	   #:find-mime-part-by-id
+	   #:encode-mime-part
+	   #:encode-mime-body
+	   #:decode-quoted-printable-stream
+	   #:decode-quoted-printable-string
+	   #:encode-quoted-printable-stream
+	   #:encode-quoted-printable-sequence
+	   #:decode-base64-stream
+	   #:decode-base64-string
+	   #:encode-base64-stream
+	   #:encode-base64-sequence
+	   #:parse-RFC2047-text
+	   #:parse-RFC822-header
+	   #:read-RFC822-headers
+	   #:time-RFC822-string
+	   #:parse-RFC822-date
+	   #:map-parts
+	   #:do-parts
+	   #:apply-on-parts
+	   #:mime-part-file-name
+	   #:mime-text-charset
+	   #:with-input-from-mime-body-stream
+	   ;; endec.lisp
+	   #:base64-encoder
+	   #:base64-decoder
+	   #:null-encoder
+	   #:null-decoder
+	   #:byte-encoder
+	   #:byte-decoder
+	   #:quoted-printable-encoder
+	   #:quoted-printable-decoder
+	   #:encoder-write-byte
+	   #:encoder-finish-output
+	   #:decoder-read-byte
+	   #:decoder-read-sequence
+	   #:*base64-line-length*
+	   #:*quoted-printable-line-length*
+	   ;; address.lisp
+	   #:parse-addresses #:mailboxes-only
+	   #:mailbox #:mbx-description #:mbx-user #:mbx-host #:mbx-domain #:mbx-domain-name #:mbx-address
+	   #:mailbox-group #:mbxg-name #:mbxg-mailboxes))
--- a/third_party/lisp/mime4cl/streams.lisp
+++ b/third_party/lisp/mime4cl/streams.lisp
@ -0,0 +1,366 @@
+ ;;; eds.lisp --- En/De-coding Streams
+
+ ;;; Copyright (C) 2012 by Walter C. Pelissero
+
+ ;;; Author: Walter C. Pelissero <walter@pelissero.de>
+ ;;; Project: mime4cl
+
+#+cmu (ext:file-comment "$Module: eds.lisp")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl)
+
+#+cmu
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  ;; CMUCL doesn't provide the STREAM-FILE-POSITION method in its
+  ;; implementation of Gray streams.  We patch it in ourselves.
+  (defgeneric stream-file-position (stream &optional position))
+  (defun my-file-position (stream &optional position)
+    (stream-file-position stream position))
+  (defvar *original-file-position-function*
+    (prog1
+	(symbol-function 'file-position)
+      (setf (symbol-function 'file-position) (symbol-function 'my-file-position))))
+  (defmethod stream-file-position (stream &optional position)
+    (if position
+	(funcall *original-file-position-function* stream position)
+	(funcall *original-file-position-function* stream)))
+
+  ;; oddly CMUCL doesn't seem to provide a default for STREAM-READ-SEQUENCE
+  (defmacro make-read-sequence (stream-type element-reader)
+    `(defmethod stream-read-sequence ((stream ,stream-type) seq &optional start end)
+       (unless start
+	 (setf start 0))
+       (unless end
+	 (setf end (length seq)))
+       (loop
+	  for i from start below end
+	  for b = (,element-reader stream)
+	  until (eq b :eof)
+	  do (setf (elt seq i) b)
+	  finally (return i))))
+
+  (make-read-sequence fundamental-binary-input-stream stream-read-byte)
+  (make-read-sequence fundamental-character-input-stream stream-read-char))
+
+(defclass coder-stream-mixin ()
+  ((real-stream :type stream
+		:initarg :stream
+		:reader real-stream)
+   (dont-close :initform nil
+	       :initarg :dont-close)))
+
+(defmethod stream-file-position ((stream coder-stream-mixin) &optional position)
+  (file-position (slot-value stream 'real-stream) position))
+
+(defclass coder-input-stream-mixin (fundamental-binary-input-stream coder-stream-mixin)
+  ())
+(defclass coder-output-stream-mixin (fundamental-binary-output-stream coder-stream-mixin)
+  ())
+
+
+(defclass quoted-printable-decoder-stream (coder-input-stream-mixin quoted-printable-decoder) ())
+(defclass base64-decoder-stream (coder-input-stream-mixin base64-decoder) ())
+(defclass 8bit-decoder-stream (coder-input-stream-mixin 8bit-decoder) ())
+
+(defclass quoted-printable-encoder-stream (coder-output-stream-mixin quoted-printable-encoder) ())
+(defclass base64-encoder-stream (coder-output-stream-mixin base64-encoder) ())
+(defclass 8bit-encoder-stream (coder-output-stream-mixin 8bit-encoder) ())
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod initialize-instance :after ((stream coder-stream-mixin) &key &allow-other-keys)
+  (unless (slot-boundp stream 'real-stream)
+    (error "REAL-STREAM is unbound.  Must provide a :STREAM argument.")))
+
+(defmethod initialize-instance ((stream coder-output-stream-mixin) &key &allow-other-keys)
+  (call-next-method)
+  (unless (slot-boundp stream 'output-function)
+    (setf (slot-value stream 'output-function)
+	  #'(lambda (char)
+	      (write-char char (slot-value stream 'real-stream))))))
+
+(defmethod initialize-instance ((stream coder-input-stream-mixin) &key &allow-other-keys)
+  (call-next-method)
+  (unless (slot-boundp stream 'input-function)
+    (setf (slot-value stream 'input-function)
+	  #'(lambda ()
+	      (read-char (slot-value stream 'real-stream) nil)))))
+
+(defmethod stream-read-byte ((stream coder-input-stream-mixin))
+  (or (decoder-read-byte stream)
+      :eof))
+
+(defmethod stream-write-byte ((stream coder-output-stream-mixin) byte)
+  (encoder-write-byte stream byte))
+
+(defmethod close ((stream coder-stream-mixin) &key abort)
+  (with-slots (real-stream dont-close) stream
+    (unless dont-close
+      (close real-stream :abort abort))))
+
+(defmethod close ((stream coder-output-stream-mixin) &key abort)
+  (unless abort
+    (encoder-finish-output stream))
+  (call-next-method))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass encoder-input-stream (fundamental-character-input-stream coder-stream-mixin)
+  ((encoder)
+   (buffer-queue :initform (make-queue)))
+  (:documentation
+   "This is the base class for encoders with the direction swapped. It
+reads from REAL-STREAM a stream of bytes, encodes it and returnes it
+in a stream of character."))
+
+(defclass quoted-printable-encoder-input-stream (encoder-input-stream) ())
+(defclass base64-encoder-input-stream (encoder-input-stream) ())
+(defclass 8bit-encoder-input-stream (fundamental-character-input-stream coder-stream-mixin) ())
+
+(defmethod initialize-instance ((stream quoted-printable-encoder-input-stream) &key &allow-other-keys)
+  (call-next-method)
+  (with-slots (encoder buffer-queue) stream
+    (setf encoder
+	  (make-instance 'quoted-printable-encoder
+			 :output-function #'(lambda (char)
+					      (queue-append buffer-queue char))))))
+
+(defmethod initialize-instance ((stream base64-encoder-input-stream) &key &allow-other-keys)
+  (call-next-method)
+  (with-slots (encoder buffer-queue) stream
+    (setf encoder
+	  (make-instance 'base64-encoder
+			 :output-function #'(lambda (char)
+					      (queue-append buffer-queue char))))))
+
+(defmethod stream-read-char ((stream encoder-input-stream))
+  (with-slots (encoder buffer-queue real-stream) stream
+    (loop
+       while (queue-empty-p buffer-queue)
+       do (be byte (read-byte real-stream nil)
+	    (if byte
+		(encoder-write-byte encoder byte)
+		(progn
+		  (encoder-finish-output encoder)
+		  (queue-append buffer-queue :eof)))))
+    (queue-pop buffer-queue)))
+
+
+(defmethod stream-read-char ((stream 8bit-encoder-input-stream))
+  (with-slots (real-stream) stream
+    (aif (read-byte real-stream nil)
+	 (code-char it)
+	 :eof)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass input-adapter-stream ()
+  ((source :initarg :source)
+   (real-stream)
+   (input-function)))
+
+(defclass binary-input-adapter-stream (fundamental-binary-input-stream input-adapter-stream) ())
+
+(defclass character-input-adapter-stream (fundamental-character-input-stream input-adapter-stream) ())
+
+(defmethod stream-element-type ((stream binary-input-adapter-stream))
+  '(unsigned-byte 8))
+
+(defmethod initialize-instance ((stream input-adapter-stream) &key &allow-other-keys)
+  (call-next-method)
+  (assert (slot-boundp stream 'source)))
+
+(defmethod initialize-instance ((stream binary-input-adapter-stream) &key &allow-other-keys)
+  (call-next-method)
+  ;; REAL-STREAM slot is set only if we are going to close it later on
+  (with-slots (source real-stream input-function) stream
+    (etypecase source
+      (string
+       (setf real-stream (make-string-input-stream source)
+	     input-function #'(lambda ()
+				(awhen (read-char real-stream nil)
+				  (char-code it)))))
+      ((vector (unsigned-byte 8))
+       (be i 0
+	 (setf input-function #'(lambda ()
+				  (when (< i (length source))
+				    (prog1 (aref source i)
+				      (incf i)))))))
+      (stream
+       (assert (input-stream-p source))
+       (setf input-function (if (subtypep (stream-element-type source) 'character)
+				#'(lambda ()
+				    (awhen (read-char source nil)
+				      (char-code it)))
+				#'(lambda ()
+				    (read-byte source nil)))))
+      (pathname
+       (setf real-stream (open source :element-type '(unsigned-byte 8))
+	     input-function #'(lambda ()
+				(read-byte real-stream nil))))
+      (file-portion
+       (setf real-stream (open-decoded-file-portion source)
+	     input-function #'(lambda ()
+				(read-byte real-stream nil)))))))
+
+(defmethod initialize-instance ((stream character-input-adapter-stream) &key &allow-other-keys)
+  (call-next-method)
+  ;; REAL-STREAM slot is set only if we are going to close later on
+  (with-slots (source real-stream input-function) stream
+    (etypecase source
+      (string
+       (setf real-stream (make-string-input-stream source)
+	     input-function #'(lambda ()
+				(read-char real-stream nil))))
+      ((vector (unsigned-byte 8))
+       (be i 0
+	 (setf input-function #'(lambda ()
+				  (when (< i (length source))
+				    (prog1 (code-char (aref source i))
+				      (incf i)))))))
+      (stream
+       (assert (input-stream-p source))
+       (setf input-function (if (subtypep (stream-element-type source) 'character)
+				#'(lambda ()
+				    (read-char source nil))
+				#'(lambda ()
+				    (awhen (read-byte source nil)
+				      (code-char it))))))
+      (pathname
+       (setf real-stream (open source :element-type 'character)
+	     input-function #'(lambda ()
+				(read-char real-stream nil))))
+      (file-portion
+       (setf real-stream (open-decoded-file-portion source)
+	     input-function #'(lambda ()
+				(awhen (read-byte real-stream nil)
+				  (code-char it))))))))
+
+(defmethod close ((stream input-adapter-stream) &key abort)
+  (when (slot-boundp stream 'real-stream)
+    (with-slots (real-stream) stream
+      (close real-stream :abort abort))))
+
+(defmethod stream-read-byte ((stream binary-input-adapter-stream))
+  (with-slots (input-function) stream
+    (or (funcall input-function)
+	:eof)))
+
+(defmethod stream-read-char ((stream character-input-adapter-stream))
+  (with-slots (input-function) stream
+    (or (funcall input-function)
+	:eof)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass delimited-input-stream (fundamental-character-input-stream coder-stream-mixin)
+  ((start-offset :initarg :start
+		 :initform 0
+		 :reader stream-start
+		 :type integer)
+   (end-offset :initarg :end
+	       :initform nil
+	       :reader stream-end
+	       :type (or null integer))))
+
+(defmethod print-object ((object delimited-input-stream) stream)
+  (if *print-readably*
+      (call-next-method)
+      (with-slots (start-offset end-offset) object
+	(print-unreadable-object (object stream :type t :identity t)
+	  (format stream "start=~A end=~A" start-offset end-offset)))))
+
+(defun base-stream (stream)
+  (if (typep stream 'delimited-input-stream)
+      (base-stream (real-stream stream))
+      stream))
+
+(defmethod initialize-instance ((stream delimited-input-stream) &key &allow-other-keys)
+  (call-next-method)
+  (unless (slot-boundp stream 'real-stream)
+    (error "REAL-STREAM is unbound.  Must provide a :STREAM argument."))
+  (with-slots (start-offset) stream
+    (when start-offset
+      (file-position stream start-offset))))
+
+(defmethod stream-read-char ((stream delimited-input-stream))
+  (with-slots (real-stream end-offset) stream
+    (if (or (not end-offset)
+	    (< (file-position real-stream) end-offset))
+	(or (read-char real-stream nil)
+	    :eof)
+	:eof)))
+
+#+(OR)(defmethod stream-read-byte ((stream delimited-input-stream))
+  (with-slots (real-stream end-offset) stream
+    (if (or (not end-offset)
+	    (< (file-position real-stream) end-offset))
+	(or (read-byte real-stream nil)
+	    :eof)
+	:eof)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass my-string-input-stream (fundamental-character-input-stream coder-stream-mixin)
+  ((string :initarg :string
+	   :reader stream-string)))
+
+(defmethod initialize-instance ((stream my-string-input-stream) &key &allow-other-keys)
+  (call-next-method)
+  (assert (slot-boundp stream 'string))
+  (with-slots (string real-stream) stream
+    (setf real-stream (make-string-input-stream string))))
+
+(defmethod stream-read-char ((stream my-string-input-stream))
+  (with-slots (real-stream) stream
+    (or (read-char real-stream nil)
+	:eof)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defstruct file-portion
+  data					;  string or a pathname
+  encoding
+  start
+  end)
+
+(defun open-file-portion (file-portion)
+  (be data (file-portion-data file-portion)
+    (etypecase data
+      (pathname
+       (be stream (open data)
+	 (make-instance 'delimited-input-stream
+			:stream stream
+			:start (file-portion-start file-portion)
+			:end (file-portion-end file-portion))))
+      (string
+       (make-instance 'delimited-input-stream
+		      :stream (make-string-input-stream data)
+		      :start (file-portion-start file-portion)
+		      :end (file-portion-end file-portion)))
+      (stream
+       (make-instance 'delimited-input-stream
+		      :stream data
+		      :dont-close t
+		      :start (file-portion-start file-portion)
+		      :end (file-portion-end file-portion))))))
+
+(defun open-decoded-file-portion (file-portion)
+  (make-instance (case (file-portion-encoding file-portion)
+		   (:quoted-printable 'quoted-printable-decoder-stream)
+		   (:base64 'base64-decoder-stream)
+		   (t '8bit-decoder-stream))
+		 :stream (open-file-portion file-portion)))
--- a/third_party/lisp/mime4cl/test/address.lisp
+++ b/third_party/lisp/mime4cl/test/address.lisp
@ -0,0 +1,124 @@
+;;;  address.lisp --- tests for the e-mail address parser
+
+;;;  Copyright (C) 2007, 2009 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+#+cmu (ext:file-comment "$Module: address.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl-tests)
+
+(defun test-parsing (string)
+  (format nil "~{~A~^, ~}" (parse-addresses string)))
+
+(deftest address-parse-simple.1
+    (test-parsing "foo@bar")
+  "foo@bar")
+
+(deftest address-parse-simple.2
+    (test-parsing "foo@bar.com")
+  "foo@bar.com")
+
+(deftest address-parse-simple.3
+    (test-parsing "foo@bar.baz.com")
+  "foo@bar.baz.com")
+
+(deftest address-parse-simple.4
+    (test-parsing "foo.ooo@bar.baz.com")
+  "foo.ooo@bar.baz.com")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-simple-commented.1
+    (test-parsing "foo@bar (Some Comment)")
+  "\"Some Comment\" <foo@bar>")
+
+(deftest address-parse-simple-commented.2
+    (test-parsing "foo@bar (Some, Comment)")
+  "\"Some, Comment\" <foo@bar>")
+
+(deftest address-parse-simple-commented.3
+    (test-parsing "foo@bar (Some Comment (yes, indeed))")
+  "\"Some Comment (yes, indeed)\" <foo@bar>")
+
+(deftest address-parse-simple-commented.4
+    (test-parsing "foo.bar@host.complicated.domain.net (Some Comment (yes, indeed))")
+  "\"Some Comment (yes, indeed)\" <foo.bar@host.complicated.domain.net>")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-angle.1
+    (test-parsing "<foo@bar.baz.net>")
+  "foo@bar.baz.net")
+
+(deftest address-parse-angle.2
+    (test-parsing "My far far friend <foo@bar.baz.net>")
+  "\"My far far friend\" <foo@bar.baz.net>")
+
+(deftest address-parse-angle.3
+    (test-parsing "\"someone, I don't like\" <foo@bar.baz.net>")
+  "\"someone, I don't like\" <foo@bar.baz.net>")
+
+(deftest address-parse-angle.4
+    (test-parsing "\"this could (be a comment)\" <foo@bar.net>")
+  "\"this could (be a comment)\" <foo@bar.net>")
+
+(deftest address-parse-angle.5
+    (test-parsing "don't be fooled <foo@bar.net>")
+  "\"don't be fooled\" <foo@bar.net>")
+
+(deftest address-parse-angle.6
+    (test-parsing "<foo@bar>")
+  "foo@bar")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-domain-literal.1
+    (test-parsing "<foo@[bar]>")
+  "foo@[bar]")
+
+(deftest address-parse-domain-literal.2
+    (test-parsing "<foo@[bar.net]>")
+  "foo@[bar.net]")
+
+(deftest address-parse-domain-literal.3
+    (test-parsing "<foo@[10.0.0.2]>")
+  "foo@[10.0.0.2]")
+
+(deftest address-parse-domain-literal.4
+    (test-parsing "<foo.bar@[10.0.0.2]>")
+  "foo.bar@[10.0.0.2]")
+
+(deftest address-parse-domain-literal.5
+    (test-parsing "somewhere unkown <foo.bar@[10.0.0.2]>")
+  "\"somewhere unkown\" <foo.bar@[10.0.0.2]>")
+
+(deftest address-parse-domain-literal.6
+    (test-parsing "\"Some--One\" <foo.bar@[10.0.0.23]>")
+  "\"Some--One\" <foo.bar@[10.0.0.23]>")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-group.1
+    (test-parsing "friends:john@bar.in.soho, jack@pub.round.the.corner, jim@[10.0.1.2];")
+  "friends: john@bar.in.soho, jack@pub.round.the.corner, jim@[10.0.1.2];")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest address-parse-mixed.1
+    (test-parsing "Foo BAR <foo@bar.com>, \"John, Smith (that one!)\" <john.smith@host.domain.org>, friends:john@bar,jack@pub;, foo.bar.baz@wow.mail.mine, dont.bark@me (Fierce Dog)")
+  "\"Foo BAR\" <foo@bar.com>, \"John, Smith (that one!)\" <john.smith@host.domain.org>, friends: john@bar, jack@pub;, foo.bar.baz@wow.mail.mine, \"Fierce Dog\" <dont.bark@me>")
--- a/third_party/lisp/mime4cl/test/endec.lisp
+++ b/third_party/lisp/mime4cl/test/endec.lisp
@ -0,0 +1,167 @@
+;;;  endec.lisp --- test suite for the MIME encoder/decoder functions
+
+;;;  Copyright (C) 2006, 2007, 2009, 2010 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+#+cmu (ext:file-comment "$Module: endec.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl-tests)
+
+(deftest quoted-printable.1
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+					   "Français, Español, böse, skøl"))
+  "Fran=E7ais, Espa=F1ol, b=F6se, sk=F8l")
+
+(deftest quoted-printable.2
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+					   "Français, Español, böse, skøl")
+				      :start 10 :end 17)
+  "Espa=F1ol")
+
+(deftest quoted-printable.3
+    (map 'string #'code-char
+	 (decode-quoted-printable-string "Fran=E7ais, Espa=F1ol, b=F6se, sk=F8l"))
+  "Français, Español, böse, skøl")
+
+(deftest quoted-printable.4
+    (map 'string #'code-char
+	 (decode-quoted-printable-string "Fran=E7ais, Espa=F1ol, b=F6se, sk=F8l"
+					 :start 12 :end 21))
+  "Español")
+
+(deftest quoted-printable.5
+    (map 'string #'code-char
+	 (decode-quoted-printable-string "this = wrong"))
+  "this = wrong")
+
+(deftest quoted-printable.6
+    (map 'string #'code-char
+	 (decode-quoted-printable-string "this is wrong="))
+  "this is wrong=")
+
+(deftest quoted-printable.7
+    (map 'string #'code-char
+	 (decode-quoted-printable-string "this is wrong=1"))
+  "this is wrong=1")
+
+(deftest quoted-printable.8
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+					   "x = x + 1"))
+  "x =3D x + 1")
+
+(deftest quoted-printable.9
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+					   "x = x + 1   "))
+  "x =3D x + 1  =20")
+
+(deftest quoted-printable.10
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+					   "this string is very very very very very very very very very very very very very very very very very very very very long"))
+  "this string is very very very very very very very very very very very ve=
+ry very very very very very very very very long")
+
+(deftest quoted-printable.11
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+					   "this string is very very                                                                                  very very long"))
+  "this string is very very                                                =
+                                  very very long")
+
+(deftest quoted-printable.12
+    (encode-quoted-printable-sequence (map '(vector (unsigned-byte 8)) #'char-code
+					   "please read the next   
+line"))
+  "please read the next  =20
+line")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest base64.1
+    (let ((*base64-line-length* nil))
+      (encode-base64-sequence (map '(vector (unsigned-byte 8)) #'char-code
+				   "Some random string.")))
+  "U29tZSByYW5kb20gc3RyaW5nLg==")
+
+(deftest base64.2
+    (let ((*base64-line-length* nil))
+      (encode-base64-sequence (map '(vector (unsigned-byte 8)) #'char-code
+				   "Some random string.") :start 5 :end 11))
+  "cmFuZG9t")
+
+(deftest base64.3
+    (map 'string #'code-char
+	 (decode-base64-string "U29tZSByYW5kb20gc3RyaW5nLg=="))
+  "Some random string.")
+
+(deftest base64.4
+    (map 'string #'code-char
+	 (decode-base64-string "some rubbish U29tZSByYW5kb20gc3RyaW5nLg== more rubbish"
+			       :start 13 :end 41))
+  "Some random string.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftest RFC2047.1
+    (parse-RFC2047-text "foo bar")
+  ("foo bar"))
+
+(defun perftest-encoder (encoder-class &optional (megs 100))
+  (declare (optimize (speed 3) (debug 0) (safety 0))
+	   (type fixnum megs))
+  (with-open-file (in #P"/dev/random" :element-type '(unsigned-byte 8))
+    (let* ((meg (* 1024 1024))
+	   (buffer (make-sequence '(vector (unsigned-byte 8)) meg))
+	   (encoder (make-instance encoder-class
+				   :output-function #'(lambda (c) (declare (ignore c))))))
+      (declare (type fixnum meg))
+      (time
+       (progn
+	 (dotimes (x megs)
+	   (read-sequence buffer in)
+	   (dotimes (i meg)
+	     (mime4cl:encoder-write-byte encoder (aref buffer i))))
+	 (mime4cl:encoder-finish-output encoder))))))
+
+(defun perftest-decoder (decoder-class &optional (megs 100))
+  (declare (optimize (speed 3) (debug 0) (safety 0))
+	   (type fixnum megs))
+  (with-open-file (in #P"/dev/random" :element-type '(unsigned-byte 8))
+    (let ((sclf:*tmp-file-defaults* (make-pathname :defaults #.(or *load-pathname* *compile-file-pathname*)
+						   :type "encoded-data")))
+      (sclf:with-temp-file (tmp nil :direction :io)
+	(let* ((meg (* 1024 1024))
+	       (buffer (make-sequence '(vector (unsigned-byte 8)) meg))
+	       (encoder-class (ecase decoder-class
+				(mime4cl:base64-decoder 'mime4cl:base64-encoder)
+				(mime4cl:quoted-printable-decoder 'mime4cl:quoted-printable-encoder)))
+	       (encoder (make-instance encoder-class
+				       :output-function #'(lambda (c)
+							    (write-char c tmp))))
+	       (decoder (make-instance decoder-class
+				       :input-function #'(lambda ()
+							   (read-char tmp nil)))))
+	  (declare (type fixnum meg))
+	  (dotimes (x megs)
+	    (read-sequence buffer in)
+	    (dotimes (i meg)
+	      (mime4cl:encoder-write-byte encoder (aref buffer i))))
+	  (mime4cl:encoder-finish-output encoder)
+	  (file-position tmp 0)
+	  (time
+	   (loop
+	      for b = (mime4cl:decoder-read-byte decoder)
+	      while b)))))))
--- a/third_party/lisp/mime4cl/test/mime.lisp
+++ b/third_party/lisp/mime4cl/test/mime.lisp
@ -0,0 +1,53 @@
+ ;;; mime.lisp --- MIME regression tests
+
+ ;;; Copyright (C) 2012 by Walter C. Pelissero
+
+ ;;; Author: Walter C. Pelissero <walter@pelissero.de>
+ ;;; Project: mime4cl
+
+#+cmu (ext:file-comment "$Module: mime.lisp")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(in-package :mime4cl-tests)
+
+(defvar *samples-directory*
+  (merge-pathnames (make-pathname :directory '(:relative "samples"))
+		   #.(or *compile-file-pathname*
+			 *load-pathname*
+			 #P"")))
+
+(deftest mime.1
+    (let* ((orig (mime-message (make-pathname :defaults #.(or *compile-file-pathname*
+							   *load-pathname*)
+					   :name "sample1"
+					   :type "msg")))
+	   (dup (mime-message (with-output-to-string (out) (encode-mime-part orig out)))))
+      (mime= orig dup))
+  t)
+
+(deftest mime.2
+    (loop
+       for f in (directory (make-pathname :defaults *samples-directory*
+					  :name :wild
+					  :type "txt"))
+       do
+	 (format t "~A:~%" f)
+	 (finish-output)
+	 (let* ((orig (mime-message f))
+		(dup (mime-message (with-output-to-string (out) (encode-mime-part orig out)))))
+	   (unless (mime= orig dup)
+	     (return nil)))
+       finally (return t))
+  t)
--- a/third_party/lisp/mime4cl/test/package.lisp
+++ b/third_party/lisp/mime4cl/test/package.lisp
@ -0,0 +1,28 @@
+;;;  package.lisp --- package description for the regression tests
+
+;;;  Copyright (C) 2006, 2009 by Walter C. Pelissero
+
+;;;  Author: Walter C. Pelissero <walter@pelissero.de>
+;;;  Project: mime4cl
+
+#+cmu (ext:file-comment "$Module: package.lisp $")
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1
+;;; of the License, or (at your option) any later version.
+;;; This library 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.
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;; 02111-1307 USA
+
+(cl:in-package :common-lisp)
+
+(defpackage :mime4cl-tests
+  (:use :common-lisp
+	:rtest :mime4cl)
+  (:export))
--- a/third_party/lisp/mime4cl/test/rt.lisp
+++ b/third_party/lisp/mime4cl/test/rt.lisp
@ -0,0 +1,254 @@
+#|----------------------------------------------------------------------------|
+ | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
+ |                                                                            |
+ | Permission  to  use,  copy, modify, and distribute this software  and  its |
+ | documentation for any purpose  and without fee is hereby granted, provided |
+ | that this copyright  and  permission  notice  appear  in  all  copies  and |
+ | supporting  documentation,  and  that  the  name  of M.I.T. not be used in |
+ | advertising or  publicity  pertaining  to  distribution  of  the  software |
+ | without   specific,   written   prior   permission.      M.I.T.  makes  no |
+ | representations  about  the  suitability of this software for any purpose. |
+ | It is provided "as is" without express or implied warranty.                |
+ |                                                                            |
+ |  M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,  INCLUDING  |
+ |  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL  |
+ |  M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL  DAMAGES  OR  |
+ |  ANY  DAMAGES  WHATSOEVER  RESULTING  FROM  LOSS OF USE, DATA OR PROFITS,  |
+ |  WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER  TORTIOUS  ACTION,  |
+ |  ARISING  OUT  OF  OR  IN  CONNECTION WITH THE USE OR PERFORMANCE OF THIS  |
+ |  SOFTWARE.                                                                 |
+ |----------------------------------------------------------------------------|#
+
+(defpackage #:regression-test
+  (:nicknames #:rtest #-lispworks #:rt) 
+  (:use #:cl)
+  (:export #:*do-tests-when-defined* #:*test* #:continue-testing
+	   #:deftest #:do-test #:do-tests #:get-test #:pending-tests
+	   #:rem-all-tests #:rem-test)
+  (:documentation "The MIT regression tester with pfdietz's modifications"))
+
+(in-package :regression-test)
+
+(defvar *test* nil "Current test name")
+(defvar *do-tests-when-defined* nil)
+(defvar *entries* '(nil) "Test database")
+(defvar *in-test* nil "Used by TEST")
+(defvar *debug* nil "For debugging")
+(defvar *catch-errors* t
+  "When true, causes errors in a test to be caught.")
+(defvar *print-circle-on-failure* nil
+  "Failure reports are printed with *PRINT-CIRCLE* bound to this value.")
+(defvar *compile-tests* nil
+  "When true, compile the tests before running them.")
+(defvar *optimization-settings* '((safety 3)))
+(defvar *expected-failures* nil
+  "A list of test names that are expected to fail.")
+
+(defstruct (entry (:conc-name nil)
+		  (:type list))
+  pend name form)
+
+(defmacro vals (entry) `(cdddr ,entry))
+
+(defmacro defn (entry) `(cdr ,entry))
+
+(defun pending-tests ()
+  (do ((l (cdr *entries*) (cdr l))
+       (r nil))
+      ((null l) (nreverse r))
+    (when (pend (car l))
+      (push (name (car l)) r))))
+
+(defun rem-all-tests ()
+  (setq *entries* (list nil))
+  nil)
+
+(defun rem-test (&optional (name *test*))
+  (do ((l *entries* (cdr l)))
+      ((null (cdr l)) nil)
+    (when (equal (name (cadr l)) name)
+      (setf (cdr l) (cddr l))
+      (return name))))
+
+(defun get-test (&optional (name *test*))
+  (defn (get-entry name)))
+
+(defun get-entry (name)
+  (let ((entry (find name (cdr *entries*)
+		     :key #'name
+		     :test #'equal)))
+    (when (null entry)
+      (report-error t
+        "~%No test with name ~:@(~S~)."
+	name))
+    entry))
+
+(defmacro deftest (name form &rest values)
+  `(add-entry '(t ,name ,form .,values)))
+
+(defun add-entry (entry)
+  (setq entry (copy-list entry))
+  (do ((l *entries* (cdr l))) (nil)
+    (when (null (cdr l))
+      (setf (cdr l) (list entry))
+      (return nil))
+    (when (equal (name (cadr l)) 
+		 (name entry))
+      (setf (cadr l) entry)
+      (report-error nil
+        "Redefining test ~:@(~S~)"
+        (name entry))
+      (return nil)))
+  (when *do-tests-when-defined*
+    (do-entry entry))
+  (setq *test* (name entry)))
+
+(defun report-error (error? &rest args)
+  (cond (*debug* 
+	 (apply #'format t args)
+	 (if error? (throw '*debug* nil)))
+	(error? (apply #'error args))
+	(t (apply #'warn args))))
+
+(defun do-test (&optional (name *test*))
+  (do-entry (get-entry name)))
+
+(defun equalp-with-case (x y)
+  "Like EQUALP, but doesn't do case conversion of characters."
+  (cond
+   ((eq x y) t)
+   ((consp x)
+    (and (consp y)
+	 (equalp-with-case (car x) (car y))
+	 (equalp-with-case (cdr x) (cdr y))))
+   ((and (typep x 'array)
+	 (= (array-rank x) 0))
+    (equalp-with-case (aref x) (aref y)))
+   ((typep x 'vector)
+    (and (typep y 'vector)
+	 (let ((x-len (length x))
+	       (y-len (length y)))
+	   (and (eql x-len y-len)
+		(loop
+		 for e1 across x
+		 for e2 across y
+		 always (equalp-with-case e1 e2))))))
+   ((and (typep x 'array)
+	 (typep y 'array)
+	 (not (equal (array-dimensions x)
+		     (array-dimensions y))))
+    nil)
+   ((typep x 'array)
+    (and (typep y 'array)
+	 (let ((size (array-total-size x)))
+	   (loop for i from 0 below size
+		 always (equalp-with-case (row-major-aref x i)
+					  (row-major-aref y i))))))
+   (t (eql x y))))
+
+(defun do-entry (entry &optional
+		       (s *standard-output*))
+  (catch '*in-test*
+    (setq *test* (name entry))
+    (setf (pend entry) t)
+    (let* ((*in-test* t)
+	   ;; (*break-on-warnings* t)
+	   (aborted nil)
+	   r)
+      ;; (declare (special *break-on-warnings*))
+
+      (block aborted
+	(setf r
+	      (flet ((%do
+		      ()
+		      (if *compile-tests*
+			  (multiple-value-list
+			   (funcall (compile
+				     nil
+				     `(lambda ()
+					(declare
+					 (optimize ,@*optimization-settings*))
+					,(form entry)))))
+			(multiple-value-list
+			 (eval (form entry))))))
+		(if *catch-errors*
+		    (handler-bind
+			((style-warning #'muffle-warning)
+			 (error #'(lambda (c)
+				    (setf aborted t)
+				    (setf r (list c))
+				    (return-from aborted nil))))
+		      (%do))
+		  (%do)))))
+
+      (setf (pend entry)
+	    (or aborted
+		(not (equalp-with-case r (vals entry)))))
+      
+      (when (pend entry)
+	(let ((*print-circle* *print-circle-on-failure*))
+	  (format s "~&Test ~:@(~S~) failed~
+                   ~%Form: ~S~
+                   ~%Expected value~P: ~
+                      ~{~S~^~%~17t~}~%"
+		  *test* (form entry)
+		  (length (vals entry))
+		  (vals entry))
+	  (format s "Actual value~P: ~
+                      ~{~S~^~%~15t~}.~%"
+		  (length r) r)))))
+  (when (not (pend entry)) *test*))
+
+(defun continue-testing ()
+  (if *in-test*
+      (throw '*in-test* nil)
+      (do-entries *standard-output*)))
+
+(defun do-tests (&optional
+		 (out *standard-output*))
+  (dolist (entry (cdr *entries*))
+    (setf (pend entry) t))
+  (if (streamp out)
+      (do-entries out)
+      (with-open-file 
+	  (stream out :direction :output)
+	(do-entries stream))))
+
+(defun do-entries (s)
+  (format s "~&Doing ~A pending test~:P ~
+             of ~A tests total.~%"
+          (count t (cdr *entries*)
+		 :key #'pend)
+	  (length (cdr *entries*)))
+  (dolist (entry (cdr *entries*))
+    (when (pend entry)
+      (format s "~@[~<~%~:; ~:@(~S~)~>~]"
+	      (do-entry entry s))))
+  (let ((pending (pending-tests))
+	(expected-table (make-hash-table :test #'equal)))
+    (dolist (ex *expected-failures*)
+      (setf (gethash ex expected-table) t))
+    (let ((new-failures
+	   (loop for pend in pending
+		 unless (gethash pend expected-table)
+		 collect pend)))
+      (if (null pending)
+	  (format s "~&No tests failed.")
+	(progn
+	  (format s "~&~A out of ~A ~
+                   total tests failed: ~
+                   ~:@(~{~<~%   ~1:;~S~>~
+                         ~^, ~}~)."
+		  (length pending)
+		  (length (cdr *entries*))
+		  pending)
+	  (if (null new-failures)
+	      (format s "~&No unexpected failures.")
+	    (when *expected-failures*
+	      (format s "~&~A unexpected failures: ~
+                   ~:@(~{~<~%   ~1:;~S~>~
+                         ~^, ~}~)."
+		    (length new-failures)
+		    new-failures)))
+	  ))
+      (null pending))))
--- a/third_party/lisp/mime4cl/test/sample1.msg
+++ b/third_party/lisp/mime4cl/test/sample1.msg
@ -0,0 +1,86 @@
+From wcp@scylla.home.lan Fri Feb 17 11:02:28 2012
+Status: RO
+X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil]
+	["1133" "Friday" "17" "February" "2012" "11:02:27" "+0100" "Walter C. Pelissero" "walter@pelissero.de" nil "56" "test" "^From:" nil nil "2" nil nil nil nil nil nil nil nil nil nil]
+	nil)
+X-Clpmr-Processed: 2012-02-17T11:02:31
+X-Clpmr-Version: 2011-10-23T12:55:20, SBCL 1.0.49
+Received: from scylla.home.lan (localhost [127.0.0.1])
+	by scylla.home.lan (8.14.5/8.14.5) with ESMTP id q1HA2Sik004513
+	for <wcp@scylla.home.lan>; Fri, 17 Feb 2012 11:02:28 +0100 (CET)
+	(envelope-from wcp@scylla.home.lan)
+Received: (from wcp@localhost)
+	by scylla.home.lan (8.14.5/8.14.5/Submit) id q1HA2SqU004512;
+	Fri, 17 Feb 2012 11:02:28 +0100 (CET)
+	(envelope-from wcp)
+Message-ID: <20286.9651.890757.323027@scylla.home.lan>
+X-Mailer: VM 8.1.1 under 23.3.1 (amd64-portbld-freebsd8.2)
+Reply-To: walter@pelissero.de
+X-Attribution: WP
+X-For-Spammers: blacklistme@pelissero.de
+X-MArch-Processing-Time: 0.552s
+MIME-Version: 1.0
+Content-Type: multipart/mixed; boundary="615CiWUaGO"
+Content-Transfer-Encoding: 7BIT
+From: walter@pelissero.de (Walter C. Pelissero)
+To: wcp@scylla.home.lan
+Subject: test
+Date: Fri, 17 Feb 2012 11:02:27 +0100
+
+
+--615CiWUaGO
+Content-Type: text/plain; charset="us-ascii"
+Content-Transfer-Encoding: 7BIT
+Content-Description: message body text
+
+Hereafter three attachments.
+
+The first:
+
+--615CiWUaGO
+Content-Type: application/octet-stream; name="attach1"
+Content-Transfer-Encoding: BASE64
+Content-Disposition: attachment; filename="attach1"
+
+YXR0YWNoMQo=
+
+--615CiWUaGO
+Content-Type: text/plain; charset="us-ascii"
+Content-Transfer-Encoding: 7BIT
+Content-Description: message body text
+
+
+The second:
+
+--615CiWUaGO
+Content-Type: application/octet-stream; name="attach2"
+Content-Transfer-Encoding: BASE64
+Content-Disposition: attachment; filename="attach2"
+
+YXR0YWNoMgo=
+
+--615CiWUaGO
+Content-Type: text/plain; charset="us-ascii"
+Content-Transfer-Encoding: 7BIT
+Content-Description: message body text
+
+
+The third:
+
+--615CiWUaGO
+Content-Type: application/octet-stream; name="attach3"
+Content-Transfer-Encoding: BASE64
+Content-Disposition: attachment; filename="attach3"
+
+YXR0YWNoMwo=
+
+--615CiWUaGO
+Content-Type: text/plain; charset="us-ascii"
+Content-Transfer-Encoding: 7BIT
+Content-Description: .signature
+
+
+-- 
+http://pelissero.de
+--615CiWUaGO--
+