steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

POP3 client library

db4
Elie Chaftari 2009-10-23 12:50:12 +03:00
parent d05127644e
commit 4e5537ebf2
8 changed files with 850 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/pop3/authors.txt Normal file
View File

@ -0,0 +1 @@
Elie Chaftari

312
extra/pop3/pop3-docs.factor Normal file
View File

@ -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: <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"

68
extra/pop3/pop3-tests.factor Normal file
View File

@ -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 ;
<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

199
extra/pop3/pop3.factor Normal file
View File

@ -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 )
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 ;

266
extra/pop3/server/server.factor Normal file
View File

@ -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: <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 ;

1
extra/pop3/server/summary.txt Normal file
View File

@ -0,0 +1 @@
POP3 server for testing purposes

1
extra/pop3/summary.txt Normal file
View File

@ -0,0 +1 @@
Retrieve mail via POP3

2
extra/pop3/tags.txt Normal file
View File

@ -0,0 +1,2 @@
enterprise
network