Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
x0r
cl-smtp
Commits
5c23a369
Commit
5c23a369
authored
Apr 24, 2019
by
Jan Idzikowski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix error rfc2045-q-encode-string, when string contains non ascii character, encode whole string
parent
a6be003b
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
32 additions
and
11 deletions
+32
-11
CHANGELOG
CHANGELOG
+8
-0
cl-smtp.asd
cl-smtp.asd
+1
-1
cl-smtp.lisp
cl-smtp.lisp
+6
-9
tests.lisp
tests.lisp
+17
-1
No files found.
CHANGELOG
View file @
5c23a369
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
...
...
cl-smtp.asd
View file @
5c23a369
...
...
@@ -21,7 +21,7 @@
:licence
"LLGPL"
:author
"Jan Idzikowski <jidzikowski@common-lisp.net>"
:maintainer
"Jan Idzikowski <jidzikowski@common-lisp.net>"
:version
"201
80105
.1"
:version
"201
90424
.1"
:perform
(
load-op
:after
(
op
webpage
)
(
pushnew
:cl-smtp
cl:*features*
))
:depends-on
(
:usocket
...
...
cl-smtp.lisp
View file @
5c23a369
...
...
@@ -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
...
...
tests.lisp
View file @
5c23a369
...
...
@@ -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"
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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