# -*- tcl -*-
# This file is part of Mailutils testsuite.
# Copyright (C) 2002, Free Software Foundation
#  
# This program 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.
#   
# This program 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 this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 

verbose "STARTED" 1
if [info exists TOOL_EXECUTABLE] {
    set MAIL $TOOL_EXECUTABLE
}
if ![info exists MAIL] {
    if ![is_remote host] {
	set MAIL [findfile $base_dir/../mail "$base_dir/../mail" [transform mail]]
	set MAIL_SPOOL_SOURCE "$srcdir/spool"
	set MAIL_FOLDER_SOURCE "$srcdir/folder"
	set MAIL_SPOOL_DIR "$objdir/data/spool"
	set MAIL_FOLDER_DIR "$objdir/data/folder"
	set MAIL_RC_DIR "$srcdir/etc"
	set MAKESPOOL "$srcdir/makespool"
    } else {
	if [info exists host_board] {
	    if [board_info $host_board exists top_builddir] {
		append MAIL "[board_info $host_board top_builddir]/mail/mail"
	    } elseif [board_info $host_board exists top_srcdir] {
		append MAIL "[board_info $host_board top_srcdir]/mail/mail"
	    }
	}

	if ![info exists MAIL] {
	    perror "The test suite is not set up for the remote testing"
	    perror "Please, read file README in mail/testsuite subdirectory"
	    perror "for instructions on how to set up it."
	    exit 1
	}	
	set MAIL_RC_DIR "[board_info $host_board srcdir]/etc"
	set MAIL_SPOOL_SOURCE "[board_info $host_board srcdir]/spool"
	set MAIL_FOLDER_SOURCE "[board_info $host_board srcdir]/folder" 
	set MAIL_SPOOL_DIR "[board_info $host_board objdir]/data/spool"
	set MAIL_FOLDER_DIR "[board_info $host_board objdir]/data/folder"
	set MAKESPOOL "[board_info $host_board srcdir]/makespool"
    }
}

verbose "using MAIL = $MAIL" 2

if ![info exists MAILFLAGS] {
    set MAILFLAGS "--nosum --norc --mail-spool $MAIL_SPOOL_DIR"
}

#FIXME: this doesn't work with remote testing
set env(MAILRC) $MAIL_RC_DIR/mail.rc
set env(MBOX) "$MAIL_SPOOL_DIR/mbox"

# The variable mail_prompt is a regexp which matches the mail prompt.
global mail_prompt
if ![info exists mail_prompt] then {
    set mail_prompt "\\? "
}

### Only procedures should come after this point.

proc mail_prepare_spools {} {
    global MAIL_SPOOL_SOURCE
    global MAIL_SPOOL_DIR
    global MAIL_FOLDER_SOURCE
    global MAIL_FOLDER_DIR
    global MAKESPOOL

    set output [remote_exec host "$MAKESPOOL \
		    $MAIL_SPOOL_SOURCE $MAIL_SPOOL_DIR\
	            $MAIL_FOLDER_SOURCE $MAIL_FOLDER_DIR"]
}

proc mail_cleanup_spools {} {
    global MAIL_SPOOL_SOURCE
    global MAIL_SPOOL_DIR
    global MAIL_FOLDER_SOURCE
    global MAIL_FOLDER_DIR
    global MAKESPOOL

    if { $MAIL_SPOOL_SOURCE != $MAIL_SPOOL_DIR } {
	set output [remote_exec host "$MAKESPOOL -r \
		    $MAIL_SPOOL_DIR $MAIL_FOLDER_DIR"]
    }
}
	    
proc default_mail_version {} {
    global MAIL
    global MAILFLAGS
    global MAILVERSION

    if [info exists MAILVERSION] {
	return
    }
    
    set output [remote_exec host "$MAIL --version"]
    regexp " \[0-9\]\[^ \t\n\r\]+" "$output" MAILVERSION
}

proc mail_version {} {
    global MAIL
    global MAILFLAGS
    global MAILVERSION
    
    default_mail_version
    if ![is_remote host] {
	clone_output "[which $MAIL] version $MAILVERSION"
    } else {
	clone_output "$MAIL on remote host version $MAILVERSION"
    }
}

proc default_mail_start {args} {
    global srcdir
    global srcdir
    global verbose
    global MAIL
    global MAILFLAGS
    global mail_prompt
    global CAPABILITY
    global expect_out
    
    default_mail_version
    
    set sw $args
    append sw " "
    
    if [info exists host_board] {
	if [board_info $host_board exists top_srcdir] {
	    append sw " --mail-spool [board_info $host_board top_srcdir]/mail/testsuite/spool"
	}
    }

    set mail_cmd "$MAIL $MAILFLAGS $args"
    verbose "MAILRC is $srcdir/etc/mail.rc" 2
    verbose "Spawning $mail_cmd"

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

    mail_expect 360 {
	-re "\[\r\n\]?${mail_prompt}$" {
	    verbose "mail initialized."
	}
	default {
	    perror "mail not initialized"
            return 1
	}
    }
    return 0
}

