Version 1 of POP3 with TLS

Updated 2007-12-06 13:45:38 by dkf

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.