factor/extra/pop3/server/server.factor

267 lines
7.1 KiB
Factor

! 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.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
[ flush ] with-global
] 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 ;