unix.exp 7.7 KB
Newer Older
Per Cederqvist's avatar
Per Cederqvist committed
1
2
3
4
5
6
7
8
# Set this to 1 to cause the test suite to wait while you attach to
# the process that is being tested.
set attach 0

# Set this to 1 if test-l2g was linked with Electric Fence.
set efence 0

# Some useful constants.
Per Cederqvist's avatar
Per Cederqvist committed
9
10
11
set nl "\r?\n"
set any "\[ -\]"
set deep_any "\\\[ -\\\]"
Per Cederqvist's avatar
Per Cederqvist committed
12
set hollerith "\[0-9\]*H$any*"
Per Cederqvist's avatar
Per Cederqvist committed
13
set any_time "\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*"
Per Cederqvist's avatar
Per Cederqvist committed
14
set any_num "\[0-9\]\[0-9\]*"
Per Cederqvist's avatar
Per Cederqvist committed
15
16
17
18
19
20
21

set maxint 2147483647

# These magic numbers are also present in the file
# src/server/testsuite/config/Makefile.am
set clientport 53262
set muxport 53263
Per Cederqvist's avatar
Per Cederqvist committed
22

Per Cederqvist's avatar
Per Cederqvist committed
23
# Fix the tty settings for minimum impact on the data flow.
Per Cederqvist's avatar
Per Cederqvist committed
24
25
set stty_init "-echo -onlcr -ocrnl -istrip"

Per Cederqvist's avatar
Per Cederqvist committed
26
27
28
# State variables.
set line_leader ""
set meta_line_leader ""
Per Cederqvist's avatar
Per Cederqvist committed
29
30
31
32
33
34
35
36
37
38
39

proc efence_blurb {} {
    global efence

    if {$efence} {
	simple_expect "" "efence blank line"
	simple_expect "  Electric Fence .* Copyright .* Bruce Perens." \
		"efence init"
    }
}

Per Cederqvist's avatar
Per Cederqvist committed
40
41
42
proc l2g_start {} {
    global spawn_id
    global l2g
Per Cederqvist's avatar
Per Cederqvist committed
43
    global efence
Per Cederqvist's avatar
Per Cederqvist committed
44
45
46
    global l2g_id
    global deep_any
    global nl
47
48
    global expect_active
    global expect_always
Per Cederqvist's avatar
Per Cederqvist committed
49
50

    spawn $l2g
Per Cederqvist's avatar
Per Cederqvist committed
51
52
53
54
55
56
57
    set l2g_id $spawn_id
    set expect_active($l2g_id) \
	    " -i $l2g_id eof { fail \"\$test (eof on l2g); wait\" } -re \"^($deep_any*)$nl\" { fail \"\$test (unexpected line '\$expect_out(1,string)')\" } -re \"($deep_any*)l2g> \" { fail \"\$test (unexpected incomplete line '\$expect_out(1,string)')\" } "
    set expect_always($l2g_id) \
	    " -i $l2g_id buffer_full { fail \"\$test (buffer_full on l2g)\" }"

    talk_to l2g
Per Cederqvist's avatar
Per Cederqvist committed
58
59
60
61
62
63

    if {$efence} {
	l2g_send "I9"
	l2g_send "a9 3 17"
	efence_blurb
    }
Per Cederqvist's avatar
Per Cederqvist committed
64
65
66
67
68
}

proc l2g_stop {} {
    global spawn_id

69
70
    l2g_send "q"
    simple_expect "test-l2g quitting"
Per Cederqvist's avatar
Per Cederqvist committed
71
    close
72
    wait
Per Cederqvist's avatar
Per Cederqvist committed
73
74
75
76
}

proc l2g_send {str} {
    unanchored_expect "^l2g> " "prompt before $str"
77
    verbose "sending $str"
Per Cederqvist's avatar
Per Cederqvist committed
78
79
80
    send "$str\n"
}

Per Cederqvist's avatar
Per Cederqvist committed
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
proc fix_expect_after {} {
    global expect_always
    global expect_active
    global spawn_id

    set stmt "expect_after"

    foreach k [array names expect_always] {
	set stmt "$stmt $expect_always($k)"
    }

    if {[info exists spawn_id] && [info exists expect_active($spawn_id)]} {
	set stmt "$stmt $expect_active($spawn_id)"
    }

    set stmt "$stmt timeout { fail \"\$test (timeout)\" }"
    verbose "evaluating $stmt" 2
    eval $stmt
}

