# The values in this file can be overridden by creating localcfg.exp 
# and setting them there.  This is useful if you are working against
# the CVS repository and make a purely local change (such as setting
# the timeout value to a low value).

# Set this to 1 to cause the test suite to wait while you attach to
# the process that is being tested.

if { ![info exists ATTACH] } {
    set ATTACH no
}

if { ![info exists MEMTRACE] } {
    set MEMTRACE /dev/null
}

if { ![info exists DBCK_MEMTRACE] } {
    set DBCK_MEMTRACE /dev/null
}

if { ![info exists EFENCE] } {
    set EFENCE 0
}

# The attach option

if { $ATTACH == "yes" } {
    set attach 1
} else {
    set attach 0
}

# Set this to 1 if test-l2g was linked with Electric Fence.
if { $EFENCE == "yes" } {
    set efence 1
} else {
    set efence 0
}

# Set MEMTRACE to the file where the trace should be sent.
# This is typically the tty where you are running the attached gdb.

# Some of the machines we run the Xenofarm tests on are really, really
# slow, so we have to increase the timeout.
set timeout [expr {3 * $timeout + 2}]

# Set the timeout value to something small for quicker testing, if you
# have a fast enough machine.
#set timeout 5

# This constant is also defined in src/include/kom-config.h.
# It also affects VALGRIND_FD in ../Makefile.am.
set PROTECTED_FDS [expr 13 + 9]

# The file descriptor used for valgrind support.  We use the
# last of the protected FD:s.  If this changes, you must
# change VALGRIND_FD in ../Makefile.am.
if {$valgrind_fd != $PROTECTED_FDS - 1} {
    error "Mismatch between valgrind_fd ($valgrind_fd) and PROTECTED_FDS ($PROTECTED_FDS)"
}
set valgrind_fd [expr $PROTECTED_FDS - 1]


# Some useful constants.
set nl "\r?\n"
set any "\[ -ÿ\]"
set deep_any "\\\[ -ÿ\\\]"
set hollerith "\[0-9\]*H$any*"
set any_time "\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*"
# 1970-01-01 GMT, but with some fuzziness to allow for local time zones.
set epoch_time "0 0 \[0-9\]* (1|31) (0|11) (70|69) (4|3) (0|364) \[01\]"
set any_num "\[0-9\]\[0-9\]*"
set any_float "\[0-9\]\[-0-9e.+\]*"
# FIXME (bug 1069): Why doesn't this work?
# set any_float "\[0-9\]\[0-9\]*(\\.\[0-9\]*)?(e(+|-)\[0-9\]\[0-9\]\[0-9\]*"

# The port that is used for Protocol A connections by the test suite.
set clientport 53262

# Port 53263 is used by ../locksuite.py.

# Extra ports used for Protocol A connections in some tests.
set clientport_2 53264
set clientport_3 53265

set aux_item_default_conf_file "$top_srcdir/run-support/aux-items.conf"

# Fix the tty settings for minimum impact on the data flow.
set stty_init "-echo -onlcr -istrip -isig erase '^-' kill '^-' werase '^-'"

# State variables.
set line_leader ""
set meta_line_leader ""

# valgrind support
set valgrindix 0

# Save all broken memory-usage files.
set memix 0

# Recursive lock count.
set lock_count 0

proc efence_blurb {} {
    global efence

    if {$efence} {
	simple_expect "" "efence blank line"
	simple_expect "  Electric Fence .* Copyright .* Bruce Perens." \
		"efence init"
    }
}

proc obtain_lock {} {
    global lock_count
    global nl
    global spawn_id
    global lock_id
    global any
    global srcdir
    global python
    global test

    if {$lock_count == 0} {
	set redo 1
	while {$redo} {
	    spawn $python $srcdir/locksuite.py
	    set lock_id $spawn_id
	    set exit_warn 1
	    set test "obtaining test suite lock"
	    expect {
		-re "^locking...$nl" {
		    exp_continue
		}
		-re "^waiting: socket (.*)$nl" {
		    warning "Test suite locked by socket $expect_out(1,string)" 0
		    exp_continue
		}
		-re "^waiting: file (.*)$nl" {
		    warning "Test suite locked by file $expect_out(1,string)" 0
		    exp_continue
		}
		-re "^failed: file ($any*) (\[^ :\]*):(\[0-9\]*)$nl" {
		    warning "failed to obtain lock due to $expect_out(1,string)"
		    warning "removing stale lock $expect_out(1,string)"
		    system "rm $expect_out(1,string)"
		    send "exit\n"
		    expect bye
		    expect eof
		    wait
		    set exit_warn 0
		}
		-re "^locked (.*)$nl" {
		    pass "$test at $expect_out(1,string)"
		    set redo 0
		    set exit_warn 0
		}
		timeout {
		    exp_continue
		}
		eof {
		    fail "$test"
		    wait
		    set redo 0
		    set exit_warn 0
		}
	    }
	    if {$exit_warn == 1} {
		warning "$test: unexpected exit from expect statement" 0
	    }
	    unset test
	}
    }
    set lock_count [expr {$lock_count + 1}]
}

proc release_lock {} {
    global lock_count
    global nl
    global spawn_id
    global lock_id
    global test

    if {$lock_count == 1} {
	set spawn_id $lock_id
	send "exit\n"
	set test "releasing test suite lock"
	expect {
	    -re "queued: socket (.*)$nl" {
		warning "Test suite blocked for $expect_out(1,string)" 0
		exp_continue
	    }
	    -re "bye (.*)$nl" {
		pass "$test at $expect_out(1,string)"
	    }
	}
	unset test
	expect eof
	wait
    }
    if {$lock_count < 1} {
	error "lock already unlocked"
    } else {
	set lock_count [expr {$lock_count - 1}]
    }
}

