Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
cl-smtp
Commits
9e6e2c87
Commit
9e6e2c87
authored
Oct 23, 2015
by
Jan Idzikowski
Browse files
Fix error with newlines in header strings.
Add tests for rfc2045-q-encode-string.
parent
38956b3f
Changes
4
Hide whitespace changes
Inline
Side-by-side
CHANGELOG
View file @
9e6e2c87
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
...
...
cl-smtp.asd
View file @
9e6e2c87
...
...
@@ -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
...
...
cl-smtp.lisp
View file @
9e6e2c87
...
...
@@ -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
))
...
...
tests.lisp
View file @
9e6e2c87
...
...
@@ -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"
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment