From jidzikowski at common-lisp.net Fri Jun 11 08:10:57 2010 From: jidzikowski at common-lisp.net (jidzikowski) Date: Fri, 11 Jun 2010 04:10:57 -0400 Subject: [cl-smtp-cvs] CVS cl-smtp Message-ID: Update of /project/cl-smtp/cvsroot/cl-smtp In directory cl-net:/tmp/cvs-serv1279 Modified Files: cl-smtp.lisp Log Message: never :wrap-at-column nil in string-to-base64-string allegro part --- /project/cl-smtp/cvsroot/cl-smtp/cl-smtp.lisp 2010/05/06 09:24:43 1.15 +++ /project/cl-smtp/cvsroot/cl-smtp/cl-smtp.lisp 2010/06/11 08:10:57 1.16 @@ -58,7 +58,7 @@ (defun string-to-base64-string (str) (declare (ignorable str)) - #+allegro (excl:string-to-base64-string str) + #+allegro (excl:string-to-base64-string str :wrap-at-column nil) #-allegro (cl-base64:string-to-base64-string str)) (defun rfc2045-q-encode-string (str &key (external-format :utf-8)) From jidzikowski at common-lisp.net Fri Jun 11 09:48:35 2010 From: jidzikowski at common-lisp.net (jidzikowski) Date: Fri, 11 Jun 2010 05:48:35 -0400 Subject: [cl-smtp-cvs] CVS cl-smtp Message-ID: Update of /project/cl-smtp/cvsroot/cl-smtp In directory cl-net:/tmp/cvs-serv31114 Modified Files: cl-smtp.lisp Log Message: fixed finish-smtp-mail, not use fresh-line --- /project/cl-smtp/cvsroot/cl-smtp/cl-smtp.lisp 2010/06/11 08:10:57 1.16 +++ /project/cl-smtp/cvsroot/cl-smtp/cl-smtp.lisp 2010/06/11 09:48:35 1.17 @@ -406,7 +406,7 @@ "Finish sending an email to the SMTP server connected to on STREAM. The server is expected to be inside of the DATA SMTP command. The connection is then terminated by sending a QUIT command." - (fresh-line stream) + (write-to-smtp stream "") (smtp-command stream "." 250) (smtp-command stream "QUIT" 221)) From jidzikowski at common-lisp.net Mon Jun 21 08:48:03 2010 From: jidzikowski at common-lisp.net (jidzikowski) Date: Mon, 21 Jun 2010 04:48:03 -0400 Subject: [cl-smtp-cvs] CVS cl-smtp Message-ID: Update of /project/cl-smtp/cvsroot/cl-smtp In directory cl-net:/tmp/cvs-serv4465 Modified Files: attachments.lisp Log Message: fixed wrap at column in base64-encode-file add #\Return#\Newline after each column --- /project/cl-smtp/cvsroot/cl-smtp/attachments.lisp 2010/05/06 09:24:43 1.8 +++ /project/cl-smtp/cvsroot/cl-smtp/attachments.lisp 2010/06/21 08:48:03 1.9 @@ -104,11 +104,11 @@ (generate-message-header sock :boundary boundary - :content-type (format nil "~A;~%~tname*=~A;~%~tname=~S" + :content-type (format nil "~A;~%~tname*=~A;~%~tname=\"~A\"" (attachment-mime-type attachment) quoted-name* quoted-name) :content-transfer-encoding "base64" - :content-disposition (format nil "attachment; filename*=~A; filename=~S" + :content-disposition (format nil "attachment; filename*=~A; filename=\"~A\"" quoted-name* quoted-name)))) (defun send-end-marker (sock boundary) @@ -158,78 +158,45 @@ (defun base64-encode-file (file-in sock &key (buffer-size 256) ;; in KB - (wrap-at-column 70)) - "Encodes the file contents given by file-in, which can be of any form appropriate to with-open-file, and write the base-64 encoded version to sock, which is a socket. - -Buffer-size, given in KB, controls how much of the file is processed and written to the socket at one time. A buffer-size of 0, processes the file all at once, regardless of its size. One will have to weigh the speed vs, memory consuption risks when chosing which way is best. - -Wrap-at-column controls where the encode string is divided for line breaks." - (when (probe-file file-in) - ;;-- open filein --------- - (with-open-file (strm-in file-in - :element-type '(unsigned-byte 8)) - (let* ((;; convert buffer size given to bytes - ;; or compute bytes based on file - max-buffer-size - (if (zerop buffer-size) - (file-length strm-in) - ;; Ensures 64 bit encoding is properly - ;; divided so that filler - ;; characters are not required between chunks - (* 24 (truncate (/ (* buffer-size 1024) 24))))) - (column-count 0) - (eof? nil) - (buffer (make-array max-buffer-size - :element-type '(unsigned-byte 8)))) - (loop - (print-debug (format nil "~%Process attachment ~a~%" file-in)) - (let* ((;; read a portion of the file into the buffer arrary and - ;; returns the index where it stopped - byte-count (dotimes (i max-buffer-size max-buffer-size) - (let ((bchar (read-byte strm-in nil 'EOF))) - (if (eql bchar 'EOF) - (progn - (setq eof? t) - (return i)) - (setf (aref buffer i) bchar)))))) - (if (zerop buffer-size) - ;; send file all at once to socket. - #+allegro - (write-string (excl:usb8-array-to-base64-string - buffer wrap-at-column) sock) - #-allegro - (cl-base64:usb8-array-to-base64-stream - buffer sock :columns wrap-at-column) - ;; otherwise process file in chunks. - ;; The extra encoded-string, - ;; and its subseq functions are brute force methods - ;; to properly handle the wrap-at-column feature - ;; between buffers. - ;; Not the most efficient way, - ;; but it works and uses existing functions - ;; in the cl-base64 package. - (let* ((;; drops off extra elements that were not filled in in reading, this is important for lisp systems that default a value into - ;; the array when it is created. -- ie Lispworks, SBCL - trimmed-buffer (if eof? - (subseq buffer 0 byte-count) - buffer)) - (encoded-string - #+allegro - (excl:usb8-array-to-base64-string - trimmed-buffer) - #-allegro - (cl-base64:usb8-array-to-base64-string - trimmed-buffer))) - (loop for ch across encoded-string - do (progn - (write-char ch sock) - (incf column-count) - (when (= column-count wrap-at-column) - (setq column-count 0) - (write-char #\Newline sock)))))) - (force-output sock) - (print-debug (format nil "~% Eof is ~a~%" eof?)) - (when (or (zerop buffer-size) - eof?) - (write-blank-line sock) - (return)))))))) + (wrap-at-column 76)) + "Encodes the file contents given by file-in, which can be of any form appropriate to with-open-file, + and write the base-64 encoded version to sock, which is a socket. + + Buffer-size is ignored + + Wrap-at-column controls where the encode string is divided for line breaks, + it is always set to a multiple of 3." + (declare (ignore buffer-size)) + (when (probe-file file-in) + ;;-- open filein --------- + (print-debug (format nil "base64-encode-file ~A" file-in)) + (with-open-file (strm-in file-in + :element-type '(unsigned-byte 8)) + (let* ((flength (file-length strm-in)) + (columns (* (truncate (/ wrap-at-column 3)) 3)) + (r 0) + (n 0)) + (loop while (< (file-position strm-in) flength) + for buffer = (make-array 3 + :element-type '(unsigned-byte 8)) + do + (loop for i from 0 to 2 do + (let ((bchar (read-byte strm-in nil 'EOF))) + (if (eql bchar 'EOF) + (progn + (setf r i) + (return)) + (setf (aref buffer i) bchar)))) + #+allegro + (write-sequence (excl:usb8-array-to-base64-string + (if (> r 0) (subseq buffer 0 r) buffer) :wrap-at-column nil) + sock) + #-allegro + (cl-base64:usb8-array-to-base64-stream + (if (> r 0) (subseq buffer 0 r) buffer) sock :columns 0) + (incf n 3) + (when (= (mod n columns) 0) + (setf n 0) + (write-blank-line sock))) + (force-output sock) + (write-blank-line sock))))) From jidzikowski at common-lisp.net Mon Jun 21 09:06:27 2010 From: jidzikowski at common-lisp.net (jidzikowski) Date: Mon, 21 Jun 2010 05:06:27 -0400 Subject: [cl-smtp-cvs] CVS cl-smtp Message-ID: Update of /project/cl-smtp/cvsroot/cl-smtp In directory cl-net:/tmp/cvs-serv9090 Modified Files: CHANGELOG README cl-smtp.asd index.html tests.lisp Log Message: add test for base64-encode-file, refresh changelog and readme, add new version in cl-smtp.asd --- /project/cl-smtp/cvsroot/cl-smtp/CHANGELOG 2010/05/06 09:24:43 1.17 +++ /project/cl-smtp/cvsroot/cl-smtp/CHANGELOG 2010/06/21 09:06:26 1.18 @@ -1,3 +1,12 @@ +Version 20100621.1 +2010.06.21 +Rewrite base64-encode-file in attachments.lisp, fixed wrap at column +and add #\Return#\Newline after each column, ignore keyword buffer-size. +Fixed string-to-base64-string allegro part in cl-smtp.lisp (wrap-at-column nil). +Fixed finish-smtp-mail in cl-smtp, not use fresh-line on stream, send #\Return#\Newline. +Add test for base64-encode-file. +Change cl-smtp.lisp, attachment.lisp, cl-smtp.asd, CHANGELOG, README + Version 20100505.1 2010.05.05 Rewrite encoding functions, now it is possible to use non ascii characters in --- /project/cl-smtp/cvsroot/cl-smtp/README 2010/05/06 09:24:43 1.10 +++ /project/cl-smtp/cvsroot/cl-smtp/README 2010/06/21 09:06:26 1.11 @@ -45,10 +45,7 @@ proper method is determined automatically. - attachments (Attachment Instance or String or Pathname: attachments to send List of Attachment/String/Pathnames) - - buffer-size (Number default 256): controls how much of a attachment file - is read on each loop before encoding - and transmitting the contents, - the number is interpreted in KB + - buffer-size (Number default 256): is no longer used, will remove in the future - ssl (or t :starttls :tls) : if t or :STARTTLS: use the STARTTLS functionality if :TLS: use TLS directly - external-format : symbol, default :utf-8 --- /project/cl-smtp/cvsroot/cl-smtp/cl-smtp.asd 2010/05/06 09:24:43 1.17 +++ /project/cl-smtp/cvsroot/cl-smtp/cl-smtp.asd 2010/06/21 09:06:27 1.18 @@ -17,7 +17,7 @@ ;;; Description: cl-smtp ASDF system definition file (asdf:defsystem :cl-smtp - :version "20100505.1" + :version "20100621.1" :perform (load-op :after (op webpage) (pushnew :cl-smtp cl:*features*)) :depends-on (:usocket --- /project/cl-smtp/cvsroot/cl-smtp/index.html 2010/05/06 09:50:40 1.3 +++ /project/cl-smtp/cvsroot/cl-smtp/index.html 2010/06/21 09:06:27 1.4 @@ -17,7 +17,11 @@

CL-SMTP is a simple lisp Networking Library that provides SMTP client protocol, supported LOGIN and PLAIN authentication methods.

-

New Version [20100505.1] Rewrite encoding functions, now it is possible to use non ascii characters in header values and in attachment filenames.

+

New Version [20100621.1] Rewrite base64-encode-file in attachments.lisp, fixed wrap at column +and add #\Return#\Newline after each column, ignore keyword buffer-size. +Fixed string-to-base64-string allegro part in cl-smtp.lisp (wrap-at-column nil). +Fixed finish-smtp-mail in cl-smtp, not use fresh-line on stream, send #\Return#\Newline. +Add test for base64-encode-file.

Documentation see the README file.

@@ -85,7 +89,7 @@
- Jan Idzikowski, 24. May 2005. + Jan Idzikowski, 21. Jun 2010.
--- /project/cl-smtp/cvsroot/cl-smtp/tests.lisp 2010/05/06 09:25:45 1.1 +++ /project/cl-smtp/cvsroot/cl-smtp/tests.lisp 2010/06/21 09:06:27 1.2 @@ -84,6 +84,21 @@ (assert (equal headerstr tmpstr)) )) +(define-cl-smtp-test "send-attachment-header-2" () + (let* ((boundary (make-random-boundary)) + (p (merge-pathnames "tests.lisp" (get-component-pathname))) + (attachment (make-attachment p + :mime-type "text/plain" + :name "foo\\bar")) + (headerstr (with-output-to-string (s) + (send-attachment-header s boundary attachment :utf-8))) + (returnnewline (format nil (format nil "~C~C" #\Return #\NewLine))) + (tmpstr (format nil "--~A~AContent-type: text/plain;~% name*=UTF-8''foo%5cbar;~% name=\"foo\\\\bar\"~AContent-Disposition: attachment; filename*=UTF-8''foo%5cbar; filename=\"foo\\\\bar\"~AContent-Transfer-Encoding: base64~A~A" + boundary returnnewline returnnewline returnnewline + returnnewline returnnewline))) + (assert (equal headerstr tmpstr)) + )) + (define-cl-smtp-test "mask-dot-1" () (assert (equal (mask-dot (format nil "~C~C.~C~C" #\Return #\NewLine @@ -131,6 +146,32 @@ ende")) ) +(defun file-to-usb8-buffer (file) + (with-open-file (s file :element-type '(unsigned-byte 8)) + (let* ((flength (file-length s)) + (buffer (make-array flength :element-type '(unsigned-byte 8)))) + (loop for i from 0 to flength do + (let ((bchar (read-byte s nil 'EOF))) + (if (eql bchar 'EOF) + (return) + (setf (aref buffer i) bchar)))) + buffer))) + +(define-cl-smtp-test "base64-encode-file" () + (let* ((p (merge-pathnames "tests.lisp" (get-component-pathname))) + (base64str1 (with-output-to-string (s) + (base64-encode-file p s))) + (buffer (file-to-usb8-buffer p)) + (base64str2 + #-allegro + (cl-base64:usb8-array-to-base64-string buffer :columns 0) + #+allegro + (excl:usb8-array-to-base64-string buffer :wrap-at-column nil) + )) + + (assert (string-equal (remove #\Return (remove #\Newline base64str1 :test #'equal) :test #'equal) base64str2)) + )) + (defun run-test (name) (handler-case (let ((test (gethash name *cl-smtp-tests*)))