proc simple_expect {regex {testname ""} {is_meta ""}} {
Per Cederqvist's avatar
Per Cederqvist committed
102
103
104
    global test
    global any
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
105
106
    global line_leader
    global meta_line_leader
Per Cederqvist's avatar
Per Cederqvist committed
107

Per Cederqvist's avatar
Per Cederqvist committed
108
109
110
111
112
    if {$is_meta == "meta"} {
	set ll $meta_line_leader
    } else {
	set ll $line_leader
    }
Per Cederqvist's avatar
Per Cederqvist committed
113
114
115
116
117
    set test $testname
    if {$test == ""} {
	set test "looking for $regex"
    }
    expect {
Per Cederqvist's avatar
Per Cederqvist committed
118
	-re "^$ll$regex$nl" {pass "$test"}
Per Cederqvist's avatar
Per Cederqvist committed
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
	timeout 	 {fail "$test (timeout)"}
	eof 		 {fail "$test (eof)"; wait}
	buffer_full 	{fail "$test (buffer_full)"}
    }
    unset test
}

proc unanchored_expect {regex testname} {
    global test
    global any
    global nl

    set test $testname
    expect {
	-re "$regex" 	{pass "$test"}
	timeout 	{fail "$test (timeout)"}
	buffer_full 	{fail "$test (buffer_full)"}
	eof 		{fail "$test (eof)"; wait}
	-re "($any*)$nl" {
138
	    fail "$test (unexpected line '$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
139
	    exp_continue
Per Cederqvist's avatar
Per Cederqvist committed
140
141
	}
	-re "($any*)l2g>" {
Per Cederqvist's avatar
Per Cederqvist committed
142
	    fail "$test (unexpected incomplete line '\$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
143
144
145
146
	}
    }
    unset test
}
Per Cederqvist's avatar
Per Cederqvist committed
147
148
149
150
151
152

proc lyskomd_start {} {
    global spawn_id
    global server_id
    global test
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
153
154
    global attach
    global timeout
155
156
    global expect_active
    global expect_always
157
158
159
160
161
162
163
164
165
166
    global srcdir

    # Check that we are in in the correct directory before removing
    # directories...
    set f [open "../lyskomd" "r"]
    close $f
    system "rm -rf db etc"
    system "mkdir db etc"
    system "cp $srcdir/../../../db-crypt/db/lyskomd-data db/"
    system "cp $srcdir/../../../db-crypt/db/lyskomd-texts db/"
Per Cederqvist's avatar
Per Cederqvist committed
167

Per Cederqvist's avatar
Per Cederqvist committed
168
    set pid [spawn ../lyskomd -d config/lyskomd-config]
Per Cederqvist's avatar
Per Cederqvist committed
169
    set server_id $spawn_id
Per Cederqvist's avatar
Per Cederqvist committed
170
171
172
173
    set expect_active($server_id) \
	    " -i $server_id eof { fail \"\$test (eof on lyskomd); wait\" }"
    set expect_always($server_id) \
	    " -i $server_id buffer_full { fail \"\$test (buffer_full on lyskomd)\" }"
Per Cederqvist's avatar
Per Cederqvist committed
174
175
176

    talk_to lyskomd
    set test "server started"
Per Cederqvist's avatar
Per Cederqvist committed
177
178
    set t $timeout
    set timeout [expr {2 * $timeout}]
Per Cederqvist's avatar
Per Cederqvist committed
179
180
181
182
183
184
    expect {
	-re "MSG: garb ready. 0 texts deleted.$nl" {pass "$test"}
	timeout         {fail "$test (timeout)"}
	buffer_full 	{fail "$test (buffer_full)"}
	eof 		{fail "$test (eof)"; wait}
    }
Per Cederqvist's avatar
Per Cederqvist committed
185
    set timeout $t
Per Cederqvist's avatar
Per Cederqvist committed
186
187
188
189
190
191
192
193
194

    if {$attach} {
	send_user "Please attach to lyskomd process $pid and press RETURN\n"
	set timeout 3600
	expect_user {
	    -re .
	}
	send_user "Continuing with timeout set to $timeout\n"
    }
Per Cederqvist's avatar
Per Cederqvist committed
195
196
197
198
199
200
201
202
203
}

proc lyskomd_death {} {
    global spawn_id
    global server_id
    global test
    global nl

    talk_to lyskomd
204
205
    simple_expect ".*Press enter to terminate lyskomd"
    send "\n"
Per Cederqvist's avatar
Per Cederqvist committed
206
207
208
209
210
211
212
213
214
215
216
217
218
219
    set test "server died"
    expect {
	-re "..*" { exp_continue }
	timeout  { fail "$test (timeout)" }
	eof      { pass "$test"; wait }
    }
}

