#!/usr/local/bin/wish8
#
#NAME
#  MailTest 1.0 - GUI tool to test a POP2/POP3/IMAP server
#
#SYNOPSIS
#  MailTest &
#
#DESCRIPTION
#  This is a test tool for exercising a POP2/POP3/IMAP server.
#  The window has four distinct sections:
#
#  1. Host contact info.  Fill in the host name or address, and
#  make sure the port number is correct (110 is standard).  You
#  will also need a valid login, and probably a password.
#
#  2. Status area.  The stat button sends a status command, and
#  displays the response.  At other times, status messages from
#  the other end will also appear here.  There is also a second
#  status area, for reporting on errors from the local system.
#  This includes mostly connection problems.
#
#  3. Message area.  There are six buttons:
#     
#     conn connects to the host and sens the user and password.
#          If this succeeds, there will be an OK message in the
#          stat line.
#     
#     list lists the messages for this user.  You can click on
#          a message to select it for the next buttons.
#     
#     retr retrieves the selected message.
#     
#     dele deletes the selected message.  If you push the list
#          button, the message should disappear from the list.
#     
#     rset undoes the dele commands, restoring deleted messages.
#     
#     quit disconnects from the mail server.  If there are any
#          deleted messages, they will disappear at this time.
#
#  4. Message area.  This is filled by the retr button described
#  above.  You can also double-click on an entry to retrieve the
#  message; the same routine as the retr button is called.
#
#BUGS
#  So far, this has only been tested against POP3 servers.
#  Stay tuned ...
#
#SEE ALSO
#  POP3commands, a file that should accompany this program.
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>

set errmsg {}
set me MailTest
if [info exists env(V_$me)] {set V $env(V_$me)} else {set V 1}
set path  [split $env(PATH) :]
foreach f {Source.w Help.w Verbose.w} {
	foreach d $path {
		if [file readable $d/$f] {
			if {$V>1} {puts "$me: source $d/$f"}
			source $d/$f
			break
}	}	}

set BF {-bd 5 -relief ridge}
set BL {-bg grey50 -fg green  -bd 2 -relief flat -padx 0 -pady 0}
set BB {-bg grey50 -fg yellow -bd 3 -relief raised -padx 0 -pady 0 -highlightthickness 0}
set BE {-bg grey50 -fg cyan   -bd 2 -relief ridge -highlightthickness 0}

set addr {} 
set conncmd {}
set connfil {}
set connpid {}
set host {}
set pass {} 
set port 110
set stat {}
set state INIT
set user {}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Button bar:

eval frame .b;	# $BF
menubutton .b.cmds -text cmds -menu .b.cmds.menu
menu .b.cmds.menu
.b.cmds.menu add command -label Quit -command exit
label .b.state -textvariable state -bd 5 -relief ridge -fg green -bg black
eval button .b.quit -text QUIT -command exit $BB -fg red2 
eval menubutton .b.help -text Help -menu .b.help.menu
menu .b.help.menu
.b.help.menu add command -label "About $me" -command "Help .about {} {}"
pack .b.cmds  -in .b -side left 
pack .b.state -in .b -side left -expand 1
pack .b.help  -in .b -side right
Verbose .b
pack .b.quit  -in .b -side right

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Frame for containing some simple instructions:

set msg1 {Fill in the above fields, and then press a conn button.}
eval frame .m1;	# $FB
eval label .m1.msg -textvariable msg1;	# -bd 0 -highlightthickness 0
pack .m1.msg -in .m1 -expand 1 -fill x 

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Frame for the id info needed to make a connection to a server:

eval frame .id;	# $BF
eval frame .id.host $BF
eval menubutton .id.host.hlbl $BL -text host -menu .id.host.hlbl.menu
menu .id.host.hlbl.menu
.id.host.hlbl.menu add command -label jack  -command "set host jack"
.id.host.hlbl.menu add command -label hack1 -command "set host hack1"
.id.host.hlbl.menu add command -label hack2 -command "set host hack2"
.id.host.hlbl.menu add command -label world.std.com -command "set host world.std.com"
eval entry .id.host.hval $BE -textvariable host -width 0
bind .id.host.hval <Return> Newhost
pack .id.host.hlbl -in .id.host -side left
pack .id.host.hval -in .id.host -side left -expand 1 -fill x

