Paste: cleaned up pop3 (interactive)

Author:	azteca
Mode:	factor
Date:	Sun, 18 Oct 2009 16:09:41

Plain Text |

Delete Paste

! Copyright (C) 2009 Elie Chaftari.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors annotations arrays assocs combinators fry
hashtables io io.crlf io.encodings.utf8 io.sockets
io.streams.duplex kernel make math math.parser math.ranges
namespaces prettyprint sequences splitting strings ;
IN: pop3.interactive

TUPLE: pop3-account
# host port timeout user password stream capa stat list
uidls messages ;

: <pop3-account> ( -- pop3-account )
    pop3-account new
        110 >>port
        60 >>timeout ;

: account ( -- pop3-account ) pop3-account get ;
: stream ( -- duplex-stream ) account stream>> ;

TUPLE: message # uidl headers from to subject size ;

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

<PRIVATE

: get-ok ( -- )
    stream [
        readln dup "+OK" head? [ drop ] [ throw ] if
    ] with-stream* ;

: get-ok-and-total ( -- )
    stream [
        readln dup "+OK" head? [
            " " split second string>number account swap
            >>stat drop
        ] [ throw ] if
    ] with-stream* ;

: command ( string -- ) write crlf flush ;

: associate-split ( seq -- assoc )
    [ " " split1 2array ] map >hashtable ;

: (readlns) ( -- )
    readln dup "." = [ , ] dip [ (readlns) ] unless ;

: readlns ( -- seq ) [ (readlns) ] { } make but-last ;

PRIVATE>

: pop3-connection ( pop3-account -- )
    [ [ host>> ] [ port>> ] bi
    <inet> utf8 <client> drop ] keep swap >>stream
    pop3-account set get-ok ;

: >user ( name -- )
    stream swap '[
        "USER " _ append command get-ok
    ] with-stream* ;

: >pass ( password -- )
    stream swap '[
        "PASS " _ append command get-ok
    ] with-stream* ;

: capa ( -- )
    stream [
        "CAPA" command get-ok
        account readlns >>capa drop
    ] with-stream* ;

: stat ( -- )
    stream [
        "STAT" command get-ok-and-total
    ] with-stream* ;

: (list) ( -- )
    stream [
        "LIST" command get-ok
        account readlns >>list drop
    ] with-stream* ;

: list ( -- assoc )
    (list) account list>> associate-split
    [ swap string>number swap ] assoc-map ;

: (uidl) ( -- )
    stream [
        "UIDL" command get-ok
        account readlns >>uidls drop
    ] with-stream* ;

: uidl ( -- assoc )
    (uidl) account uidls>> associate-split
    [ swap string>number swap ] assoc-map ;

: top ( message# #lines -- )
    <raw-source> raw-source set
    stream -rot '[
        "TOP " _ number>string append " "
        append _ number>string append
        command get-ok
        raw readlns >>top drop
    ] with-stream* ;

: retr ( message# -- )
    stream swap '[
        "RETR " _ number>string append command get-ok
        raw readlns >>content drop
    ] with-stream* ;

: raw-content ( -- seq )
    raw content>> ;

: dele ( message# -- )
    stream swap '[
        "DELE " _ number>string append command get-ok
    ] 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 ;

: consolidate ( -- seq )
    account stat>> zero? [ "No mail for account." ] [
        1 account stat>> [a,b] [
            { [ 0 top ]
            [ <message> swap >># ]
            [ uidl 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 ;

: quit ( -- )
    stream [ "QUIT" command get-ok ] with-stream ;

Annotation: unit tests for pop3

Author:	azteca
Mode:	factor
Date:	Sun, 18 Oct 2009 16:11:24

Plain Text |

Delete Annotation

! Copyright (C) 2009 Elie Chaftari.
! See http://factorcode.org/license.txt for BSD license.
USING: concurrency.promises namespaces pop3.interactive
pop3.server sequences tools.test accessors ;
IN: pop3.interactive.tests

<promise> "p" set

[ ] [ "p" get mock-pop3-server ] unit-test
[ ] [
        <pop3-account>
            "127.0.0.1" >>host
            "p" get ?promise >>port
        pop3-connection
] unit-test
[ ] [ "username@host.com" >user ] unit-test
[ ] [ "password" >pass ] unit-test
[ { "CAPA" "TOP" "UIDL" } ] [ capa account capa>> ] unit-test
[ ] [ stat ] unit-test
[ H{ { 1 "1006" } { 2 "747" } } ] [ list ] unit-test
[ ] [ 1 0 top ] unit-test
[
    {
        T{ message
            { # 1 }
            { uidl "000000d547ac2fc2" }
            { from "from@mail.com" }
            { to "username@host.com" }
            { subject "Testing with mock POP3 server" }
            { size "1006" }
        }
        T{ message
            { # 2 }
            { uidl "000000d647ac2fc2" }
            { from "from@mail.com" }
            { to "username@host.com" }
            { subject "Testing with mock POP3 server" }
            { size "747" }
        }
    }
] [ consolidate ] unit-test
[ ] [ 1 retr ] unit-test
[ f ] [ raw-content empty? ] unit-test
[ ] [ 1 dele ] unit-test
[ ] [ quit ] unit-test

Annotation: pop3 mock server

Author:	azteca
Mode:	factor
Date:	Sun, 18 Oct 2009 16:12:55

Plain Text |

Delete Annotation

! 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 0
! 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
! .
! TOP 1 1
! +OK
! Return-Path: <from@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@mail.com
! To: username@host.com
! Subject: Testing the mock pop3 server
! Content-Type: text/plain; charset=UTF-8
! 
! Just a test.
! .
! DELE 1
! +OK message deleted
! 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" = ]
            [
                "+OK\r\n1 000000d547ac2fc2\r\n2 000000d647ac2fc2\r\n.\r\n"
                write flush t
            ]
        }
        {
            [ dup "TOP" head? ]
            [
"""+OK
Return-Path: <from@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@mail.com
To: username@host.com
Subject: Testing with mock POP3 server
Content-Type: text/plain; charset=UTF-8

.
"""
                write flush t
            ]
        }
        {
            [ dup "RETR" head? ]
            [
"""+OK
Return-Path: <from@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@mail.com
To: username@host.com
Subject: Testing with mock POP3 server
Content-Type: text/plain; charset=UTF-8

Just a test.
.
"""
                write flush t
            ]
        }
        {
            [ 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 ;

New Annotation

Summary:
Author:
Mode:	textPostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonqdocrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsparqlsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt
Body:

Done