summaryrefslogtreecommitdiff
path: root/imap4d/testsuite/lib/imap4d.exp
blob: 213c5ef32938a9e306aec78de6fb1f71e0032fa1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
# -*- tcl -*-
# This file is part of Mailutils testsuite.
# Copyright (C) 2002, 2005, 2007, 2008, 2010 Free Software Foundation, Inc.
#  
# 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 3 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., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 USA.

source $top_srcdir/testsuite/lib/mailutils.exp
    
mu_init "--rcfile=$objdir/imap4d.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 imap4d"
    exit 0
}

set IMAP4D_ETC_DIR "$MU_DATA_DIR/etc"

mu_makespool "$MU_RC_DIR" "$IMAP4D_ETC_DIR"
mu_create_config imap4d

set IMAP4D_TAG 0

### Only procedures should come after this point.

proc imap4d_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_imap4d_start {args} {
    global verbose
    global MU_TOOL
    global MU_TOOL_FLAGS
    global expect_out
    global imap4d_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 imap4d_cmd "$MU_TOOL $sw"
    verbose "Spawning $imap4d_cmd"

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

    mu_expect 360 {
	-re "\\* (OK)|(PREAUTH) IMAP4rev1 Debugging mode.*\r\n" {
	    verbose "imap4d initialized."
	}
	default {
	    perror "imap4d not initialized"
            exit 1
	}
    }
    return 0
}

proc default_imap4d_stop {} {
    verbose "Stopping imap4d"
    if [imap4d_test "LOGOUT"\
	    "BYE Session terminating." \
	    "OK LOGOUT Completed"] {
	perror "LOGOUT failed"
	exit 1
    }
    remote_close host;
    return 0
}

proc imap4d_start {args} {
    global MU_SPOOL_DIR
    
    verbose "Starting imap4d"

    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_imap4d_start [concat [lrange $args $i end]]]
}
    
proc imap4d_stop {} {
    global imap4d_spawn_id
    if {[info exists imap4d_spawn_id] && $imap4d_spawn_id > 0} {
	default_imap4d_stop
	unset imap4d_spawn_id
    }
}

##

proc imap4d_make_command { string } {
    global IMAP4D_TAG
    
    incr IMAP4D_TAG
    return "$IMAP4D_TAG $string"
}

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

proc imap4d_command { cmd } {
    return [mu_command [imap4d_make_command $cmd]]
}

proc imap4d_uidvalidity {} {
    regsub "(\[0-9\]*)\[0-9\]" "[clock seconds]" "\\1\[0-9\]" val
    return $val
}

proc imap4d_exit {} {
    imap4d_stop
}

proc imap4d_auth {args} {
    set user [lindex $args 0]
    set pass [lindex $args 1]
    if [imap4d_test "LOGIN $user $pass"] {
	perror "Failed to authorize."
	exit 1
    }
}    
    
# imap4d_test [-message MESSAGE][-default (FAIL|XFAIL)][-long][-silent][-sort]
#            COMMAND [UNTAGGED...][TAGGED]
# COMMAND   - Command to send.
# UNTAGGED  - A list of untagged responses to expect in return. 
# TAGGED    - A tagged response to expect in return. Defaults to "OK"
# MESSAGE   - [optional] message to output
proc imap4d_test {args} {
    global IMAP4D_TAG
    global verbose
    
    set default ""
    set message ""
    set long 0
    set silent 0
    set sort 0
    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" == "-long"} {
	    set long 1
	} elseif {"$a" == "-silent"} {
	    set silent 1
	} elseif {"$a" == "-sort"} {
	    set sort 1
	} 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 {$long} {
	set command_data [lindex $args 1]
	set args [lrange $args 1 end]
    } 
	
    set pattern [list]
    set len [expr [llength $args] - 1]

    if {$len >= 2} {
	set regexp 0
	set literal 0
	for {set i 1} {$i <= [expr $len - 1]} {incr i} {
	    switch -regexp -- "[lindex $args $i]" {
		^-re.*$	-
		^--     { set item "[lindex $args $i]"; set regexp 1 }
		^-literal   { set literal 1; continue }
		^-noliteral { set literal 0; continue }
		default {  if {!$literal} {
				if {$regexp} {
				    set item "\\* [lindex $args $i]"
				} else {
				    set item "* [lindex $args $i]"
				}
			   } else {
				set item [lindex $args $i]
			   }
 		           set regexp 0
		       }
	    }
	    
	    set pattern [concat $pattern [list $item]]
	}
	set tagged [lindex $args end]
    } elseif {$len == 1} {
	set tagged [lindex $args end]
    } else {
	set tagged "OK"
    }

    verbose "TAGGED $tagged"
    if {$long} {
	set command "$command {[string length $command_data]}"
	imap4d_command $command
	set pattern [concat $pattern [list "$IMAP4D_TAG $tagged"]]

	mu_expect 360 {
	    -re "^\\+ GO AHEAD.*$" { }
	    default {
		perror "imap4d_long_test failed"
		return 1
	    }
	}

	verbose "Sending $command_data" 3
	mu_send "$command_data\n"

	set s [split $command_data "\n"]
        set s [lrange $s 0 [expr [llength $s] - 2]]
        set result [mu_expect_list 360 [concat $s $pattern]]
    } elseif {$sort && [llength $pattern] > 0} {
	set command [imap4d_make_command $command]
	set result [mu_test $command [list "-re" "(.*)\n$IMAP4D_TAG $tagged"]]
	if {$result == 0} {
	    if [info exists expect_out(1,string)] {
		set out [lsort -ascii [split $expect_out(1,string) "\n"]]
		set in [lsort -ascii $pattern]
		if {[llength $in] == [llength $out]} {
		    for {set i 0} {$i < [llength $in]} {incr i} {
			regexp "(\[^\r\]*)" [lindex $out $i] dummy tmp
			if [string compare [lindex $in $i] $tmp] {
			    verbose "Item $i comparison failed"
			    set result 1
			    break
			}
		    }
		} else {
		    verbose "Input and output lists have different lengths"
		    set result 1
		}

		if {$result} {
		    verbose "Input: $in"
		    verbose "Output: $out"
		}
		
	    } else {
		verbose "expect_out(1,string) does not exist. Buffer: $expect_out(buffer)"
		set result 1
	    }
	} 
    } else {
	set command [imap4d_make_command $command]
	set pattern [concat $pattern [list "$IMAP4D_TAG $tagged"]]
        set result [mu_test $command $pattern]
    }

    if {!$silent} {
	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
}
	    

Return to:

Send suggestions and report system problems to the System administrator.