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*)))
