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.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         { [ dup not ] [ f ] }
  40         {
  41             [ dup [ "HELO" head? ] [ "EHLO" head? ] bi or ]
  42             [ "220 and..?\r\n" write flush t ]
  43         }
  44         {
  45             [ dup "STARTTLS" = ]
  46             [
  47                 "220 2.0.0 Ready to start TLS\r\n" write flush
  48                 accept-secure-handshake t
  49             ]
  50         }
  51         { [ dup "QUIT" = ] [ "220 bye\r\n" write flush f ] }
  52         { [ dup "MAIL FROM:" head? ] [ "220 OK\r\n" write flush t ] }
  53         { [ dup "RCPT TO:" head? ] [ "220 OK\r\n" write flush t ] }
  54         {
  55             [ dup "DATA" = ]
  56             [
  57                 data-mode on
  58                 "354 Enter message, ending with \".\" on a line by itself\r\n"
  59                 write flush t
  60             ]
  61         }
  62         {
  63             [ dup "." = data-mode get and ]
  64             [
  65                 data-mode off
  66                 "220 OK\r\n" write flush t
  67             ]
  68         }
  69         { [ data-mode get ] [ dup [ print ] with-global t ] }
  70         [ "500 ERROR\r\n" write flush t ]
  71     } cond nip [ process ] when ;
  72
  73 :: mock-smtp-server ( promise -- )
  74     ! Store the port we are running on in the promise.
  75     [
  76         [
  77             "127.0.0.1" 0 <inet4> ascii <server> [
  78             dup addr>> port>> promise fulfill
  79                 accept drop [
  80                     1 minutes timeouts
  81                     "220 hello\r\n" write flush
  82                     process
  83                     [ flush ] with-global
  84                 ] with-stream
  85             ] with-disposal
  86         ] with-test-context
  87     ] in-thread ;