Commit 5c23a369 authored by Jan Idzikowski's avatar Jan Idzikowski
Browse files

Fix error rfc2045-q-encode-string, when string contains non ascii character, encode whole string

parent a6be003b
Version 20190424.1
2019.04.24
Fix error rfc2045-q-encode-string, when string contains non ascii character,
encode whole string
add new tests
Thanks Saman H. Pasha for the bug report and test
Change cl-smtp.asd, cl-smtp.lisp. tests.lisp CHANGELOG
Version 20180105.1
2018.01.05
Fix error dot masking in rfc2045-q-encode-string-to-stream
......
......@@ -21,7 +21,7 @@
:licence "LLGPL"
:author "Jan Idzikowski <jidzikowski@common-lisp.net>"
:maintainer "Jan Idzikowski <jidzikowski@common-lisp.net>"
:version "20180105.1"
:version "20190424.1"
:perform (load-op :after (op webpage)
(pushnew :cl-smtp cl:*features*))
:depends-on (:usocket
......
......@@ -68,11 +68,15 @@
when (< 127 (char-code c)) do (return t)))
(defun rfc2045-q-encode-string (str &key (external-format :utf-8))
(let ((line-has-non-ascii nil)
(let ((line-has-non-ascii (string-has-non-ascii str))
(last-line-break 0)
(len (length str))
(exformat (flex:make-external-format external-format)))
(with-output-to-string (s)
(when line-has-non-ascii
(format s "=?~A?Q?"
(string-upcase (symbol-name external-format)))
(setf line-has-non-ascii t))
(loop for c across str
for n from 0 to len
for column = (- n last-line-break)
......@@ -86,19 +90,12 @@
(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?"
(string-upcase (symbol-name external-format)))
(setf line-has-non-ascii t))
(line-has-non-ascii
(loop for byte across (flex:string-to-octets
(make-string 1 :initial-element c)
:external-format exformat)
do (format s "~:@(=~2,'0X~)" byte)))
(t
(when line-has-non-ascii
(write-sequence "?=" s)
(setf line-has-non-ascii nil))
(unless (char= c #\Return)
(write-char c s)))))
(when line-has-non-ascii
......
......@@ -96,19 +96,35 @@ n !"
nil"12345678901234567890123456789012345678901234567890123456789012345678901234=~C~C5."
#\Return #\Newline)))))
(define-cl-smtp-test "rfc2045-q-encode-string-to-stream-10" ()
(let* ((str "لینک تایید | Verification link")
(qstr (with-output-to-string (s)
(rfc2045-q-encode-string-to-stream
str s :external-format :utf-8 :columns 74))))
(assert qstr)
(assert (string-equal qstr "=D9=84=DB=8C=D9=86=DA=A9 =D8=AA=D8=A7=DB=8C=DB=8C=D8=AF | Verification link"))))
(define-cl-smtp-test "string-has-non-ascii-1" ()
(assert (string-has-non-ascii "test Ü ende")))
(define-cl-smtp-test "string-has-non-ascii-2" ()
(assert (not (string-has-non-ascii "test ende"))))
(define-cl-smtp-test "rfc2045-q-encode-string-utf-8" ()
(define-cl-smtp-test "rfc2045-q-encode-string-utf-8-1" ()
(let* ((str "öüäÖÜÄß")
(qstr (rfc2045-q-encode-string str :external-format :utf-8)))
(assert qstr)
(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-utf-8-2" ()
(let* ((str "لینک تایید | Verification link")
(qstr (rfc2045-q-encode-string str :external-format :utf-8)))
(assert qstr)
(assert (string-equal
qstr "=?UTF-8?Q?=D9=84=DB=8C=D9=86=DA=A9=20=D8=AA=D8=A7=DB=8C=DB=8C=D8=AF=20=7C=20=56=65=72=69=66=69=63=61=74=69=6F=6E=20=6C=69=6E=6B?="))))
(define-cl-smtp-test "rfc2045-q-encode-string-newline-1" ()
(assert (equal (rfc2045-q-encode-string
"123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A123456789A")
......
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