--- /dev/null
+Elie Chaftari
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Elie Chaftari.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays assocs help.markup help.syntax kernel math
+sequences strings ;
+IN: pop3
+
+HELP: <pop3-account>
+{ $values
+
+ { "pop3-account" pop3-account }
+}
+{ $description "creates a " { $link pop3-account } " object with defaults for the port and timeout slots." } ;
+
+HELP: account
+{ $values
+
+ { "pop3-account" pop3-account }
+}
+{ $description "You only need to call " { $link connect } " after calling this word to reconnect to the latest accessed POP3 account." }
+{ $examples
+ { $code
+ "account connect"
+ ""
+ }
+} ;
+
+HELP: >user
+{ $values
+ { "name" "userID of the account" }
+}
+{ $description "Sends the userID of the account on the POP3 server (this could be the full e-mail address)" $nl
+"This must be the first command after " { $link connect } " if username and password have not been set with " { $link <pop3-account> } "."
+} ;
+
+HELP: >pwd
+{ $values
+ { "password" "password for the userID" }
+}
+{ $description "Sends the clear-text password for the userID. The password may be case sensitive. This must be the next command after " { $link >user } "." } ;
+
+HELP: capa
+{ $values
+
+ { "array" array }
+}
+{ $description "Queries the mail server capabilities, as described in RFC 2449. It is advised to check for command support before calling the appropriate words (e.g. TOP UIDL)." } ;
+
+HELP: connect
+{ $values
+ { "pop3-account" pop3-account }
+}
+{ $description "Opens a network connection to the pop3 mail server with the settings given in the pop3-account slots." }
+{ $examples
+ { $code "USING: accessors pop3 ;"
+ "<pop3-account>"
+ " \"pop.yourisp.com\" >>host"
+ " \"username@yourisp.com\" >>user"
+ " \"pass123\" >>pwd"
+ "connect"
+ ""
+ }
+} ;
+
+HELP: consolidate
+{ $values
+
+ { "seq" sequence }
+}
+{ $description "Builds a sequence of email tuples, iterating over each email top and consolidating its headers with its number, uidl, and size." } ;
+
+HELP: delete
+{ $values
+ { "message#" fixnum }
+}
+{ $description "This marks message number message# for deletion from the server. This is the way to get rid of a problem causing message. It is not actually deleted until the " { $link close } " word is issued. If you lose the connection to the mail server before calling the " { $link close } " word, the server should not delete any messages. Example: 3 delete" } ;
+
+HELP: headers
+{ $values
+
+ { "assoc" assoc }
+}
+{ $description "Gathers and associates the From:, Subject:, and To: headers of each message." } ;
+
+HELP: list
+{ $values
+
+ { "assoc" assoc }
+}
+{ $description "Lists each message with its number and size in bytes" } ;
+
+HELP: pop3-account
+{ $class-description "A POP3 account on a POP3 server. It has the following slots:"
+ { $table
+ { { $slot "#" } "The ephemeral ordinal number of the message." }
+ { { $slot "host" } "The name or IP address of the remote host to which a POP3 connection is required." }
+ { { $slot "port" } "The POP3 server port (defaults to 110)." }
+ { { $slot "timeout" } "Maximum time in minutes to wait for a response from the POP3 server (defaults to 1 minutes)." }
+ { { $slot "user" } "The userID of the account on the POP3 server." }
+ { { $slot "pwd" } { "The clear-text password for the userID." } }
+ { { $slot "stream" } { "The duplex input/output stream wrapping the POP3 session." } }
+ { { $slot "capa" } { "A list of the mail server capabilities." } }
+ { { $slot "count" } { "Number of messages in the mailbox." } }
+ { { $slot "list" } { "A list of every message with its number and size in bytes" } }
+ { { $slot "uidls" } { "The UIDL (Unique IDentification Listing) of every message in the mailbox together with its ordinal number." } }
+ { { $slot "messages" } { "A sequence of email tuples in the mailbox containing each email's headers, number, uidl, and size." } }
+ }
+"The " { $slot "host" } " is required; the rest are either set by default or optional." $nl
+"The " { $slot "user" } " and " { $slot "pwd" } " must either be set before using " { $link connect } " or immediately after it with the " { $link >user } " and " { $link >pwd } " words."
+} ;
+
+HELP: message
+{ $class-description "An e-mail message having the following slots:"
+ { $table
+ { { $slot "#" } "The ephemeral ordinal number of the message." }
+ { { $slot "uidl" } "The POP3 UIDL (Unique IDentification Listing) of the message." }
+ { { $slot "headers" } "The From:, Subject:, and To: headers of the message." }
+ { { $slot "from" } "The sender of the message. An e-mail address." }
+ { { $slot "to" } "The recipients of the message." }
+ { { $slot "subject" } { "The subject of the message." } }
+ { { $slot "size" } { "The size of the message in octets." } }
+ }
+} ;
+
+HELP: close
+{ $description "Deletes any messages marked for deletion, and then logs you off of the mail server. This is the last command to use." } ;
+
+HELP: retrieve
+{ $values
+ { "message#" fixnum }
+ { "seq" sequence }
+}
+{ $description "Sends message number message# to you. You should prepare for some base64 decoding. You probably want to do this with a mailer." } ;
+
+HELP: reset
+{ $description "Resets the status of the remote POP3 server. This includes resetting the status of all messages to not be deleted." } ;
+
+HELP: count
+{ $values
+
+ { "n" fixnum }
+}
+{ $description "Gets the number of messages in the mailbox." } ;
+
+HELP: top
+{ $values
+ { "message#" fixnum } { "#lines" fixnum }
+ { "seq" sequence }
+}
+{ $description "Lists the header for message# and the first #lines of the message text. For example, 1 0 top would list just the headers for message 1, where as 1 5 top would list the headers and first 5 lines of the message text." } ;
+
+HELP: uidl
+{ $values
+ { "message#" fixnum }
+ { "uidl" string }
+}
+{ $description "Gets the POP3 UIDL (Unique IDentification Listing) of the given message#." } ;
+
+HELP: uidls
+{ $values
+
+ { "assoc" assoc }
+}
+{ $description "Gets the POP3 UIDL (Unique IDentification Listing) of every specific message in the mailbox together with its ordinal number. UIDL provides a mechanism that avoids numbering issues between POP3 sessions by assigning a permanent and unique ID for each message." } ;
+
+ARTICLE: "pop3" "POP3 client library"
+"The " { $vocab-link "pop3" } " vocab implements a client interface to the POP3 protocol, enabling a Factor application to talk to POP3 servers. It allows interactive sessions similar to telnet ones to do maintenance on your mailbox on a POP3 mail server; to look at, and possibly delete, any problem causing message (e.g. too large, improperly formatted, etc.)." $nl
+"Word names do not necessarily map directly to POP3 commands defined in RFC1081 or RFC1939, although most commands are supported." $nl
+"This article assumes that you are familiar with the POP3 protocol."
+$nl
+"Connecting to the mail server:"
+{ $subsections connect }
+"You need to construct a pop3-account tuple first, setting at least the host slot."
+{ $subsections <pop3-account> }
+{ $examples
+ { $code "USING: accessors pop3 ;"
+ "<pop3-account>"
+ " \"pop.yourisp.com\" >>host"
+ " \"username@yourisp.com\" >>user"
+ " \"pass123\" >>pwd"
+ "connect"
+ ""
+ }
+}
+$nl
+"If you do not supply the username or password, you will need to call the " { $link >user } " and " { $link >pwd } " vocabs in this order after the " { $link connect } " vocab."
+{ $examples
+ { $code "USING: accessors pop3 ;"
+ "<pop3-account>"
+ " \"pop.yourisp.com\" >>host"
+ "connect"
+ ""
+ "\"username@yourisp.com\" >user"
+ "\"pass123\" >pwd"
+ ""
+ }
+}
+$nl
+{ $notes "Subsequent calls to the " { $link pop3-account } " thus created can be done by calling the " { $link account } " word. If you needed to reconnect to the same POP3 account after having called " { $link close } ", you only need to call " { $link account } " followed by " { $link connect } "." }
+$nl
+"Querying the mail server:"
+$nl
+"For its capabilities:"
+{ $subsections capa }
+{ $examples
+ { $code
+ "capa ."
+ "{ \"CAPA\" \"TOP\" \"UIDL\" }"
+ ""
+ }
+}
+$nl
+"For the message count:"
+{ $subsections count }
+{ $examples
+ { $code
+ "count ."
+ "2"
+ ""
+ }
+}
+$nl
+"For each message's size:"
+{ $subsections list }
+{ $examples
+ { $code
+ "list ."
+ "H{ { 1 \"1006\" } { 2 \"747\" } }"
+ ""
+ }
+}
+$nl
+"For a specific message raw header, appropriate headers, or number of lines:"
+{ $subsections top }
+{ $examples
+ { $code
+ "1 0 top ."
+ "<the raw-source of the message header is retrieved>"
+ ""
+ }
+ { $code
+ "1 5 top ."
+ "<the raw-source of the message header and its first 5 lines are retrieved>"
+ ""
+ }
+ { $code
+ "1 0 top headers ."
+ "H{"
+ " { \"From:\" \"from@mail.com\" }"
+ " { \"Subject:\" \"Re:\" }"
+ " { \"To:\" \"username@host.com\" }"
+ "}"
+ ""
+ }
+}
+$nl
+"To consolidate all the messages of this account into a single association:"
+{ $subsections consolidate }
+{ $examples
+ { $code
+ "consolidate ."
+"""{
+ T{ message
+ { # 1 }
+ { uidl \"000000d547ac2fc2\" }
+ { from \"from.first@mail.com\" }
+ { to \"username@host.com\" }
+ { subject \"First subject\" }
+ { size \"1006\" }
+ }
+ T{ message
+ { # 2 }
+ { uidl \"000000d647ac2fc2\" }
+ { from \"from.second@mail.com\" }
+ { to \"username@host.com\" }
+ { subject \"Second subject\" }
+ { size \"747\" }
+ }
+}"""
+ ""
+ }
+}
+$nl
+"You may want to delete message #2 but want to make sure you are deleting the right one. You can check that message #2 has the uidl from the example above."
+{ $subsections uidl }
+{ $examples
+ { $code
+ "2 uidl ."
+ "\"000000d647ac2fc2\""
+ ""
+ }
+}
+$nl
+"Now with your mind at rest, you can delete message #2. The message is marked for deletion."
+{ $subsections delete }
+{ $examples
+ { $code
+ "2 delete"
+ ""
+ }
+}
+$nl
+"The messages marked for deletion are actually deleted only when " { $link close } " is called. This should be the last command you issue. "
+{ $subsections close }
+{ $examples
+ { $code
+ "close"
+ ""
+ }
+}
+{ $notes "If you change your mind at any point, you can call " { $link reset } " to reset the status of all messages to not be deleted." } ;
+
+ABOUT: "pop3"
--- /dev/null
+! Copyright (C) 2009 Elie Chaftari.
+! See http://factorcode.org/license.txt for BSD license.
+USING: concurrency.promises namespaces kernel pop3 pop3.server
+sequences tools.test accessors ;
+IN: pop3.tests
+
+FROM: pop3 => count delete ;
+
+<promise> "p1" set
+
+[ ] [ "p1" get mock-pop3-server ] unit-test
+[ ] [
+ <pop3-account>
+ "127.0.0.1" >>host
+ "p1" get ?promise >>port
+ connect
+] unit-test
+[ ] [ "username@host.com" >user ] unit-test
+[ ] [ "password" >pwd ] unit-test
+[ { "CAPA" "TOP" "UIDL" } ] [ capa ] unit-test
+[ 2 ] [ count ] unit-test
+[ H{ { 1 "1006" } { 2 "747" } } ] [ list ] unit-test
+[
+ H{
+ { "From:" "from.first@mail.com" }
+ { "Subject:" "First test with mock POP3 server" }
+ { "To:" "username@host.com" }
+ }
+] [ 1 0 top drop headers ] unit-test
+[
+ {
+ T{ message
+ { # 1 }
+ { uidl "000000d547ac2fc2" }
+ { from "from.first@mail.com" }
+ { to "username@host.com" }
+ { subject "First test with mock POP3 server" }
+ { size "1006" }
+ }
+ T{ message
+ { # 2 }
+ { uidl "000000d647ac2fc2" }
+ { from "from.second@mail.com" }
+ { to "username@host.com" }
+ { subject "Second test with mock POP3 server" }
+ { size "747" }
+ }
+ }
+] [ consolidate ] unit-test
+[ "000000d547ac2fc2" ] [ 1 uidl ] unit-test
+[ ] [ 1 delete ] unit-test
+[ ] [ reset ] unit-test
+[ ] [ close ] unit-test
+
+
+<promise> "p2" set
+
+[ ] [ "p2" get mock-pop3-server ] unit-test
+[ ] [
+ <pop3-account>
+ "127.0.0.1" >>host
+ "p2" get ?promise >>port
+ "username@host.com" >>user
+ "password" >>pwd
+ connect
+] unit-test
+[ f ] [ 1 retrieve empty? ] unit-test
+[ ] [ close ] unit-test
--- /dev/null
+! Copyright (C) 2009 Elie Chaftari.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors annotations arrays assocs calendar combinators
+fry hashtables io io.crlf io.encodings.utf8 io.sockets
+io.streams.duplex io.timeouts kernel make math math.parser
+math.ranges namespaces prettyprint sequences splitting
+strings ;
+IN: pop3
+
+TUPLE: pop3-account
+# host port timeout user pwd stream capa count list
+uidls messages ;
+
+: <pop3-account> ( -- pop3-account )
+ pop3-account new
+ 110 >>port
+ 1 minutes >>timeout ;
+
+: account ( -- pop3-account ) pop3-account get ;
+
+TUPLE: message # uidl headers from to subject size ;
+
+<PRIVATE
+
+: stream ( -- duplex-stream ) account stream>> ;
+
+: <message> ( -- message ) message new ; inline
+
+TUPLE: raw-source top headers content ;
+
+: <raw-source> ( -- raw-source ) raw-source new ; inline
+
+: raw ( -- raw-source ) raw-source get ;
+
+: set-read-timeout ( -- )
+ stream [
+ account timeout>> timeouts
+ ] with-stream* ;
+
+: get-ok ( -- )
+ stream [
+ readln dup "+OK" head? [ drop ] [ throw ] if
+ ] with-stream* ;
+
+: get-ok-and-total ( -- total )
+ stream [
+ readln dup "+OK" head? [
+ " " split second string>number dup account (>>count)
+ ] [ throw ] if
+ ] with-stream* ;
+
+: get-ok-and-uidl ( -- uidl )
+ stream [
+ readln dup "+OK" head? [
+ " " split last
+ ] [ throw ] if
+ ] with-stream* ;
+
+: command ( string -- ) write crlf flush get-ok ;
+
+: command-and-total ( string -- total ) write crlf flush
+ get-ok-and-total ;
+
+: command-and-uidl ( string -- uidl ) write crlf flush
+ get-ok-and-uidl ;
+
+: associate-split ( seq -- assoc )
+ [ " " split1 ] H{ } map>assoc ;
+
+: split-map ( seq -- assoc )
+ associate-split [ [ string>number ] dip ] assoc-map ;
+
+: (readlns) ( -- )
+ readln dup "." = [ , ] dip [ (readlns) ] unless ;
+
+: readlns ( -- seq ) [ (readlns) ] { } make but-last ;
+
+: (list) ( -- )
+ stream [
+ "LIST" command
+ readlns account (>>list)
+ ] with-stream* ;
+
+: (uidls) ( -- )
+ stream [
+ "UIDL" command
+ readlns account (>>uidls)
+ ] with-stream* ;
+
+PRIVATE>
+
+: >user ( name -- )
+ [ stream ] dip '[
+ "USER " _ append command
+ ] with-stream* ;
+
+: >pwd ( password -- )
+ [ stream ] dip '[
+ "PASS " _ append command
+ ] with-stream* ;
+
+: connect ( pop3-account -- )
+ [
+ [ host>> ] [ port>> ] bi
+ <inet> utf8 <client> drop
+ ] keep swap >>stream
+ {
+ [ pop3-account set ]
+ [ user>> [ >user ] when* ]
+ [ pwd>> [ >pwd ] when* ]
+ } cleave
+ set-read-timeout
+ get-ok ;
+
+: capa ( -- array )
+ stream [
+ "CAPA" command
+ readlns dup account (>>capa)
+ ] with-stream* ;
+
+: count ( -- n )
+ stream [
+ "STAT" command-and-total
+ ] with-stream* ;
+
+: list ( -- assoc )
+ (list) account list>> split-map ;
+
+: uidl ( message# -- uidl )
+ [ stream ] dip '[
+ "UIDL " _ number>string append command-and-uidl
+ ] with-stream* ;
+
+: uidls ( -- assoc )
+ (uidls) account uidls>> split-map ;
+
+: top ( message# #lines -- seq )
+ <raw-source> raw-source set
+ [ stream ] 2dip '[
+ "TOP " _ number>string append " "
+ append _ number>string append
+ command
+ readlns dup raw (>>top)
+ ] with-stream* ;
+
+: headers ( -- assoc )
+ raw top>> {
+ [
+ [ dup "From:" head?
+ [ raw [ swap suffix ] change-headers drop ]
+ [ drop ] if
+ ] each
+ ]
+ [
+ [ dup "To:" head?
+ [ raw [ swap suffix ] change-headers drop ]
+ [ drop ] if
+ ] each
+ ]
+ [
+ [ dup "Subject:" head?
+ [ raw [ swap suffix ] change-headers drop ]
+ [ drop ] if
+ ] each
+ ]
+ } cleave raw headers>> associate-split ;
+
+: retrieve ( message# -- seq )
+ [ stream ] dip '[
+ "RETR " _ number>string append command
+ readlns dup raw (>>content)
+ ] with-stream* ;
+
+: delete ( message# -- )
+ [ stream ] dip '[
+ "DELE " _ number>string append command
+ ] with-stream* ;
+
+: reset ( -- )
+ stream [ "RSET" command ] with-stream* ;
+
+: consolidate ( -- seq )
+ count zero? [ "No mail for account." ] [
+ 1 account count>> [a,b] [
+ {
+ [ 0 top drop ]
+ [ <message> swap >># ]
+ [ uidls at >>uidl ]
+ [ list at >>size ]
+ } cleave
+ "From:" headers at >>from
+ "To:" headers at >>to
+ "Subject:" headers at >>subject
+ account [ swap suffix ] change-messages drop
+ ] each account messages>>
+ ] if ;
+
+: close ( -- )
+ stream [ "QUIT" command ] with-stream ;
--- /dev/null
+! Copyright (C) 2009 Elie Chaftari.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors calendar combinators concurrency.promises
+destructors fry io io.crlf io.encodings.utf8 io.sockets
+io.sockets.secure.unix.debug io.streams.duplex io.timeouts
+kernel locals math.parser namespaces prettyprint sequences
+splitting threads ;
+IN: pop3.server
+
+! Mock POP3 server for testing purposes.
+
+! $ telnet 127.0.0.1 (start-pop3-server outputs listening port)
+! Trying 127.0.0.1...
+! Connected to localhost.
+! Escape character is '^]'.
+! +OK POP3 server ready
+! USER username@host.com
+! +OK Password required
+! PASS password
+! +OK Logged in
+! STAT
+! +OK 2 1753
+! LIST
+! +OK 2 messages:
+! 1 1006
+! 2 747
+! .
+! UIDL 1
+! +OK 1 000000d547ac2fc2
+! TOP 1 0
+! +OK
+! Return-Path: <from.first@mail.com>
+! Delivered-To: username@host.com
+! Received: from User.local ([66.249.71.201])
+! by mail.isp.com with ESMTP id n95BgmJg012655
+! for <username@host.com>; Mon, 5 Oct 2009 14:42:59 +0300
+! Date: Mon, 5 Oct 2009 14:42:31 +0300
+! Message-Id: <4273644000823950677-1254742951070701@User.local>
+! MIME-Version: 1.0
+! Content-Transfer-Encoding: base64
+! From: from.first@mail.com
+! To: username@host.com
+! Subject: First test with mock POP3 server
+! Content-Type: text/plain; charset=UTF-8
+!
+! .
+! DELE 1
+! +OK Marked for deletion
+! QUIT
+! +OK POP3 server closing connection
+! Connection closed by foreign host.
+
+: process ( -- )
+ read-crlf {
+ {
+ [ dup "USER" head? ]
+ [
+
+ "+OK Password required\r\n"
+ write flush t
+ ]
+ }
+ {
+ [ dup "PASS" head? ]
+ [
+ "+OK Logged in\r\n"
+ write flush t
+ ]
+ }
+ {
+ [ dup "CAPA" = ]
+ [
+ "+OK\r\nCAPA\r\nTOP\r\nUIDL\r\n.\r\n"
+ write flush t
+ ]
+ }
+ {
+ [ dup "STAT" = ]
+ [
+ "+OK 2 1753\r\n"
+ write flush t
+ ]
+ }
+ {
+ [ dup "LIST" = ]
+ [
+ "+OK 2 messages:\r\n1 1006\r\n2 747\r\n.\r\n"
+ write flush t
+ ]
+ }
+ {
+ [ dup "UIDL" head? ]
+ [
+ {
+ {
+ [ dup "UIDL 1" = ]
+ [
+ "+OK 1 000000d547ac2fc2\r\n"
+ write flush t
+ ]
+ }
+ {
+ [ dup "UIDL 2" = ]
+ [
+ "+OK 2 000000d647ac2fc2\r\n"
+ write flush t
+ ]
+ }
+ [
+ "+OK\r\n1 000000d547ac2fc2\r\n2 000000d647ac2fc2\r\n.\r\n"
+ write flush t
+ ]
+ } cond
+ ]
+ }
+ {
+ [ dup "TOP" head? ]
+ [
+ {
+ {
+ [ dup "TOP 1 0" = ]
+ [
+"""+OK
+Return-Path: <from.first@mail.com>
+Delivered-To: username@host.com
+Received: from User.local ([66.249.71.201])
+ by mail.isp.com with ESMTP id n95BgmJg012655
+ for <username@host.com>; Mon, 5 Oct 2009 14:42:59 +0300
+Date: Mon, 5 Oct 2009 14:42:31 +0300
+Message-Id: <4273644000823950677-1254742951070701@User.local>
+MIME-Version: 1.0
+Content-Transfer-Encoding: base64
+From: from.first@mail.com
+To: username@host.com
+Subject: First test with mock POP3 server
+Content-Type: text/plain; charset=UTF-8
+
+.
+"""
+ write flush t
+ ]
+ }
+ {
+ [ dup "TOP 2 0" = ]
+ [
+"""+OK
+Return-Path: <from.second@mail.com>
+Delivered-To: username@host.com
+Received: from User.local ([66.249.71.201])
+ by mail.isp.com with ESMTP id n95BgmJg012655
+ for <username@host.com>; Mon, 5 Oct 2009 14:44:09 +0300
+Date: Mon, 5 Oct 2009 14:43:11 +0300
+Message-Id: <9783644000823934577-4563442951070856@User.local>
+MIME-Version: 1.0
+Content-Transfer-Encoding: base64
+From: from.second@mail.com
+To: username@host.com
+Subject: Second test with mock POP3 server
+Content-Type: text/plain; charset=UTF-8
+
+.
+"""
+ write flush t
+ ]
+ }
+ } cond
+ ]
+ }
+ {
+ [ dup "RETR" head? ]
+ [
+ {
+ {
+ [ dup "RETR 1" = ]
+ [
+"""+OK
+Return-Path: <from.first@mail.com>
+Delivered-To: username@host.com
+Received: from User.local ([66.249.71.201])
+ by mail.isp.com with ESMTP id n95BgmJg012655
+ for <username@host.com>; Mon, 5 Oct 2009 14:42:59 +0300
+Date: Mon, 5 Oct 2009 14:42:31 +0300
+Message-Id: <4273644000823950677-1254742951070701@User.local>
+MIME-Version: 1.0
+Content-Transfer-Encoding: base64
+From: from.first@mail.com
+To: username@host.com
+Subject: First test with mock POP3 server
+Content-Type: text/plain; charset=UTF-8
+
+This is the body of the first test.
+.
+"""
+ write flush t
+ ]
+ }
+ {
+ [ dup "RETR 2" = ]
+ [
+"""+OK
+Return-Path: <from.second@mail.com>
+Delivered-To: username@host.com
+Received: from User.local ([66.249.71.201])
+ by mail.isp.com with ESMTP id n95BgmJg012655
+ for <username@host.com>; Mon, 5 Oct 2009 14:44:09 +0300
+Date: Mon, 5 Oct 2009 14:43:11 +0300
+Message-Id: <9783644000823934577-4563442951070856@User.local>
+MIME-Version: 1.0
+Content-Transfer-Encoding: base64
+From: from.second@mail.com
+To: username@host.com
+Subject: Second test with mock POP3 server
+Content-Type: text/plain; charset=UTF-8
+
+This is the body of the second test.
+.
+"""
+ write flush t
+ ]
+ }
+ } cond
+ ]
+ }
+ {
+ [ dup "DELE" head? ]
+ [
+ "+OK Marked for deletion\r\n"
+ write flush t
+ ]
+ }
+ {
+ [ dup "RSET" = ]
+ [
+ "+OK\r\n"
+ write flush t
+ ]
+ }
+ {
+ [ dup "QUIT" = ]
+ [
+ "+OK POP3 server closing connection\r\n"
+ write flush f
+ ]
+ }
+ } cond nip [ process ] when ;
+
+:: mock-pop3-server ( promise -- )
+ #! Store the port we are running on in the promise.
+ [
+ [
+ "127.0.0.1" 0 <inet4> utf8 <server> [
+ dup addr>> port>> promise fulfill
+ accept drop [
+ 1 minutes timeouts
+ "+OK POP3 server ready\r\n" write flush
+ process
+ global [ flush ] bind
+ ] with-stream
+ ] with-disposal
+ ] with-test-context
+ ] in-thread ;
+
+: start-pop3-server ( -- )
+ <promise> [ mock-pop3-server ] keep ?promise
+ number>string "POP3 server started on port "
+ prepend print ;
--- /dev/null
+POP3 server for testing purposes
--- /dev/null
+Retrieve mail via POP3
--- /dev/null
+enterprise
+network
projects / factor.git / commitdiff