proc l2g_start {} {
    global spawn_id
    global l2g
    global efence
    global l2g_id
    global deep_any
    global nl
    global expect_active
    global expect_always
    global test
    global MEMTRACE
    global valgrind
    global valgrind_fd

    obtain_lock

    if {$valgrind != ""} {
	spawn ./valgrind.wrap valgrind-l2g.log --suppressions=lyskomd.supp --num-callers=40 --leak-check=full --logfile-fd=$valgrind_fd --show-reachable=yes $l2g
    } else {
	spawn $l2g
    }
    set l2g_id $spawn_id
    set expect_active($l2g_id) \
	    " -i $l2g_id eof { fail \"\$test (eof on l2g)\"; wait } -re \"^($deep_any*)$nl\" { fail \"\$test (unexpected line '\$expect_out(1,string)')\" } -re \"($deep_any*)l2g> \" { fail \"\$test (unexpected incomplete line '\$expect_out(1,string)')\" } timeout { fail \"\$test (timeout on l2g)\" }"
    set expect_always($l2g_id) \
	    " -i $l2g_id full_buffer { fail \"\$test (full_buffer on l2g)\" }"

    talk_to l2g

    set test "starting l2g"
    expect {
	-re "^Where does the trace want to go today. .stderr.$nl" {
	    pass "Tracing is activated ($MEMTRACE)"
	    send "$MEMTRACE\n"
            exp_continue
	}
	-re "^l2g> " {
	    pass "$test"
	}
    }
    unset test
    send "\n"
    simple_expect "^EMPTY LINE" "noop command"

    if {$efence} {
	l2g_send "I9"
	l2g_send "a9 3 17"
	efence_blurb
    }
}

proc l2g_stop {} {
    global spawn_id

    l2g_send "q"
    simple_expect "test-l2g quitting"
    wait
    close
    check_valgrind valgrind-l2g.log 1 1 {}

    release_lock
}

proc l2g_send {str} {
    unanchored_expect "^l2g> " "prompt before $str"
    verbose "sending $str"
    send "$str\n"
}

proc fix_expect_after {} {
    global expect_always
    global expect_active
    global spawn_id

    set stmt "expect_after"

    foreach k [array names expect_always] {
	set stmt "$stmt $expect_always($k)"
    }

    if {[info exists spawn_id] && [info exists expect_active($spawn_id)]} {
	set stmt "$stmt $expect_active($spawn_id)"
    }

    verbose "evaluating $stmt" 2
    eval $stmt
}

proc simple_expect {regex {testname ""} {is_meta ""}} {
    global test
    global any
    global nl
    global line_leader
    global meta_line_leader
    global verbose

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        

    if {$is_meta == "meta"} {
	set ll $meta_line_leader
    } else {
	set ll $line_leader
    }

    if {[string range "$regex" 0 2] == "<<<"} {
	set regex "[string range "$regex" 3 end]"
	set ll ""
    }

    set test $testname
    if {$test == ""} {
	set test "looking for $regex"
    }
    if {[regexp "^(\[=%\])(\[0-9\]*)(( )(..*))?$" "$regex" all a refno]} {
	# This looks like a protocol A reply.
	verbose "simple_expect: looking for refno $refno: \"$regex\"; line leader \"$ll\"." 2
	expect {
	    -re "^$ll$regex$nl"    {pass "$test"}
	    -re "^$ll=$refno$nl"   {fail "$test (unexpected reply =$refno)"}

	    -re "^${ll}(\[=%\]$refno $any*)$nl" {
		fail "$test (unexpected reply $expect_out(1,string))"
	    }

	    timeout 	           {fail "$test (timeout)"}
	    eof 		   {fail "$test (eof)"; wait}
	    full_buffer 	   {fail "$test (full_buffer)"}
	}
    } else {
	verbose "simple_expect: looking for \"$regex\"; line leader \"$ll\"." 2
	expect {
	    -re "^$ll$regex$nl" {pass "$test"}
	    timeout 	        {fail "$test (timeout)"}
	    eof 		{fail "$test (eof)"; wait}
	    full_buffer 	{fail "$test (full_buffer)"}
	}
    }
    verbose "simple_expect: done" 2
    unset test
}

proc lyskomd_expect {regex} {
    global current_talk_what
    global current_talk_nr

    set what $current_talk_what
    set nr $current_talk_nr

    talk_to lyskomd
    simple_expect "$regex"
    talk_to $what $nr
}

proc client_expect {nr regex} {
    global current_talk_what
    global current_talk_nr

    set oldwhat $current_talk_what
    set oldnr $current_talk_nr

    talk_to client $nr
    simple_expect "$regex"
    talk_to $oldwhat $oldnr
}

proc client_good_bad_expect {nr good_regex bad_regex {xreason ""}} {
    global current_talk_what
    global current_talk_nr

    set oldwhat $current_talk_what
    set oldnr $current_talk_nr

    talk_to client $nr
    good_bad_expect "$good_regex" "$bad_regex" "$xreason"
    talk_to $oldwhat $oldnr
}

proc good_bad_expect {good_regex bad_regex {xreason ""}} {
    global test
    global any
    global nl
    global line_leader
    global meta_line_leader
    global verbose

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        
    set ll $line_leader

    if {![regexp "^(\[=%\])(\[0-9\]*)(( )(..*))?$" "$good_regex" all first refno]} {
	fail "$test (broken good regex)"
	unset test
	return
    }
    set rest "[string range "$bad_regex" 1 end]"
    if {$rest != ""} {
	set rest " $rest"
    }
    set bad_regex "[string range "$bad_regex" 0 0]$refno$rest"

    set test "looking for $good_regex (or $bad_regex)"

    expect {
	-re "^${ll}($good_regex)$nl"    {
	    if {$xreason != ""} {
		setup_xfail "*-*-*" "$xreason"
	    }
	    pass "$test (got $expect_out(1,string))"
	}
	-re "^$ll$bad_regex$nl"     {
	    if {$xreason != ""} {
		setup_xfail "*-*-*" "$xreason"
	    }
	    fail "$test (bad regex matches)"
	}
	-re "^${ll}(\[=%\]$refno $any*)$nl" {
	    fail "$test (unexpected reply $expect_out(1,string))"
	}

	timeout	           {fail "$test (timeout)"}
	eof 		   {fail "$test (eof)"; wait}
	full_buffer 	   {fail "$test (full_buffer)"}
    }
    unset test
}

