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