Attachment "tcllib.3.diff" to
ticket [443613ffff]
added by
andreas_kupries
2001-08-02 23:19:59.
? modules/pop3/pop3ah.tcl
Index: modules/pop3/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/pop3/ChangeLog,v
retrieving revision 1.6
diff -u -r1.6 ChangeLog
--- modules/pop3/ChangeLog 2001/06/22 15:29:18 1.6
+++ modules/pop3/ChangeLog 2001/08/02 16:02:11
@@ -1,3 +1,33 @@
+2001-08-02 Andreas Kupries <[email protected]>
+
+ * 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
+ <[email protected]> for his help in testing the code.
+
+2001-07-31 Andreas Kupries <[email protected]>
+
+ * 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 <[email protected]>
* pop3.tcl: Fixed dubious code reported by frink.
Index: modules/pop3/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/pop3/pkgIndex.tcl,v
retrieving revision 1.1
diff -u -r1.1 pkgIndex.tcl
--- modules/pop3/pkgIndex.tcl 2000/03/06 18:57:55 1.1
+++ modules/pop3/pkgIndex.tcl 2001/08/02 16:02:11
@@ -8,4 +8,4 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-package ifneeded pop3 1.0 [list source [file join $dir pop3.tcl]]
+package ifneeded pop3 1.3 [list source [file join $dir pop3.tcl]]
Index: modules/pop3/pop3.n
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/pop3/pop3.n,v
retrieving revision 1.4
diff -u -r1.4 pop3.n
--- modules/pop3/pop3.n 2001/07/06 18:30:52 1.4
+++ modules/pop3/pop3.n 2001/08/02 16:02:11
@@ -11,9 +11,9 @@
.SH NAME
pop3 \- Tcl client for POP3 email protocol
.SH SYNOPSIS
-\fBpackage require pop3 ?1.0?\fR
+\fBpackage require pop3 ?1.3?\fR
.sp
-\fB::pop3::open\fR \fIhost user Ipassword \fR?\fIport\fR?
+\fB::pop3::open\fR ?-msex \fB0|1\fR? ?-retr-mode \fBretr|list|slow\fR? \fIhost user Ipassword \fR?\fIport\fR?
.sp
\fB::pop3::status\fR \fIchan\fR
.sp
@@ -40,12 +40,22 @@
\fBcatch\fR command.
.SH COMMANDS
.TP
-\fB::pop3::open\fR \fIhost username password \fR?\fIport\fR?
+\fB::pop3::open\fR ?-msex \fB0|1\fR? ?-retr-mode \fBretr|list|slow\fR? \fIhost username password \fR?\fIport\fR?
Open a socket connection to the server specified by \fIhost\fR,
transmit the \fIusername\fR and \fIpassword\fR as login information to
the server. The default port number is 110, which can be overridden
using the optional \fIport\fR argument. The return value is a channel
used by all of the other ::pop3 functions.
+
+The command recognizes the options \fI-msex\fR and
+\fI-retr-mode\fR. The first of them can be used to notify the package
+of the fact that the server to talk to is an MS Exchange server (which
+has some oddities we have to work around). The default is 0.
+
+The retrieval mode determines how exactly messages are read from the
+server. The allowed values are \fBretr\fR, \fBlist\fR and
+\fBslow\fR. The default is \fBretr\fR. See \fB::pop3::retrieve\fR for
+more information.
.TP
\fB::pop3::status\fR \fIchan\fR
Query the server for the status of the mail spool. The status is
@@ -64,6 +74,20 @@
is not specified, only one message will be retrieved. The return
value is a list containing each message as a separate element. See
the \fIstartIndex\fR and \fIendIndex\fR descriptions below.
+
+The retrieval mode determines how exactly messages are read from the
+server. The mode \fBretr\fR 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 \fBlist\fR 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, \fBslow\fR, 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.
+
+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.
.TP
\fB::pop3::delete\fR \fIchan startIndex \fR?\fIendIndex\fR
Delete a range of messages from the server. If the \fIendIndex\fR is
Index: modules/pop3/pop3.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/pop3/pop3.tcl,v
retrieving revision 1.10
diff -u -r1.10 pop3.tcl
--- modules/pop3/pop3.tcl 2001/06/22 15:29:18 1.10
+++ modules/pop3/pop3.tcl 2001/08/02 16:02:11
@@ -12,9 +12,29 @@
#
# RCS: @(#) $Id: pop3.tcl,v 1.10 2001/06/22 15:29:18 andreas_kupries Exp $
-package provide pop3 1.2
+package require cmdline
+package provide pop3 1.3
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 [retr]. 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::open --
@@ -22,6 +42,10 @@
# 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.
@@ -32,16 +56,72 @@
# The connection channel (a socket).
# May throw errors from the server.
-proc ::pop3::open {host user password {port 110}} {
+proc ::pop3::open {args} {
+ variable state
+ array set cstate {msex 0 retr_mode retr}
+
+ while {[set err [cmdline::getopt args {msex.arg retr-mode.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"
+ }
+ }
+ }
+ 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 == {}} {
+ set port 110
+ }
+
+ # Argument processing is finally complete, now open the channel
set chan [socket $host $port]
fconfigure $chan -buffering none
- fconfigure $chan -translation binary
-
+
+ if {$cstate(msex)} {
+ # We are talking to MS Exchange. Work around its quirks.
+ fconfigure $chan -translation binary
+ } else {
+ fconfigure $chan -translation {binary crlf}
+ }
+
if {[catch {::pop3::send $chan {}} errorStr]} {
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 {[catch {
::pop3::send $chan "user $user"
::pop3::send $chan "pass $password"
@@ -49,6 +129,9 @@
error "POP3 LOGIN ERROR: $errorStr"
}
+ # Remember the state.
+
+ set state($chan) [array get cstate]
return $chan
}
@@ -128,6 +211,8 @@
# May throw errors from the server.
proc ::pop3::retrieve {chan start {end -1}} {
+ variable state
+ array set cstate $state($chan)
set count [lindex [::pop3::status $chan] 0]
set last 0
@@ -148,7 +233,6 @@
if {$start == 0} {
set start 1
}
-
if {![string is integer $end]} {
if {$end == "end"} {
@@ -169,23 +253,119 @@
set result {}
for {set index $start} {$index <= $end} {incr index} {
+ switch -exact -- $cstate(retr_mode) {
+ retr {
+ set sizeStr [::pop3::send $chan "RETR $index"]
+
+ if {[scan $sizeStr {%d %s} size dummy] < 0} {
+ # 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.
+
+ set cstate(retr_mode) list
+ set state($chan) [array get cstate]
+
+ # Retrieve in slow motion.
+ set msgBuffer [RetrSlow $chan]
+ } else {
+ set msgBuffer [RetrFast $chan $size]
+ }
+ }
+ list {
+ set sizeStr [::pop3::send $chan "LIST $index"]
- set sizeStr [::pop3::send $chan "RETR $index"]
+ if {[scan $sizeStr {%d %d %s} dummy size dummy] < 0} {
+ # 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]
+
+ # Retrieve in slow motion.
+ set msgBuffer [RetrSlow $chan]
+ } else {
+ # Ignore response of RETR, already know the size
+ # through LIST
- scan $sizeStr {%d %s} size dummy
-
- set msgBuffer [read $chan $size]
+ ::pop3::send $chan "RETR $index"
- # get the terminating "."
- # sometimes the gets returns nothing,
- # need to get the real terminating "."
- while {[gets $chan] != ".\r"} {}
+ set msgBuffer [RetrFast $chan $size]
+ }
+ }
+ slow {
+ # Retrieve in slow motion.
+ 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]
+
+ # We might have read not enough because of .-stuffed lines.
+ # Read the possible remainder in line by line fashion!
+ #
+ # get the terminating "."
+ # sometimes the gets returns nothing,
+ # need to get the real terminating "."
+
+ while {[set line [gets $chan]] != ".\r"} {
+ append msgBuffer $line
+ }
+
+ # 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]
+
+ # 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::delete --
#
# Delete messages on the POP3 server.
@@ -266,7 +446,9 @@
# None.
proc ::pop3::close {chan} {
+ variable state
catch {::pop3::send $chan "QUIT"}
+ unset state($chan)
::close $chan
}
@@ -324,21 +506,26 @@
if {[catch {::pop3::send $chan "LIST"} errorStr]} {
error "POP3 LIST ERROR: $errorStr"
}
+ set msgBuffer {}
while {1} {
set line [gets $chan]
# End of the message is a line with just "."
+
+ set line [string trimright $line]
- if {[string trimright $line] == "."} {
+ if {$line == "."} {
break
} elseif {[string index $line 0] == "."} {
+ # Use trimright to ge rid of superfluous \r's
+ # (we get them due to binary mode)
+
set line [string range $line 1 end]
}
lappend msgBuffer $line
}
} else {
-
# argument msg given, single-line response expected
if {[catch {expr {0 + $msg}}]} {
@@ -377,10 +564,10 @@
if {[string trimright $line] == "."} {
break
} elseif {[string index $line 0] == "."} {
- set line [string range $line 1 end]
+ # Get rid of traling \r's. We get them due to binary mode.
+ set line [string trimright [string range $line 1 end]]
}
append msgBuffer "$line\n"
}
return $msgBuffer
}
-
