move some words to private
db4
Doug Coleman 2008-08-28 23:19:18 -05:00
parent 61122e6e9f
commit 3eae1ffe4b
2 changed files with 52 additions and 6 deletions

View File

@ -0,0 +1,46 @@
! 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 ;
IN: smtp
HELP: smtp-server
{ $description "Holds an " { $link inet } " object with the address of an SMTP server." } ;
HELP: smtp-read-timeout
{ $description "Holds an " { $link duration } " object that specifies how long to wait for a response from the SMTP server." } ;
HELP: with-smtp-connection
{ $values { "quot" quotation } }
{ $description "Connects to an SMTP server stored in " { $link smtp-server } " and calls the quotation." } ;
HELP: <email>
{ $values { "email" email } }
{ $description "Creates an empty " { $link email } " object." } ;
HELP: send-email
{ $values { "email" email } }
{ $description "Sends an " { $link email } " object to an STMP server stored in the " { $link smtp-server } " variable. The required slots are " { $snippet "from" } " and " { $snippet "to" } "." }
{ $examples
{ $example "<email>"
" \"groucho@marx.bros\" >>from"
" { \"chico@marx.bros\" \"harpo@marx.bros\" } >>to"
" { \"gummo@marx.bros\" } >>cc"
" { \"zeppo@marx.bros\" } >>bcc"
" \"Pickup line\" >>subject"
" \"If I said you had a beautiful body, would you hold it against me?\" >>body"
"send-email"
""
}
} ;
ARTICLE: "smtp" "SMTP Client Library"
"Start by creating a new email object:"
{ $subsection <email> }
"Set the " { $snippet "from" } " slot to a " { $link string } "." $nl
"Set the recipient fields, " { $snippet "to" } ", " { $snippet "cc" } ", and " { $snippet "bcc" } ", to arrays of strings."
"Set the " { $snippet "subject" } " to a " { $link string } "." $nl
"Set the " { $snippet "body" } " to a " { $link string } "." $nl
;

View File

@ -1,5 +1,5 @@
! Copyright (C) 2007, 2008 Elie CHAFTARI, Dirk Vleugels,
! Slava Pestov.
! Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays namespaces io io.timeouts kernel logging io.sockets
sequences combinators sequences.lib splitting assocs strings
@ -9,7 +9,7 @@ IN: smtp
SYMBOL: smtp-domain
SYMBOL: smtp-server "localhost" "smtp" <inet> smtp-server set-global
SYMBOL: read-timeout 1 minutes read-timeout set-global
SYMBOL: smtp-read-timeout 1 minutes smtp-read-timeout set-global
SYMBOL: esmtp t esmtp set-global
LOG: log-smtp-connection NOTICE ( addrspec -- )
@ -19,7 +19,7 @@ LOG: log-smtp-connection NOTICE ( addrspec -- )
dup log-smtp-connection
ascii [
smtp-domain [ host-name or ] change
read-timeout get timeouts
smtp-read-timeout get timeouts
call
] with-client ; inline
@ -33,6 +33,7 @@ TUPLE: email
: <email> ( -- email ) email new ;
<PRIVATE
: crlf ( -- ) "\r\n" write ;
: command ( string -- ) write crlf flush ;
@ -151,7 +152,7 @@ ERROR: invalid-header-string string ;
] "" make ;
: extract-email ( recepient -- email )
#! This could be much smarter.
! This could be much smarter.
" " last-split1 swap or "<" ?head drop ">" ?tail drop ;
: email>headers ( email -- hashtable )
@ -179,6 +180,7 @@ ERROR: invalid-header-string string ;
body>> send-body get-ok
quit get-ok
] with-smtp-connection ;
PRIVATE>
: send-email ( email -- )
[ email>headers ] keep (send-email) ;
@ -200,5 +202,3 @@ ERROR: invalid-header-string string ;
! : cram-md5-auth ( key login -- )
! "AUTH CRAM-MD5\r\n" get-ok
! (cram-md5-auth) "\r\n" append get-ok ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!