eval frame .id.addr $BF
eval label .id.addr.albl $BL -text addr
eval entry .id.addr.aval $BE -textvariable addr -width 0
bind .id.addr.aval <Return> Newaddr
eval menubutton .id.addr.plbl $BL -text port -menu .id.addr.plbl.menu
menu .id.addr.plbl.menu
.id.addr.plbl.menu add command -label {POP2 109} -command {set port 109}
.id.addr.plbl.menu add command -label {POP3 110} -command {set port 110}
.id.addr.plbl.menu add command -label {IMAP 143} -command {set port 143}
eval entry .id.addr.pval $BE -textvariable port -width 0
bind .id.addr.pval <Return> Newport

eval frame .id.user $BF
eval menubutton .id.user.ulbl $BL -text user -menu .id.user.ulbl.menu
menu .id.user.ulbl.menu
.id.user.ulbl.menu add command -label test     -command "set user test"
.id.user.ulbl.menu add command -label test1    -command "set user test1"
.id.user.ulbl.menu add command -label test2    -command "set user test2"
.id.user.ulbl.menu add command -label popuser  -command "set user popuser"
.id.user.ulbl.menu add command -label brickwal -command "set user brickwal"
.id.user.ulbl.menu add command -label crotched -command "set user crotched"
.id.user.ulbl.menu add command -label dual     -command "set user dual"
.id.user.ulbl.menu add command -label tinker   -command "set user tinker"
.id.user.ulbl.menu add command -label vesuvias -command "set user vesuvias"
.id.user.ulbl.menu add command -label wildcat  -command "set user wildcat"
.id.user.ulbl.menu add command -label jcsd     -command "set user jcsd"
eval entry .id.user.uval $BE -textvariable user -width 8
bind .id.user.uval <Return> Newuser
eval label .id.user.plbl $BL -text password
eval entry .id.user.pval $BE -textvariable pass -width 8 -show *
bind .id.user.pval <Return> Newpass

pack .id.user.ulbl -in .id.user -side left
pack .id.user.uval -in .id.user -side left -expand 1 -fill x
pack .id.user.plbl -in .id.user -side left
pack .id.user.pval -in .id.user -side left

pack .id.addr.albl -in .id.addr -side left
pack .id.addr.aval -in .id.addr -side left -expand 1 -fill x
pack .id.addr.plbl -in .id.addr -side left
pack .id.addr.pval -in .id.addr -side left

pack .id.host -in .id -side left -fill x -expand 1
pack .id.addr -in .id -side left -fill x
pack .id.user -in .id -side left -fill x

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
eval frame .st;	# $BF
eval button .st.stat $BB -text stat -command doSTAT3
eval entry  .st.resp $BE -textvariable stat 
pack .st.stat -in .st -side left
pack .st.resp -in .st -side left -expand 1 -fill x

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
eval entry .em $BE -textvariable errmsg $BE -fg yellow 

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
eval frame .op;	# $BF

eval frame .op.pop2 $BF
eval frame .op.pop3 $BF
eval frame .op.imap $BF
eval frame .op.list $BF
eval frame .op.l3 $BF

eval label  .op.pop2.titl $BL -width 4 -text POP2

eval label  .op.pop3.titl $BL -width 4 -text POP3
eval button .op.pop3.conn $BB -width 4 -text conn -command doCONN3
eval button .op.pop3.rset $BB -width 4 -text rset -command doRSET3 
eval button .op.pop3.quit $BB -width 4 -text quit -command doQUIT3 

eval listbox .op.list.msgs $BE -height 8 -bd 0 \
	-yscrollcommand {".op.list.scry set"}
scrollbar .op.list.scry -width 8 -command ".op.list.msgs yview"
bind .op.list.msgs <Double-1> {doRETR3}
pack .op.list.msgs -in .op.list -side left  -expand 1 -fill both
pack .op.list.scry -in .op.list -side right -fill y

eval button .op.pop3.list $BB -width 4 -text list -command doLIST3 
eval button .op.pop3.retr $BB -width 4 -text retr -command doRETR3 
eval button .op.pop3.dele $BB -width 4 -text dele -command doDELE3

eval label  .op.imap.titl $BL -width 4 -text IMAP

pack .op.pop2.titl -in .op.pop2 -side top

pack .op.pop3.titl -in .op.pop3 -side top
pack .op.pop3.conn -in .op.pop3 -side top
pack .op.pop3.list -in .op.pop3 -side top 
pack .op.pop3.retr -in .op.pop3 -side top
pack .op.pop3.dele -in .op.pop3 -side top
pack .op.pop3.rset -in .op.pop3 -side top
pack .op.pop3.quit -in .op.pop3 -side top

pack .op.imap.titl -in .op.imap -side top

