diff --git a/basis/smtp/smtp-tests.factor b/basis/smtp/smtp-tests.factor index e3638bd969..8a9107b905 100644 --- a/basis/smtp/smtp-tests.factor +++ b/basis/smtp/smtp-tests.factor @@ -15,7 +15,7 @@ IN: smtp.tests [ { "hello" "." "world" } validate-message ] must-fail -[ "hello\r\nworld\r\n.\r\n" ] [ +[ "aGVsbG8Kd29ybGQ=\r\n.\r\n" ] [ "hello\nworld" [ send-body ] with-string-writer ] unit-test @@ -50,7 +50,10 @@ IN: smtp.tests [ { + { "Content-Transfer-Encoding" "base64" } + { "Content-Type" "Text/plain; charset=utf-8" } { "From" "Doug " } + { "MIME-Version" "1.0" } { "Subject" "Factor rules" } { "To" "Slava , Ed " } } diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index c17db13b01..2ffc2e6db3 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -92,9 +92,8 @@ M: message-contains-dot summary ( obj -- string ) [ message-contains-dot ] when ; : send-body ( body -- ) - string-lines - validate-message - [ write crlf ] each + utf8 encode + >base64-lines write crlf "." command ; : quit ( -- ) @@ -167,6 +166,13 @@ M: plain-auth send-auth : auth ( -- ) smtp-auth get send-auth ; +: encode-header ( string -- string' ) + dup aux>> [ + "=?utf-8?B?" + swap utf8 encode >base64 + "?=" 3append + ] when ; + ERROR: invalid-header-string string ; : validate-header ( string -- string' ) @@ -175,7 +181,7 @@ ERROR: invalid-header-string string ; : write-header ( key value -- ) [ validate-header write ] - [ ": " write validate-header write ] bi* crlf ; + [ ": " write validate-header encode-header write ] bi* crlf ; : write-headers ( assoc -- ) [ write-header ] assoc-each ; @@ -195,6 +201,13 @@ ERROR: invalid-header-string string ; ! This could be much smarter. " " split1-last swap or "<" ?head drop ">" ?tail drop ; +: utf8-mime-header ( -- alist ) + { + { "MIME-Version" "1.0" } + { "Content-Transfer-Encoding" "base64" } + { "Content-Type" "Text/plain; charset=utf-8" } + } ; + : email>headers ( email -- hashtable ) [ { @@ -205,7 +218,7 @@ ERROR: invalid-header-string string ; } cleave now timestamp>rfc822 "Date" set message-id "Message-Id" set - ] { } make-assoc ; + ] { } make-assoc utf8-mime-header append ; : (send-email) ( headers email -- ) [