73 lines
1.8 KiB
Factor
73 lines
1.8 KiB
Factor
|
! Copyright (C) 2007 Elie CHAFTARI
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
|
||
|
|
! Mock SMTP server for testing purposes.
|
||
|
|
|
||
|
|
! Usage: 4321 smtp-server
|
||
|
|
! $ 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.
|
||
|
|
|
||
|
|
USING: combinators kernel prettyprint io io.server sequences
|
||
|
|
namespaces io.sockets continuations ;
|
||
|
|
|
||
|
|
SYMBOL: data-mode
|
||
|
|
|
||
|
|
: process ( -- )
|
||
|
|
readln {
|
||
|
|
{ [ [ dup "HELO" head? ] keep "EHLO" head? or ] [
|
||
|
|
"220 and..?\r\n" write flush t
|
||
|
|
] }
|
||
|
|
{ [ dup "QUIT" = ] [
|
||
|
|
"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 ] [ t ] }
|
||
|
|
{ [ t ] [
|
||
|
|
"500 ERROR\r\n" write flush t
|
||
|
|
] }
|
||
|
|
} cond nip [ process ] when ;
|
||
|
|
|
||
|
|
: smtp-server ( port -- )
|
||
|
|
"Starting SMTP server on port " write dup . flush
|
||
|
|
"127.0.0.1" swap <inet4> <server> [
|
||
|
|
accept [
|
||
|
|
60000 stdio get set-timeout
|
||
|
|
"220 hello\r\n" write flush
|
||
|
|
process
|
||
|
|
] with-stream
|
||
|
|
] with-disposal ;
|