diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/pop3 | |
parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/pop3')
-rw-r--r-- | tcllib/modules/pop3/ChangeLog | 419 | ||||
-rw-r--r-- | tcllib/modules/pop3/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | tcllib/modules/pop3/pop3.man | 274 | ||||
-rw-r--r-- | tcllib/modules/pop3/pop3.tcl | 830 | ||||
-rw-r--r-- | tcllib/modules/pop3/pop3.test | 611 |
5 files changed, 2136 insertions, 0 deletions
diff --git a/tcllib/modules/pop3/ChangeLog b/tcllib/modules/pop3/ChangeLog new file mode 100644 index 0000000..97e5e38 --- /dev/null +++ b/tcllib/modules/pop3/ChangeLog @@ -0,0 +1,419 @@ +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2012-01-10 Andreas Kupries <andreask@activestate.com> + + * pop3.test: Requiring Tcl 8.4 here as well. + + * pop3.tcl: [Bug 3471474]: Fixed bug where the socketcmd was not + * pop3.man: treated as cmdprefix as documented, but as command + * pkgIndex.tcl: name. Dropped supported for 8.2 and moved forward + to require Tcl 8.4. Keep the 8.4-ism of 'eq'. Bumped the version + to 1.9. + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-11-08 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test (pop3-7.0): Updated for additional configure options + returned by peek, plus same change to the socket handle handling + as for pop3-0.8, see below. + +2011-11-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test (pop3-0.8): Modified the test case matching a bit to + handle the fact that under 8.6 a socket channel handle may + contain hex data after the general prefix, instead of just + digits. + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2011-01-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Fixed tests results to list the new options. + * pop3.tcl: Fixed issue with closing during open introduced by the + patch. When a connect error occurs we cannot send a QUIT any + longer, and have to close the socket directly. + +2011-01-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.tcl: Extended package with STARTTLS support provided by + * pop3.man: Pascal Scheffers. This switches a regular connection + * pkgIndex.tcl: over to SSL/TLS. Version bumped to 1.8. + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2009-09-28 Andreas Kupries <andreask@activestate.com> + + * pop3.test: Moved the dialog setup for test pop3-7.0 into the + test, to ensure that it is not run if TLS is not available. + +2009-04-13 Andreas Kupries <andreask@activestate.com> + + * pop3.tcl (::pop3::open): Extended to accept a new option + * pop3.man: -socketcmd, through which the user can override the + * pop3.test: way the connection is opened. Primary use is securing + * pkgIndex.tcl: of the connection via SSL (package tls, command + tls::socket). Updated documentation. Extended testsuite. Bumped + package version to 1.7. + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-08-08 Andreas Kupries <andreask@activestate.com> + + * pop3.test: And snit is loaded by coserv.tcl too, no explicit + load required. + +2007-08-01 Andreas Kupries <andreask@activestate.com> + + * pop3.test: Updated to new snit dependency in comm. + +2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.man: Fixed all warnings due to use of now deprecated + commands. Added a section about how to give feedback. + +2006-10-29 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Made pop3-0.5 more robust, accept more than just + 'connection refused' as proper failure to connect. Like 'timed + out'. + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-09-28 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Added use of local log package, fixed bug in dialog + setup for testcases pop3-2.4 and -2.5, extended these two test + cases to have the dialog trace in their result. + +2006-01-28 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Fixed cleanup of temp. files used by testsuite. + +2006-01-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: More boilerplate simplified via use of test support. + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Hooked into the new common test support code. + +2006-01-10 Andreas Kupries <andreask@activestate.com> + + * pop3.test: Fixed [SF Tcllib Bug 1316056]. Uncluttering test + output. + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2004-10-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * clnt.tcl: Removed old unused code. It was part of the testsuite + * srv.tcl: in the very beginning. It was unused in the first + rewrite to the old sub process and dialog facility. + + * pop3.test: Rewritten to use the new facilities for programmed + interaction and sub processes. + + * pop3.tcl (::pop3::open): Capitalized the user and pass + commands. Every command in the wire is now fully capitalized. + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-08-25 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Added code to remove the temp. file containing the + server log. + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6.1 ======================== + * + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2004-01-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pkgIndex.tcl: Version bumped up to 1.6.1. + * pop3.man: + + * pop3.test: New test for the corner case. + * pop3.tcl (::pop3::RetrFast): Thanks to Clif Flynt for reporting a + new corner case I had not considered in the fast/slow + transition code, plus patch. Modified a number of string + comparisons, using [string equal] instead of "==" (Improved + performance due to less conversion and less checking for + numerics, and possibly bytecompilation in Tcl 8.4+). + +2003-11-18 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.tcl (pop3::open): Remembering initial count of messages, as + limit for message ids. + (pop3::delete): Replaced [status] call with access to stored + limit for validation of message ids. + (pop3::retrieve): Ditto. + The changes above fix [SF Tcllib Bug 833486]. + + * pop3.test: Updated testsuite to the changes in the sequences of + pop3 commands (New STAT after PASS, and no STAT before + LAST/RETR, nor before LAST/DELE). + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-05-02 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Creating the name of the file containing the fake + server only once. Because the tcltest 1.0 [makeFile] coming with + Tcl 8.2 will return the fully generated name only once, and not + everytime it is called. + +2003-04-21 Andreas Kupries <andreask@activestate.com> + + * pop3.test (0.6): Fixed test 0.6, removed dependency on service + running on port 25 (smtp), using fake service on some free port + instead. + +2003-04-11 Andreas Kupries <andreask@activestate.com> + + * pop3.tcl: + * pop3.man: + * pkgIndex.tcl: Set version of the package to to 1.6 + +2003-04-09 Andreas Kupries <andreask@activestate.com> + + * pop3.man: Documented new API. + + * pop3.tcl: More logging of internal activity. Final nail into the + bug #528928 (Additional border cases were not handled yet, + incorrect handling detected through the new testsuite). + + New API 'pop3::config'. + + * pop3.test: Testsuite rewritten. Uses the sub-process and server + support provided by the new module 'devtools'. Avoids the stdin + lockup on windows. Uses a micro server for fixed responses to + the client instead of a true pop3 server, simplifies the + testing, less external dependencies, also better control over + the data sent to the client = easier to create intentionally + (semi-)bogus information to stress border cases. + +2003-04-03 Andreas Kupries <andreask@activestate.com> + + * pop3.tcl: Fixed bug in the new code which wasn't found because + that case was untestable when using a full-blown pop3 demon (Was + unable to construct a message which caused the boundary + condition to ocur in the client). Found using the microserver + code. + + * pop3.test: Removed test case planned to test the above mentioned + boundary case. Added code for a microserver based testcase which + does exercize the condition. Deactivated as microserver is not + yet part of tcllib. + + * pop3.test: + * srv.tcl: Corrected leftover changes from yesterday which should + not have been in the commit. I.e. reactivated reporting and + correct cleanup. + +2003-04-02 Andreas Kupries <andreask@activestate.com> + + * srv.tcl: + * pop3.test: Added tests and messages for bug #528928. + + * pop3.tcl (pop3::open): Bug fix, close channel to server when + talking to it fails (no greeting, login failure). This cleans up + a leak of open sockets. + + (pop3::RetrFast): Fixed bug #528928 where a .-stuffed line was + misinterpreted as mail terminator. + +2003-01-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.man: More semantic markup, less visual one. + +2002-10-14 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Updated to expect 10 messages in pop3-6.0. + * srv.tcl: Initialize server with 10 messages. Divert log output + to server log. Prevents hangs in pop3-6.0. + + * pop3.tcl (pop3::retrieve): Changed conditionals around [scan] to + check for the actual number of conversions required to make the + code work, instead of < 0. This fixes bug 620062. + +2002-09-04 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * srv.tcl: Extended to cleanup the fake maildrop directories when + exiting the server. + + * pop3.test: Updated to handle differences between 8.3 and 8.4 + (different error messages). Added code to suppress logging under + normal circumstances. Extended to clean up the log file created + by the test pop3 server. + +2002-09-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.test: Added testcase 6.0, a nano-client to retrieve and + delete all messages on a pop server in one go. Directly derived + from the script for Tcllib bug #501577. Unable to reproduce that + bug :( + + * pop3.test: + * clnt.tcl: + * srv.tcl: Added testsuite. Incomplete. No test of 'delete' + command yet. The problems found by the testsuite so far were all + in the used pop3 server (pop3d module of tcllib). + +2002-03-25 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.man: New file, doctools manpage. + +2002-01-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * Bumped version to 1.5.1 + +2001-12-11 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.tcl (retrieve): Forgot several 'RETR $index' + commands. Fixed now. This is tcllib bug item #490151 reported by + an unknown person. + +2001-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.n: + * pop3.tcl: + * pkgIndex.tcl: Version up to 1.5 + +2001-08-20 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.tcl: Added UIDL command, patch [448634] by Mark G. Saye + <markgsaye@users.sourceforge.net>. Code was added manually as + the patch was not applicable anymore after the recent changes + (see below). Updated implementation of UIDL to use the new + command [RetrSlow] instead of performing the retrieval by + itself. Also updated the implementations of the TOP and LIST + commands to do the same. + +2001-08-02 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.n: Updated to new package version, see [447013] too. + + * pop3.tcl: Lots of changes with regard to items [443613] and + [443645]. Switched auto back to binary (or else the counting of + octects is not right and we will hang trying to read more than + is coming from the server). This means we have to perform EOL + translation on the message on our own, this was effectively an + unreported bug. also unreported was that the faster code did not + do .-unstuffing, which the slower line-by-line code did. This is + now fixed too. My thanks to Ashwin Hirschi + <deery@users.sourceforge.net> for his help in testing the code. + +2001-07-31 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pkgIndex.tcl: Updated to reflect pkg version in the code. After + the fact comment: This also fixes SF bug [447013] + + * pop3.tcl: Added 'state' variable to remember state information + about the active (= open) pop3 connections. This state includes + information about the retrieval mode to use and whether we are + talking to an MS Exchange server or not. MS Exchange can't be + set automatically for now, but the retrieval mode is + auto-detected. Because of the former, pop3::open now accepts the + options -msex and -retr-mode. This should allay and fix the SF + bugs [443613] and [443645]. + + (pop3::list): Fixed bug [443619]. + +2001-06-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pop3.tcl: Fixed dubious code reported by frink. + +2001-01-24 Scott Redman <redman@tivo.com> + + * pop3.tcl: Fixed a bug when getting the "." back + with extra \r by adding a [string trimright $line]. + Reported by Joe English, [bug: 124477]. + +2000-09-14 Scott Redman <redman@ajubasolutions.com> + + * pop3.tcl: Based on feedback from Cameron Laird, I did some + digging into the RFC and figured out that using the number of + octets given by RETR at the beginning of the retrieval to grab + that number of bytes was far more efficient. Thanks to Cameron + for pointing that out. Speed for retrieval should be greatly + improved. Changed version to 1.1. + +2000-05-18 Scott Redman <redman@scriptics.com> + + * pop3.tcl: + * pop3.n: Applied patch from Petteri Kettunen to add the LIST and + TOP implementations. See RFC1939. Also removed a spurious puts + command. [bug: 5426] + +2000-05-17 Scott Redman <redman@scriptics.com> + + * pop3.tcl: Remove extra '.'s added by the POP3 server. If a + line begins with a '.', the server will add a '.' to the line to + prevent confusion with the end-of-message character (which is also + '.'). [bug: 5522] + +2000-03-06 Scott Redman <redman@scriptics.com> + + * ChangeLog: + * man.macros: + * pkgIndex.tcl: + * pop3.n: + * pop3.tcl: New POP3 email client API, inspired by Scott + Beasley's "frenchie" email client program. diff --git a/tcllib/modules/pop3/pkgIndex.tcl b/tcllib/modules/pop3/pkgIndex.tcl new file mode 100644 index 0000000..a104789 --- /dev/null +++ b/tcllib/modules/pop3/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide Tcl] 8.4]} {return} +package ifneeded pop3 1.9 [list source [file join $dir pop3.tcl]] diff --git a/tcllib/modules/pop3/pop3.man b/tcllib/modules/pop3/pop3.man new file mode 100644 index 0000000..829fb29 --- /dev/null +++ b/tcllib/modules/pop3/pop3.man @@ -0,0 +1,274 @@ +[manpage_begin pop3 n 1.9] +[keywords email] +[keywords mail] +[keywords pop] +[keywords pop3] +[keywords {rfc 1939}] +[keywords secure] +[keywords ssl] +[keywords tls] +[comment {-*- tcl -*- doctools manpage}] +[moddesc {Tcl POP3 Client Library}] +[titledesc {Tcl client for POP3 email protocol}] +[category Networking] +[require Tcl 8.4] +[require pop3 [opt 1.9]] +[description] + +The [package pop3] package provides a simple Tcl-only client library +for the POP3 email protocol as specified in +[uri http://www.rfc-editor.org/rfc/rfc1939.txt {RFC 1939}]. + +It works by opening the standard POP3 socket on the server, +transmitting the username and password, then providing a Tcl API to +access the POP3 protocol commands. All server errors are returned as +Tcl errors (thrown) which must be caught with the Tcl [cmd catch] +command. + +[include ../common-text/tls-security-notes.inc] + +[section API] + +[list_begin definitions] + +[call [cmd ::pop3::open] \ + [opt "[option -msex] 0|1"] \ + [opt "[option -retr-mode] retr|list|slow"] \ + [opt "[option -socketcmd] cmdprefix"] \ + [opt "[option -stls] 0|1"] \ + [opt "[option -tls-callback] stls-callback-command"] \ + [arg {host username password}] [opt [arg port]]] + +Open a socket connection to the server specified by [arg host], +transmit the [arg username] and [arg password] as login information to +the server. The default port number is [const 110], which can be +overridden using the optional [arg port] argument. The return value +is a channel used by all of the other ::pop3 functions. + +[para] + +The command recognizes three options + +[list_begin options] + +[opt_def -msex boolean] + +Setting this option tells the package that the server we are talking +to is an MS Exchange server (which has some oddities we have to work +around). The default is [const False]. + +[opt_def -retr-mode retr|list|slow] + +The retrieval mode determines how exactly messages are read from the +server. + +The allowed values are [const retr], [const list] and [const slow]. +The default is [const retr]. See [cmd ::pop3::retrieve] for more +information. + +[opt_def -socketcmd cmdprefix] + +This option allows the user to overide the use of the builtin +[cmd socket] command with any API-compatible command. The envisioned +main use is the securing of the new connection via SSL, through the +specification of the command [cmd tls::socket]. This command is +specially recognized as well, changing the default port of the +connection to [const 995]. + +[opt_def -stls boolean] + +Setting this option tells the package to secure the connection using +SSL or TLS. It performs STARTTLS as described in IETF RFC 2595, it +first opens a normal, unencrypted connection and then negotiates a +SSLv3 or TLSv1 connection. If the connection cannot be secured, the +connection will be closed and an error will be returned + +[opt_def -tls-callback stls-callback-command] + +This option allows the user to overide the [cmd tls::callback] used during +the [const -stls] SSL/TLS handshake. See the TLS manual for details on how +to implement this callback. + +[list_end] + +[call [cmd ::pop3::config] [arg chan]] + +Returns the configuration of the pop3 connection identified by the +channel handle [arg chan] as a serialized array. + +[call [cmd ::pop3::status] [arg chan]] + +Query the server for the status of the mail spool. The status is +returned as a list containing two elements, the first is the number of +email messages on the server and the second is the size (in octets, 8 +bit blocks) of the entire mail spool. + +[call [cmd ::pop3::last] [arg chan]] + +Query the server for the last email message read from the spool. This +value includes all messages read from all clients connecting to the +login account. This command may not be supported by the email server, +in which case the server may return 0 or an error. + +[call [cmd ::pop3::retrieve] [arg {chan startIndex}] [opt [arg endIndex]]] + +Retrieve a range of messages from the server. If the [arg endIndex] +is not specified, only one message will be retrieved. The return +value is a list containing each message as a separate element. See +the [arg startIndex] and [arg endIndex] descriptions below. + +[para] + +The retrieval mode determines how exactly messages are read from the +server. The mode [const retr] assumes that the RETR command delivers +the size of the message as part of the command status and uses this to +read the message efficiently. In mode [const list] RETR does not +deliver the size, but the LIST command does and we use this to +retrieve the message size before the actual retrieval, which can then +be done efficiently. In the last mode, [const slow], the system is +unable to obtain the size of the message to retrieve in any manner and +falls back to reading the message from the server line by line. + +[para] + +It should also be noted that the system checks upon the configured +mode and falls back to the slower modes if the above assumptions are +not true. + +[call [cmd ::pop3::delete] [arg {chan startIndex}] [opt [arg endIndex]]] + +Delete a range of messages from the server. If the [arg endIndex] is +not specified, only one message will be deleted. Note, the indices +are not reordered on the server, so if you delete message 1, then the +first message in the queue is message 2 (message index 1 is no longer +valid). See the [arg startIndex] and [arg endIndex] descriptions +below. + +[list_begin definitions] + +[def [arg startIndex]] + +The [arg startIndex] may be an index of a specific message starting +with the index 1, or it have any of the following values: + +[list_begin definitions] + +[def [const start]] + +This is a logical value for the first message in the spool, equivalent +to the value 1. + +[def [const next]] + +The message immediately following the last message read, see +[cmd ::pop3::last]. + +[def [const end]] + +The most recent message in the spool (the end of the spool). This is +useful to retrieve only the most recent message. + +[list_end] + +[def [arg endIndex]] + +The [arg endIndex] is an optional parameter and defaults to the value +"-1", which indicates to only retrieve the one message specified by + +[arg startIndex]. If specified, it may be an index of a specific +message starting with the index "1", or it may have any of the +following values: + +[list_begin definitions] + +[def [const last]] + +The message is the last message read by a POP3 client, see +[cmd ::pop3::last]. + +[def [const end]] + +The most recent message in the spool (the end of the spool). + +[list_end] +[list_end] + +[call [cmd ::pop3::list] [arg chan] [opt [arg msg]]] + +Returns the scan listing of the mailbox. If parameter [arg msg] is +given, then the listing only for that message is returned. + +[call [cmd ::pop3::top] [arg chan] [arg msg] [arg n] ] + +Optional POP3 command, not all servers may support this. + +[cmd ::pop3::top] retrieves headers of a message, specified by +parameter [arg msg], and number of [arg n] lines from the message +body. + +[call [cmd ::pop3::uidl] [arg chan] [opt [arg msg]]] + +Optional POP3 command, not all servers may support this. + +[cmd ::pop3::uidl] returns the uid listing of the mailbox. If the +parameter [arg msg] is specified, then the listing only for that +message is returned. + +[call [cmd ::pop3::capa] [arg chan]] + +Optional POP3 command, not all servers may support this. + +[cmd ::pop3::capa] returns a list of the capabilities of the server. +TOP, SASL, UIDL, LOGIN-DELAY and STLS are typical capabilities. + +See IETF RFC 2449. + +[call [cmd ::pop3::close] [arg chan]] + +Gracefully close the connect after sending a POP3 QUIT command down +the socket. + +[list_end] + +[section {Secure mail transfer}] + +A pop3 connection can be secured with SSL/TLS by requiring the package +[package TLS] and then using either the option [option -socketcmd] or +the option [option -stls] of the command [cmd pop3::open]. + +The first method, option [option -socketcmd], will force the use +of the [cmd tls::socket] command when opening the connection. This is +suitable for POP3 servers which expect SSL connections only. These will +generally be listening on port 995. + +[example { + package require tls + tls::init -cafile /path/to/ca/cert -keyfile ... + + # Create secured pop3 channel + pop3::open -socketcmd tls::socket \\ + $thehost $theuser $thepassword + + ... +}] + +The second method, option [option -stls], will connect to the standard POP3 +port and then perform an STARTTLS handshake. This will only work for POP3 +servers which have this capability. The package will confirm that the +server supports STARTTLS and the handshake was performed correctly before +proceeding with authentication. + +[example { + package require tls + tls::init -cafile /path/to/ca/cert -keyfile ... + + # Create secured pop3 channel + pop3::open -stls 1 \\ + $thehost $theuser $thepassword + + ... +}] + +[vset CATEGORY pop3] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/pop3/pop3.tcl b/tcllib/modules/pop3/pop3.tcl new file mode 100644 index 0000000..1c467e6 --- /dev/null +++ b/tcllib/modules/pop3/pop3.tcl @@ -0,0 +1,830 @@ +# pop3.tcl -- +# +# POP3 mail client package, written in pure Tcl. +# Some concepts borrowed from "frenchie", a POP3 +# mail client utility written by Scott Beasley. +# +# Copyright (c) 2000 by Ajuba Solutions. +# portions Copyright (c) 2000 by Scott Beasley +# portions Copyright (c) 2010-2012 Andreas Kupries +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: pop3.tcl,v 1.38 2012/01/10 20:02:22 andreas_kupries Exp $ + +package require Tcl 8.4 +package require cmdline +package require log +package provide pop3 1.9 + +namespace eval ::pop3 { + + # The state variable remembers information about the open pop3 + # connection. It is indexed by channel id. The information is + # a keyed list, with keys "msex" and "retr_mode". The value + # associated with "msex" is boolean, a true value signals that the + # server at the other end is MS Exchange. The value associated + # with "retr_mode" is one of {retr, list, slow}. + + # The value of "msex" influences how the translation for the + # channel is set and is determined by the contents of the received + # greeting. The value of "retr_mode" is initially "retr" and + # completely determined by the first call to [retrieve]. For "list" + # the system will use LIST before RETR to retrieve the message size. + + # The state can be influenced by options given to "open". + + variable state + array set state {} + +} + +# ::pop3::config -- +# +# Retrieve configuration of pop3 connection +# +# Arguments: +# chan The channel, returned by ::pop3::open +# +# Results: +# A serialized array. + +proc ::pop3::config {chan} { + variable state + return $state($chan) +} + +# ::pop3::close -- +# +# Close the connection to the POP3 server. +# +# Arguments: +# chan The channel, returned by ::pop3::open +# +# Results: +# None. + +proc ::pop3::close {chan} { + variable state + catch {::pop3::send $chan "QUIT"} + unset state($chan) + ::close $chan + return +} + +# ::pop3::delete -- +# +# Delete messages on the POP3 server. +# +# Arguments: +# chan The channel, returned by ::pop3::open +# start The first message to delete in the range. +# May be "next" (the next message after the last +# one seen, see ::pop3::last), "start" (aka 1), +# "end" (the last message in the spool, for +# deleting only the last message). +# end (optional, defaults to -1) The last message +# to delete in the range. May be "last" +# (the last message viewed), "end" (the last +# message in the spool), or "-1" (the default, +# any negative number means delete only +# one message). +# +# Results: +# None. +# May throw errors from the server. + +proc ::pop3::delete {chan start {end -1}} { + + variable state + array set cstate $state($chan) + set count $cstate(limit) + set last 0 + catch {set last [::pop3::last $chan]} + + if {![string is integer $start]} { + if {[string match $start "next"]} { + set start $last + incr start + } elseif {$start == "start"} { + set start 1 + } elseif {$start == "end"} { + set start $count + } else { + error "POP3 Deletion error: Bad start index $start" + } + } + if {$start == 0} { + set start 1 + } + + if {![string is integer $end]} { + if {$end == "end"} { + set end $count + } elseif {$end == "last"} { + set end $last + } else { + error "POP3 Deletion error: Bad end index $end" + } + } elseif {$end < 0} { + set end $start + } + + if {$end > $count} { + set end $count + } + + for {set index $start} {$index <= $end} {incr index} { + if {[catch {::pop3::send $chan "DELE $index"} errorStr]} { + error "POP3 DELETE ERROR: $errorStr" + } + } + return {} +} + +# ::pop3::last -- +# +# Gets the index of the last email read from the server. +# Note, some POP3 servers do not support this feature, +# in which case the value returned may always be zero, +# or an error may be thrown. +# +# Arguments: +# chan The channel, returned by ::pop3::open +# +# Results: +# The index of the last email message read, which may +# be zero if none have been read or if the server does +# not support this feature. +# Server errors may be thrown, including some cases +# when the LAST command is not supported. + +proc ::pop3::last {chan} { + + if {[catch { + set resultStr [::pop3::send $chan "LAST"] + } errorStr]} { + error "POP3 LAST ERROR: $errorStr" + } + + return [string trim $resultStr] +} + +# ::pop3::list -- +# +# Returns "scan listing" of the mailbox. If parameter msg +# is defined, then the listing only for the given message +# is returned. +# +# Arguments: +# chan The channel open to the POP3 server. +# msg The message number (optional). +# +# Results: +# If msg parameter is not given, Tcl list of scan listings in +# the maildrop is returned. In case msg parameter is given, +# a list of length one containing the specified message listing +# is returned. + +proc ::pop3::list {chan {msg ""}} { + global PopErrorNm PopErrorStr debug + + if {$msg == ""} { + if {[catch {::pop3::send $chan "LIST"} errorStr]} { + error "POP3 LIST ERROR: $errorStr" + } + set msgBuffer [RetrSlow $chan] + } else { + # argument msg given, single-line response expected + + if {[catch {expr {0 + $msg}}]} { + error "POP3 LIST ERROR: malformed message number '$msg'" + } else { + set msgBuffer [string trim [::pop3::send $chan "LIST $msg"]] + } + } + return $msgBuffer +} + +# pop3::open -- +# +# Opens a connection to a POP3 mail server. +# +# Arguments: +# args A list of options and values, possibly empty, +# followed by the regular arguments, i.e. host, user, +# passwd and port. The latter is optional. +# +# host The name or IP address of the POP3 server host. +# user The username to use when logging into the server. +# passwd The password to use when logging into the server. +# port (optional) The socket port to connect to, defaults +# to port 110, the POP standard port address. +# +# Results: +# The connection channel (a socket). +# May throw errors from the server. + +proc ::pop3::open {args} { + variable state + array set cstate {socketcmd ::socket msex 0 retr_mode retr limit {} stls 0 tls-callback {}} + + log::log debug "pop3::open | [join $args]" + + while {[set err [cmdline::getopt args { + msex.arg + retr-mode.arg + socketcmd.arg + stls.arg + tls-callback.arg + } opt arg]]} { + if {$err < 0} { + return -code error "::pop3::open : $arg" + } + switch -exact -- $opt { + msex { + if {![string is boolean $arg]} { + return -code error \ + ":pop3::open : Argument to -msex has to be boolean" + } + set cstate(msex) $arg + } + retr-mode { + switch -exact -- $arg { + retr - list - slow { + set cstate(retr_mode) $arg + } + default { + return -code error \ + ":pop3::open : Argument to -retr-mode has to be one of retr, list or slow" + } + } + } + socketcmd { + set cstate(socketcmd) $arg + } + stls { + if {![string is boolean $arg]} { + return -code error \ + ":pop3::open : Argument to -tls has to be boolean" + } + set cstate(stls) $arg + } + tls-callback { + set cstate(tls-callback) $arg + } + default { + # Can't happen + } + } + } + + if {[llength $args] > 4} { + return -code error "To many arguments to ::pop3::open" + } + if {[llength $args] < 3} { + return -code error "Not enough arguments to ::pop3::open" + } + foreach {host user password port} $args break + if {$port == {}} { + if {([lindex $cstate(socketcmd) 0] eq "tls::socket") || + ([lindex $cstate(socketcmd) 0] eq "::tls::socket")} { + # Standard port for SSL-based pop3 connections. + set port 995 + } else { + # Standard port for any other type of connection. + set port 110 + } + } + + log::log debug "pop3::open | protocol, connect to $host $port" + + # Argument processing is finally complete, now open the channel + + set chan [eval [linsert $cstate(socketcmd) end $host $port]] + fconfigure $chan -buffering none + + log::log debug "pop3::open | connect on $chan" + + if {$cstate(msex)} { + # We are talking to MS Exchange. Work around its quirks. + fconfigure $chan -translation binary + } else { + fconfigure $chan -translation {binary crlf} + } + + log::log debug "pop3::open | wait for greeting" + + if {[catch {::pop3::send $chan {}} errorStr]} { + ::close $chan + return -code error "POP3 CONNECT ERROR: $errorStr" + } + + if {0} { + # -FUTURE- Identify MS Exchange servers + set cstate(msex) 1 + + # We are talking to MS Exchange. Work around its quirks. + fconfigure $chan -translation binary + } + + if {$cstate(stls)} { + log::log debug "pop3::open | negotiating TLS on $chan" + if {[catch { + set capa [::pop3::capa $chan] + log::log debug "pop3::open | Server $chan can $capa" + } errorStr]} { + close $chan + return -code error "POP3 CONNECT/STLS ERROR: $errorStr" + } + + if { [lsearch -exact $capa STLS] == -1} { + log::log debug "pop3::open | Server $chan can't STLS" + close $chan + return -code error "POP CONNECT ERROR: STLS requested but not supported by server" + } + log::log debug "pop3::open | server can TLS on $chan" + + if {[catch { + ::pop3::send $chan "STLS" + } errorStr]} { + close $chan + return -code error "POP3 STLS ERROR: $errorStr" + } + + package require tls + + log::log debug "pop3::open | tls::import $chan" + # Explicitly disable ssl2 and only allow ssl3 and tlsv1. Although the defaults + # will work with most servers, ssl2 is really, really old and is deprecated. + if {$cstate(tls-callback) ne ""} { + set newchan [tls::import $chan -ssl2 0 -ssl3 1 -tls1 1 -cipher SSLv3,TLSv1 -command $cstate(tls-callback)] + } else { + set newchan [tls::import $chan -ssl2 0 -ssl3 1 -tls1 1 -cipher SSLv3,TLSv1] + } + + if {[catch { + log::log debug "pop3::open | tls::handshake $chan" + tls::handshake $chan + } errorStr]} { + close $chan + return -code error "POP3 CONNECT/TLS HANDSHAKE ERROR: $errorStr" + } + + array set security [tls::status $chan] + set sbits 0 + if { [info exists security(sbits)] } { + set sbits $security(sbits) + } + if { $sbits == 0 } { + close $chan + return -code error "POP3 CONNECT/TLS: TLS Requested but not available" + } elseif { $sbits < 128 } { + close $chan + return -code error "POP3 CONNECT/TLS: TLS Requested but insufficient (<128bits): $sbits" + } + + log::log debug "pop3::open | $chan now in $sbits bit TLS mode ($security(cipher))" + } + + log::log debug "pop3::open | authenticate $user (*password not shown*)" + + if {[catch { + ::pop3::send $chan "USER $user" + ::pop3::send $chan "PASS $password" + } errorStr]} { + ::close $chan + return -code error "POP3 LOGIN ERROR: $errorStr" + } + + # [ 833486 ] Can't delete messages one at a time ... + # Remember the number of messages in the maildrop at the beginning + # of the session. This gives us the highest possible number for + # message ids later. Note that this number must not be affected + # when deleting mails later. While the number of messages drops + # down the limit for the message id's stays the same. The messages + # are not renumbered before the session actually closed. + + set cstate(limit) [lindex [::pop3::status $chan] 0] + + # Remember the state. + + set state($chan) [array get cstate] + + log::log debug "pop3::open | ok ($chan)" + return $chan +} + +# ::pop3::retrieve -- +# +# Retrieve email message(s) from the server. +# +# Arguments: +# chan The channel, returned by ::pop3::open +# start The first message to retrieve in the range. +# May be "next" (the next message after the last +# one seen, see ::pop3::last), "start" (aka 1), +# "end" (the last message in the spool, for +# retrieving only the last message). +# end (optional, defaults to -1) The last message +# to retrieve in the range. May be "last" +# (the last message viewed), "end" (the last +# message in the spool), or "-1" (the default, +# any negative number means retrieve only +# one message). +# +# Results: +# A list containing all of the messages retrieved. +# May throw errors from the server. + +proc ::pop3::retrieve {chan start {end -1}} { + variable state + array set cstate $state($chan) + + set count $cstate(limit) + set last 0 + catch {set last [::pop3::last $chan]} + + if {![string is integer $start]} { + if {[string match $start "next"]} { + set start $last + incr start + } elseif {$start == "start"} { + set start 1 + } elseif {$start == "end"} { + set start $count + } else { + error "POP3 Retrieval error: Bad start index $start" + } + } + if {$start == 0} { + set start 1 + } + + if {![string is integer $end]} { + if {$end == "end"} { + set end $count + } elseif {$end == "last"} { + set end $last + } else { + error "POP3 Retrieval error: Bad end index $end" + } + } elseif {$end < 0} { + set end $start + } + + if {$end > $count} { + set end $count + } + + set result {} + + ::log::log debug "pop3 $chan retrieve $start -- $end" + + for {set index $start} {$index <= $end} {incr index} { + switch -exact -- $cstate(retr_mode) { + retr { + set sizeStr [::pop3::send $chan "RETR $index"] + + ::log::log debug "pop3 $chan retrieve ($sizeStr)" + + if {[scan $sizeStr {%d %s} size dummy] < 1} { + # The server did not deliver the size information. + # Switch our mode to "list" and use the slow + # method this time. The next call will use LIST before + # RETR to get the size information. If even that fails + # the system will fall back to slow mode all the time. + + ::log::log debug "pop3 $chan retrieve - no size information, go slow" + + set cstate(retr_mode) list + set state($chan) [array get cstate] + + # Retrieve in slow motion. + set msgBuffer [RetrSlow $chan] + } else { + ::log::log debug "pop3 $chan retrieve - size information present, use fast mode" + + set msgBuffer [RetrFast $chan $size] + } + } + list { + set sizeStr [::pop3::send $chan "LIST $index"] + + if {[scan $sizeStr {%d %d %s} dummy size dummy] < 2} { + # Not even LIST generates the necessary size information. + # Switch to full slow mode and don't bother anymore. + + set cstate(retr_mode) slow + set state($chan) [array get cstate] + + ::pop3::send $chan "RETR $index" + + # Retrieve in slow motion. + set msgBuffer [RetrSlow $chan] + } else { + # Ignore response of RETR, already know the size + # through LIST + + ::pop3::send $chan "RETR $index" + set msgBuffer [RetrFast $chan $size] + } + } + slow { + # Retrieve in slow motion. + + ::pop3::send $chan "RETR $index" + set msgBuffer [RetrSlow $chan] + } + } + lappend result $msgBuffer + } + return $result +} + +# ::pop3::RetrFast -- +# +# Fast retrieval of a message from the pop3 server. +# Internal helper to prevent code bloat in "pop3::retrieve" +# +# Arguments: +# chan The channel to read the message from. +# +# Results: +# The text of the retrieved message. + +proc ::pop3::RetrFast {chan size} { + set msgBuffer [read $chan $size] + + foreach line [split $msgBuffer \n] { + ::log::log debug "pop3 $chan fast <$line>" + } + + # There is a small discrepance in counting octets we have to be + # aware of. 'size' is #octets before transmission, i.e. can be + # with one eol character, CR or LF. The channel system in binary + # mode counts every character, and the protocol specified CRLF as + # eol, so for every line in the message we read that many + # characters _less_. Another factor which can cause a miscount is + # the ".-stuffing performed by the sender. I.e. what we got now is + # not necessarily the complete message. We have to perform slow + # reads to get the remainder of the message. This has another + # complication. We cannot simply check for a line containing the + # terminating signature, simply because the point where the + # message was broken in two might just be in between the dots of a + # "\r\n..\r\n" sequence. We have to make sure that we do not + # misinterpret the second part of this sequence as terminator. + # Another possibility: "\r\n.\r\n" is broken just after the dot. + # Then we have to ensure to not to miss the terminator entirely. + + # Sometimes the gets returns nothing, need to get the real + # terminating "." / " + + if {[string equal [string range $msgBuffer end-3 end] "\n.\r\n"]} { + # Complete terminator found. Remove it from the message buffer. + + ::log::log debug "pop3 $chan /5__" + set msgBuffer [string range $msgBuffer 0 end-3] + + } elseif {[string equal [string range $msgBuffer end-2 end] "\n.\r"]} { + # Complete terminator found. Remove it from the message buffer. + # Also perform an empty read to remove the missing '\n' from + # the channel. If we don't do this all following commands will + # run into off-by-one (character) problems. + + ::log::log debug "pop3 $chan /4__" + set msgBuffer [string range $msgBuffer 0 end-2] + while {[read $chan 1] != "\n"} {} + + } elseif {[string equal [string range $msgBuffer end-1 end] "\n."]} { + # \n. at the end of the fast buffer. + # Can be \n.\r\n = Terminator + # or \n..\r\n = dot-stuffed single . + + log::log debug "pop3 $chan /check for cut .. or terminator sequence" + + # Idle until non-empty line encountered. + while {[set line [gets $chan]] == ""} {} + if {"$line" == "\r"} { + # Terminator already found. Note that we have to + # remove the partial terminator sequence from the + # message buffer. + ::log::log debug "pop3 $chan /3__ <$line>" + set msgBuffer [string range $msgBuffer 0 end-1] + } else { + # Append line and look for the real terminator + append msgBuffer $line + ::log::log debug "pop3 $chan ____ <$line>" + while {[set line [gets $chan]] != ".\r"} { + ::log::log debug "pop3 $chan ____ <$line>" + append msgBuffer $line + } + ::log::log debug "pop3 $chan /2__ <$line>" + } + } elseif {[string equal [string index $msgBuffer end] \n]} { + # Line terminator (\n) found. The remainder of the mail has to + # consist of true lines we can read directly. + + while {![string equal [set line [gets $chan]] ".\r"]} { + ::log::log debug "pop3 $chan ____ <$line>" + append msgBuffer $line + } + ::log::log debug "pop3 $chan /1__ <$line>" + } else { + # Incomplete line at the end of the buffer. We complete it in + # a single read, and then handle the remainder like the case + # before, where we had a complete line at the end of the + # buffer. + + set line [gets $chan] + ::log::log debug "pop3 $chan /1a_ <$line>" + append msgBuffer $line + + ::log::log debug "pop3 $chan /1b_" + + while {![string equal [set line [gets $chan]] ".\r"]} { + ::log::log debug "pop3 $chan ____ <$line>" + append msgBuffer $line + } + ::log::log debug "pop3 $chan /1c_ <$line>" + } + + ::log::log debug "pop3 $chan done" + + # Map both cr+lf and cr to lf to simulate auto EOL translation, then + # unstuff .-stuffed lines. + + return [string map [::list \n.. \n.] [string map [::list \r \n] [string map [::list \r\n \n] $msgBuffer]]] +} + +# ::pop3::RetrSlow -- +# +# Slow retrieval of a message from the pop3 server. +# Internal helper to prevent code bloat in "pop3::retrieve" +# +# Arguments: +# chan The channel to read the message from. +# +# Results: +# The text of the retrieved message. + +proc ::pop3::RetrSlow {chan} { + + set msgBuffer "" + + while {1} { + set line [string trimright [gets $chan] \r] + ::log::log debug "pop3 $chan slow $line" + + # End of the message is a line with just "." + if {$line == "."} { + break + } elseif {[string index $line 0] == "."} { + set line [string range $line 1 end] + } + + append msgBuffer $line "\n" + } + + return $msgBuffer +} + +# ::pop3::send -- +# +# Send a command string to the POP3 server. This is an +# internal function, but may be used in rare cases. +# +# Arguments: +# chan The channel open to the POP3 server. +# cmdstring POP3 command string +# +# Results: +# Result string from the POP3 server, except for the +OK tag. +# Errors from the POP3 server are thrown. + +proc ::pop3::send {chan cmdstring} { + global PopErrorNm PopErrorStr debug + + if {$cmdstring != {}} { + ::log::log debug "pop3 $chan >>> $cmdstring" + puts $chan $cmdstring + } + + set popRet [string trim [gets $chan]] + ::log::log debug "pop3 $chan <<< $popRet" + + if {[string first "+OK" $popRet] == -1} { + error [string range $popRet 4 end] + } + + return [string range $popRet 3 end] +} + +# ::pop3::status -- +# +# Get the status of the mail spool on the POP3 server. +# +# Arguments: +# chan The channel, returned by ::pop3::open +# +# Results: +# A list containing two elements, {msgCount octetSize}, +# where msgCount is the number of messages in the spool +# and octetSize is the size (in octets, or 8 bytes) of +# the entire spool. + +proc ::pop3::status {chan} { + + if {[catch {set statusStr [::pop3::send $chan "STAT"]} errorStr]} { + error "POP3 STAT ERROR: $errorStr" + } + + # Dig the sent size and count info out. + set rawStatus [split [string trim $statusStr]] + + return [::list [lindex $rawStatus 0] [lindex $rawStatus 1]] +} + +# ::pop3::top -- +# +# Optional POP3 command (see RFC1939). Retrieves message header +# and given number of lines from the message body. +# +# Arguments: +# chan The channel open to the POP3 server. +# msg The message number to be retrieved. +# n Number of lines returned from the message body. +# +# Results: +# Text (with newlines) from the server. +# Errors from the POP3 server are thrown. + +proc ::pop3::top {chan msg n} { + global PopErrorNm PopErrorStr debug + + if {[catch {::pop3::send $chan "TOP $msg $n"} errorStr]} { + error "POP3 TOP ERROR: $errorStr" + } + + return [RetrSlow $chan] +} + +# ::pop3::uidl -- +# +# Returns "uid listing" of the mailbox. If parameter msg +# is defined, then the listing only for the given message +# is returned. +# +# Arguments: +# chan The channel open to the POP3 server. +# msg The message number (optional). +# +# Results: +# If msg parameter is not given, Tcl list of uid listings in +# the maildrop is returned. In case msg parameter is given, +# a list of length one containing the uid of the specified +# message listing is returned. + +proc ::pop3::uidl {chan {msg ""}} { + if {$msg == ""} { + if {[catch {::pop3::send $chan "UIDL"} errorStr]} { + error "POP3 UIDL ERROR: $errorStr" + } + set msgBuffer [RetrSlow $chan] + } else { + # argument msg given, single-line response expected + + if {[catch {expr {0 + $msg}}]} { + error "POP3 UIDL ERROR: malformed message number '$msg'" + } else { + set msgBuffer [string trim [::pop3::send $chan "UIDL $msg"]] + } + } + + return $msgBuffer +} + +# ::pop3::capa -- +# +# Returns "capabilities" of the server. +# +# Arguments: +# chan The channel open to the POP3 server. +# +# Results: +# A Tcl list with the capabilities of the server. +# UIDL, TOP, STLS are typical capabilities. + + +proc ::pop3::capa {chan} { + global PopErrorNm PopErrorStr debug + + if {[catch {::pop3::send $chan "CAPA"} errorStr]} { + error "POP3 CAPA ERROR: $errorStr" + } + set msgBuffer [string map {\r {}} [RetrSlow $chan]] + + return [split $msgBuffer \n] +} + diff --git a/tcllib/modules/pop3/pop3.test b/tcllib/modules/pop3/pop3.test new file mode 100644 index 0000000..30b53de --- /dev/null +++ b/tcllib/modules/pop3/pop3.test @@ -0,0 +1,611 @@ +# -*- tcl -*- +# pop3.test: tests for the pop3 client. +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 2002-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# +# RCS: @(#) $Id: pop3.test,v 1.31 2012/01/10 20:06:52 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 1.0 + +tcltest::testConstraint hastls [expr {![catch {package require tls}]}] + +support { + #use snit/snit.tcl snit ;# comm futures, not used, still a dependency + #use comm/comm.tcl comm + use log/log.tcl log + useTcllibFile devtools/coserv.tcl ; # loads comm, snit too! + useTcllibFile devtools/dialog.tcl +} +testing { + useLocal pop3.tcl pop3 +} + +# ------------------------------------------------------------------------- +# Server processes. Programmed dialogs, server side. + +dialog::setup server {Pop3 Fake Server} + +# ---------------------------------------------------------------------- +# Dialog scripts for the various servers we start ... + +proc init {} { + dialog::crlf. + dialog::send. {+OK localhost coserv ready <534358773_pop3d1_12380@localhost>} +} +proc initBad {} { + dialog::crlf. + dialog::send. Grumble +} +proc loginOk {} { + init + dialog::respond. {+OK please send PASS command} + dialog::respond. {+OK congratulations} +} +proc loginStatusOk {} { + init + dialog::respond. {+OK please send PASS command} + dialog::respond. {+OK congratulations} + dialog::respond. {+OK 11 176} +} +proc loginFailed {} { + init + dialog::respond. {+OK please send PASS command} + dialog::respond. {-ERR authentication failed, sorry} +} +proc loginFailedLock {} { + init + dialog::respond. {+OK please send PASS command} + dialog::respond. {-ERR could not aquire lock for maildrop ak} +} +proc statusOk {} { + loginStatusOk + dialog::respond. {+OK 11 176} +} +proc statusOkQuit {} { + statusOk + dialog::respond. {+OK localhost coserv shutting down} +} +proc lastFailed {} { + loginStatusOk + dialog::respond. {-ERR unknown command 'LAST'} +} +proc uidlFailed {} { + loginStatusOk + dialog::respond. {-ERR unknown command 'UIDL'} +} +proc retrFailed {} { + loginStatusOk + dialog::respond. {-ERR unknown command 'LAST'} + dialog::respond. {+OK localhost coserv shutting down} +} +proc topFailed {} { + loginStatusOk + dialog::respond. {-ERR no such message} + dialog::respond. {+OK localhost coserv shutting down} +} + +set __messageA {MIME-Version: 1.0 +Content-Type: text/plain; + charset="us-ascii" + +Test ______ + +. + +-- +Done +} + +set __messageB {MIME-Version: 1.0 +Content-Type: text/plain; + charset="us-ascii" + +Test ______ + +This line can cause a failure. + +-- +Done +} + +set __messageC {MIME-Version: 1.0 +Content-Type: text/plain; + charset="us-ascii" + +Test ______ + +This line can cause a failure. + +-- +Done +} + +proc message {msg {n {}}} { + if {$n == {}} {set n [string length $msg]} + + set lines [split $msg \n] + set n [llength $lines] + + foreach l $lines { + if {[string match .* $l]} {set l .$l} + if {[string length $l] || ($n > 1)} { + dialog::send. $l + } + incr n -1 + } + dialog::send. . +} + +proc retrMessage {list msg {n {}}} { + if {$n == {}} {set n [string length $msg]} + + loginOk + dialog::respond. "+OK 1 $n" + dialog::respond. {-ERR unknown command 'LAST'} + + if {$list} {dialog::respond. "+OK 1 $n"} + + dialog::respond. "+OK $n octets" + message $msg $n + dialog::respond. {+OK localhost coserv shutting down} +} + +proc topMessage {msg} { + loginStatusOk + dialog::respond. +OK + message $msg + dialog::respond. {+OK localhost coserv shutting down} +} + +proc deleDialog {} { + loginStatusOk + dialog::respond. {+OK 11 176} + + foreach n {1 2 3 4 5 6 7 8 9 10 11} { + dialog::respond. {-ERR unknown command 'LAST'} + dialog::respond. {+OK 6 octets} + dialog::send. {Content-Type: text/plain;} + dialog::send. { charset="us-ascii"} + dialog::send. {} + dialog::send. { } + dialog::send. {.} + dialog::respond. {-ERR unknown command 'LAST'} + dialog::respond. "+OK message $n deleted" + } + dialog::respond. {+OK localhost coserv shutting down} +} + +proc bgerror {message} { + global errorCode errorInfo + puts $errorCode + puts $errorInfo + return +} + +proc peek {chan} { + set res {} + array set _ [::pop3::config $chan] + foreach k [lsort [array names _]] { + lappend res $k $_($k) + } + return $res +} + +# Reduce output generated by the client. +set disable 1 +::log::lvSuppress info $disable +::log::lvSuppress notice $disable +::log::lvSuppress debug $disable +::log::lvSuppress warning $disable + +#tcltest::verbose {pass body error skip} + +if 0 { + rename test test__ + proc test {args} { + puts "[lindex $args 0] ________________________________________________________________________" + return [uplevel test__ $args] + } +} + +proc blot {txt sock} { + string map [list $sock SOCK] $txt +} + +# ---------------------------------------------------------------------- +# Tests. Operations +# +# open, status, delete, cut, open, status | +# open, status, delete, close | +# +# ---------------------------------------------------------------------- + +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- +# Handling of 'open' alone. +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- + +test pop3-0.0 {bogus options} { + catch {pop3::open -foo bar localhost ak smash 7664} msg + set msg +} {::pop3::open : Illegal option "-foo"} + +test pop3-0.1 {bogus options} { + catch {pop3::open -msex bar localhost ak smash 2534} msg + set msg +} {:pop3::open : Argument to -msex has to be boolean} + +test pop3-0.2 {bogus options} { + catch {pop3::open -retr-mode bar localhost ak smash 54345} msg + set msg +} {:pop3::open : Argument to -retr-mode has to be one of retr, list or slow} + +test pop3-0.3 {not enough arguments} { + catch {pop3::open localhost ak} msg + set msg +} {Not enough arguments to ::pop3::open} + +test pop3-0.4 {too many arguments} { + catch {pop3::open localhost ak smash 432490 dribble} msg + set msg +} {To many arguments to ::pop3::open} + +test pop3-0.5 {connect to missing server} { + catch {pop3::open localhost foo foo 1111} msg + string match {couldn't open socket: *} $msg +} 1 + +test pop3-0.6 {wrong type of server (fake)} { + dialog::dialog_set initBad + catch {pop3::open localhost foo foo [dialog::listener]} msg + dialog::waitdone + regsub {^([^:]*:).*$} $msg {\1} msg + set msg +} {POP3 CONNECT ERROR:} + +test pop3-0.7 {unknown user} { + dialog::dialog_set loginFailed + catch {pop3::open localhost usrX *** [dialog::listener]} msg + dialog::waitdone + set msg +} {POP3 LOGIN ERROR: authentication failed, sorry} + +test pop3-0.8 {open pop3 channel} { + dialog::dialog_set loginStatusOk + set psock [pop3::open localhost ak smash [dialog::listener]] + close $psock + dialog::waitdone + set msg [string match sock* $psock] + # status data is retained if the connection is not closed through + # the prescribed api command. + lappend msg [peek $psock] + set msg +} {1 {limit 11 msex 0 retr_mode retr socketcmd ::socket stls 0 tls-callback {}}} + +test pop3-0.9 {outside close} { + dialog::dialog_set loginStatusOk + set psock [pop3::open localhost ak smash [dialog::listener]] + close $psock + catch {pop3::close $psock} msg + dialog::waitdone + blot $msg $psock +} {can not find channel named "SOCK"} + +test pop3-0.10 {multiple open pop3 channel to same maildrop} { + dialog::dialog_set loginFailedLock + catch {pop3::open localhost ak smash [dialog::listener]} msg + dialog::waitdone + set msg +} {POP3 LOGIN ERROR: could not aquire lock for maildrop ak} + +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- +# Handling of 'status'. +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- + +test pop3-1.0 {status after cut} { + dialog::dialog_set loginStatusOk + set psock [pop3::open localhost ak smash [dialog::listener]] + close $psock + catch {pop3::status $psock} msg + dialog::waitdone + blot $msg $psock +} {POP3 STAT ERROR: can not find channel named "SOCK"} + +test pop3-1.1 {status after close} { + dialog::dialog_set loginStatusOk + set psock [pop3::open localhost ak smash [dialog::listener]] + pop3::close $psock + catch {pop3::status $psock} msg + dialog::waitdone + blot $msg $psock +} {POP3 STAT ERROR: can not find channel named "SOCK"} + +test pop3-1.2 {status ok} { + dialog::dialog_set statusOkQuit + set psock [pop3::open localhost ak smash [dialog::listener]] + set status [pop3::status $psock] + lappend status [peek $psock] + pop3::close $psock + dialog::waitdone + set status +} {11 176 {limit 11 msex 0 retr_mode retr socketcmd ::socket stls 0 tls-callback {}}} + +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- +# Handling of 'retrieve'. +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- + +test pop3-2.0 {retrieve, no arguments} { + catch {pop3::retrieve} msg + set msg +} [tcltest::wrongNumArgs "pop3::retrieve" "chan start ?end?" 0] + +test pop3-2.1 {retrieve, not enough arguments} { + catch {pop3::retrieve sock5} msg + set msg +} [tcltest::wrongNumArgs "pop3::retrieve" "chan start ?end?" 1] + +test pop3-2.2 {retrieve, too many arguments} { + catch {pop3::retrieve sock5 foo bar fox} msg + set msg +} [tcltest::tooManyArgs "pop3::retrieve" "chan start ?end?"] + +test pop3-2.3 {retrieve without valid channel} { + catch {pop3::retrieve sock5 foo bar} msg + set msg +} {can't read "state(sock5)": no such element in array} + +test pop3-2.4 {retrieve, invalid start} { + dialog::dialog_set retrFailed + set psock [pop3::open localhost ak smash [dialog::listener]] + catch {pop3::retrieve $psock foo bar} msg + pop3::close $psock + list $msg [join [dialog::waitdone] \n] +} {{POP3 Retrieval error: Bad start index foo} {crlf +>> {+OK localhost coserv ready <534358773_pop3d1_12380@localhost>} +<< {USER ak} +>> {+OK please send PASS command} +<< {PASS smash} +>> {+OK congratulations} +<< STAT +>> {+OK 11 176} +<< LAST +>> {-ERR unknown command 'LAST'} +<< QUIT +>> {+OK localhost coserv shutting down} +empty}} + +test pop3-2.5 {retrieve, invalid end} { + dialog::dialog_set retrFailed + set psock [pop3::open localhost ak smash [dialog::listener]] + catch {pop3::retrieve $psock 0 bar} msg + pop3::close $psock + list $msg [join [dialog::waitdone] \n] +} {{POP3 Retrieval error: Bad end index bar} {crlf +>> {+OK localhost coserv ready <534358773_pop3d1_12380@localhost>} +<< {USER ak} +>> {+OK please send PASS command} +<< {PASS smash} +>> {+OK congratulations} +<< STAT +>> {+OK 11 176} +<< LAST +>> {-ERR unknown command 'LAST'} +<< QUIT +>> {+OK localhost coserv shutting down} +empty}} + +set msg {MIME-Version: 1.0 +Content-Type: text/plain; + charset="us-ascii" + + +} + +foreach {n mode len listflag} { + 0 retr {} 0 + 1 list {} 1 + 2 slow {} 0 + 3 retr 98 0 + 4 retr 114 0 + 5 retr 0 0 + 6 retr 1 0 + 7 retr 97 0 + 8 retr 113 0 + 9 retr 99 0 + 10 retr 115 0 + 11 retr 116 0 +} { + test pop3-2.6.$n "retrieval, $mode $len" { + dialog::dialog_set {retrMessage $listflag $__messageA $len} + set psock [pop3::open -retr-mode $mode localhost ak smash [dialog::listener]] + set res [pop3::retrieve $psock 1] + pop3::close $psock + dialog::waitdone + set res + } [list $__messageA] ; # {} +} + +# Note: 2.7 == 2.6.3 | Separate test cases to make clear that they +# Note: 2.8 == 2.6.4 | there created to check for a bug report. + +test pop3-2.7 {fast retrieval, .-stuff border break, #528928} { + dialog::dialog_set {retrMessage 0 $__messageA 98} + set psock [pop3::open -retr-mode retr localhost ak smash [dialog::listener]] + set res [pop3::retrieve $psock 1] + pop3::close $psock + dialog::waitdone + set res +} [list $__messageA] + + +test pop3-2.8 {fast retrieval, .-stuff border break, #528928} { + dialog::dialog_set {retrMessage 0 $__messageA 114} + set psock [pop3::open -retr-mode retr localhost ak smash [dialog::listener]] + set res [pop3::retrieve $psock 1] + pop3::close $psock + dialog::waitdone + set res +} [list $__messageA] + +test pop3-2.9 {fast retrieval, .-stuff border break} { + dialog::dialog_set {retrMessage 0 $__messageB 126} + set psock [pop3::open -retr-mode retr localhost ak smash [dialog::listener]] + set res [pop3::retrieve $psock 1] + pop3::close $psock + dialog::waitdone + set res +} [list $__messageB] + +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- +# Handling of 'top'. +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- + +test pop3-3.0 {top, no arguments} { + catch {pop3::top} msg + set msg +} [tcltest::wrongNumArgs "pop3::top" "chan msg n" 0] + +test pop3-3.1 {top, not enough arguments} { + catch {pop3::top sock5} msg + set msg +} [tcltest::wrongNumArgs "pop3::top" "chan msg n" 1] + +test pop3-3.2 {top, too many arguments} { + catch {pop3::top sock5 foo bar fox} msg + set msg +} [tcltest::tooManyArgs "pop3::top" "chan msg n"] + +test pop3-3.3 {top without valid channel} { + catch {pop3::top sockXXX foo bar} msg + set msg +} {POP3 TOP ERROR: can not find channel named "sockXXX"} + +test pop3-3.4 {top, invalid message id} { + dialog::dialog_set topFailed + set psock [pop3::open localhost ak smash [dialog::listener]] + catch {pop3::top $psock foo bar} msg + pop3::close $psock + dialog::waitdone + set msg +} {POP3 TOP ERROR: no such message} + +set msg {MIME-Version: 1.0 +Content-Type: text/plain; + charset="us-ascii" + +} + +test pop3-3.5 {top} { + dialog::dialog_set {topMessage $__messageA} + set psock [pop3::open localhost ak smash [dialog::listener]] + set res [pop3::top $psock 1 1] + pop3::close $psock + dialog::waitdone + set res +} $__messageA + +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- +# Handling of 'delete' +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- + + +test pop3-5.0 {get and delete all message, nano-client} { + set res "" + dialog::dialog_set deleDialog + set psock [pop3::open -retr-mode slow localhost ak smash [dialog::listener]] + set x [lindex [pop3::status $psock] 0] + lappend res $x + for {set i 0 } {$i < $x} {incr i} { + set j [expr {$i + 1}] + set msg [pop3::retrieve $psock $j] + lappend res [string length $msg] + pop3::delete $psock $j + } + pop3::close $psock + + set n 3 + foreach t [dialog::waitdone] { + if {![string match "<<*" $t]} {continue} + # Ignore commands from the login interaction. + if {$n} {incr n -1 ; continue} + lappend res [lindex $t 1] + } + set res +} {11 67 67 67 67 67 67 67 67 67 67 67 STAT LAST {RETR 1} LAST {DELE 1} LAST {RETR 2} LAST {DELE 2} LAST {RETR 3} LAST {DELE 3} LAST {RETR 4} LAST {DELE 4} LAST {RETR 5} LAST {DELE 5} LAST {RETR 6} LAST {DELE 6} LAST {RETR 7} LAST {DELE 7} LAST {RETR 8} LAST {DELE 8} LAST {RETR 9} LAST {DELE 9} LAST {RETR 10} LAST {DELE 10} LAST {RETR 11} LAST {DELE 11} QUIT} + +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- +# Handling of 'last', 'uidl'. +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- + +## None. The server used here (tcllib/pop3d) +## does not support the 'LAST' command, nor 'UIDL'. + +test pop3-6.0 {last} { + dialog::dialog_set lastFailed + set psock [pop3::open localhost ak smash [dialog::listener]] + catch {pop3::last $psock} msg + pop3::close $psock + dialog::waitdone + set msg +} {POP3 LAST ERROR: unknown command 'LAST'} + +test pop3-6.1 {uidl} { + dialog::dialog_set uidlFailed + set psock [pop3::open localhost ak smash [dialog::listener]] + catch {pop3::uidl $psock} msg + pop3::close $psock + dialog::waitdone + set msg +} {POP3 UIDL ERROR: unknown command 'UIDL'} + +test pop3-7.0 {open pop3 channel secured via package tls} hastls { + dialog::shutdown + dialog::setup server {Pop3 Fake Server} 1 + + tls::init \ + -keyfile [tcllibPath devtools/receiver.key] \ + -certfile [tcllibPath devtools/receiver.crt] \ + -cafile [tcllibPath devtools/ca.crt] \ + -ssl2 1 \ + -ssl3 1 \ + -tls1 0 \ + -require 1 + + dialog::dialog_set loginStatusOk + set psock [pop3::open -socketcmd tls::socket localhost ak smash [dialog::listener]] + close $psock + dialog::waitdone + set msg [string match sock* $psock] + # status data is retained if the connection is not closed through + # the prescribed api command. + lappend msg [peek $psock] + set msg +} {1 {limit 11 msex 0 retr_mode retr socketcmd tls::socket stls 0 tls-callback {}}} + +# ---------------------------------------------------------------------- +# ---------------------------------------------------------------------- +dialog::shutdown +testsuiteCleanup |