unix.exp 6.89 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
15
16
17
18
19
20

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
21

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

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

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

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

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

proc l2g_stop {} {
    global spawn_id

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

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

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

Per Cederqvist's avatar
Per Cederqvist committed
107
108
109
110
111
    if {$is_meta == "meta"} {
	set ll $meta_line_leader
    } else {
	set ll $line_leader
    }
Per Cederqvist's avatar
Per Cederqvist committed
112
113
114
115
116
    set test $testname
    if {$test == ""} {
	set test "looking for $regex"
    }
    expect {
Per Cederqvist's avatar
Per Cederqvist committed
117
	-re "^$ll$regex$nl" {pass "$test"}
Per Cederqvist's avatar
Per Cederqvist committed
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
	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" {
137
	    fail "$test (unexpected line '$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
138
	    exp_continue
Per Cederqvist's avatar
Per Cederqvist committed
139
140
	}
	-re "($any*)l2g>" {
Per Cederqvist's avatar
Per Cederqvist committed
141
	    fail "$test (unexpected incomplete line '\$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
142
143
144
145
	}
    }
    unset test
}
Per Cederqvist's avatar
Per Cederqvist committed
146
147
148
149
150
151

proc lyskomd_start {} {
    global spawn_id
    global server_id
    global test
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
152
153
    global attach
    global timeout
154
155
    global expect_active
    global expect_always
156
157
158
159
160
161
162
163
164
165
    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
166

Per Cederqvist's avatar
Per Cederqvist committed
167
    set pid [spawn ../lyskomd -d config/lyskomd-config]
Per Cederqvist's avatar
Per Cederqvist committed
168
    set server_id $spawn_id
Per Cederqvist's avatar
Per Cederqvist committed
169
170
171
172
    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
173
174
175
176
177
178
179
180
181

    talk_to lyskomd
    set test "server started"
    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
182
183
184
185
186
187
188
189
190

    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
191
192
193
194
195
196
197
198
199
}

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

    talk_to lyskomd
200
201
    simple_expect ".*Press enter to terminate lyskomd"
    send "\n"
Per Cederqvist's avatar
Per Cederqvist committed
202
203
204
205
206
207
208
209
210
211
212
213
214
215
    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
216
217
218
    global expect_always
    global expect_active
    global srcdir
219
    global deep_any
Per Cederqvist's avatar
Per Cederqvist committed
220

Per Cederqvist's avatar
Per Cederqvist committed
221
    spawn python $srcdir/tcpconnect.py localhost $clientport MRK:client$nr
Per Cederqvist's avatar
Per Cederqvist committed
222
    set client_id($nr) $spawn_id
223
    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
224
225
    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
226
227
228

    talk_to client $nr

Per Cederqvist's avatar
Per Cederqvist committed
229
230
231
    simple_expect "Connecting to localhost $clientport" \
	    "client connects" meta
    simple_expect "Connected" "client connected" meta
Per Cederqvist's avatar
Per Cederqvist committed
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
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
262
263
264
265
proc talk_to {what {nr ""}} {
    global spawn_id
    global server_id
    global client_id
Per Cederqvist's avatar
Per Cederqvist committed
266
267
268
269
270
271
    global l2g_id
    global line_leader
    global meta_line_leader

    set line_leader ""
    set meta_line_leader ""
Per Cederqvist's avatar
Per Cederqvist committed
272
273
274
275
276
277
278

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

Per Cederqvist's avatar
Per Cederqvist committed
289
290
291
292
293
    if {$line_leader != ""} {
	set meta_line_leader "${line_leader}meta: "
	set line_leader "${line_leader}: "
    }

Per Cederqvist's avatar
Per Cederqvist committed
294
    verbose "TALKING TO $spawn_id $what $nr"
Per Cederqvist's avatar
Per Cederqvist committed
295
    fix_expect_after
Per Cederqvist's avatar
Per Cederqvist committed
296
297
298
299
300
301
}

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