88 lines
2.4 KiB
Factor
88 lines
2.4 KiB
Factor
! Copyright (C) 2007 Elie CHAFTARI
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: combinators kernel prettyprint io io.timeouts sequences
|
|
namespaces io.sockets io.sockets.secure continuations calendar
|
|
io.encodings.ascii io.streams.duplex destructors locals
|
|
concurrency.promises threads accessors smtp.private
|
|
io.sockets.secure.debug io.crlf ;
|
|
IN: smtp.server
|
|
|
|
! Mock SMTP server for testing purposes.
|
|
|
|
! $ telnet 127.0.0.1 4321
|
|
! Trying 127.0.0.1...
|
|
! Connected to localhost.
|
|
! Escape character is '^]'.
|
|
! 220 hello
|
|
! EHLO
|
|
! 220 and..?
|
|
! MAIL FROM: <here@mail.com>
|
|
! 220 OK
|
|
! RCPT TO: <there@mail.com>
|
|
! 220 OK
|
|
! Hi
|
|
! 500 ERROR
|
|
! DATA
|
|
! 354 Enter message, ending with "." on a line by itself
|
|
! Hello I am still waiting for your call
|
|
! Thanks
|
|
! .
|
|
! 220 OK
|
|
! QUIT
|
|
! bye
|
|
! Connection closed by foreign host.
|
|
|
|
SYMBOL: data-mode
|
|
|
|
: process ( -- )
|
|
read-crlf {
|
|
{ [ dup not ] [ f ] }
|
|
{
|
|
[ dup [ "HELO" head? ] [ "EHLO" head? ] bi or ]
|
|
[ "220 and..?\r\n" write flush t ]
|
|
}
|
|
{
|
|
[ dup "STARTTLS" = ]
|
|
[
|
|
"220 2.0.0 Ready to start TLS\r\n" write flush
|
|
accept-secure-handshake t
|
|
]
|
|
}
|
|
{ [ dup "QUIT" = ] [ "220 bye\r\n" write flush f ] }
|
|
{ [ dup "MAIL FROM:" head? ] [ "220 OK\r\n" write flush t ] }
|
|
{ [ dup "RCPT TO:" head? ] [ "220 OK\r\n" write flush t ] }
|
|
{
|
|
[ dup "DATA" = ]
|
|
[
|
|
data-mode on
|
|
"354 Enter message, ending with \".\" on a line by itself\r\n"
|
|
write flush t
|
|
]
|
|
}
|
|
{
|
|
[ dup "." = data-mode get and ]
|
|
[
|
|
data-mode off
|
|
"220 OK\r\n" write flush t
|
|
]
|
|
}
|
|
{ [ data-mode get ] [ dup [ print ] with-global t ] }
|
|
[ "500 ERROR\r\n" write flush t ]
|
|
} cond nip [ process ] when ;
|
|
|
|
:: mock-smtp-server ( promise -- )
|
|
#! Store the port we are running on in the promise.
|
|
[
|
|
[
|
|
"127.0.0.1" 0 <inet4> ascii <server> [
|
|
dup addr>> port>> promise fulfill
|
|
accept drop [
|
|
1 minutes timeouts
|
|
"220 hello\r\n" write flush
|
|
process
|
|
[ flush ] with-global
|
|
] with-stream
|
|
] with-disposal
|
|
] with-test-context
|
|
] in-thread ;
|