REBOL [ Title: "DO-POP Scheme" Date: 6-jul-2005 File: %do-pop-scheme.r Author: "Brett Handley" Purpose: {A scheme to allow flexible POP3 operations.} Comment: { *You need to learn and understand the POP3 protocol to use this properly. See http://en.wikipedia.org/wiki/POP3 *DELE *marks* messages for deletion but they are not physically deleted by the server until after QUIT is issued. Messages can be unmarked with RSET. For this reason the the mailbox-length and mailbox-size variables are not updated for DELE and keep their original values from when the port is opened. Therefore at any given time, the number of messages that will be left after all messages marked for deletion are removed will be: (mailbox-length - messages-deleted) } Library: [ level: 'intermediate platform: 'all type: 'protocol domain: 'email tested-under: [ core 1.3.1.3.1 on [WinXP] {Basic tests.} "Brett" ] support: none license: none comment: { Copyright (C) 2005 Brett Handley All rights reserved. * Portions of this code based upon the POP scheme by REBOL Technologies. * Read the associated documentation for license terms, you must agree with the terms to use this script. } ] ] ; Sample use. comment [ ; -- Example 1: Quick check of mailbox statistics. ----------------------------------------------- read do-pop://mailbox:%password--mailserver--com ; -- Example 2: Interactive POP commands using their network names given by the RFC. ------------- popcmd: open do-pop://mailbox:%password--mailserver--com insert popcmd 'list print copy popcmd insert popcmd [my-message: retr 1] print my-message insert popcmd [help list] close popcmd ; -- Example 3: Syntactically nicer. -------------------------------------------------------------- pop-service: open do-pop://mailbox:%password--mailserver--com do-pop: func [value][insert pop-service value copy pop-service] foreach [msgnum size] do-pop 'list [ do-pop [ print [msgnum get in import-email top msgnum 'subject ] ] ] close pop-service ] make Root-Protocol [ {Evaluate REBOL code within a POP context.} ; -------------------------------------------------- ; Modes, Constants and helpers ; -------------------------------------------------- port-flags: system/standard/port-flags/pass-thru ; Use these to ensure correct behaviour. copy*: get in system/words 'copy insert*: get in system/words 'insert close*: get in system/words 'close net-log: get in net-utils 'net-log ; -------------------------------------------------- ; Port lifetime methods. ; -------------------------------------------------- open: func [ "Open the port. Required handler method." port "An initialised but not yet open port." /local greeting timestamp result ] [ net-log ["Port Request - Open" ] ; Create context specific commands port/locals: context [ commands: context [ ; ------------------------------------------------ ; POP Transaction State Commands ; ------------------------------------------------ dele: func [ "Marks the message as deleted. Affects STAT, LIST, UIDL." message-number [integer! string!] ] [ request-remote port ["DELE" message-number] messages-deleted: messages-deleted + 1 return ; unset ] noop: func [ {Sends the command.} ] [ request-remote port "NOOP" return ; unset ] list: func [ {Returns scan listings of messages.} /only message-number [integer! string!] "Restrict to specified message." ] [ either only [ copy* next parse request-remote port ["LIST" message-number] none ] [ request-remote port "LIST" parse read-til-dot port make string! 1024 none ] ] retr: func [ {Retrieves the message.} message-number [integer! string!] ] [ request-remote port ["RETR" message-number] read-til-dot port make string! 10000 ] rset: func [ {Unmarks (resets) all messages marked as deleted.} ] [ request-remote port "RSET" messages-deleted: 0 return ; unset ] stat: func [ {Returns statistics of mailbox as [length size].} ] [ use [length size] [ set [length size] copy* next parse request-remote port "STAT" none reduce [to integer! length to integer! size] ] ] top: func [ {Returns headers for message.} message-number [integer! string!] /lines number [integer!] {Number of body lines to include. Default is 0.} ] [ request-remote port ["TOP" message-number form any [number 0]] read-til-dot port make string! 10000 ] uidl: func [ {Returns unique-id listing.} /only message-number [integer! string!] "Restrict to specified message." ] [ either only [ copy* next parse request-remote port ["UIDL" message-number] none ] [ request-remote port "UIDL" parse read-til-dot port make string! 1024 none ] ] ] mailbox-length: 0 mailbox-size: 0 messages-deleted: 0 pop-result: none ] ; Set the state variables tail. port/state/tail: none if error? set/any 'result try [ ; Open the connection. Based upon logic from prot-pop.r by REBOL Technologies. open-proto port greeting: request-remote port 'none if any [ port/algorithm <> 'apop not parse greeting [to "<" copy timestamp thru ">" to end] error? catch [ request-remote port reform [ "APOP" port/user lowercase enbase/base checksum/method rejoin [timestamp port/pass] 'md5 16 ] ] ] [ request-remote port ["USER" port/user] request-remote port ["PASS" port/pass] ] ;Get stats and set variables. do bind [pop-result: set [mailbox-length mailbox-size] commands/stat] in port/locals 'self ] [ attempt [request-remote port "QUIT"] result ] port ] close: func [ "Close the port. Required handler method." port "An open port." ] [ net-log ["Port Request - Close" ] attempt [request-remote port "QUIT"] port/locals: none ; Free up local context. close* port/sub-port ] ; -------------------------------------------------- ; Port item methods. ; -------------------------------------------------- copy: func [ "Copy from the port. Returns result of last Insert to the port." port "An open port." ] [ ; Copy from port/state/index. net-log ["Port Request - Copy" ] get/any in port/locals 'pop-result ] insert: func [ "Insert data into the port. Supports Insert request." port "An open port." data ] [ ; Insert at port/state/index. Need to modify port/state/tail? net-log ["Port Request - Insert" :data] ; Evaluate. set/any in port/locals 'pop-result do bind bind/copy data in port/locals 'self in port/locals/commands 'self port ] ; ------------------------------------------------------------------- ; Support functions ; ------------------------------------------------------------------- ; read-til-dot copied and modified from prot-pop.r by REBOL Technologies. read-til-dot: func [port buf] [ while [(line: system/words/pick port/sub-port 1) <> "."] [ insert* tail buf line insert* tail buf newline ] buf ] request-remote: func [ "Sends pop command to the server, checks reply." port value ] [ net-utils/confirm port/sub-port compose/only [(value) "+OK"] ] ; -------------------------------------------------- ; Install the scheme. ; -------------------------------------------------- net-utils/net-install do-pop self 110 ]