proc client_extracting_expect {nr regex var grp} {
    global current_talk_what
    global current_talk_nr

    set oldwhat $current_talk_what
    set oldnr $current_talk_nr

    talk_to client $nr
    extracting_expect "$regex" $var $grp
    talk_to $oldwhat $oldnr
}


proc extracting_expect {regex var grp} {
    global test
    global any
    global nl
    global line_leader
    global $var
    global verbose

    set test "looking for $regex"

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }

    set $var ""

    expect {
	-re "^$line_leader$regex$nl" {
	    set $var $expect_out($grp,string)
	    pass "$test (extracted $expect_out($grp,string))"
	}
	timeout 	 {fail "$test (timeout)"}
	eof 		 {fail "$test (eof)"; wait}
	full_buffer 	{fail "$test (full_buffer)"}
    }
    unset test
}


proc unanchored_expect {regex testname} {
    global test
    global any
    global nl
    global verbose

    set test $testname

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        

    expect {
	-re "$regex" 	{pass "$test"}
	timeout 	{fail "$test (timeout)"}
	full_buffer 	{fail "$test (full_buffer)"}
	eof 		{fail "$test (eof)"; wait}
	-re "($any*)$nl" {
	    fail "$test (unexpected line '$expect_out(1,string)' waiting for '$regex')"
	    exp_continue
	}
	-re "($any*)l2g> " {
	    fail "$test (unexpected incomplete line '$expect_out(1,string)' waiting for '$regex')"
	}
    }
    unset test
}

proc spawn_lyskomd {logfile arg} {
    global valgrind
    global spawn_id
    global valgrind_fd

    set cmd "spawn"
    if {$valgrind != ""} {
	set cmd "$cmd ./valgrind.wrap"
	set cmd "$cmd $logfile"
	# set cmd "$cmd -v"
	set cmd "$cmd --num-callers=40"
	set cmd "$cmd --suppressions=lyskomd.supp"
	set cmd "$cmd --leak-check=full"
	set cmd "$cmd --logfile-fd=$valgrind_fd"
	set cmd "$cmd --show-reachable=yes"
    }
    set cmd "$cmd ../lyskomd"
    if { $arg == "" } {
	set cmd "$cmd -f config/lyskomd-config"
    } else {
	set cmd "$cmd $arg"
    }
    set pid [eval $cmd]
    return $pid
}

proc unpack_db {basename} {
    global srcdir

    # Check that we are in in the correct directory before removing
    # directories...
    set f [open "../lyskomd" "r"]
    close $f

    system "rm -rf db etc"
    system "mkdir db etc"
    system "cp $srcdir/lyskomd.0/$basename.data db/lyskomd-data"
    system "cp $srcdir/lyskomd.0/$basename.texts db/lyskomd-texts"
    system "chmod 644 db/lyskomd-data db/lyskomd-texts"
    if {[file exists "$srcdir/lyskomd.0/$basename.nr"]} {
	system "cp $srcdir/lyskomd.0/$basename.nr db/number.txt"
	system "chmod 644 db/number.txt"
    }
}

proc set_debug_calls {} {
    global debug_calls
    global line_leader
    global nl
    global test

    set test "Testing for debug calls"
    set debug_calls 2
    expect {
	-re "^${line_leader}WARNING: This server was compiled with --with-debug-calls\\.$nl" {
	    expect -re "^${line_leader}It isn.t safe to use in a production environment.$nl"
	    pass "$test (enabled)"
	    set debug_calls 1
	}
	-re "^${line_leader}Debug calls are disabled, as they should be\\.$nl" {
	    pass "$test (disabled)"
	    set debug_calls 0
	}
	timeout         {fail "$test (timeout)"}
	full_buffer 	{fail "$test (full_buffer)"}
	eof 		{fail "$test (eof)"; wait}
    }
    if {$debug_calls == 2} {
	fail "$test (no info found)"
	set debug_calls 0
    }
}