proc default_mail_stop {} {

    verbose "Stopping mail"

}

proc mail_start {args} {
    verbose "Starting mail"

    set reuse_spool 0
    for {set i 0} {$i < [llength $args]} {incr i} {
	set a [lindex $args $i]
	if {"$a" == "-reuse-spool"} {
	    set reuse_spool 1
	} else {
	    break;
	}
    }

    if {$reuse_spool == 0} {
	mail_prepare_spools
    }
    return [default_mail_start [lrange $args $i end]]
}
    
proc mail_stop {} {
    return [default_mail_stop];
}

##

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

proc mail_command { cmd } {
    set res [mail_send "$cmd\n"]
    mail_expect 30 {
	-ex "\r\n" { }
	default {
	    perror "mail_command for target failed";
	    return -1
	}
    }
    return $res
}

proc mail_exit {} {
    set res [mail_send "exit\n"]
    sleep 5
    return res
}

proc mail_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 mail,timeout] {
	    if [info exists timeout] {
		if { $timeout < [target_info mail,timeout] } {
		    set gtimeout [target_info mail,timeout];
		} else {
		    set gtimeout $timeout;
		}
	    } else {
		set gtimeout [target_info mail,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 "RUNNING remote_expect host $gtimeout $notransfer $expcode" 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;
	}
    }

    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
    }
}

# default_mail_test COMMAND PATTERN
# COMMAND   - Command to send to mail
# 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 default_mail_test { args } {
    global verbose
    global mail_prompt
    global suppress_flag
    global mail_prompt	
    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}" != "" } {
	if { [mail_command "${command}"] != "" } {
	    if { ! $do_suppress } {
		perror "Couldn't send \"$command\".";
	    }
	    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} {$i < [llength $pattern]} {incr i} {
	regsub "\[ \t\]*$" [lindex ${pattern} $i] "" pat
	verbose "i=$i, pat=$pat" 2
	mail_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
		}
		mail_expect $tmt {
		    -re "\[ \t]*\r\n" { }
		    default {
			set result 1
			break
		    }
		    timeout {
			set result -2
			break
		    }
		    eof {
			set result -3
			break
		    }
		}
	    }
	    default {
		set result 1
		break
	    }
	    timeout {
		set result -2
		break
	    }
	    eof {
		set result -3
		break
	    }
	}
    }

    return $result
}

# mail_test [-message MESSAGE][-default (FAIL|XFAIL)][-noprompt]
#            COMMAND PATTERN [PATTERN...]
# COMMAND   - Command to send to mail.
# PATTERN   - Sequence to expect in return. 
# MESSAGE   - [optional] message to output
proc mail_test { args } {
    global verbose
    global mail_prompt
    global suppress_flag;
    upvar timeout timeout

    set default ""
    set message ""
    set wait_for_prompt 1
    for {set i 0} {$i < [llength $args]} {incr i} {
	set a [lindex $args $i]
	if {"$a" == "-default"} {
	    set default [lindex $args [expr $i + 1]]
	    incr i
	} elseif {"$a" == "-message"} {
	    set message [lindex $args [expr $i + 1]]
	    incr i
	} elseif {"$a" == "-noprompt"} {
	    set wait_for_prompt 0
	} else {
	    set args [lrange $args $i end]
	    break
	}
    }
    
    if {"$message" == ""}  {
	set message [lindex $args 0]
    }

    if $verbose>2 then {
	send_user "Message is \"$message\"\n"
    }
    set command [lindex $args 0]
    set pattern [lrange $args 1 end]
    set result [default_mail_test $command $pattern]
    if {$wait_for_prompt} {
	mail_expect 30 {
		-re "\[\r\n\]?${mail_prompt}$" {}
		default {
			perror "mail not initialized"
			return 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
}

proc mail_test_file {args} {
    global verbose
    
    set default ""
    set message ""

    for {set i 0} {$i < [llength $args]} {incr i} {
	set a [lindex $args $i]
	if {"$a" == "-default"} {
	    set default [lindex $args [expr $i + 1]]
	    incr i
	} elseif {"$a" == "-message"} {
	    set message [lindex $args [expr $i + 1]]
	    incr 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]
    set pattern [lrange $args 1 end]

    set res [remote_spawn host "/bin/cat $filename"]
    if { $res < 0 || $res == "" } {
	perror "Reading $filename failed."
	return 1;
    }
    set result [default_mail_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"
    }
    return $result
}