Commit b67708b8 authored by Jan Idzikowski's avatar Jan Idzikowski

Fix error rfc2045-q-encode-string, encoding and newline

 - when string contains non ascii character,
   and has more than 74 charactesr, set correct encoding string after newline
parent 5c23a369
Version 20190523.1
2019.05.23
Fix error rfc2045-q-encode-string, when string contains non ascii character,
and has more than 74 charactesr, set correct encoding string after newline
add new test
Change cl-smtp.asd, cl-smtp.lisp. tests.lisp CHANGELOG
Version 20190424.1
2019.04.24
Fix error rfc2045-q-encode-string, when string contains non ascii character,
......
......@@ -21,7 +21,7 @@
:licence "LLGPL"
:author "Jan Idzikowski <jidzikowski@common-lisp.net>"
:maintainer "Jan Idzikowski <jidzikowski@common-lisp.net>"
:version "20190424.1"
:version "20190523.1"
:perform (load-op :after (op webpage)
(pushnew :cl-smtp cl:*features*))
:depends-on (:usocket
......
......@@ -69,37 +69,42 @@
(defun rfc2045-q-encode-string (str &key (external-format :utf-8))
(let ((line-has-non-ascii (string-has-non-ascii str))
(estart (concatenate 'string "=?"
(string-upcase (symbol-name external-format))
"?Q?"))
(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))
(write-sequence estart s))
(loop for c across str
for n from 0 to len
for column = (- n last-line-break)
do
(when (>= column 74)
(when line-has-non-ascii
(write-sequence "?=" s))
(write-blank-line s)
(write-char #\Space s)
(when line-has-non-ascii
(write-sequence estart s))
(setf last-line-break n))
(cond
((char= c #\NewLine)
(setf last-line-break n)
(write-blank-line s)
(write-char #\Space s))
(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
((char= c #\NewLine)
(setf last-line-break n)
(write-blank-line s)
(write-char #\Space s))
(t
(unless (char= c #\Return)
(write-char c s)))))
(when line-has-non-ascii
(format s "?=")))))
(write-sequence "?=" s)))))
(defun rfc2045-q-encode-string-to-stream (str stream
&key (external-format :utf-8)
......
......@@ -124,6 +124,14 @@ n !"
(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-utf-8-3" ()
(let* ((str "Test: check correct newline in quoted encoding string for string longer then 74 charecters with spezial german 'ü' 'Ü' 'ä' 'Ä' 'ö' 'Ö' 'ß' characters")
(qstr (rfc2045-q-encode-string str :external-format :utf-8)))
(assert qstr)
(assert (equal
qstr "=?UTF-8?Q?=54=65=73=74=3A=20=63=68=65=63=6B=20=63=6F=72=72=65=63=74=20=6E=65=77=6C=69=6E=65=20=69=6E=20=71=75=6F=74=65=64=20=65=6E=63=6F=64=69=6E=67=20=73=74=72=69=6E=67=20=66=6F=72=20=73=74=72=69=6E=67=20=6C=6F=6E=67=65=72=20=74=68?=
=?UTF-8?Q?=65=6E=20=37=34=20=63=68=61=72=65=63=74=65=72=73=20=77=69=74=68=20=73=70=65=7A=69=61=6C=20=67=65=72=6D=61=6E=20=27=C3=BC=27=20=27=C3=9C=27=20=27=C3=A4=27=20=27=C3=84=27=20=27=C3=B6=27=20=27=C3=96=27=20=27=C3=9F=27=20=63=68=61=72=61=63=74=65=72?=
=?UTF-8?Q?=73?="))))
(define-cl-smtp-test "rfc2045-q-encode-string-newline-1" ()
(assert (equal (rfc2045-q-encode-string
......
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