proc lyskomd_start {{aux_item_conf_file ""} \
	{extra_config ""} \
	{base_config ""} \
	{args ""} \
	{db_suffix ""} \
	{log_messages {}} \
	{init_db 1} \
	{want_stale 0} \
	{confs 6} \
	{texts 1} \
	{nogarb 0} \
	{db_messages {}} \
	{pre_lock_messages {}} \
	{listen_messages {}}} {

    global spawn_id
    global server_id
    global test
    global deep_any
    global nl
    global attach
    global timeout
    global expect_active
    global expect_always
    global clientport
    global aux_item_default_conf_file
    global lyskomd_pid
    global top_srcdir
    global mem_trace
    global MEMTRACE
    global line_leader
    global any

    obtain_lock

    if { $aux_item_conf_file == "" } {
        set aux_item_conf_file $aux_item_default_conf_file
    }

    # Check that we are in in the correct directory before removing
    # directories...
    set f [open "../lyskomd" "r"]
    close $f
    if {$init_db} {
	system "rm -rf db etc"
	system "mkdir db etc"
	system "cp $top_srcdir/db-crypt/db/lyskomd-data$db_suffix db/lyskomd-data"
	system "cp $top_srcdir/db-crypt/db/lyskomd-texts db/"
	system "cp $top_srcdir/db-crypt/db/number.txt db/"
	system "chmod 644 db/lyskomd-data db/lyskomd-texts db/number.txt"
    }

    set cf [open "config/lyskomd-config" "w"]
    puts $cf "Listen: $clientport"
    puts $cf "Prefix: [pwd]"

    # FIXME (bug 1088): For now, we continue to use the pre-2.1.0 file names.
    puts $cf "Data file: db/lyskomd-data"
    puts $cf "Backup file: db/lyskomd-backup"
    puts $cf "Backup file 2: db/lyskomd-backup-prev"
    puts $cf "Lock file: db/lyskomd-lock"
    puts $cf "Text file: db/lyskomd-texts"
    puts $cf "Number file: db/number.txt"
    puts $cf "Number temp file: db/number.tmp"
    puts $cf "Text backup file: db/lyskomd-texts-backup"
    puts $cf "Backup export directory: exportdb"
    puts $cf "Log file: etc/server-log"
    if {[regexp -nocase "Log statistics:" $extra_config] == 0
	&& [regexp -nocase "Log statistics:" $base_config] == 0} {
	puts $cf "Log statistics: etc/lyskomd-log"
    }
    puts $cf "Pid file: etc/pid"
    puts $cf "Memory usage file: etc/memory-usage"
    puts $cf "Status file: etc/status"
    puts $cf "Connection status file: etc/connections.txt"
    puts $cf "Connection status temp file: etc/connections.tmp"
    puts $cf "Core directory: cores"

    if { $base_config == "" } {
        if { [regexp -nocase "Max conferences:" $extra_config] == 0 } {
            puts $cf "Max conferences: 2000"
        }
        if { [regexp -nocase "Max texts:" $extra_config] == 0 } {
            puts $cf "Max texts: 20000"
        }
	if { [regexp -nocase "DNS log threshold:" $extra_config] == 0 } {
	    puts $cf "DNS log threshold: 3600"
	}
	if { [regexp -nocase "Sync interval:" $extra_config] == 0 } {
	    puts $cf "Sync interval: 1 day"
	}
	if { [regexp -nocase "Connect timeout:" $extra_config] == 0 } {
	    puts $cf "Connect timeout: 1 day"
	}
	if { [regexp -nocase "Login timeout:" $extra_config] == 0 } {
	    puts $cf "Login timeout: 1 day"
	}
        puts $cf "Aux-item definition file: $aux_item_conf_file"
    } else {
        puts $cf $base_config
    }
    puts $cf $extra_config
    close $cf

    set pid [spawn_lyskomd valgrind-lyskomd.log $args]
    set lyskomd_pid $pid

    set server_id $spawn_id
    set expect_active($server_id) \
	    " -i $server_id -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line from lyskomd: \$expect_out(1,string))\"; exp_continue } -i $server_id eof { fail \"\$test (eof on lyskomd)\"; wait } timeout { fail \"\$test (timeout on lyskomd)\" }"
    set expect_always($server_id) \
	    " -i $server_id full_buffer { fail \"\$test (full_buffer on lyskomd)\" } -i $server_id eof { fail \"\$test (eof on lyskomd)\" }"

    talk_to lyskomd
    set test "server started"
    set t $timeout
    set timeout [expr {2 * $timeout}]
    set mem_trace 0
    set unattached $attach
    expect {
	-re "^Where does the trace want to go today. .stderr." {
	    pass "Tracing is activated ($MEMTRACE)"
	    if {$unattached} {
		send_user "Please attach to lyskomd pid $pid and hit RETURN\n"
		set timeout 3600
		set t 3600
		expect_user {
		    -re .
		}
		send_user "Continuing with timeout set to $timeout\n"
		set unattached 0
	    }
	    send "$MEMTRACE\n"
	    set mem_trace 1
            exp_continue
	}
	-re "^${line_leader}... Version $any* .process $any*. started.$nl" {
	}
	timeout         {fail "$test (timeout)"}
	full_buffer 	{fail "$test (full_buffer)"}
	eof 		{fail "$test (eof)"; wait}
    }

    set_debug_calls

    foreach prelockmsg $pre_lock_messages {
	simple_expect "$prelockmsg"
    }

    set stale 0
    set test "Lock created"
    expect {
	-re "^${line_leader}Removed stale lock file left by ($any*):($any*).$nl" {
	    if {$stale == 1} {
		fail "$test (more than one stale lock file removed)"
	    } elseif {$want_stale == 0} {
		fail "$test (lyskomd removed a stale lock file)"
	    }
	    set stale 1
	    exp_continue
	}
	-re "^${line_leader}Created lock ($any*)$nl" {
	    pass "$test (lock file $expect_out(1,string)"
	}
	timeout         {fail "$test (timeout)"}
	full_buffer 	{fail "$test (full_buffer)"}
	eof 		{fail "$test (eof)"; wait}
    }   
    set timeout $t
    if {$stale == 0 && $want_stale == 1} {
	fail "$test (no stale lock file removed)"
    }
    unset test

    simple_expect "Listening for clients on 0.0.0.0:$clientport."
    foreach listenmsg $listen_messages {
	simple_expect "$listenmsg"
    }
    simple_expect "Database = [pwd]/db/lyskomd-data"
    simple_expect "Backup = [pwd]/db/lyskomd-backup"
    simple_expect "2nd Backup = [pwd]/db/lyskomd-backup-prev"
    simple_expect "Lock File = [pwd]/db/lyskomd-lock"
    simple_expect "MSG: init_cache: using datafile."
    simple_expect "Database saved on $any*"

    foreach dbmsg $db_messages {
	simple_expect "$dbmsg"
    }

    simple_expect "Read $confs confs/persons and $texts texts"

    foreach logmsg $log_messages {
	simple_expect "$logmsg"
    }

    if {$nogarb == 0} {
	simple_expect "MSG: garb started."
	simple_expect "MSG: garb ready. 0 texts deleted."
    }

    if {$unattached} {
	send_user "Please attach to lyskomd process $pid and press RETURN\n"
	set timeout 3600
	expect_user {
	    -re .
	}
	send_user "Continuing with timeout set to $timeout\n"
    }
}

