diff --git a/extra/pop3/authors.txt b/extra/pop3/authors.txt new file mode 100644 index 0000000000..0a1127186c --- /dev/null +++ b/extra/pop3/authors.txt @@ -0,0 +1 @@ +Elie Chaftari \ No newline at end of file diff --git a/extra/pop3/pop3-docs.factor b/extra/pop3/pop3-docs.factor new file mode 100644 index 0000000000..aeb6d210f6 --- /dev/null +++ b/extra/pop3/pop3-docs.factor @@ -0,0 +1,312 @@ +! 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: +{ $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 } "." +} ; + +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 ;" + "" + " \"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 } +{ $examples + { $code "USING: accessors pop3 ;" + "" + " \"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 ;" + "" + " \"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 ." + "" + "" + } + { $code + "1 5 top ." + "" + "" + } + { $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" diff --git a/extra/pop3/pop3-tests.factor b/extra/pop3/pop3-tests.factor new file mode 100644 index 0000000000..8efc07ceee --- /dev/null +++ b/extra/pop3/pop3-tests.factor @@ -0,0 +1,68 @@ +! 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 ; + + "p1" set + +[ ] [ "p1" get mock-pop3-server ] unit-test +[ ] [ + + "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 + + + "p2" set + +[ ] [ "p2" get mock-pop3-server ] unit-test +[ ] [ + + "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 diff --git a/extra/pop3/pop3.factor b/extra/pop3/pop3.factor new file mode 100644 index 0000000000..030d265f37 --- /dev/null +++ b/extra/pop3/pop3.factor @@ -0,0 +1,199 @@ +! 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 new + 110 >>port + 1 minutes >>timeout ; + +: account ( -- pop3-account ) pop3-account get ; + +TUPLE: message # uidl headers from to subject size ; + +> ; + +: ( -- message ) message new ; inline + +TUPLE: raw-source top headers content ; + +: ( -- 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 + utf8 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 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 ] + [ 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 ; diff --git a/extra/pop3/server/server.factor b/extra/pop3/server/server.factor new file mode 100644 index 0000000000..775a457fc5 --- /dev/null +++ b/extra/pop3/server/server.factor @@ -0,0 +1,266 @@ +! 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: +! Delivered-To: username@host.com +! Received: from User.local ([66.249.71.201]) +! by mail.isp.com with ESMTP id n95BgmJg012655 +! for ; 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: +Delivered-To: username@host.com +Received: from User.local ([66.249.71.201]) + by mail.isp.com with ESMTP id n95BgmJg012655 + for ; 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: +Delivered-To: username@host.com +Received: from User.local ([66.249.71.201]) + by mail.isp.com with ESMTP id n95BgmJg012655 + for ; 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: +Delivered-To: username@host.com +Received: from User.local ([66.249.71.201]) + by mail.isp.com with ESMTP id n95BgmJg012655 + for ; 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: +Delivered-To: username@host.com +Received: from User.local ([66.249.71.201]) + by mail.isp.com with ESMTP id n95BgmJg012655 + for ; 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 utf8 [ + 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 ( -- ) + [ mock-pop3-server ] keep ?promise + number>string "POP3 server started on port " + prepend print ; diff --git a/extra/pop3/server/summary.txt b/extra/pop3/server/summary.txt new file mode 100644 index 0000000000..56d261eb25 --- /dev/null +++ b/extra/pop3/server/summary.txt @@ -0,0 +1 @@ +POP3 server for testing purposes diff --git a/extra/pop3/summary.txt b/extra/pop3/summary.txt new file mode 100644 index 0000000000..387a099622 --- /dev/null +++ b/extra/pop3/summary.txt @@ -0,0 +1 @@ +Retrieve mail via POP3 diff --git a/extra/pop3/tags.txt b/extra/pop3/tags.txt new file mode 100644 index 0000000000..80d57bb287 --- /dev/null +++ b/extra/pop3/tags.txt @@ -0,0 +1,2 @@ +enterprise +network