proc ::pop3::open {args} {
variable state
array set cstate {msex 0 retr_mode retr limit {} ssl 0}
log::log debug "pop3::open | [join $args]"
while {[set err [cmdline::getopt args {msex.arg retr-mode.arg ssl.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"
}
}
}
ssl {
if {![string is boolean $arg]} {
return -code error \
":pop3::open : Argument to -ssl has to be boolean"
}
set cstate(ssl) $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 == {}} {
set port 110
}
log::log debug "pop3::open | protocol, connect to $host $port"
# Argument processing is finally complete, now open the channel
if {$cstate(ssl)} {
package require tls
set chan [::tls::socket $host $port]
} else {
set chan [socket $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
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
}
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
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
}To use it, simply do:package require pop3than source this code, to overwrite the pop3::open proc with the patched version.Now you can for example simply do:
set p [::pop3::open -ssl 1 $server $user $password 995]If your server listens ssl enabled on port 995.Note: This does not implement the standard RFC 2595 STLS command, to start as normal pop3 and switch to tls in between.
[ThF] - 2011-08-24 03:22:47> I needed a quick and dirty solution to read our POP3 server, which is only available with enabled TLS now...I had the same problem too, and therefore i inserted your code in one of my routines. It runs excellent, so many thanks for it.