proc lyskomd_fail_start {log_messages
			 {aux_item_conf_file "" }
                         {extra_config ""}
                         {base_config ""}
                         {args ""}
			 {pre_lock_messages {}}
			 {expected_leaks {}}} {
    global spawn_id
    global server_id
    global test
    global deep_any
    global any
    global nl
    global line_leader
    global timeout
    global expect_active
    global expect_always
    global clientport
    global aux_item_default_conf_file
    global lyskomd_pid
    global top_srcdir
    global MEMTRACE

    obtain_lock

    if { $aux_item_conf_file == "" } {
        set aux_item_conf_file $aux_item_default_conf_file
    }

    # Check that we are in in the correct directory before removing
    # directories...
    set f [open "../lyskomd" "r"]
    close $f
    system "rm -rf db etc"
    system "mkdir db etc"
    system "cp $top_srcdir/db-crypt/db/lyskomd-data db/"
    system "cp $top_srcdir/db-crypt/db/lyskomd-texts db/"
    system "cp $top_srcdir/db-crypt/db/number.txt db/"
    system "chmod 644 db/lyskomd-data db/lyskomd-texts db/number.txt"

    set cf [open "config/lyskomd-config" "w"]
    puts $cf "Listen: $clientport"
    if { $base_config == "" } {
        puts $cf "Max conferences: 2000"
        puts $cf "Max texts: 2000"
        puts $cf "Prefix: [pwd]"
        puts $cf "Aux-item definition file: $aux_item_conf_file"

	# FIXME (bug 1088): For now, we continue to use the pre-2.1.0 file names.
	puts $cf "Data file: db/lyskomd-data"
	puts $cf "Backup file: db/lyskomd-backup"
	puts $cf "Backup file 2: db/lyskomd-backup-prev"
	puts $cf "Lock file: db/lyskomd-lock"
	puts $cf "Text file: db/lyskomd-texts"
	puts $cf "Number file: db/number.txt"
	puts $cf "Number temp file: db/number.tmp"
	puts $cf "Text backup file: db/lyskomd-texts-backup"
	puts $cf "Backup export directory: exportdb"
	puts $cf "Log file: etc/server-log"
	puts $cf "Log statistics: etc/lyskomd-log"
	puts $cf "Pid file: etc/pid"
	puts $cf "Memory usage file: etc/memory-usage"
	puts $cf "Status file: etc/status"
	puts $cf "Connection status file: etc/connections.txt"
	puts $cf "Connection status temp file: etc/connections.tmp"
	puts $cf "Core directory: cores"
    } else {
        puts $cf $base_config
    }
    puts $cf $extra_config
    close $cf

    set pid [spawn_lyskomd valgrind-lyskomdfail.log $args]
    set lyskomd_pid $pid

    set server_id $spawn_id
    set expect_active($server_id) \
	    " -i $server_id -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line from lyskomd: \$expect_out(1,string))\"; exp_continue } -i $server_id eof { fail \"\$test (eof on lyskomd)\"; wait } timeout { fail \"\$test (timeout on lyskomd)\" }"
    set expect_always($server_id) \
	    " -i $server_id full_buffer { fail \"\$test (full_buffer on lyskomd)\" } -i $server_id eof { fail \"\$test (eof on lyskomd)\" }"

    talk_to lyskomd
    set test "server start failed"
    set t $timeout
    set timeout [expr {2 * $timeout}]
    
    expect {
	-re "^Where does the trace want to go today. .stderr." {
	    pass "Tracing is activated ($MEMTRACE)"
	    send "$MEMTRACE\n"
            exp_continue
	}
	-re "^${line_leader}... Version $any* .process $any*. started.$nl" {
	}
	timeout         {fail "$test (timeout)" }
	full_buffer 	{fail "$test (full_buffer)" }
	eof 		{fail "$test (eof)"; wait}
    }

    foreach prelockmsg $pre_lock_messages {
	simple_expect "$prelockmsg"
    }

    set_debug_calls

    foreach logmsg $log_messages {
	simple_expect "$logmsg"
    }
    simple_expect "Previous message is fatal. Will dump core now."
    simple_expect "Search for the core in [pwd]"

    set timeout $t

    set test "server died"
    expect {
        timeout   { fail "$test (timeout)" }
        eof       { pass "$test"; wait }
    }
    unset expect_always($server_id)
    unset expect_active($server_id)
    unset spawn_id
    fix_expect_after
    check_valgrind valgrind-lyskomdfail.log 0 0 $expected_leaks

    release_lock
}

proc check_memory_usage {} {
    global memix

    set allocated_strings unknown
    set allocated_blocks unknown
    set existing_confs unknown

    set f [ open "etc/memory-usage" ]
    while { [ gets $f line] >= 0 } {
        if { [regexp "Allocated blocks .grand total." $line] } {
            set allocated_blocks [lindex "$line" [expr [llength "$line"] - 1]]
        } elseif { [regexp "Allocated strings" $line] } {
            set allocated_strings [lindex "$line" [expr [llength "$line"] - 1]]
        } elseif { [regexp "Existing confs:" $line] } {
	    set existing_confs [lindex "$line" [expr [llength "$line"] - 1]]
	}
    }
    close $f

    if { $allocated_blocks != 0 } {
	while {[file exists "memory-usage-$memix.log"]} {
	    set memix [expr $memix + 1]
	}
	set saved "memory-usage-$memix.log"
	system "mv etc/memory-usage $saved"
        fail "Allocated blocks on exit (see $saved)"
    } else {
        pass "Allocated blocks on exit"
    }
    if { $allocated_strings != 0 } {
        fail "Allocated strings on exit"
    } else {
        pass "Allocated strings on exit"
    }
    if { $existing_confs != 0 } {
        fail "Existing conferences on exit"
    } else {
        pass "Existing conferences on exit"
    }
}

