unix.exp 8.73 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

23
24
set aux_item_default_conf_file "../../../run-support/aux-items.conf"

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

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

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
42
43
44
proc l2g_start {} {
    global spawn_id
    global l2g
Per Cederqvist's avatar
Per Cederqvist committed
45
    global efence
Per Cederqvist's avatar
Per Cederqvist committed
46
47
48
    global l2g_id
    global deep_any
    global nl
49
50
    global expect_active
    global expect_always
Per Cederqvist's avatar
Per Cederqvist committed
51
52

    spawn $l2g
Per Cederqvist's avatar
Per Cederqvist committed
53
54
55
56
57
58
59
    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
60
61
62
63
64
65

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

proc l2g_stop {} {
    global spawn_id

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

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

Per Cederqvist's avatar
Per Cederqvist committed
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
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
104
105
106
    global test
    global any
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
107
108
    global line_leader
    global meta_line_leader
Per Cederqvist's avatar
Per Cederqvist committed
109

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

128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
proc extracting_expect {regex var grp} {
    global test
    global any
    global nl
    global line_leader
    global $var

    set test "looking for $regex"

    expect {
	-re "^$line_leader$regex$nl" {
	    set $var $expect_out($grp,string)
	    pass "$test"
	}
	timeout 	 {fail "$test (timeout)"}
	eof 		 {fail "$test (eof)"; wait}
	buffer_full 	{fail "$test (buffer_full)"}
    }
    unset test
}


Per Cederqvist's avatar
Per Cederqvist committed
150
151
152
153
154
155
156
157
158
159
160
161
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" {
162
	    fail "$test (unexpected line '$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
163
	    exp_continue
Per Cederqvist's avatar
Per Cederqvist committed
164
165
	}
	-re "($any*)l2g>" {
Per Cederqvist's avatar
Per Cederqvist committed
166
	    fail "$test (unexpected incomplete line '\$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
167
168
169
170
	}
    }
    unset test
}
Per Cederqvist's avatar
Per Cederqvist committed
171

172
173
proc lyskomd_start {{aux_item_conf_file "" }
                    {extra_config ""}} {
Per Cederqvist's avatar
Per Cederqvist committed
174
175
176
177
    global spawn_id
    global server_id
    global test
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
178
179
    global attach
    global timeout
180
181
    global expect_active
    global expect_always
182
    global srcdir
David Byers's avatar
David Byers committed
183
184
    global clientport
    global muxport
185
186
187
188
189
    global aux_item_default_conf_file

    if { $aux_item_conf_file == "" } {
        set aux_item_conf_file $aux_item_default_conf_file
    }
190
191
192
193
194
195
196
197
198

    # 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
199

David Byers's avatar
David Byers committed
200
201
202
203
204
205
206
207
208
    set cf [open "$srcdir/config/lyskomd-config" "w"]
    set cwd [pwd]
    cd $srcdir
    set wd [pwd]
    cd $cwd
    puts $cf "Client port: $clientport"
    puts $cf "Mux port: $muxport"
    puts $cf "Prefix: $wd"
    puts $cf "Aux-item definition file: $wd/$aux_item_conf_file"
209
    puts $cf $extra_config
David Byers's avatar
David Byers committed
210
211
212
213
    close $cf

    set pid [spawn ../lyskomd -d $srcdir/config/lyskomd-config]

Per Cederqvist's avatar
Per Cederqvist committed
214
    set server_id $spawn_id
Per Cederqvist's avatar
Per Cederqvist committed
215
216
217
218
    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
219
220
221

    talk_to lyskomd
    set test "server started"
Per Cederqvist's avatar
Per Cederqvist committed
222
223
    set t $timeout
    set timeout [expr {2 * $timeout}]
Per Cederqvist's avatar
Per Cederqvist committed
224
225
226
227
228
229
    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
230
    set timeout $t
Per Cederqvist's avatar
Per Cederqvist committed
231
232
233
234
235
236
237
238
239

    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
240
241
242
243
244
245
246
247
248
}

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

    talk_to lyskomd
249
250
    simple_expect ".*Press enter to terminate lyskomd"
    send "\n"
Per Cederqvist's avatar
Per Cederqvist committed
251
252
253
254
255
256
257
258
259
260
261
262
263
264
    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
265
266
267
    global expect_always
    global expect_active
    global srcdir
268
    global deep_any
Per Cederqvist's avatar
Per Cederqvist committed
269

Per Cederqvist's avatar
Per Cederqvist committed
270
    spawn python $srcdir/tcpconnect.py localhost $clientport MRK:client$nr
Per Cederqvist's avatar
Per Cederqvist committed
271
    set client_id($nr) $spawn_id
272
    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
273
274
    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
275
276
277

    talk_to client $nr

Per Cederqvist's avatar
Per Cederqvist committed
278
279
280
    simple_expect "Connecting to localhost $clientport" \
	    "client connects" meta
    simple_expect "Connected" "client connected" meta
Per Cederqvist's avatar
Per Cederqvist committed
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
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
311
312
313
314
proc talk_to {what {nr ""}} {
    global spawn_id
    global server_id
    global client_id
Per Cederqvist's avatar
Per Cederqvist committed
315
316
317
318
319
320
    global l2g_id
    global line_leader
    global meta_line_leader

    set line_leader ""
    set meta_line_leader ""
Per Cederqvist's avatar
Per Cederqvist committed
321
322
323
324
325
326
327

    switch $what {
	lyskomd {
	    set spawn_id $server_id
	}
	client {
	    set spawn_id $client_id($nr)
Per Cederqvist's avatar
Per Cederqvist committed
328
329
330
331
	    set line_leader "MRK:client$nr"
	}
	l2g {
	    set spawn_id $l2g_id
Per Cederqvist's avatar
Per Cederqvist committed
332
333
334
335
336
337
	}
	default {
	    error "attempting to talk to $what"
	}
    }

Per Cederqvist's avatar
Per Cederqvist committed
338
339
340
341
342
    if {$line_leader != ""} {
	set meta_line_leader "${line_leader}meta: "
	set line_leader "${line_leader}: "
    }

Per Cederqvist's avatar
Per Cederqvist committed
343
    verbose "TALKING TO $spawn_id $what $nr"
Per Cederqvist's avatar
Per Cederqvist committed
344
    fix_expect_after
Per Cederqvist's avatar
Per Cederqvist committed
345
346
347
348
349
350
}

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

351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
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
}