Updated 2013-01-20 09:17:46 by pooryorick

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.