Fossil SCM

fossil-scm / tools / fake-smtpd.tcl

Source Blame History 84 lines

f031f74…	drh	1	#!/usr/bin/tclsh
f031f74…	drh	2	#
f031f74…	drh	3	# This script is a testing aid for working on the Relay notification method
f031f74…	drh	4	# in Fossil.
f031f74…	drh	5	#
f031f74…	drh	6	# This script listens for connections on port 25 or probably some other TCP
f031f74…	drh	7	# port specified by the "--port N" option. It pretend to be an SMTP server,
f031f74…	drh	8	# though it does not actually relay any email. Instead, it just prints the
f031f74…	drh	9	# SMTP conversation on stdout.
f031f74…	drh	10	#
f031f74…	drh	11	# If the "--max N" option is used, then the fake SMTP server shuts down
f031f74…	drh	12	# with an error after receiving N messages from the client. This can be
f031f74…	drh	13	# used to test retry capabilities in the client.
f031f74…	drh	14	#
f031f74…	drh	15	# Suggested Test Procedure For Fossil Relay Notifications
f031f74…	drh	16	#
f031f74…	drh	17	# 1. Bring up "fossil ui"
f031f74…	drh	18	# 2. Configure notification for relay to localhost:8025
f031f74…	drh	19	# 3. Start this script in a separate window. Something like:
f031f74…	drh	20	# tclsh fake-smtpd.tcl -port 8025 -max 100
f031f74…	drh	21	# 4. Send test messages using Fossil
f031f74…	drh	22	#
f031f74…	drh	23	proc conn_puts {chan txt} {
f031f74…	drh	24	puts "S: $txt"
f031f74…	drh	25	puts $chan $txt
f031f74…	drh	26	flush $chan
f031f74…	drh	27	}
f031f74…	drh	28	set mxMsg 100000000
f031f74…	drh	29	proc connection {chan ip port} {
f031f74…	drh	30	global mxMsg
f031f74…	drh	31	set nMsg 0
f031f74…	drh	32	puts "* begin connection from $ip:$port *"
f031f74…	drh	33	conn_puts $chan "220 localhost fake-SMTPD"
f031f74…	drh	34	set inData 0
f031f74…	drh	35	while {1} {
f031f74…	drh	36	set line [string trimright [gets $chan]]
f031f74…	drh	37	if {$line eq ""} {
f031f74…	drh	38	if {[eof $chan]} break
f031f74…	drh	39	}
f031f74…	drh	40	puts "C: $line"
f031f74…	drh	41	incr nMsg
f031f74…	drh	42	if {$inData} {
f031f74…	drh	43	if {$line eq "."} {
f031f74…	drh	44	set inData 0
f031f74…	drh	45	conn_puts $chan "250 Ok"
f031f74…	drh	46	}
f031f74…	drh	47	} elseif {$nMsg>$mxMsg} {
f031f74…	drh	48	conn_puts $chan "999 I'm done!"
f031f74…	drh	49	break
f031f74…	drh	50	} elseif {[string match "HELO *" $line]} {
f031f74…	drh	51	conn_puts $chan "250 Ok"
f031f74…	drh	52	} elseif {[string match "EHLO *" $line]} {
f031f74…	drh	53	conn_puts $chan "250-SIZE 100000"
f031f74…	drh	54	conn_puts $chan "250 HELP"
f031f74…	drh	55	} elseif {[string match "DATA*" $line]} {
f031f74…	drh	56	conn_puts $chan "354 End data with <CR><LF>.<CR><LF>"
f031f74…	drh	57	set inData 1
f031f74…	drh	58	} elseif {[string match "QUIT*" $line]} {
f031f74…	drh	59	conn_puts $chan "221 Bye"
f031f74…	drh	60	break
f031f74…	drh	61	} else {
f031f74…	drh	62	conn_puts $chan "250 Ok"
f031f74…	drh	63	}
f031f74…	drh	64	}
f031f74…	drh	65	puts "* connection closed ($nMsg messages) *"
f031f74…	drh	66	close $chan
f031f74…	drh	67	}
f031f74…	drh	68	set port 25
f031f74…	drh	69	set argc [llength $argv]
f031f74…	drh	70	for {set i 0} {$i<$argc-1} {incr i} {
f031f74…	drh	71	set arg [lindex $argv $i]
f031f74…	drh	72	if {$arg eq "-port" \|\| $arg eq "--port"} {
f031f74…	drh	73	incr i
f031f74…	drh	74	set port [lindex $argv $i]
f031f74…	drh	75	}
f031f74…	drh	76	if {$arg eq "-max" \|\| $arg eq "--max"} {
f031f74…	drh	77	incr i
f031f74…	drh	78	set mxMsg [lindex $argv $i]
f031f74…	drh	79	}
f031f74…	drh	80	}
f031f74…	drh	81	puts "listening on localhost:$port"
f031f74…	drh	82	socket -server connection $port
f031f74…	drh	83	set forever 0
f031f74…	drh	84	vwait forever

Fossil SCM

Keyboard Shortcuts