proc parse_valgrind_leak {f} {
    if {[gets $f line] < 0} {
	fail "valgrind EOF in leak summary"
	return 999
    }
    if {[regexp ":  *\[0-9\]* bytes in (\[0-9\]*) block" "$line" all blocks]} {
	return $blocks
    }
    fail "valgrind leak report parse error"
    return 998
}

proc check_valgrind {logfile need_leaks need_errs expected_leaks} {
    # The "expected_leaks" argument should be a such as:
    #
    #   {"Bug 99 & Bug 93" 4 3 9 11}
    #
    # that indicates that due to Bug 99 and Bug 93 there will be 4
    # definite leaks, 3 possible leaks, 9 still reachable blocks, and
    # 11 suppressed leaks.
    
    global valgrindix
    global valgrind
    global test

    if {$valgrind == ""} {
	return
    }

    set errfound 0
    set memfound 0
    set errcount 0
    set leakcount 0

    # Rename the file.  $saved holds the new name.
    while {[file exists "valgrind-$valgrindix.log"]} {
	set valgrindix [expr $valgrindix + 1]
    }
    set saved "valgrind-$valgrindix.log"
    system "mv $logfile $saved"

    # Should the log file be kept?
    set keep 0

    set f [open $saved]
    while {[gets $f line] >= 0} {
	if {[regexp "ERROR SUMMARY: (\[0-9\]*) errors" $line match errs]} {
	    if {$errfound} {
		fail "check_valgrind logic error due to $saved"
		set keep 1
	    } else {
		set errfound 1
		set errcount $errs
	    }
	}
	if {[regexp "LEAK SUMMARY:" $line]} {
	    set memfound 1
	    set definite [parse_valgrind_leak $f]
	    set possible [parse_valgrind_leak $f]
	    set reachable [parse_valgrind_leak $f]
	    set suppressed [parse_valgrind_leak $f]
	    if {$expected_leaks != {}} {
		set xreason [lindex $expected_leaks 0]
		set exp_def [lindex $expected_leaks 1]
		set exp_pos [lindex $expected_leaks 2]
		set exp_rea [lindex $expected_leaks 3]
		set exp_sup [lindex $expected_leaks 4]

		setup_xfail "*-*-*" $xreason
		if {$exp_def == $definite
		    && $exp_pos == $possible
		    && $exp_rea == $reachable
		    && $exp_sup == $suppressed} {

		    fail "memory leaks: $definite definite, $possible possible"
		    
		    set definite 0
		    set possible 0
		    set reachable 0
		    set suppressed 0
		} else {
		    pass "wrong memory leak count found"
		}
	    }
	    set leakcount [expr $definite + $possible + $reachable]
	    # Ignore up to 25 suppressed blocks.
	    if {$suppressed > 25} {
	    	set leakcount "$suppressed"
	    }
	}
	if {[regexp "No malloc'd blocks -- no leaks are possible" $line]} {
	    set memfound 1
	}
    }
    close $f
    if {$errfound == 0 && $need_errs == 1} {
	fail "no error summary in valgrind output $saved"
	set keep 1
    }

    if {$memfound == 0 && $need_leaks == 1} {
	fail "no malloc summary in valgrind output $saved"
	set keep 1
    }

    if {$errcount == 0} {
	pass "valgrind found no errors"
    } else {
	fail "valgrind found $errcount error(s).  See $saved."
	set keep 1
    }
    if {$leakcount == 0} {
	pass "valgrind found no leaks"
    } else {
	if {$definite} {
	    fail "valgrind found $definite definite leaks.  See $saved."
	    set keep 1
	}
	if {$possible} {
	    fail "valgrind found $possible possible leaks.  See $saved."
	    set keep 1
	}
	if {$reachable} {
	    fail "valgrind found $reachable reachable blocks.  See $saved."
	    set keep 1
	}
	if {$suppressed} {
	    fail "valgrind found $suppressed suppressed blocks.  See $saved."
	    set keep 1
	}
    }

    if {$keep == 0} {
	system rm $saved
    }
}

proc lyskomd_death {{expected_leaks {}} {reason 5}} {
    # See check_valgrind for a description of "expected_leaks".
    global spawn_id
    global server_id
    global test
    global any
    global nl
    global expect_active
    global expect_always

    talk_to lyskomd
    if {$reason == "signal"} {
	simple_expect "Signal TERM received. Shutting down server."
    } elseif {$reason == "sighup"} {
	simple_expect "Signal HUP received. Shutting down server. Please use SIGTERM instead."
    } elseif {$reason == "sigint"} {
	simple_expect "Signal INT received. Shutting down server. Please use SIGTERM instead."
    } elseif {$reason == "restart_kom"} {
	simple_expect "Search for the core in $any*"
    } else {
	simple_expect "shutdown initiated by person $reason $any*"
    }
    if {$reason != "restart_kom"} {
	simple_expect "../lyskomd terminated normally."
	simple_expect "Press enter to terminate lyskomd"
	send "\n"
    }
    set test "server died"
    expect {
	timeout  { fail "$test (timeout)" }
	eof      { pass "$test"; wait }
    }
    unset expect_active($server_id)
    unset expect_always($server_id)
    unset spawn_id
    fix_expect_after

    if {$reason != "restart_kom"} {
	system "cat etc/memory-usage >> usage.all"
	check_memory_usage
	check_valgrind valgrind-lyskomd.log 1 1 $expected_leaks
    }
    dbck_run

    release_lock
}

proc kill_lyskomd {} {
    global lyskomd_pid
    global test
    global spawn_id
    global expect_active
    global expect_always
    global server_id

    talk_to lyskomd
    system "kill -KILL $lyskomd_pid"
    set test "server died"
    expect {
	timeout  { fail "$test (timeout)" }
	eof      { pass "$test"; wait }
    }
    unset expect_active($server_id)
    unset expect_always($server_id)
    unset spawn_id
    fix_expect_after

    release_lock
}

proc dbck_run {{extra_lines {}}} {
    global nl
    global any
    global test
    global any_num
    global DBCK_MEMTRACE
    global valgrind
    global spawn_id
    global valgrind_fd

    if {$valgrind != ""} {
	spawn ./valgrind.wrap valgrind-dbck.log --leak-check=full --suppressions=lyskomd.supp --num-callers=40 --logfile-fd=$valgrind_fd --show-reachable=yes ../dbck -d config/lyskomd-config
    } else {
	spawn ../dbck -d config/lyskomd-config
    }
    set test "dbck started"
    expect_after {
	timeout { fail "$test (timeout)" }
	eof { fail "$test (eof)" }
    }
    expect {
	-re "^Where does the trace want to go today. .stderr.$nl" {
	    pass "Tracing is activated ($DBCK_MEMTRACE)"
	    send "$DBCK_MEMTRACE\n"
            exp_continue
	}
	-re "^MSG: init_cache: using datafile\.$nl" { 
            pass "$test" 
        }
    }

    foreach line $extra_lines {
	set test "dbck sent extra line $line"
	expect {
	    -re "^$line$nl" {
		pass "$test"
	    }
	}
    }

    set test "dbck sent second line"
    expect {
	-re "^Read $any_num confs/persons and $any_num texts, eof at $any_num$nl" {
	    pass "$test"
	}
    }
    set test "dbck sent final line"
    expect {
	-re "^Press enter to terminate dbck$nl" {
	    pass "$test"
	}
	-re "^($any*)$nl" {
	    fail "$test (unexpected line: $expect_out(1,string))"
	    exp_continue
	}
    }
    send "\n"
    set test "dbck died"
    expect {
	eof { pass "$test"; wait }
    }
    unset test
    check_valgrind valgrind-dbck.log 0 1 {}
}
    
proc client_start {nr {port 0}} {
    global client_id
    global clientport
    global spawn_id
    global test
    global nl
    global expect_always
    global expect_active
    global srcdir
    global deep_any
    global python

    if {$port == 0} {
	set port $clientport
    }

    spawn $python $srcdir/tcpconnect.py localhost $port MRK:client$nr
    set client_id($nr) $spawn_id
    set expect_active($client_id($nr)) " -i $client_id($nr) -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line \$expect_out(1,string))\"; exp_continue } timeout { fail \"\$test (timeout on client $nr)\" }"
    set expect_always($client_id($nr)) \
	    " -i $client_id($nr) full_buffer { fail \"\$test (full_buffer on client$nr)\" } "

    talk_to client $nr

    simple_expect "Connecting to localhost $port" \
	    "client connects" meta
    simple_expect "Connected" "client connected" meta
}

proc client_start_fail {nr {response ""}} {
    global client_id
    global clientport
    global spawn_id
    global test
    global nl
    global expect_always
    global expect_active
    global srcdir
    global deep_any
    global python

    obtain_lock

    spawn $python $srcdir/tcpconnect.py localhost $clientport MRK:client$nr
    set client_id($nr) $spawn_id
    set expect_active($client_id($nr)) " -i $client_id($nr) -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line \$expect_out(1,string))\"; exp_continue } timeout { fail \"\$test (timeout on client $nr)\" }"
    set expect_always($client_id($nr)) \
	    " -i $client_id($nr) eof { fail \"\$test (eof on client$nr)\" } -i $client_id($nr) full_buffer { fail \"\$test (full_buffer on client$nr)\" } "

    talk_to client $nr

    simple_expect "Connecting to localhost $clientport" \
	    "client connects" meta
    simple_expect "Connected" "client connected" meta

    if { $response != "" } {
        simple_expect "$response"
    }

    simple_expect "EOF on socket" "client $nr got EOF from server" meta
    send "die\n"
    set test "client $nr closes pty"
    expect {
	eof { pass "$test"; wait }
    }
    unset test

    unset expect_active($client_id($nr))
    unset expect_always($client_id($nr))
    unset spawn_id

    fix_expect_after

    release_lock
}

proc kill_client {nr} {
    global client_id
    global expect_always
    global expect_active
    global timeout
    global line_leader
    global test
    global any
    global nl

    set old_timeout $timeout
    set timeout 0
    talk_to client $nr
    set test "looking for stray output before killing client $nr"
    set ok 1
    expect {
	-re "^${line_leader}($any*)$nl" {
	    fail "$test (got $expect_out(1,string))"
	    set ok 0
	    exp_continue
	}
	-re "^${line_leader}($any*)" {
	    fail "$test (got $expect_out(1,string)) (no end-of-line)"
	    set ok 0
	    exp_continue
	}
	-re "($any$any*)" {
	    fail "$test (got $expect_out(1,string)) (bad line-leader)"
	    set ok 0
	    exp_continue
	}
	timeout {
	    if {$ok} {
		pass "$test"
	    }
	}
	eof {
	    fail "$test (eof on client)"
	}
    }
    unset test
    set timeout $old_timeout
   
    close -i $client_id($nr)
    wait -i  $client_id($nr)
    unset expect_active($client_id($nr))
    unset expect_always($client_id($nr))
    fix_expect_after
}

proc suspend_client {} {
    global current_talk_nr

    send "\#suspend socket\n"
    simple_expect "suspended" "client $current_talk_nr suspended" meta
}

