extra/smtp/server/server.factor

   1 ! Copyright (C) 2007 Elie CHAFTARI
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: combinators kernel prettyprint io io.timeouts io.server
   4 sequences namespaces io.sockets continuations calendar io.encodings.ascii ;
   5 IN: smtp.server
   6
   7 ! Mock SMTP server for testing purposes.
   8
   9 ! Usage: 4321 mock-smtp-server
  10 ! $ telnet 127.0.0.1 4321
  11 ! Trying 127.0.0.1...
  12 ! Connected to localhost.
  13 ! Escape character is '^]'.
  14 ! 220 hello
  15 ! EHLO
  16 ! 220 and..?
  17 ! MAIL FROM: <here@mail.com>
  18 ! 220 OK
  19 ! RCPT TO: <there@mail.com>
  20 ! 220 OK
  21 ! Hi
  22 ! 500 ERROR
  23 ! DATA
  24 ! 354 Enter message, ending with "." on a line by itself
  25 ! Hello I am still waiting for your call
  26 ! Thanks
  27 ! .
  28 ! 220 OK
  29 ! QUIT
  30 ! bye
  31 ! Connection closed by foreign host.
  32
  33 SYMBOL: data-mode
  34
  35 : process ( -- )
  36     readln {
  37         { [ [ dup "HELO" head? ] keep "EHLO" head? or ] [
  38             "220 and..?\r\n" write flush t
  39           ] }
  40         { [ dup "QUIT" = ] [
  41             "bye\r\n" write flush f
  42           ] }
  43         { [ dup "MAIL FROM:" head? ] [
  44             "220 OK\r\n" write flush t
  45           ] }
  46         { [ dup "RCPT TO:" head? ] [
  47             "220 OK\r\n" write flush t
  48           ] }
  49         { [ dup "DATA" = ] [
  50             data-mode on
  51             "354 Enter message, ending with \".\" on a line by itself\r\n"
  52             write flush t
  53           ] }
  54         { [ dup "." = data-mode get and ] [
  55             data-mode off
  56             "220 OK\r\n" write flush t
  57           ] }
  58         { [ data-mode get ] [ dup global [ print ] bind t ] }
  59         [
  60             "500 ERROR\r\n" write flush t
  61         ]
  62     } cond nip [ process ] when ;
  63
  64 : mock-smtp-server ( port -- )
  65     "Starting SMTP server on port " write dup . flush
  66     "127.0.0.1" swap <inet4> ascii <server> [
  67         accept [
  68             1 minutes stdio get set-timeout
  69             "220 hello\r\n" write flush
  70             process
  71             global [ flush ] bind
  72         ] with-stream
  73     ] with-disposal ;