! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel quotations help.syntax help.markup
-io.sockets strings calendar ;
+io.sockets strings calendar io.encodings.utf8 ;
IN: smtp
HELP: smtp-domain
{ { $slot "to" } "The recipients of the e-mail. A sequence of e-mail addresses." }
{ { $slot "cc" } "Carbon-copy. A sequence of e-mail addresses." }
{ { $slot "bcc" } "Blind carbon-copy. A sequence of e-mail addresses." }
- { { $slot "subject" } " The subject of the e-mail. A string." }
+ { { $slot "subject" } "The subject of the e-mail. A string." }
+ { { $slot "content-type" } { "The MIME type of the body. A string, default is " { $snippet "text/plain" } "." } }
+ { { $slot "encoding" } { "An encoding to send the body as. Default is " { $link utf8 } "." } }
{ { $slot "body" } " The body of the e-mail. A string." }
}
"The " { $slot "from" } " and " { $slot "to" } " slots are required; the rest are optional."
[ { "hello" "." "world" } validate-message ] must-fail
[ "aGVsbG8Kd29ybGQ=\r\n.\r\n" ] [
- "hello\nworld" [ send-body ] with-string-writer
+ T{ email { body "hello\nworld" } } [ send-body ] with-string-writer
] unit-test
[ { "500 syntax error" } <response> check-response ]
[
{
{ "Content-Transfer-Encoding" "base64" }
- { "Content-Type" "Text/plain; charset=utf-8" }
+ { "Content-Type" "text/plain; charset=UTF-8" }
{ "From" "Doug <erg@factorcode.org>" }
{ "MIME-Version" "1.0" }
{ "Subject" "Factor rules" }
! Copyright (C) 2007, 2008 Elie CHAFTARI, Dirk Vleugels,
-! Slava Pestov, Doug Coleman.
+! Slava Pestov, Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays namespaces make io io.encodings.string
-io.encodings.utf8 io.timeouts io.sockets io.sockets.secure
-io.encodings.ascii kernel logging sequences combinators
-splitting assocs strings math.order math.parser random system
-calendar summary calendar.format accessors sets hashtables
-base64 debugger classes prettyprint io.crlf ;
+USING: arrays namespaces make io io.encodings.string io.encodings.utf8
+io.encodings.iana io.timeouts io.sockets io.sockets.secure
+io.encodings.ascii kernel logging sequences combinators splitting
+assocs strings math.order math.parser random system calendar summary
+calendar.format accessors sets hashtables base64 debugger classes
+prettyprint io.crlf words ;
IN: smtp
SYMBOL: smtp-domain
{ cc array }
{ bcc array }
{ subject string }
+ { content-type string initial: "text/plain" }
+ { encoding word initial: utf8 }
{ body string } ;
: <email> ( -- email ) email new ; inline
"." over member?
[ message-contains-dot ] when ;
-: send-body ( body -- )
- utf8 encode
+: send-body ( email -- )
+ [ body>> ] [ encoding>> ] bi encode
>base64-lines write crlf
"." command ;
! 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-content-type ( email -- content-type )
+ [ content-type>> ] [ encoding>> encoding>name ] bi "; charset=" glue ;
-: email>headers ( email -- hashtable )
+: email>headers ( email -- assoc )
[
+ now timestamp>rfc822 "Date" set
+ message-id "Message-Id" set
+ "1.0" "MIME-Version" set
+ "base64" "Content-Transfer-Encoding" set
{
[ from>> "From" set ]
[ to>> ", " join "To" set ]
[ cc>> ", " join [ "Cc" set ] unless-empty ]
[ subject>> "Subject" set ]
+ [ email-content-type "Content-Type" set ]
} cleave
- now timestamp>rfc822 "Date" set
- message-id "Message-Id" set
- ] { } make-assoc utf8-mime-header append ;
+ ] { } make-assoc ;
: (send-email) ( headers email -- )
[
data get-ok
swap write-headers
crlf
- body>> send-body get-ok
+ send-body get-ok
quit get-ok
] with-smtp-connection ;