From rnewman at tellme.com Wed Aug 16 07:18:08 2006 From: rnewman at tellme.com (Richard Newman) Date: Wed, 16 Aug 2006 00:18:08 -0700 Subject: [cl-smtp-devel] Attachment content type patch Message-ID: Adds the ability to specify the MIME type of an attachment by providing (attachment content-type) instead of attachment in the attachments list. -R Index: attachments.lisp =================================================================== RCS file: /project/cl-smtp/cvsroot/cl-smtp/attachments.lisp,v retrieving revision 1.1 diff -u -r1.1 attachments.lisp --- attachments.lisp 4 Apr 2006 13:04:40 -0000 1.1 +++ attachments.lisp 16 Aug 2006 07:01:13 -0000 @@ -56,21 +56,22 @@ (format nil "~%") message (format nil "~%"))) -(defun send-attachment (sock attachment boundary buffer-size) +(defun send-attachment (sock attachment boundary buffer-size &optional content-type) (print-debug (format nil "Sending attachment: ~a" attachment)) (when (probe-file attachment) (let ((name (file-namestring attachment))) - (send-attachment-header sock boundary name) + (send-attachment-header sock boundary name content-type) (base64-encode-file attachment sock :buffer-size buffer-size) ))) -(defun send-attachment-header (sock boundary name) +(defun send-attachment-header (sock boundary name &optional content- type) (write-to-smtp sock - (format nil "~%--~a~%Content-type: application/ octet-stream;~%~tname=\"~a\"~%Content-Transfer-Encoding: base64~% Content-Disposition: attachment; filename=\"~a\"~%" - boundary - name - name))) + (format nil "~%--~a~%Content-type: ~a;~%~tname=\"~a \"~%Content-Transfer-Encoding: base64~%Content-Disposition: attachment; filename=\"~a\"~%" + boundary + (or content-type "application/octet-stream") + name + name))) (defun send-attachments-end-marker (sock boundary) (write-to-smtp sock Index: cl-smtp.lisp =================================================================== RCS file: /project/cl-smtp/cvsroot/cl-smtp/cl-smtp.lisp,v retrieving revision 1.5 diff -u -r1.5 cl-smtp.lisp --- cl-smtp.lisp 4 Apr 2006 13:04:40 -0000 1.5 +++ cl-smtp.lisp 16 Aug 2006 07:01:13 -0000 @@ -83,6 +83,9 @@ (defun send-smtp (host from to subject message &key (port 25) cc bcc reply-to extra-headers display-name authentication attachments buffer-size) + "ATTACHMENTS is a list of either values or conses. If an attachment is a cons, + then it is of the form (attachment content-type); otherwise, the default + octet-stream content-type is used." (let ((sock (socket-stream (make-smtp-socket host port))) (boundary (make-random-boundary))) (unwind-protect @@ -129,7 +132,9 @@ (write-to-smtp sock message) (when attachments (dolist (attachment attachments) - (send-attachment sock attachment boundary buffer-size)) + (if (consp attachment) + (send-attachment sock (car attachment) boundary buffer-size (cadr attachment)) + (send-attachment sock attachment boundary buffer- size))) (send-attachments-end-marker sock boundary)) (write-char #\. sock) (write-char #\Return sock)