schlenk I needed a quick and dirty solution to read our POP3 server, which is only available with enabled TLS now, so I hacked up this. Its basically a slightly modified pop3 open procedure that accepts a -ssl switch.
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 pop3
than 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.