basis/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 sequences
   4 namespaces io.sockets io.sockets.secure continuations calendar
   5 io.encodings.ascii io.streams.duplex destructors locals
   6 concurrency.promises threads accessors smtp.private
   7 io.sockets.secure.unix.debug io.crlf ;
   8 IN: smtp.server
   9
  10 ! Mock SMTP server for testing purposes.
  11
  12 ! $ telnet 127.0.0.1 4321
  13 ! Trying 127.0.0.1...
  14 ! Connected to localhost.
  15 ! Escape character is '^]'.
  16 ! 220 hello
  17 ! EHLO
  18 ! 220 and..?
  19 ! MAIL FROM: <here@mail.com>
  20 ! 220 OK
  21 ! RCPT TO: <there@mail.com>
  22 ! 220 OK
  23 ! Hi
  24 ! 500 ERROR
  25 ! DATA
  26 ! 354 Enter message, ending with "." on a line by itself
  27 ! Hello I am still waiting for your call
  28 ! Thanks
  29 ! .
  30 ! 220 OK
  31 ! QUIT
  32 ! bye
  33 ! Connection closed by foreign host.
  34
  35 SYMBOL: data-mode
  36
  37 : process ( -- )
  38     read-crlf {
  39         {
  40             [ dup [ "HELO" head? ] [ "EHLO" head? ] bi or ]
  41             [ "220 and..?\r\n" write flush t ]
  42         }
  43         {
  44             [ dup "STARTTLS" = ]
  45             [
  46                 "220 2.0.0 Ready to start TLS\r\n" write flush
  47                 accept-secure-handshake t
  48             ]
  49         }
  50         { [ dup "QUIT" = ] [ "220 bye\r\n" write flush f ] }
  51         { [ dup "MAIL FROM:" head? ] [ "220 OK\r\n" write flush t ] }
  52         { [ dup "RCPT TO:" head? ] [ "220 OK\r\n" write flush t ] }
  53         {
  54             [ dup "DATA" = ]
  55             [
  56                 data-mode on
  57                 "354 Enter message, ending with \".\" on a line by itself\r\n"
  58                 write flush t
  59             ]
  60         }
  61         {
  62             [ dup "." = data-mode get and ]
  63             [
  64                 data-mode off
  65                 "220 OK\r\n" write flush t
  66             ]
  67         }
  68         { [ data-mode get ] [ dup global [ print ] bind t ] }
  69         [ "500 ERROR\r\n" write flush t ]
  70     } cond nip [ process ] when ;
  71
  72 :: mock-smtp-server ( promise -- )
  73     #! Store the port we are running on in the promise.
  74     [
  75         [
  76             "127.0.0.1" 0 <inet4> ascii <server> [
  77             dup addr>> port>> promise fulfill
  78                 accept drop [
  79                     1 minutes timeouts
  80                     "220 hello\r\n" write flush
  81                     process
  82                     global [ flush ] bind
  83                 ] with-stream
  84             ] with-disposal
  85         ] with-test-context
  86     ] in-thread ;