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 @@

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

- <p><b>New Version</b> [20100505.1] Rewrite encoding functions, now it is possible to use non ascii characters in header values and in attachment filenames.</p> + <p><b>New Version</b> [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.</p>

<p><b>Documentation</b> see the README file.</p>

@@ -85,7 +89,7 @@ </ul>

<div class="footer"> - <a href="mailto:jidzikowski (at) common-lisp (dot) net">Jan Idzikowski</a>, 24. May 2005. + <a href="mailto:jidzikowski (at) common-lisp (dot) net">Jan Idzikowski</a>, 21. Jun 2010. </div>

<div class="check"> --- /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*)))