[cl-smtp-cvs] CVS cl-smtp

[jidzikowski]

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