Commit 9e6e2c87 authored by Jan Idzikowski's avatar Jan Idzikowski
Browse files

Fix error with newlines in header strings.

Add tests for rfc2045-q-encode-string.
parent 38956b3f
Version 20151023.2
2015.10.23
Fix error with newlines in header strings.
Add tests for rfc2045-q-encode-string.
Change cl-smtp.asd, cl-smtp.lisp, tests.lisp CHANGELOG
Version 20151023.1
2015.10.23
Fix error with single line with 1 dot
......
......@@ -21,7 +21,7 @@
:licence "LLGPL"
:author "Jan Idzikowski <jidzikowski@common-lisp.net>"
:maintainer "Jan Idzikowski <jidzikowski@common-lisp.net>"
:version "20151023.1"
:version "20151023.2"
:perform (load-op :after (op webpage)
(pushnew :cl-smtp cl:*features*))
:depends-on (:usocket
......
......@@ -69,10 +69,23 @@
(defun rfc2045-q-encode-string (str &key (external-format :utf-8))
(let ((line-has-non-ascii nil)
(last-line-break 0)
(len (length str))
(exformat (flex:make-external-format external-format)))
(with-output-to-string (s)
(loop for c across str do
(loop for c across str
for n from 0 to len
for column = (- n last-line-break)
do
(when (>= column 74)
(write-blank-line s)
(write-char #\Space s)
(setf last-line-break n))
(cond
((char= c #\NewLine)
(setf last-line-break n)
(write-blank-line s)
(write-char #\Space s))
((< 127 (char-code c))
(unless line-has-non-ascii
(format s "=?~A?Q?"
......@@ -84,9 +97,10 @@
do (format s "~:@(=~2,'0X~)" byte)))
(t
(when line-has-non-ascii
(format s "?=")
(write-sequence "?=" s)
(setf line-has-non-ascii nil))
(format s "~C" c))))
(unless (char= c #\Return)
(write-char c s)))))
(when line-has-non-ascii
(format s "?=")))))
......@@ -115,7 +129,7 @@
(write-blank-line stream))
((or (char= c #\Space)
(char= c #\Tab))
(if (char= nc #\NewLine)
(if (eq nc #\NewLine)
(format stream "~:@(=~2,'0X~)" (char-code c))
(write-char c stream)))
((or (< 127 (char-code c))
......
......@@ -74,6 +74,25 @@ n !"
(assert (string-equal
qstr "=?UTF-8?Q?=C3=B6=C3=BC=C3=A4=C3=96=C3=9C=C3=84=C3=9F?="))))
(define-cl-smtp-test "rfc2045-q-encode-string-newline-1" ()
(assert (equal (rfc2045-q-encode-string
"123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A")
(format nil"123456789A123456789A123456789A123456789A123456789A123456789A123456789A1234~C~C 56789A123456789A123456789A123456789A123456789A123456789A123456789A12345678~C~C 9A123456789A" #\Return #\Newline #\Return #\Newline))))
(define-cl-smtp-test "rfc2045-q-encode-string-newline-2" ()
(assert (equal (rfc2045-q-encode-string
(format nil "123456789A123456789A~CEND"
#\Newline))
(format nil "123456789A123456789A~C~C END"
#\Return #\Newline))))
(define-cl-smtp-test "rfc2045-q-encode-string-newline-3" ()
(assert (equal (rfc2045-q-encode-string
(format nil "123456789A123456789A~C~C.~C~CEND"
#\Return #\Newline #\Return #\Newline))
(format nil "123456789A123456789A~C~C .~C~C END"
#\Return #\Newline #\Return #\Newline))))
(define-cl-smtp-test "escape-rfc822-quoted-string" ()
(assert (equal (escape-rfc822-quoted-string "test end") "test end"))
(assert (equal (escape-rfc822-quoted-string "test\\end")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment