# -*- tcl -*-
# This file is part of Mailfromd testsuite.
# Copyright (C) 2003, 2006 Sergey Poznyakoff
#
# Mailfromd is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# Mailfromd is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Mailfromd; if not, write to the Free Software Foundation,
# Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

proc start_daemon {args} {
    global MAILFROMD_TESTDIR
    global MAILFROMD_STATE_DIR
    global MAILFROMD_ETC_DIR
    global MAILFROMD_TOOL
    global MAILFROMD_PID

    verbose "START_DAEMON"

    set pidfile $MAILFROMD_STATE_DIR/mailfromd.pid
    file delete $pidfile
    set script [lindex $args 0]
    verbose "SCRIPT $script [regexp \"/.*\" $script]"
    if ![string equal -length 1 $script "/"] {
	set script "$MAILFROMD_ETC_DIR/$script"
    }
    verbose "$MAILFROMD_TOOL \
                     --port=unix:/tmp/mailfromd-test/socket\
                     --remove\
                     --pidfile=$pidfile\
                     --transcript\
                     --trace\
                     --debug=100\
                     --log-tag=testing-mailfromd\
                     -I$MAILFROMD_TESTDIR/etc\
                     --log-facility=mail\
		     $script"
    if [catch {exec "$MAILFROMD_TOOL" \
                     "--port=unix:/tmp/mailfromd-test"\
                     "--remove"\
                     "--pidfile=$pidfile"\
                     "--transcript"\
                     "--trace"\
                     "--debug=100"\
                     "-I$MAILFROMD_TESTDIR/etc"\
                     "--log-tag=testing-mailfromd"\
		     "--log-facility=mail"\
                     $script} diag] {
	fail "Cannot start mailfromd: $diag"
	return
    }
#     remote_exec host "$MAILFROMD_TOOL" \
#                       --port=unix:$MAILFROMD_STATE_DIR/socket\
#                       --remove\
#                       --pidfile=$pidfile\
#                       --transcript\
#                       --trace\
#                       --debug=100\
#                       --log-tag=testing-mailfromd\
#                       -I$MAILFROMD_TESTDIR/etc\
#                       --log-facility=mail\
#                       $MAILFROMD_ETC_DIR/[lindex $args 0]"

    set attempt 0
    while {![file exists $pidfile]} {
	incr attempt
	if {$attempt > 10} {
	    fail "Cannot start mailfromd"
	    exit 1
	}
	sleep 1
    }
    set chan [open $pidfile r]
    gets $chan MAILFROMD_PID
    verbose "Daemon PID $MAILFROMD_PID"
    close $chan
}

proc kill_daemon {} {
    global MAILFROMD_PID

    if {![info exists MAILFROMD_PID]} {
	return
    }

    # Tcl has no kill primitive. The following Ruby Goldberg trick is
    # borrowed from DejaGNU (see remote.exp)
    verbose "Killing mailfromd daemon $MAILFROMD_PID"
    exec sh -c "exec > /dev/null 2>&1 && \
        (kill -2 $MAILFROMD_PID || kill -2 $MAILFROMD_PID) && \
         sleep 5 && (kill -15 $MAILFROMD_PID || kill $MAILFROMD_PID) && \
         sleep 5 && (kill -9 $MAILFROMD_PID || kill -9 $MAILFROMD_PID)" &;
}



proc mailfromd_init {args} {
    global TOOL_EXECUTABLE
    global MAILFROMD_TOOL
    global MAILFROMD_STATE_DIR
    global MAILFROMD_ETC_DIR
    global MAILFROMD_TOOL_FLAGS
    global MAILFROMD_TESTDIR
    global MAILFROMD_SRCDIR
    global MAILFROMD_TOP_SRCDIR
    global MAILFROMD_CONFIG_FILE
    global tool
    global base_dir
    global top_srcdir
    global objdir
    global host_board
    global srcdir

    verbose "MAILFROMD_INIT "
    
    if [info exists TOOL_EXECUTABLE] {
	set MAILFROMD_TOOL $TOOL_EXECUTABLE
    }

    if ![info exists MAILFROMD_TOOL] {
	if ![is_remote host] {
	    set MAILFROMD_TOOL [findfile $base_dir/../src/$tool "$base_dir/../src/$tool" [transform $tool]]
	    set MAILFROMD_SRCDIR "$srcdir"
	    set MAILFROMD_TOP_SRCDIR "$top_srcdir"
	    set MAILFROMD_TESTDIR "$objdir"
	    set MAILFROMD_ETC_DIR "$top_srcdir/testsuite/etc"
	    set MAILFROMD_STATE_DIR "$objdir/state"
	} else {
	    if [info exists host_board] {
		if [board_info $host_board exists top_builddir] {
		    append MAILFROMD_TOOL "[board_info $host_board top_builddir]/$tool/$tool"
		} elseif [board_info $host_board exists top_srcdir] {
		    append MAILFROMD_TOOL "[board_info $host_board top_srcdir]/$tool/$tool"
	        }
	    }

	    if ![info exists MAILFROMD_TOOL] {
		perror "The test suite is not set up for the remote testing"
	        perror "Please, read file README in $tool/testsuite subdirectory"
	        perror "for instructions on how to set up it."
	        exit 1
	    }
	    set MAILFROMD_SRCDIR "[board_info $host_board srcdir]"
	    set MAILFROMD_TOP_SRCDIR "[board_info $host_board top_srcdir]"
	    set MAILFROMD_TESTDIR "[board_info $host_board objdir]"
	    set MAILFROMD_ETC_DIR "[board_info $host_board top_srcdir]/testsuite/etc"
	    set MAILFROMD_STATE_DIR "[board_info $host_board objdir]/state"
	}
    }
    set MAILFROMD_CONFIG_FILE [lindex $args 0]
    verbose "MAILFROMD_TOOL=$MAILFROMD_TOOL"    

    verbose "Preparing stat directory"
    if ![file exists $MAILFROMD_STATE_DIR] {
	file mkdir $MAILFROMD_STATE_DIR
    } elseif ![file isdirectory $MAILFROMD_STATE_DIR] {
	error "$MAILFROMD_STATE_DIR exists but is not a directory"
    } else {
	file delete -force $MAILFROMD_STATE_DIR
	file mkdir $MAILFROMD_STATE_DIR
    }
    
    verbose "Preparing mqueue directory"
    set mqdir "$MAILFROMD_STATE_DIR/mqueue"
    if ![file exists $mqdir] {
	file mkdir $mqdir
    } elseif ![file isdirectory $mqdir] {
	error "$mqdir exists but is not a directory"
    }
}

proc default_mailfromd_start {args} {
    global MAILFROMD_TOOL
    global MAILFROMD_TOOL_FLAGS
    global MAILFROMD_ETC_DIR
    global MAILFROMD_STATE_DIR
    global MAILFROMD_CONFIG_FILE
    global MAILFROMD_TESTDIR
    global expect_out
    global mta_spawn_id

    verbose "DEFAULT_MAILFROMD_START"
    
    if [info exists MAILFROMD_CONFIG_FILE] {
	start_daemon $MAILFROMD_CONFIG_FILE
    } else {
        verbose "Config file $MAILFROMD_CONFIG_FILE does not exist!!!"
    }

    set sw "-Ltesting -bs -C $MAILFROMD_TESTDIR/etc/sendmail.cf"

    # FIXME:
    set SENDMAIL_TOOL "sendmail"
    set cmd "$SENDMAIL_TOOL $sw"
    verbose "Spawning $cmd"

    set mta_spawn_id [remote_spawn host $cmd]
    if { $mta_spawn_id < 0 || $mta_spawn_id == "" } {
	perror "Spawning $cmd failed."
	return 1;
    }

    return 0
}

proc default_mailfromd_stop {} {
    global mta_spawn_id
    verbose -log "STOPPING MAILFROMD"
    kill_daemon
    if {[info exists mta_spawn_id] && $mta_spawn_id > 0} {
	remote_close host
	unset mta_spawn_id
    }
}

proc mailfromd_stop {} {
    default_mailfromd_stop
}

proc mailfromd_send { string } {
    global suppress_flag;
    if {[info exists suppress_flag] && $suppress_flag} {
	return "suppressed";
    }
    return [remote_send host "$string"]
}

proc mailfromd_command { cmd } {
    set res [mailfromd_send "$cmd\n"]
    mailfromd_expect 30 {
	-ex "\r\n" { }
	default {
	    perror "mailfromd_command for target failed";
	    return -1
	}
    }
    if { $res == "" } {
	set res 0
    }
    verbose "mailfromd_command RESULT: $res" 2
    return $res
}

proc mailfromd_expect { args } {
    global env
    if { [lindex $args 0] == "-notransfer" } {
	set notransfer -notransfer;
	set args [lrange $args 1 end];
    } else {
	set notransfer "";
    }

    if { [llength $args] == 2  && [lindex $args 0] != "-re" } {
	set gtimeout [lindex $args 0];
	set expcode [list [lindex $args 1]];
    } else {
	upvar timeout timeout;

	set expcode $args;
	if [target_info exists mailfromd,timeout] {
	    if [info exists timeout] {
		if { $timeout < [target_info mailfromd,timeout] } {
		    set gtimeout [target_info mailfromd,timeout];
		} else {
		    set gtimeout $timeout;
		}
	    } else {
		set gtimeout [target_info mailfromd,timeout];
	    }
	}

	if ![info exists gtimeout] {
	    global timeout;
	    if [info exists timeout] {
		set gtimeout $timeout;
	    } else {
		# Eeeeew.
		set gtimeout 60;
	    }
	}
    }

    global suppress_flag;
    global remote_suppress_flag;
    global verbose
    if [info exists remote_suppress_flag] {
	set old_val $remote_suppress_flag;
    }
    if [info exists suppress_flag] {
	if { $suppress_flag } {
	    set remote_suppress_flag 1;
	}
    }

    verbose "EXPCODE is $expcode" 4
    verbose "RUNNING remote_expect host $gtimeout $notransfer" 2

    set code [catch \
	{uplevel remote_expect host $gtimeout $notransfer $expcode} string];
    if [info exists old_val] {
	set remote_suppress_flag $old_val;
    } else {
	if [info exists remote_suppress_flag] {
	    unset remote_suppress_flag;
	}
    }

    verbose "mailfromd_expect CODE: $code" 2
    if {$code == 1} {
        global errorInfo errorCode;

	return -code error -errorinfo $errorInfo -errorcode $errorCode $string
    } elseif {$code == 2} {
	return -code return $string
    } elseif {$code == 3} {
	return 
    } elseif {$code > 4} {
	return -code $code $string
    }
}

proc mailfromd_expect_list {args} {
    set tmt [lindex $args 0]
    set pattern [lindex $args 1]

    set result 0
    for {set i 0} {$i < [llength $pattern]} {incr i} {
	set regexp 0
	switch -exact -- "[lindex ${pattern} $i]" {
	    -re		{ set regexp 1; incr i }
	    --          { incr i }
	}

	regsub "\[ \t\]*$" [lindex ${pattern} $i] "" pat
	verbose "i=$i, pat=$pat, regexp=$regexp" 2

	if {$regexp} {
	   verbose "REGEX for $pat / [llength $pat] " 3
	   mailfromd_expect $tmt {
	       -re $pat { }
	       default {
		   set result 1
		   break
	       }
	       timeout {
		   set result -2
		   break
	       }
	       eof {
		   set result -3
		   break
	       }
	   }
       } else {
	   mailfromd_expect $tmt {
	       -ex "$pat" {
		   if { $expect_out(buffer) != $expect_out(0,string) } {
		       verbose "Got \"$expect_out(buffer)\"" 2
		       verbose "instead of expected \"$pat\\r\\n\"" 2
		       set result 1
		       break
		   }
	       }
 	       default {
		   set result 1
		   break
	       }
	       timeout {
		   set result -2
		   break
	       }
	       eof {
		   set result -3
		   break
	       }
	   }
       }
       if {$result == 0} {
	   mailfromd_expect $tmt {
	       -re "^\[ \t]*\r\n" { }
	       default { set result 1 }
	       timeout { set result -2 }
	       eof { set result -3 }
           }
	}
    }
    return $result
}    

# mailfromd_test COMMAND PATTERN
# COMMAND   - Command to send to the program
# PATTERN   - A list of strings to expect in return
# Return value:
#        -3 - eof
#        -2 - timeout
#        -1 - generic failure
#         1 - test fails
#         0 - test succeeds
proc mailfromd_test { args } {
    global verbose
    global suppress_flag
    upvar timeout timeout
    
    set command [lindex $args 0]
    set pattern [lindex $args 1]

    if { [info exists suppress_flag] && $suppress_flag } {
	set do_suppress 1
    } else {
	set do_suppress 0
    }

    if $verbose>2 then {
	send_user "Command: \"$command\"\n"
	send_user "Pattern: \"$pattern\"\n"
    }
    
    set result -1
    if { "${command}" != "" } {
	set res [mailfromd_command "${command}"]
	if { $res != "" } {
	    if { ! $do_suppress } {
		perror "Couldn't send \"$command\": $res.";
	    }
	    return $result;
        }
    }

    if [info exists timeout] {
	set tmt $timeout;
    } else {
	global timeout;
	if [info exists timeout] {
	    set tmt $timeout;
	} else {
	    set tmt 60;
	}
    }

    set result 0
    for {set i 0} {$result == 0 && $i < [llength $pattern]} {incr i} {
	verbose "NEXT ($i)"
	set regexp 0
	switch -exact -- "[lindex ${pattern} $i]" {
	    -re		{ set regexp 1; incr i }
	    --          { incr i }
	}

	regsub "\[ \t\]*$" [lindex ${pattern} $i] "" pat
	verbose "i=$i, pat=$pat, regexp=$regexp" 2

	if {$regexp} {
	   mailfromd_expect $tmt {
	       -re "$pat\[ \r\t\]*\r\n" { }
	       default {
		   set result 1
		   break
	       }
	       timeout {
		   set result -2
		   break
	       }
	       eof {
		   set result -3
		   break
	       }
	   }
       } else {
	   mailfromd_expect $tmt {
	       -ex "$pat" {
		   if { $expect_out(buffer) != $expect_out(0,string) } {
		       verbose "Got \"$expect_out(buffer)\"" 2
		       verbose "instead of expected \"$pat\\r\\n\"" 2
		       set result 1
		       break
		   }
	       }
 	       default {
		   set result 1
		   break
	       }
	       timeout {
		   set result -2
		   break
	       }
	       eof {
		   set result -3
		   break
	       }
	   }

	   if {$result == 0} {
	       mailfromd_expect $tmt {
		   -re "^\[ \t]*\r\n" { }
		   default { set result 1 }
		   timeout { set result -2 }
		   eof { set result -3 }
	       }
	   }
       }
    }
    return $result
}

proc mailfromd_test_file {args} {
    global verbose
    
    set default ""
    set message ""
    set catprog "/bin/cat"
    
    for {set i 0} {$i < [llength $args]} {incr i} {
	set a [lindex $args $i]
	if {"$a" == "-default"} {
	    incr i
	    set default [lindex $args $i]
	} elseif {"$a" == "-pattern"} {
	    incr i
	    set pattern [lindex $args $i]
	} elseif {"$a" == "-message"} {
	    incr i
	    set message [lindex $args $i]
	} elseif {"$a" == "-catprog"} {
	    incr i
	    set catprog [lindex $args $i]
	} else {
	    set args [lrange $args $i end]
	    break
	}
    }
    
    if {"$message" == ""}  {
	set message "Contents of [lindex $args 0]"
    }

    if $verbose>2 then {
	send_user "Message is \"$message\"\n"
    }

    set filename [lindex $args 0]
    if ![info exists pattern] {
        set pattern [lrange $args 1 end]
    }
    
    set res [remote_spawn host "$catprog $filename"]
    if { $res < 0 || $res == "" } {
	perror "Reading $filename failed."
	return 1;
    }
    set result [mailfromd_test "" $pattern]
    if {$result == 0} {
	pass "$message"
    } elseif {$result == 1} {
	if { "$default" == "" || "$default" != "FAIL" } {
	    fail "$message"
	} else {
	    xfail "$message"
	    set result 0
	}
    } elseif {$result == -2} {
	fail "$message (timeout)"
    } elseif {$result == -3} {
	fail "$message (eof)"
    } else {
	fail "$message"
    }
    remote_close host
    return $result
}

proc default_mailfromd_version {} {
    global MAILFROMD_TOOL
    global MAILFROMD_TOOL_FLAGS
    global MAILFROMD_TOOL_VERSION
    global MAILFROMD_CAPABILITY

    if [info exists MAILFROMD_TOOL_VERSION] {
	return
    }
    set output [remote_exec host "$MAILFROMD_TOOL --show-defaults"]
    set flg [split [lindex $output 1] "\r\n"]
    for {set i 0} {$i < [llength $flg]} {incr i} {
	if [regexp "^(.\[^:\]*): *(.*)\$" [lindex $flg $i] var name value] {
	    set MAILFROMD_CAPABILITY($name) $value
	} elseif {[lindex $flg $i] != ""} {
	    set MAILFROMD_CAPABILITY([lindex $flg $i]) 1
	}
    }
    if [info exists MAILFROMD_CAPABILITY(VERSION)] {
	set MAILFROMD_TOOL_VERSION $MAILFROMD_CAPABILITY(VERSION)
    } else {
	set MAILFROMD_TOOL_VERSION "UNKNOWN"
    }
}

proc mailfromd_version {} {
    default_anubis_version
}    

proc mailfromd_check_capability {args} {
    global MAILFROMD_CAPABILITY

    set name [lindex $args 0]

    if {![info exists MAILFROMD_CAPABILITY]} {
	mailfromd_init
	default_mailfromd_version
    }

    if {![info exists MAILFROMD_CAPABILITY] || \
	    ![info exists MAILFROMD_CAPABILITY($name)]} {
	return 0
    } else {
	return $MAILFROMD_CAPABILITY($name)
    }
}

# mailfromd_exec [-retcode N][-message S][-default (FAIL | XFAIL)][-arg S...]
#                [-pattern PATTERN-LIST][PATTERN...]
#
# Executes $MAILFROMD_TOOL and checks whether it returns with the given exit
# status and its output matches supplied PATTERN.
# Switches:
# -retcode N        Expect program to finish with exit code N instead of the
#                   default 0 (search for word 'Pity' below, though).
# -arg S            Supply additional arguments to the program.
# -message S        Set message to output when printing results of the test.
# -default          Supply the expected testcase result
proc mailfromd_exec {args} {
    global verbose
    global MAILFROMD_TESTDIR
    global MAILFROMD_TOOL
    global MAILFROMD_TOOL_FLAGS
    global expect_out

    set sw "-I$MAILFROMD_TESTDIR/etc"
    if [info exists MAILFROMD_TOOL_FLAGS] {
	set sw "$sw $MAILFROMD_TOOL_FLAGS"
    }
    
    default_mailfromd_version

    set default 0
    set message ""
    set result 0
    set retcode 0
    for {set i 0} {$i < [llength $args]} {incr i} {
	set opt [lindex $args $i]
	if {"$opt" == "-retcode"} {
	    incr i
	    set retcode [lindex $args $i]
	    verbose "RETCODE $retcode" 1
	} elseif {"$opt" == "-message"} {
	    incr i
	    set message [lindex $args $i]
	} elseif {"$opt" == "-default"} {
	    incr i
	    set default [lindex $args $i]
	} elseif {"$opt" == "-arg"} {
	    incr i
	    append sw " [lindex $args $i]"
	} elseif {"$opt" == "-arg-list"} {
	    incr i
	    set s [lindex $args $i]
	    for {set j 0} {$j < [llength $s]} {incr j} {
		append sw " [lindex $s $j]"
	    }
	} elseif {"$opt" == "-pattern"} {
	    incr i
	    set pattern [lindex $args $i]
	} else {
	    break
	}
    }	

    if [info exists pattern] {
	set args [concat $pattern [lrange $args $i end]]
    } else {
	set args [lrange $args $i end]
    }

    # Pity, dejagnu provides no way to retrieve exit status of the process.
    # This ugly construction is used to work around this. Hopefully, it
    # should execute on any decent platform...
    set cmd "sh -c \"$MAILFROMD_TOOL $sw\; echo \$?\""
    verbose "Executing $cmd"

    set res [remote_exec host $cmd]

    lappend args "$retcode"
	    
    set output [lindex $res 1]

    if {[llength $args] == 0 && [string length $output] != 0} {
	verbose "Expected \"[lindex $args 1]\" but founf EOF" 1
	set result 1
    }

    for {set i 0} {$result == 0 && $i < [llength $args]} {incr i} {
	if {[string length $output] == 0} {
	    verbose "Not enough output from $cmd" 1
	    verbose "Stopped waiting for \"[lindex $args $i]\"" 1
	    set result 1
	    break
	}
	set regexp 0

	switch -exact -- "[lindex $args $i]" {
	    -re     { set regexp 1; incr i }
	    -ex     -
	    --      { incr i }
	}
	    
	set pattern [lindex $args $i]
	verbose "PATTERN $pattern"

	if {$regexp} {
	    verbose "does \"$output\" match regular expression \"$pattern\"?" 1
	    if {![regexp -- "${pattern}(.*)" "$output" dummy output]} {
		set result 1
	    }
	} else {
	    verbose "does \"$output\" match exact string \"$pattern\"?" 1
	    if {"$pattern" != ""} {
		if {[string first "$pattern" "$output"] != 0} {
		    set result 1
		}
		set output [string range $output [string length $pattern] end]
	    }
	}

	if {![regexp -- "\[ \t]*\r\n(.*)" "$output" dummy output]} {
	    set result 1
	}

	if {$result} {
	    verbose "NO" 1
	} else {
	    verbose "yes" 1
	}
    }

    if {$result == 0} {
	pass "$message"
    } elseif {$result == 1} {
	if { "$default" == "" || "$default" != "FAIL" } {
	    fail "$message"
	} else {
	    xfail "$message"
	    set result 0
	}
    } elseif {$result == -2} {
	fail "$message (timeout)"
    } elseif {$result == -3} {
	fail "$message (eof)"
    } else {
	fail "$message"
    }

    return $result
}

# State map:
#  0    -- command
#  1    -- pattern
proc mailfromd_pat {patname} {
    global MAILFROMD_ETC_DIR
    global MAILFROMD_STATE_DIR
    global MAILFROMD_TESTDIR
    global MAILFROMD_CONFIG_FILE
    global gpg_prog
    
    verbose "MAILFROMD_PAT $patname" 1
    if ![regexp "^/.*" $patname x y] {
	set patname "$MAILFROMD_ETC_DIR/$patname"
    }
    if {[catch {open $patname r} chan]} {
	fail "Could not open $patname"
	return 
    }

    set state 0
    set options ""
    set testname ""
    set mode ""
    set retcode 0
    set rcfile ""
    set rcdir $MAILFROMD_ETC_DIR
    mailfromd_init
    for {gets $chan line} {![eof $chan]} {gets $chan line} {
	verbose "LINE $line" 1
	if { $state == 0 } {
	    switch -regexp -- "$line" {
		"^#.*" { }
		"^:TEST" {
		    regexp "^:TEST (.*)" $line dummy testname
		}
		"^:MODE" {
		    regexp "^:MODE (.*)" $line dummy mode
		}
		"^:OPTIONS" {
		    regexp "^:OPTIONS (.*)" $line dummy opt
		    set x [split $opt]
		    for {set n 0} {$n < [llength $x]} {incr n} {
			set opt [lindex $x $n]
			switch -re -- "$opt" {
			    "^\\$.*"	{ lappend options [expr $opt] }
			    default	{ if {$opt != ""} {
						lappend options $opt
					  }
			                }
			}
		    }
		}
	        "^:RCFILE" {
	            regexp "^:RCFILE (.*)" $line dummy rcfile
	        }
		"^:RCDIR" {
		    set rcdir "$MAILFROMD_TESTDIR/etc"
		}
	        "^:RETCODE" {
	            regexp "^:RETCODE (.*)" $line dummy retcode
	        }
	        "^:PATTERN" {
		    set state 1
	        }
		"^:SLEEP" {
		    regexp "^:SLEEP (.*)" $line dummy interval
		    after [expr {int($interval * 1000)}]
		}
		"^:END" {
		    verbose "MODE $mode"
		    if {$mode == "EXEC"} {
			set inv mailfromd_exec
			if {$options != ""} {
			    lappend inv -arg $options
			}
			if {$retcode != 0} {
			    lappend inv -retcode $retcode
			}
			if {$testname != ""} {
			    lappend inv -message $testname
			}
			if {$rcfile != ""} {
			    lappend inv -arg "$rcdir/$rcfile"
			}
			eval $inv $pattern
		    } elseif {$mode == "SPAWN"} {
			set MAILFROMD_CONFIG_FILE $rcdir/$rcfile
			set inv default_mailfromd_start
			if {$options != ""} {
			    lappend inv $options
			}
			verbose "RUN $inv"
			eval $inv

			set file_pattern ""
			for {set pat $pattern} \
			    {[llength $pat] > 0} \
			    {set pat [lrange $pat 1 end]} {

			    set line [lindex $pat 0]
			    set result 0
			    if [regexp "^:EXPECT (\[0-9\]\[0-9\]*)\$" $line dummy expect] {
			        mailfromd_expect {
				    -re "$expect \[^\n\]*\n" { set result 0 }
				    -re "^.*\[^\n\]*\n" {
					verbose "THROW FAILURE" 2
					set result 1
				    }
				    timeout { set result -2 }
				    eof { set result -3 }
				    default { set result 1 }
				}
			    } elseif [regexp "^:EXPECT (.*)" $line dummy expect] {
				mailfromd_expect {
				    -re "$expect\[^\n\]*\n" { set result 0 }
				    -re "^.*\[^\n\]*\n" {
					verbose "THROW FAILURE" 2
					set result 1
				    }
				    timeout { set result -2 }
				    eof { set result -3 }
				    default { set result 1 }
				}
			    } elseif [regexp "^:ADD (.*)" $line dummy expect] {
				if [regexp "^-- (.*)" $expect dummy str] {
				    lappend file_pattern "--"
				    set expect $str
				} elseif [regexp "^-re (.*)" $expect dummy str] {
				    lappend file_pattern "-re"
				    set expect $str
				}
				lappend file_pattern "$expect"
			    } elseif [regexp "^:DEL (.*)" $line dummy expect] {
				verbose "DEL:: $expect"
				mailfromd_command "$expect"
			    } else {
				mailfromd_command "$line"
				lappend file_pattern $line
			    }
			    verbose "RESULT now is $result" 2
			    if {$result != 0} {
				break
			    }
			}

			default_mailfromd_stop

			if { $result == -2} {
			    fail "$testname (timeout)"
			} elseif { $result == -3} {
			    fail "$testname (eof)"
			} elseif { $result } {
			    fail "$testname"
			} else {
			    pass "$testname"
			}
			
#			set inv mailfromd_test_file
#			if {$testname != ""} {
#			    lappend inv -message $testname
#			}
#			lappend inv "$MAILFROMD_STATE_DIR/mta.log"
#			eval $inv $file_pattern
		    } elseif {$mode == "CAT"} {
			verbose "OPT $options"
			set inv mailfromd_test_file
			lappend inv -catprog [concat $options]
			lappend inv "$MAILFROMD_STATE_DIR/mta.log"
			eval $inv $pattern
		    }
		    ## Reset all variables
		    set pattern ""
		    set file_pattern ""
                    set options ""
                    set testname ""
                    set mode ""
                    set retcode 0
                    set rcfile ""
	        }
	    }
	} else {
	    switch -regexp -- "$line" {
		"^HELO" {
		    lappend pattern $line
		}
		"^:END" { set state 0 }
		"^-- (.*)" {
		    regexp "^-- (.*)" $line dummy str
		    lappend pattern "--" $str
		}
		"^-re (.*)" {
		    regexp "^-re (.*)" $line dummy str
		    lappend pattern "-re" $str
		}
		default { lappend pattern $line }
	    }
	}    
    }
}


# End of mailfromd.exp