proc hose_client {} {
    send "\#hose socket\n"
}

proc resume_client {} {
    global current_talk_nr

    send "\#resume socket\n"
    simple_expect "resumed" "client $current_talk_nr resumed" meta
}

proc client_death {nr} {
    global client_id
    global spawn_id
    global test
    global expect_always
    global expect_active

    talk_to client $nr

    simple_expect "EOF on socket" "client $nr got EOF from server" meta
    send "die\n"
    set test "client $nr closes pty"
    expect {
	eof { pass "$test"; wait }
    }
    unset test

    unset expect_active($client_id($nr))
    unset expect_always($client_id($nr))
    unset spawn_id

    fix_expect_after
}
    
proc get_time_client_start {nr args} {
    global get_time_client_id
    global clientport
    global spawn_id
    global test
    global nl
    global expect_always
    global expect_active
    global deep_any

    set cmd "spawn ./get-time-often --silent"
    foreach a $args {
	set cmd "$cmd $a"
    }
    set cmd "$cmd localhost $clientport"
    eval $cmd
    set get_time_client_id($nr) $spawn_id
    set expect_active($get_time_client_id($nr)) " -i $get_time_client_id($nr) -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line \$expect_out(1,string))\"; exp_continue } timeout { fail \"\$test (timeout on get_time_client $nr)\" }"
    set expect_always($get_time_client_id($nr)) \
	    " -i $get_time_client_id($nr) full_buffer { fail \"\$test (full_buffer on get_time_client $nr)\" } "

    talk_to get_time_client $nr

    simple_expect "connected"
    simple_expect "handshake OK"
}

proc get_time_client_death {nr} {
    global get_time_client_id
    global spawn_id
    global test
    global expect_always
    global expect_active

    talk_to get_time_client $nr

    set test "get_time_client $nr closes pty"
    expect {
	eof { pass "$test"; wait }
    }
    unset test

    unset expect_active($get_time_client_id($nr))
    unset expect_always($get_time_client_id($nr))
    unset spawn_id

    fix_expect_after
}

proc utility_start {nr args} {
    global utility_id
    global spawn_id
    global test
    global nl
    global expect_always
    global expect_active
    global deep_any

    set cmd "spawn "
    foreach a $args {
	set cmd "$cmd $a"
    }
    eval $cmd
    set utility_id($nr) $spawn_id
    set expect_active($utility_id($nr)) " -i $utility_id($nr) -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line \$expect_out(1,string))\"; exp_continue } timeout { fail \"\$test (timeout on utility $nr)\" }"
    set expect_always($utility_id($nr)) \
	    " -i $utility_id($nr) full_buffer { fail \"\$test (full_buffer on utility $nr)\" } "

    talk_to utility $nr
}

proc utility_death {nr} {
    global utility_id
    global spawn_id
    global test
    global expect_always
    global expect_active

    talk_to utility $nr

    set test "utility $nr closes pty"
    expect {
	eof { pass "$test"; wait }
    }
    unset test

    unset expect_active($utility_id($nr))
    unset expect_always($utility_id($nr))
    unset spawn_id

    fix_expect_after
}


proc talk_to {what {nr ""}} {
    global spawn_id
    global server_id
    global client_id
    global get_time_client_id
    global utility_id
    global l2g_id
    global line_leader
    global meta_line_leader
    global current_talk_what
    global current_talk_nr
    global any_num

    set line_leader ""
    set meta_line_leader ""

    switch $what {
	lyskomd {
	    set spawn_id $server_id
	    set line_leader "\[0-9\]\[0-9\]\[0-9\]\[0-9\]\[0-9\]\[0-9\] \[0-9\]\[0-9\]:\[0-9\]\[0-9\]:\[0-9\]\[0-9\] $any_num "
	}
	client {
	    set spawn_id $client_id($nr)
	    set line_leader "MRK:client$nr"
	}
	get_time_client {
	    set spawn_id $get_time_client_id($nr)
	}
	utility {
	    set spawn_id $utility_id($nr)
	}
	l2g {
	    set spawn_id $l2g_id
	}
	default {
	    error "attempting to talk to $what"
	}
    }

    set current_talk_what $what
    set current_talk_nr $nr

    if {$line_leader != "" && $what != "lyskomd"} {
	set meta_line_leader "${line_leader}meta: "
	set line_leader "${line_leader}: "
    }

    verbose "TALKING TO $spawn_id $what $nr"
    fix_expect_after
}

proc holl {str} {
    return "[string length $str]H$str"
}

proc idholl {str} {
    global lyskomd_host;
    return [holl "$str@$lyskomd_host"]
}

proc read_versions {} {
    # Read $top_srcdir/versions and store the versions in global variables.
    global top_srcdir
    global protocol_a_level
    global server_software
    global server_version
    global server_compat_version

    set f [open "$top_srcdir/versions"]
    while {[gets $f line] >= 0} {
	if {[lindex $line 0] == "PROTOCOL-A-LEVEL:"} {
	    set protocol_a_level [lindex $line 1]
	} elseif {[lindex $line 0] == "SERVER-SOFTWARE:"} {
	    set server_software [lindex $line 1]
	} elseif {[lindex $line 0] == "SERVER-VERSION:"} {
	    set server_version [lindex $line 1]
	} elseif {[lindex $line 0] == "SERVER-COMPAT-VERSION:"} {
	    set server_compat_version [lindex $line 1]
	}
    }
    close $f
}

proc dump_statistics {} {
    global lyskomd_pid

    system "kill -USR1 $lyskomd_pid"
}

# If you want to override the timeout or some other values, you
# can do so by creating "localcfg.exp" in the build tree.
if {[file exists "config/localcfg.exp"]} {
    source "config/localcfg.exp"
}