proc client_start {nr} {
    global client_id
    global clientport
    global spawn_id
    global test
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
220
221
222
    global expect_always
    global expect_active
    global srcdir
223
    global deep_any
Per Cederqvist's avatar
Per Cederqvist committed
224

Per Cederqvist's avatar
Per Cederqvist committed
225
    spawn python $srcdir/tcpconnect.py localhost $clientport MRK:client$nr
Per Cederqvist's avatar
Per Cederqvist committed
226
    set client_id($nr) $spawn_id
227
    set expect_active($client_id($nr)) " -i $client_id($nr) -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line \$expect_out(1,string))\"; exp_continue } "
Per Cederqvist's avatar
Per Cederqvist committed
228
229
    set expect_always($client_id($nr)) \
	    " -i $client_id($nr) eof { fail \"\$test (eof on client$nr); wait\" } -i $client_id($nr) buffer_full { fail \"\$test (buffer_full on client$nr)\" } "
Per Cederqvist's avatar
Per Cederqvist committed
230
231
232

    talk_to client $nr

Per Cederqvist's avatar
Per Cederqvist committed
233
234
235
    simple_expect "Connecting to localhost $clientport" \
	    "client connects" meta
    simple_expect "Connected" "client connected" meta
Per Cederqvist's avatar
Per Cederqvist committed
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
proc client_death {nr} {
    global client_id
    global clientport
    global spawn_id
    global test
    global nl
    global expect_always
    global expect_active
    global srcdir
    global deep_any

    talk_to client $nr

    simple_expect "EOF on socket" "client $nr got EOF from server" meta
    send "die\n"
    set test "client $nr closes pty"
    expect {
	eof { pass "$test"; wait }
    }
    unset test

    unset expect_active($client_id($nr))
    unset expect_always($client_id($nr))
    unset spawn_id

    fix_expect_after
}
    
Per Cederqvist's avatar
Per Cederqvist committed
266
267
268
269
proc talk_to {what {nr ""}} {
    global spawn_id
    global server_id
    global client_id
Per Cederqvist's avatar
Per Cederqvist committed
270
271
272
273
274
275
    global l2g_id
    global line_leader
    global meta_line_leader

    set line_leader ""
    set meta_line_leader ""
Per Cederqvist's avatar
Per Cederqvist committed
276
277
278
279
280
281
282

    switch $what {
	lyskomd {
	    set spawn_id $server_id
	}
	client {
	    set spawn_id $client_id($nr)
Per Cederqvist's avatar
Per Cederqvist committed
283
284
285
286
	    set line_leader "MRK:client$nr"
	}
	l2g {
	    set spawn_id $l2g_id
Per Cederqvist's avatar
Per Cederqvist committed
287
288
289
290
291
292
	}
	default {
	    error "attempting to talk to $what"
	}
    }

Per Cederqvist's avatar
Per Cederqvist committed
293
294
295
296
297
    if {$line_leader != ""} {
	set meta_line_leader "${line_leader}meta: "
	set line_leader "${line_leader}: "
    }

Per Cederqvist's avatar
Per Cederqvist committed
298
    verbose "TALKING TO $spawn_id $what $nr"
Per Cederqvist's avatar
Per Cederqvist committed
299
    fix_expect_after
Per Cederqvist's avatar
Per Cederqvist committed
300
301
302
303
304
305
}

proc holl {str} {
    return "[string length $str]H$str"
}

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
proc read_versions {} {
    # Read $top_srcdir/versions and store the versions in global variables.
    global top_srcdir
    global protocol_a_level
    global server_software
    global server_version
    global server_compat_version

    set f [open "$top_srcdir/versions"]
    while {[gets $f line] >= 0} {
	if {[lindex $line 0] == "PROTOCOL-A-LEVEL:"} {
	    set protocol_a_level [lindex $line 1]
	} elseif {[lindex $line 0] == "SERVER-SOFTWARE:"} {
	    set server_software [lindex $line 1]
	} elseif {[lindex $line 0] == "SERVER-VERSION:"} {
	    set server_version [lindex $line 1]
	} elseif {[lindex $line 0] == "SERVER-COMPAT-VERSION:"} {
	    set server_compat_version [lindex $line 1]
	}
    }
    close $f
}