pop3d.exp 4.72 KB
# -*- tcl -*-
# This file is part of Mailutils testsuite.
# Copyright (C) 2002, 2007-2008, 2010-2012, 2014-2016 Free Software
# Foundation, Inc.
#  
# GNU Mailutils 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 3 of the License, or
# (at your option) any later version.
#   
# GNU Mailutils 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 GNU Mailutils.  If not, see <http://www.gnu.org/licenses/>. 

source $top_srcdir/testsuite/lib/mailutils.exp
    
mu_init "--config-file=$objdir/pop3d.rc"
mu_version
if ![mu_check_capability ENABLE_VIRTUAL_DOMAINS] {
    clone_output "WARNING: Support for virtual domains not compiled in"
    clone_output "WARNING: Skipping tests for pop3d"
    exit 0
}

set POP3D_ETC_DIR "$MU_DATA_DIR/etc"
mu_makespool "$MU_RC_DIR" "$POP3D_ETC_DIR"
mu_create_config pop3d

### Only procedures should come after this point.

proc pop3d_version {} {
    global MU_TOOL
    global MU_TOOL_FLAGS
    global MU_TOOL_VERSION
    
    mu_version
    if ![is_remote host] {
	clone_output "[which $MU_TOOL] version $MU_TOOL_VERSION"
    } else {
	clone_output "$MU_TOOL on remote host version $MU_TOOL_VERSION"
    }
}

proc default_pop3d_start {args} {
    global verbose
    global MU_TOOL
    global MU_TOOL_FLAGS
    global expect_out
    global pop3d_spawn_id
    
    mu_version

    set args [lindex $args 0]
    if [info exists MU_TOOL_FLAGS] {
	set sw $MU_TOOL_FLAGS
    } else {
	set sw ""
    }
    
    if [llength $args] {
	append sw $args
    } 
    
    set pop3d_cmd "$MU_TOOL $sw"
    verbose "Spawning $pop3d_cmd"

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

    mu_expect 360 {
	-re "\\+OK.*" {
	    verbose "pop3d initialized."
	}
	default {
	    perror "pop3d not initialized"
            exit 1
	}
    }
    return 0
}

proc default_pop3d_stop {} {
    set res [pop3d_send "quit\n"]
    mu_expect 360 {
	-re "\\+OK.*$"  { }
	default {
	    perror "quit failed"
	    exit 1
	}
    }
    remote_close host
    return res
}

proc pop3d_start {args} {
    global MU_SPOOL_DIR
    
    verbose "Starting pop3d"

    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} {
	mu_prepare_spools
	mu_copy_file $MU_SPOOL_DIR/teaparty.mbox $MU_SPOOL_DIR/INBOX
    }
    return [default_pop3d_start [concat [lrange $args $i end]]]
}
    
proc pop3d_stop {} {
    global pop3d_spawn_id
    if {[info exists pop3d_spawn_id] && $pop3d_spawn_id > 0} {
	default_pop3d_stop
	unset pop3d_spawn_id
    }
}

##

proc pop3d_send { string } {
    return [mu_send "$string"]
}

proc pop3d_command { cmd } {
    return [mu_command $cmd]
}

proc pop3d_exit {} {
    pop3d_stop
}

proc pop3d_auth {args} {
    set user [lindex $args 0]
    set pass [lindex $args 1]
    pop3d_test "USER $user" 
    if [pop3d_test "PASS $pass"] {
	perror "Failed to authorize."
	exit 1
    }
}    
    
# pop3d_test [-message MESSAGE][-default (FAIL|XFAIL)]
#            COMMAND [PATTERN...]
# COMMAND   - Command to send.
# PATTERN   - Sequence to expect in return. Defaults to "+OK"
# MESSAGE   - [optional] message to output
proc pop3d_test { args } {
    global verbose
    global suppress_flag;
    upvar timeout timeout

    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 [lindex $args 0]
    }

    if $verbose>2 then {
	send_user "Message is \"$message\"\n"
    }
    set command [lindex $args 0]
    if {[llength $args] >= 2} {
	set pattern [lrange $args 1 end]
    } else {
	set pattern "+OK"
    }
    set result [mu_test $command $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
}