Skip to content

John McEleney / mailutils

Go to a project
Toggle navigation
Toggle navigation pinning
Commit 6a863e26 6a863e26c9d1d085323589fa4f39cf3049340d6d by Sergey Poznyakoff
Options

added to the repository

1 parent ad4b4727
Inline Side-by-side
Showing 12 changed files with 576 additions and 0 deletions
1 Makefile
2 Makefile.in
3 *.log
4 *.sum
5 site.exp
6 remote.exp
1 # -*- tcl -*-
2 # This file is part of Mailutils testsuite.
3 # Copyright (C) 2002, Free Software Foundation
4 #
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software Foundation,
17 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
18
19 verbose "STARTED" 1
20 if [info exists TOOL_EXECUTABLE] {
21 set MAIL $TOOL_EXECUTABLE
22 }
23 if ![info exists MAIL] {
24 if ![is_remote host] {
25 set MAIL [findfile $base_dir/../mail "$base_dir/../mail" [transform mail]]
26 } else {
27 if [info exists host_board] {
28 if [board_info $host_board exists top_builddir] {
29 append MAIL "[board_info $host_board top_builddir]/mail/mail"
30 } elseif [board_info $host_board exists top_srcdir] {
31 append MAIL "[board_info $host_board top_srcdir]/mail/mail"
32 }
33 }
34
35 if ![info exists MAIL] {
36 perror "The test suite is not set up for the remote testing"
37 perror "Please, read file README in mail/testsuite subdirectory"
38 perror "for instructions on how to set up it."
39 exit 1
40 }
41 }
42 }
43
44 verbose "using MAIL = $MAIL" 2
45
46 if ![info exists MAILFLAGS] {
47 set MAILFLAGS "--nosum --norc --mail-spool $srcdir/spool"
48 }
49
50 #FIXME:
51 set env(MAILRC) $srcdir/etc/mail.rc
52
53 # The variable mail_prompt is a regexp which matches the mail prompt.
54 global mail_prompt
55 if ![info exists mail_prompt] then {
56 set mail_prompt "\\? "
57 }
58
59 ### Only procedures should come after this point.
60
61 proc default_mail_version {} {
62 global MAIL
63 global MAILFLAGS
64 global MAILVERSION
65
66 if [info exists MAILVERSION] {
67 return
68 }
69
70 set output [remote_exec host "$MAIL --version"]
71 regexp " \[0-9\]\[^ \t\n\r\]+" "$output" MAILVERSION
72 }
73
74 proc mail_version {} {
75 global MAIL
76 global MAILFLAGS
77 global MAILVERSION
78
79 default_mail_version
80 if ![is_remote host] {
81 clone_output "[which $MAIL] version $MAILVERSION"
82 } else {
83 clone_output "$MAIL on remote host version $MAILVERSION"
84 }
85 }
86
87 proc default_mail_start {args} {
88 global srcdir
89 global srcdir
90 global verbose
91 global MAIL
92 global MAILFLAGS
93 global mail_prompt
94 global CAPABILITY
95 global expect_out
96
97 default_mail_version
98
99 set sw $args
100 append sw " "
101
102 if [info exists host_board] {
103 if [board_info $host_board exists top_srcdir] {
104 append sw " --mail-spool [board_info $host_board top_srcdir]/mail/testsuite/spool"
105 }
106 }
107
108 set mail_cmd "$MAIL $MAILFLAGS $args"
109 verbose "MAILRC is $srcdir/etc/mail.rc" 2
110 verbose "Spawning $mail_cmd"
111
112 set res [remote_spawn host $mail_cmd]
113 if { $res < 0 || $res == "" } {
114 perror "Spawning $mail_cmd failed."
115 return 1;
116 }
117
118 mail_expect 360 {
119 -re "\[\r\n\]?${mail_prompt}$" {
120 verbose "mail initialized."
121 }
122 default {
123 perror "mail not initialized"
124 return 1
125 }
126 }
127 return 0
128 }
129
130 proc default_mail_stop {} {
131
132 verbose "Stopping mail"
133
134 }
135
136 proc mail_start {args} {
137 verbose "Starting mail"
138 return [default_mail_start [lrange $args 0 end]]
139 }
140
141 proc mail_stop {} {
142 return [default_mail_stop];
143 }
144
145 ##
146
147 proc mail_send { string } {
148 global suppress_flag;
149 if {[info exists suppress_flag] && $suppress_flag} {
150 return "suppressed";
151 }
152 return [remote_send host "$string"]
153 }
154
155 proc mail_command { cmd } {
156 set res [mail_send "$cmd\n"]
157 mail_expect 30 {
158 -ex "${cmd}\r\n" { }
159 default {
160 perror "mail_command for target failed";
161 return -1
162 }
163 }
164 return $res
165 }
166
167 proc mail_exit {} {
168 set res [mail_send "exit\n"]
169 sleep 5
170 return res
171 }
172
173 proc mail_expect { args } {
174 global env
175 if { [lindex $args 0] == "-notransfer" } {
176 set notransfer -notransfer;
177 set args [lrange $args 1 end];
178 } else {
179 set notransfer "";
180 }
181
182 if { [llength $args] == 2 && [lindex $args 0] != "-re" } {
183 set gtimeout [lindex $args 0];
184 set expcode [list [lindex $args 1]];
185 } else {
186 upvar timeout timeout;
187
188 set expcode $args;
189 if [target_info exists mail,timeout] {
190 if [info exists timeout] {
191 if { $timeout < [target_info mail,timeout] } {
192 set gtimeout [target_info mail,timeout];
193 } else {
194 set gtimeout $timeout;
195 }
196 } else {
197 set gtimeout [target_info mail,timeout];
198 }
199 }
200
201 if ![info exists gtimeout] {
202 global timeout;
203 if [info exists timeout] {
204 set gtimeout $timeout;
205 } else {
206 # Eeeeew.
207 set gtimeout 60;
208 }
209 }
210 }
211 global suppress_flag;
212 global remote_suppress_flag;
213 global verbose
214 if [info exists remote_suppress_flag] {
215 set old_val $remote_suppress_flag;
216 }
217 if [info exists suppress_flag] {
218 if { $suppress_flag } {
219 set remote_suppress_flag 1;
220 }
221 }
222
223 verbose "RUNNING remote_expect host $gtimeout $notransfer" 2
224
225 set code [catch \
226 {uplevel remote_expect host "$gtimeout $notransfer" $expcode} string];
227 if [info exists old_val] {
228 set remote_suppress_flag $old_val;
229 } else {
230 if [info exists remote_suppress_flag] {
231 unset remote_suppress_flag;
232 }
233 }
234
235 if {$code == 1} {
236 global errorInfo errorCode;
237
238 return -code error -errorinfo $errorInfo -errorcode $errorCode $string
239 } elseif {$code == 2} {
240 return -code return $string
241 } elseif {$code == 3} {
242 return
243 } elseif {$code > 4} {
244 return -code $code $string
245 }
246 }
247
248 # default_mail_test COMMAND PATTERN
249 # COMMAND - Command to send to mail
250 # PATTERN - A list of strings to expect in return
251 # Return value:
252 # -3 - eof
253 # -2 - timeout
254 # -1 - generic failure
255 # 1 - test fails
256 # 0 - test succeeds
257 proc default_mail_test { args } {
258 global verbose
259 global mail_prompt
260 global suppress_flag;
261 upvar timeout timeout
262
263 set command [lindex $args 0]
264 set pattern [lindex $args 1]
265
266 if { [info exists suppress_flag] && $suppress_flag } {
267 set do_suppress 1
268 } else {
269 set do_suppress 0
270 }
271
272 if $verbose>2 then {
273 send_user "Command: \"$command\"\n"
274 send_user "Pattern: \"$pattern\"\n"
275 }
276
277 set result -1
278 if { [mail_command "${command}"] != "" } {
279 if { ! $do_suppress } {
280 perror "Couldn't send \"$command\".";
281 }
282 return $result;
283 }
284
285 if [info exists timeout] {
286 set tmt $timeout;
287 } else {
288 global timeout;
289 if [info exists timeout] {
290 set tmt $timeout;
291 } else {
292 set tmt 60;
293 }
294 }
295
296 set result 0
297 for {set i 0} {$i < [llength $pattern]} {incr i} {
298 verbose "i=$i, pat=[lindex ${pattern} $i]" 2
299 mail_expect $tmt {
300 -ex "[lindex ${pattern} $i]" { }
301 -ex "[lindex ${pattern} $i]\r\n" { }
302 default {
303 set result 1
304 break
305 }
306 timeout {
307 set result -2
308 break
309 }
310 eof {
311 set result -3
312 break
313 }
314 }
315 }
316 return $result
317 }
318
319 # mail_test [-message MESSAGE][-default (FAIL|XFAIL)]
320 # COMMAND PATTERN [PATTERN...]
321 # COMMAND - Command to send to mail.
322 # PATTERN - Sequence to expect in return.
323 # MESSAGE - [optional] message to output
324 proc mail_test { args } {
325 global verbose
326 global mail_prompt
327 global suppress_flag;
328 upvar timeout timeout
329
330 set default ""
331 set message ""
332 for {set i 0} {$i < [llength $args]} {incr i} {
333 set a [lindex $args $i]
334 if {"$a" == "-default"} {
335 set default [lindex $args [expr $i + 1]]
336 incr i
337 } elseif {"$a" == "-message"} {
338 set message [lindex $args [expr $i + 1]]
339 incr i
340 } else {
341 set args [lrange $args $i end]
342 break
343 }
344 }
345
346 if {"$message" == ""} {
347 set message [lindex $args 0]
348 }
349
350 if $verbose>2 then {
351 send_user "Message is \"$message\"\n"
352 }
353 set command [lindex $args 0]
354 set pattern [lrange $args 1 end]
355 set result [default_mail_test $command $pattern]
356
357 if {$result == 0} {
358 pass "$message"
359 } elseif {$result == 1} {
360 if { "$default" == "" || "$default" != "FAIL" } {
361 fail "$message"
362 } else {
363 xfail "$message"
364 set result 0
365 }
366 } elseif {$result == -2} {
367 fail "$message (timeout)"
368 } elseif {$result == -3} {
369 fail "$message (eof)"
370 } else {
371 fail "$message"
372 }
373 return $result
374 }
375
1 # -*- tcl -*-
2 # This file is part of Mailutils testsuite.
3 # Copyright (C) 2002, Free Software Foundation
4 #
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software Foundation,
17 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
18
19 mail_start "--file=%mbox1"
20
21 mail_command "alias staff alice tweedledum tweedledee"
22 mail_test -message "alias staff" "alias" "staff alice tweedledum tweedledee "
23
24 mail_command "alias teeparty alice march.hare hatter"
25 mail_test -message "alias teeparty" "alias" \
26 "teeparty alice march.hare hatter "\
27 "staff alice tweedledum tweedledee "
28
29 mail_command "alias messengers haigha hatta"
30 mail_test -message "alias messengers" "alias" \
31 "teeparty alice march.hare hatter "\
32 "staff alice tweedledum tweedledee "\
33 "messengers haigha hatta "
34
35 mail_command "unalias teeparty"
36 mail_test -message "unalias" "alias" \
37 "staff alice tweedledum tweedledee " \
38 "messengers haigha hatta "
39
40 mail_test -message "alias messengers output"\
41 "alias messengers" "messengers haigha hatta "
42
43 mail_test -message "alias teeparty output" \
44 "alias teeparty" "\"teeparty\": not a group"
45
46 mail_command "alias pretenders lion unicorn"
47 mail_test -message "alias pretenders" "alias"\
48 "pretenders lion unicorn "\
49 "staff alice tweedledum tweedledee "\
50 "messengers haigha hatta "
51
52 mail_exit
53
54 return 0
1 # -*- tcl -*-
2 # This file is part of Mailutils testsuite.
3 # Copyright (C) 2002, Free Software Foundation
4 #
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software Foundation,
17 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
18
19 mail_start "--file=%mbox1"
20 mail_test "headers" \
21 ">N 1 Foo Bar Fri Dec 28 22:18 44/1255 Jabberwocky\r\n" \
22 " N 2 Bar Fri Dec 28 23:28 13/535 Re: Jabberwocky\r\n"
23
24 mail_test "print"\
25 "Date: Fri, 28 Dec 2001 22:18:08 +0200" \
26 "From: Foo Bar <foobar@nonexistent.net>" \
27 "To: Bar <bar@dontmailme.org>" \
28 "Subject: Jabberwocky"\
29 ""\
30 "`Twas brillig, and the slithy toves"\
31 "Did gyre and gimble in the wabe;"\
32 "All mimsy were the borogoves,"\
33 "And the mome raths outgrabe."
34
35 mail_test -message "headers (2)" "headers" \
36 ">R 1 Foo Bar Fri Dec 28 22:18 44/1255 Jabberwocky\r\n" \
37 " N 2 Bar Fri Dec 28 23:28 13/535 Re: Jabberwocky\r\n"
38
39 mail_test "next" \
40 "Date: Fri, 28 Dec 2001 23:28:08 +0200"\
41 "From: Bar <bar@dontmailme.org>"\
42 "To: Foo Bar <foobar@nonexistent.net>"\
43 "Subject: Re: Jabberwocky"\
44 ""\
45 "It seems very pretty, but it's *rather* hard to understand!'"\
46 "Somehow it seems to fill my head with ideas -- only I don't"\
47 "exactly know what they are! However, SOMEBODY killed SOMETHING:"\
48 "that's clear, at any rate..."
49
50 mail_test -message "headers (3)" "headers" \
51 " R 1 Foo Bar Fri Dec 28 22:18 44/1255 Jabberwocky\r\n" \
52 ">R 2 Bar Fri Dec 28 23:28 13/535 Re: Jabberwocky\r\n"
53
54 mail_test "prev"\
55 "Date: Fri, 28 Dec 2001 22:18:08 +0200" \
56 "From: Foo Bar <foobar@nonexistent.net>" \
57 "To: Bar <bar@dontmailme.org>" \
58 "Subject: Jabberwocky"\
59 ""\
60 "`Twas brillig, and the slithy toves"\
61 "Did gyre and gimble in the wabe;"\
62 "All mimsy were the borogoves,"\
63 "And the mome raths outgrabe."
64
65 mail_test -message "headers (4)" "headers" \
66 ">R 1 Foo Bar Fri Dec 28 22:18 44/1255 Jabberwocky\r\n" \
67 " R 2 Bar Fri Dec 28 23:28 13/535 Re: Jabberwocky\r\n"
68
69
70
71 #mail_exit
72 return 0
...\ No newline at end of file ...\ No newline at end of file
1 From foobar@nonexistent.net Fri Dec 28 22:18:09 2001
2 Received: (from foobar@nonexistent.net)
3 by nonexistent.net id fBSKI8N04906
4 for bar@dontmailme.org; Fri, 28 Dec 2001 22:18:08 +0200
5 Date: Fri, 28 Dec 2001 22:18:08 +0200
6 From: Foo Bar <foobar@nonexistent.net>
7 Message-Id: <200112282018.fBSKI8N04906@nonexistent.net>
8 To: Bar <bar@dontmailme.org>
9 Subject: Jabberwocky
10
11 `Twas brillig, and the slithy toves
12 Did gyre and gimble in the wabe;
13 All mimsy were the borogoves,
14 And the mome raths outgrabe.
15
16 `Beware the Jabberwock, my son!
17 The jaws that bite, the claws that catch!
18 Beware the Jujub bird, and shun
19 The frumious Bandersnatch!'
20
21 He took his vorpal sword in hand:
22 Long time the manxome foe he sought --
23 So rested he by the Tumtum gree,
24 And stood awhile in thought.
25
26 And as in uffish thought he stood,
27 The Jabberwock, with eyes of flame,
28 Came whiffling through the tulgey wook,
29 And burbled as it came!
30
31 One, two! One, two! And through and through
32 The vorpal blade went snicker-snack!
33 He left it dead, and with its head
34 He went galumphing back.
35
36 `And has thou slain the Jabberwock?
37 Come to my arms, my beamish boy!
38 O frabjous day! Calloh! Callay!
39 He chortled in his joy.
40
41 `Twas brillig, and the slithy toves
42 Did gyre and gimble in the wabe;
43 All mimsy were the borogoves,
44 And the mome raths outgrabe.
45
46
47 From bar@dontmailme.org Fri Dec 28 23:28:09 2001
48 Received: (from bar@dontmailme.org)
49 by dontmailme.org id fERKR9N16790
50 for foobar@nonexistent.net; Fri, 28 Dec 2001 22:18:08 +0200
51 Date: Fri, 28 Dec 2001 23:28:08 +0200
52 From: Bar <bar@dontmailme.org>
53 To: Foo Bar <foobar@nonexistent.net>
54 Message-Id: <200112232808.fERKR9N16790@dontmailme.org>
55 Subject: Re: Jabberwocky
56
57 It seems very pretty, but it's *rather* hard to understand!'
58 Somehow it seems to fill my head with ideas -- only I don't
59 exactly know what they are! However, SOMEBODY killed SOMETHING:
60 that's clear, at any rate...
61