pack .op.pop2 -in .op -side left -fill y
pack .op.pop3 -in .op -side left -fill y
pack .op.imap -in .op -side left -fill y
pack .op.list -in .op -side left -expand 1 -fill both
pack .op.l3 -in .op -side left

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
eval frame .ms $BF
eval frame .ms.r1;	# $BF
eval frame .ms.r2;	# $BF

eval text  .ms.r1.txt \
	-yscrollcommand {".ms.r1.scy set"} \
	-height 10 -width 80 -bd 0 -padx 0 -pady 0
scrollbar  .ms.r1.scy -width 8 -command ".ms.r1.txt yview" -orient vertical
#scrollbar  .ms.r2.scx -width 8 -command ".ms.r1.txt xview" -orient horizontal
#button     .ms.r2.but -width 1 -command ".ms.r1.txt delete 1.0 end" -text * \
	-bd 0 -padx 0 -pady 0 -highlightthickness 0

pack .ms.r1 -in .ms -side top -fill both -expand 1
#pack .ms.r2 -in .ms -side bottom -fill x
pack .ms.r1.txt -in .ms.r1 -side left  -fill both -expand 1
pack .ms.r1.scy -in .ms.r1 -side right -fill y
#pack .ms.r2.scx -in .ms.r2 -side left  -fill x -expand 1
#pack .ms.r2.but -in .ms.r2 -side right

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Shut down connection to server.
proc CloseConn {} {
	global V me connpid connfil 
	set F CloseConn
	if {$connfil != {}} {
		if {$V>1} {puts "$me/$F: Close previous connection."}
		if [catch {close $connfil} m] {Err $m}
		set connfil {}
		after 1000
	}
	if {$connpid > 0} {
		if {$V>1} {puts "$me/$F: Kill connect process $connpid."}
		if [catch {exec kill -TERM $connpid} m] {Err $m}
		set connpid {}
		after 1000
	}
	.op.list.msgs delete 0 end
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doCONN3 {} {
	global V me host addr port conncmd connpid connfil pass user
	set F doCONN3
	if {$V>1} {puts "$me/$F called."}
	if {$user == {}} {
		Err "No user specified."
		Stat "No user specified."
		return
	}
	if {$pass == {}} {
		Err "No password specified."
		Stat "No password specified."
	}
	if {$host != {}} {
		set conncmd "telnet $host $port"
	} elseif {$addr != {}} {
		set host $addr
		set conncmd "telnet $addr $port"
	} else {
		Err "No host or address specified."
		return
	}
	if {$V>1} {puts "$me/$F: CONNECT with \"$conncmd\""}
	if [catch {open "| $conncmd" w+} x] {
		Err "Can't open \"$conncmd\" ($x)"
		return
	}
	State CONN3
	if {$V>1} {puts "$me/$F: $x is \"$conncmd\""}
	set connfil $x
	set connpid [pid $x]
	fileevent $x readable "connrsp $x"
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doLIST3 {} {
	global V me connfil listndx
	if {$V>1} {puts "$me/doLIST3 called."}
	Send $connfil list
	flush $connfil
	State LIST3
	set listndx 0
	.op.list.msgs delete 0 end
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doQUIT3 {} {
	global V me connfil
	if {$V>1} {puts "$me/doQUIT3 called."}
	Send $connfil quit
	State QUIT3
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doDELE3 {} {
	global V me connfil
	if {$V>1} {puts "$me/doDELE3 called."}
	State DELE3
	.ms.r1.txt delete 1.0 end
	set mlist [.op.list.msgs curselection]
	if {$V>1} {puts "$me: {$mlist} selected."}
	foreach m $mlist {
		set sel [.op.list.msgs get $m]
		if [regexp {^([0-9]+) is ([0-9]+)} $sel {} mndx msiz] {
			Send $connfil "dele $mndx"
		}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doRETR3 {} {
	global V me connfil
	if {$V>1} {puts "$me/doRETR3 called."}
	State RETR3
	.ms.r1.txt delete 1.0 end
	set mlist [.op.list.msgs curselection]
	if {$V>1} {puts "$me: {$mlist} selected."}
	foreach m $mlist {
		set sel [.op.list.msgs get $m]
		if [regexp {^([0-9]+) is ([0-9]+)} $sel {} mndx msiz] {
			Send $connfil "retr $mndx"
		}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doRSET3 {} {
	global V me connfil
	if {$V>1} {puts "$me/doRSET3 called."}
	Send $connfil rset
	State RSET3
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doSTAT3 {} {
	global V me connfil stat
	if {$V>1} {puts "$me/doSTAT3 called."}
	Send $connfil stat
	State STAT3
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doPASS3 {} {
	global V me connfil pass
	if {$V>1} {puts "$me/doPASS3 called."}
	Send $connfil "pass $pass"
	State PASS3
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc doUSER3 {} {
	global V me connfil user
	if {$V>1} {puts "$me/doUSER3 called."}
	Send $connfil "user $user"
	State USER3
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Send {f m} {
	global V me
	if {$V>1} {puts "$me: Send $f \"$m\""}
	if {$f == {}} {Err "Not connected."; return}
	puts $f $m
	flush $f
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Err m {
	global V me errmsg
	set errmsg $m
	if {$V>1} {puts "$me: $m"}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Newhost {} {
	global V me host
	if {$V>1} {puts "$me/Newhost called for host=\"$host\"."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Newaddr {} {
	global V me addr
	if {$V>1} {puts "$me/Newaddr called for addr=\"$addr\"."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Newport {} {
	global V me port
	if {$V>1} {puts "$me/Newport called for port=\"$port\"."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Newpass {} {
	global V me pass
	if {$V>1} {puts "$me/Newpass called for pass=\"$pass\"."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Stat {s} {
	global V me stat
	set stat $s
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc State {s} {
	global V me state
	if {$V>1} {puts "$me/State change from \"$state\" to \"$s\"."}
	set state $s
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc connrsp {f} {
	global V me addr connfil connpid listndx msgs state
	set F connrsp
	if {$V>3} {puts "$me/$F: f=$f state=\"$state\""}
	if {[gets $f line] < 0} {
		if {$V>1} {puts "$me/$F: EOF."}
		if [catch {close $f} m] {Err $m}
		if {$f == $connfil} {
			CloseConn
		}
	}
	if {$V>1} {puts "$me/$F: GOT \"$line\" in state \"$state\""}
	if [regexp {^\-ERR (.*)} $line {} rsp] {
		if {$V>0} {puts "$me/$F: ERR $rsp"}
		Err $line
	} elseif [regexp {^\+OK (.*)} $line {} rsp] {
		if [regexp {^(Q*POP[0-9]*) (.*)} $rsp {} prot desc] {
			if {$V>1} {puts "$me/$F/OK: Protocol $prot for \"$desc\""}
			Stat $line
			doUSER3
			return
		} elseif [regexp -nocase {^user name accepted, password} $rsp {}] {
			if {$V>1} {puts "$me/$F/OK: User accepted; send password."}
			doPASS3
			return
		} elseif [regexp -nocase {password required} $rsp {}] {
			if {$V>1} {puts "$me/$F/OK: User accepted; send password."}
			doPASS3
			return
		} elseif [regexp {^Mailbox open, ([0-9]+) message} $rsp {} msgs] {
			if {$V>1} {puts "$me/$F/OK: Mailbox with $msgs messages."}
			Stat "Connected, $msgs messages."
			set state OK
			.op.list.msgs delete 0 end
		} elseif [regexp {(.*) has ([0-9]+) message} $rsp {} idnt msgs] {
			if {$V>1} {puts "$me/$F/OK: $idnt has $msgs messages."}
			Stat "Connected, $msgs messages."
			set state OK
			.op.list.msgs delete 0 end
		} elseif [regexp {signing off} $rsp] {
			if {$V>1} {puts "$me/$F/OK: Server signed off."}
			Stat $line
			CloseConn
			State INIT
		} else {
			if {$V>2} {puts "$me/$F/OK: Drop \"$line\""}
			Stat $line
		}
	} elseif {$state == {LIST3}} {
		if {$V>8} {puts "$me/$F: list state."}
		if [regexp {^([0-9]+) ([0-9]+)} $line {} mndx msiz] {
			if {$V>1} {puts "$me/$F: list mndx=\"$mndx\" msiz=\"$msiz\"."}
			.op.list.msgs insert end "$mndx is $msiz bytes."
			incr listndx 
		} else {
			if {$V>2} {puts "$me/$F: Drop \"$line\" (LIST3)"}
		}
	} elseif {$state == {RETR3}} {
		if {$V>8} {puts "$me/$F: retr state."}
		.ms.r1.txt insert end "$line\n"
	} elseif [regexp {^Trying[ 	]+([0-9.]+)} $line {} a] {
		set addr [string trimright $a {.}]
		if {$V>2} {puts "$me/$F: Addr $addr ..."}
	} else {
		if {$V>2} {puts "$me/$F: Drop \"$line\" (no match)"}
	}
	update idletasks
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

           pack .b  -side top -fill x
           pack .id -side top -fill x
if {$V>0} {pack .m1 -side top -fill x}
           pack .op -side top -fill x
           pack .st -side top -fill x
           pack .em -side top -fill x
           pack .ms -side top -fill both -expand 1