extra/pop3/server/server.factor

   1 ! Copyright (C) 2009 Elie Chaftari.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors calendar combinators concurrency.promises
   4 destructors fry io io.crlf io.encodings.utf8 io.sockets
   5 io.sockets.secure.debug io.streams.duplex io.timeouts
   6 kernel locals math.parser namespaces prettyprint sequences
   7 splitting threads ;
   8 IN: pop3.server
   9
  10 ! Mock POP3 server for testing purposes.
  11
  12 ! $ telnet 127.0.0.1 (start-pop3-server outputs listening port)
  13 ! Trying 127.0.0.1...
  14 ! Connected to localhost.
  15 ! Escape character is '^]'.
  16 ! +OK POP3 server ready
  17 ! USER username@host.com
  18 ! +OK Password required
  19 ! PASS password
  20 ! +OK Logged in
  21 ! STAT
  22 ! +OK 2 1753
  23 ! LIST
  24 ! +OK 2 messages:
  25 ! 1 1006
  26 ! 2 747
  27 ! .
  28 ! UIDL 1
  29 ! +OK 1 000000d547ac2fc2
  30 ! TOP 1 0
  31 ! +OK
  32 ! Return-Path: <from.first@mail.com>
  33 ! Delivered-To: username@host.com
  34 ! Received: from User.local ([66.249.71.201])
  35 !       by mail.isp.com  with ESMTP id n95BgmJg012655
  36 !       for <username@host.com>; Mon, 5 Oct 2009 14:42:59 +0300
  37 ! Date: Mon, 5 Oct 2009 14:42:31 +0300
  38 ! Message-Id: <4273644000823950677-1254742951070701@User.local>
  39 ! MIME-Version: 1.0
  40 ! Content-Transfer-Encoding: base64
  41 ! From: from.first@mail.com
  42 ! To: username@host.com
  43 ! Subject: First test with mock POP3 server
  44 ! Content-Type: text/plain; charset=UTF-8
  45 !
  46 ! .
  47 ! DELE 1
  48 ! +OK Marked for deletion
  49 ! QUIT
  50 ! +OK POP3 server closing connection
  51 ! Connection closed by foreign host.
  52
  53 : process ( -- )
  54     read-crlf {
  55         {
  56             [ dup "USER" head? ]
  57             [
  58
  59                 "+OK Password required\r\n"
  60                 write flush t
  61             ]
  62         }
  63         {
  64             [ dup "PASS" head? ]
  65             [
  66                 "+OK Logged in\r\n"
  67                 write flush t
  68             ]
  69         }
  70         {
  71             [ dup "CAPA" = ]
  72             [
  73                 "+OK\r\nCAPA\r\nTOP\r\nUIDL\r\n.\r\n"
  74                 write flush t
  75             ]
  76         }
  77         {
  78             [ dup "STAT" = ]
  79             [
  80                 "+OK 2 1753\r\n"
  81                 write flush t
  82             ]
  83         }
  84         {
  85             [ dup "LIST" = ]
  86             [
  87                 "+OK 2 messages:\r\n1 1006\r\n2 747\r\n.\r\n"
  88                 write flush t
  89             ]
  90         }
  91         {
  92             [ dup "UIDL" head? ]
  93             [
  94                 {
  95                     {
  96                         [ dup "UIDL 1" = ]
  97                         [
  98                             "+OK 1 000000d547ac2fc2\r\n"
  99                             write flush t
 100                         ]
 101                     }
 102                     {
 103                         [ dup "UIDL 2" = ]
 104                         [
 105                             "+OK 2 000000d647ac2fc2\r\n"
 106                             write flush t
 107                         ]
 108                     }
 109                         [
 110                             "+OK\r\n1 000000d547ac2fc2\r\n2 000000d647ac2fc2\r\n.\r\n"
 111                             write flush t
 112                         ]
 113                 } cond
 114             ]
 115         }
 116         {
 117             [ dup "TOP" head? ]
 118             [
 119                 {
 120                     {
 121                         [ dup "TOP 1 0" = ]
 122                         [
 123 "+OK
 124 Return-Path: <from.first@mail.com>
 125 Delivered-To: username@host.com
 126 Received: from User.local ([66.249.71.201])
 127         by mail.isp.com  with ESMTP id n95BgmJg012655
 128         for <username@host.com>; Mon, 5 Oct 2009 14:42:59 +0300
 129 Date: Mon, 5 Oct 2009 14:42:31 +0300
 130 Message-Id: <4273644000823950677-1254742951070701@User.local>
 131 MIME-Version: 1.0
 132 Content-Transfer-Encoding: base64
 133 From: from.first@mail.com
 134 To: username@host.com
 135 Subject: First test with mock POP3 server
 136 Content-Type: text/plain; charset=UTF-8
 137
 138 .
 139 "
 140                             write flush t
 141                         ]
 142                     }
 143                     {
 144                         [ dup "TOP 2 0" = ]
 145                         [
 146 "+OK
 147 Return-Path: <from.second@mail.com>
 148 Delivered-To: username@host.com
 149 Received: from User.local ([66.249.71.201])
 150         by mail.isp.com  with ESMTP id n95BgmJg012655
 151         for <username@host.com>; Mon, 5 Oct 2009 14:44:09 +0300
 152 Date: Mon, 5 Oct 2009 14:43:11 +0300
 153 Message-Id: <9783644000823934577-4563442951070856@User.local>
 154 MIME-Version: 1.0
 155 Content-Transfer-Encoding: base64
 156 From: from.second@mail.com
 157 To: username@host.com
 158 Subject: Second test with mock POP3 server
 159 Content-Type: text/plain; charset=UTF-8
 160
 161 .
 162 "
 163                             write flush t
 164                         ]
 165                     }
 166                 } cond
 167             ]
 168         }
 169         {
 170             [ dup "RETR" head? ]
 171             [
 172                 {
 173                     {
 174                         [ dup "RETR 1" = ]
 175                         [
 176 "+OK
 177 Return-Path: <from.first@mail.com>
 178 Delivered-To: username@host.com
 179 Received: from User.local ([66.249.71.201])
 180         by mail.isp.com  with ESMTP id n95BgmJg012655
 181         for <username@host.com>; Mon, 5 Oct 2009 14:42:59 +0300
 182 Date: Mon, 5 Oct 2009 14:42:31 +0300
 183 Message-Id: <4273644000823950677-1254742951070701@User.local>
 184 MIME-Version: 1.0
 185 Content-Transfer-Encoding: base64
 186 From: from.first@mail.com
 187 To: username@host.com
 188 Subject: First test with mock POP3 server
 189 Content-Type: text/plain; charset=UTF-8
 190
 191 This is the body of the first test.
 192 .
 193 "
 194                             write flush t
 195                         ]
 196                     }
 197                     {
 198                         [ dup "RETR 2" = ]
 199                         [
 200 "+OK
 201 Return-Path: <from.second@mail.com>
 202 Delivered-To: username@host.com
 203 Received: from User.local ([66.249.71.201])
 204         by mail.isp.com  with ESMTP id n95BgmJg012655
 205         for <username@host.com>; Mon, 5 Oct 2009 14:44:09 +0300
 206 Date: Mon, 5 Oct 2009 14:43:11 +0300
 207 Message-Id: <9783644000823934577-4563442951070856@User.local>
 208 MIME-Version: 1.0
 209 Content-Transfer-Encoding: base64
 210 From: from.second@mail.com
 211 To: username@host.com
 212 Subject: Second test with mock POP3 server
 213 Content-Type: text/plain; charset=UTF-8
 214
 215 This is the body of the second test.
 216 .
 217 "
 218                             write flush t
 219                         ]
 220                     }
 221                 } cond
 222             ]
 223         }
 224         {
 225             [ dup "DELE" head? ]
 226             [
 227                 "+OK Marked for deletion\r\n"
 228                 write flush t
 229             ]
 230         }
 231         {
 232             [ dup "RSET" = ]
 233             [
 234                 "+OK\r\n"
 235                 write flush t
 236             ]
 237         }
 238         {
 239             [ dup "QUIT" = ]
 240             [
 241                 "+OK POP3 server closing connection\r\n"
 242                 write flush f
 243             ]
 244         }
 245     } cond nip [ process ] when ;
 246
 247 :: mock-pop3-server ( promise -- )
 248     ! Store the port we are running on in the promise.
 249     [
 250         [
 251             "127.0.0.1" 0 <inet4> utf8 <server> [
 252             dup addr>> port>> promise fulfill
 253                 accept drop [
 254                     1 minutes timeouts
 255                     "+OK POP3 server ready\r\n" write flush
 256                     process
 257                     [ flush ] with-global
 258                 ] with-stream
 259             ] with-disposal
 260         ] with-test-context
 261     ] in-thread ;
 262
 263 : start-pop3-server ( -- )
 264     <promise> [ mock-pop3-server ] keep ?promise
 265     number>string "POP3 server started on port "
 266     prepend print ;