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

if { ![info exists ATTACH] } {
    set ATTACH no
}

if { ![info exists MEMTRACE] } {
    set MEMTRACE /dev/null
}

David Byers's avatar
Server:    
David Byers committed
12
13
14
15
if { ![info exists DBCK_MEMTRACE] } {
    set DBCK_MEMTRACE /dev/null
}

David Byers's avatar
David Byers committed
16
17
18
19
20
21
22
23
24
25
26
if { ![info exists EFENCE] } {
    set EFENCE 0
}

# The attach option

if { $ATTACH == "yes" } {
    set attach 1
} else {
    set attach 0
}
Per Cederqvist's avatar
Per Cederqvist committed
27
28

# Set this to 1 if test-l2g was linked with Electric Fence.
David Byers's avatar
David Byers committed
29
30
31
32
33
if { $EFENCE == "yes" } {
    set efence 1
} else {
    set efence 0
}
Per Cederqvist's avatar
Per Cederqvist committed
34

35
36
# Set MEMTRACE to the file where the trace should be sent.
# This is typically the tty where you are running the attached gdb.
David Byers's avatar
David Byers committed
37

38

39
40
# Set the timeout value to something small for quicker testing, if you
# have a fast enough machine.
41
# set timeout 5
42

Per Cederqvist's avatar
Per Cederqvist committed
43
# Some useful constants.
Per Cederqvist's avatar
Per Cederqvist committed
44
45
46
set nl "\r?\n"
set any "\[ -\]"
set deep_any "\\\[ -\\\]"
Per Cederqvist's avatar
Per Cederqvist committed
47
set hollerith "\[0-9\]*H$any*"
Per Cederqvist's avatar
Per Cederqvist committed
48
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
49
set any_num "\[0-9\]\[0-9\]*"
Per Cederqvist's avatar
Per Cederqvist committed
50
51
52
53
54
55

set maxint 2147483647

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

57
set aux_item_default_conf_file "$top_srcdir/run-support/aux-items.conf"
58

Per Cederqvist's avatar
Per Cederqvist committed
59
# Fix the tty settings for minimum impact on the data flow.
60
set stty_init "-echo -onlcr -istrip -isig erase '^-' kill '^-' werase '^-'"
Per Cederqvist's avatar
Per Cederqvist committed
61

Per Cederqvist's avatar
Per Cederqvist committed
62
63
64
# State variables.
set line_leader ""
set meta_line_leader ""
Per Cederqvist's avatar
Per Cederqvist committed
65

66
67
68
# Values that show up in protocol messages
set lyskomd_host [exec python -c "import socket\nprint socket.gethostbyaddr(\"127.0.0.1\")\[0\]"]

69
70
# valgrind support
set valgrindix 0
71

Per Cederqvist's avatar
Per Cederqvist committed
72
73
74
75
76
77
78
79
80
81
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
82
83
84
proc l2g_start {} {
    global spawn_id
    global l2g
Per Cederqvist's avatar
Per Cederqvist committed
85
    global efence
Per Cederqvist's avatar
Per Cederqvist committed
86
87
88
    global l2g_id
    global deep_any
    global nl
89
90
    global expect_active
    global expect_always
91
92
    global test
    global MEMTRACE
Per Cederqvist's avatar
Per Cederqvist committed
93
    global valgrind
Per Cederqvist's avatar
Per Cederqvist committed
94

Per Cederqvist's avatar
Per Cederqvist committed
95
96
97
98
99
    if {$valgrind != ""} {
	spawn ./valgrind.wrap --num-callers=40 --leak-check=yes --logfile-fd=25  $l2g
    } else {
	spawn $l2g
    }
Per Cederqvist's avatar
Per Cederqvist committed
100
101
102
103
104
105
106
    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
107

108
109
110
111
112
    set test "starting l2g"
    expect {
	-re "^Where does the trace want to go today. .stderr.$nl" {
	    pass "Tracing is activated ($MEMTRACE)"
	    send "$MEMTRACE\n"
113
            exp_continue
114
115
116
117
118
119
120
121
122
	}
	-re "^l2g> " {
	    pass "$test"
	}
    }
    unset test
    send "\n"
    simple_expect "^EMPTY LINE" "noop command"

Per Cederqvist's avatar
Per Cederqvist committed
123
124
125
126
127
    if {$efence} {
	l2g_send "I9"
	l2g_send "a9 3 17"
	efence_blurb
    }
Per Cederqvist's avatar
Per Cederqvist committed
128
129
130
131
132
}

proc l2g_stop {} {
    global spawn_id

133
134
    l2g_send "q"
    simple_expect "test-l2g quitting"
135
    wait
Per Cederqvist's avatar
Per Cederqvist committed
136
137
    close
    check_valgrind {}
Per Cederqvist's avatar
Per Cederqvist committed
138
139
140
141
}

proc l2g_send {str} {
    unanchored_expect "^l2g> " "prompt before $str"
142
    verbose "sending $str"
Per Cederqvist's avatar
Per Cederqvist committed
143
144
145
    send "$str\n"
}

Per Cederqvist's avatar
Per Cederqvist committed
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
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
167
168
169
    global test
    global any
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
170
171
    global line_leader
    global meta_line_leader
David Byers's avatar
David Byers committed
172
173
174
175
176
177
178
    global verbose

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        
Per Cederqvist's avatar
Per Cederqvist committed
179

Per Cederqvist's avatar
Per Cederqvist committed
180
181
182
183
184
    if {$is_meta == "meta"} {
	set ll $meta_line_leader
    } else {
	set ll $line_leader
    }
Per Cederqvist's avatar
Per Cederqvist committed
185
186
187
188
    set test $testname
    if {$test == ""} {
	set test "looking for $regex"
    }
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
    if {[regexp "^(\[=%\])(\[0-9\]*)(( )(..*))?$" "$regex" all a refno]} {
	# This looks like a protocol A reply.
	expect {
	    -re "^$ll$regex$nl"    {pass "$test"}
	    -re "^$ll=$refno$nl"   {fail "$test (unexpected reply =$refno)"}

	    -re "^${ll}(\[=%\]$refno $any*)$nl" {
		fail "$test (unexpected reply $expect_out(1,string))"
	    }

	    timeout 	           {fail "$test (timeout)"}
	    eof 		   {fail "$test (eof)"; wait}
	    buffer_full 	   {fail "$test (buffer_full)"}
	}
    } else {
	expect {
	    -re "^$ll$regex$nl" {pass "$test"}
	    timeout 	        {fail "$test (timeout)"}
	    eof 		{fail "$test (eof)"; wait}
	    buffer_full 	{fail "$test (buffer_full)"}
	}
Per Cederqvist's avatar
Per Cederqvist committed
210
211
212
213
    }
    unset test
}

Per Cederqvist's avatar
Per Cederqvist committed
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
proc good_bad_expect {good_regex bad_regex {xreason ""}} {
    global test
    global any
    global nl
    global line_leader
    global meta_line_leader
    global verbose

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        
    set ll $line_leader

    if {![regexp "^(\[=%\])(\[0-9\]*)(( )(..*))?$" "$good_regex" all first refno]} {
	fail "$test (broken good regex)"
	unset test
	return
    }
    set bad_regex "[string range "$bad_regex" 0 0]$refno [string range "$bad_regex" 1 end]"

    set test "looking for $good_regex (or $bad_regex)"

    expect {
	-re "^${ll}($good_regex)$nl"    {
	    if {$xreason != ""} {
		setup_xfail "*-*-*" "$xreason"
	    }
	    pass "$test (got $expect_out(1,string))"
	}
	-re "^$ll$bad_regex$nl"     {
	    if {$xreason != ""} {
		setup_xfail "*-*-*" "$xreason"
	    }
	    fail "$test (bad regex matches)"
	}
	-re "^${ll}(\[=%\]$refno $any*)$nl" {
	    fail "$test (unexpected reply $expect_out(1,string))"
	}

	timeout	           {fail "$test (timeout)"}
	eof 		   {fail "$test (eof)"; wait}
	buffer_full 	   {fail "$test (buffer_full)"}
    }
    unset test
}

262
263
264
265
266
267
proc extracting_expect {regex var grp} {
    global test
    global any
    global nl
    global line_leader
    global $var
David Byers's avatar
David Byers committed
268
    global verbose
269
270
271

    set test "looking for $regex"

David Byers's avatar
David Byers committed
272
273
274
275
    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
276
277
278

    set $var ""

279
280
281
282
283
284
285
286
287
288
289
290
291
    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
292
293
294
295
proc unanchored_expect {regex testname} {
    global test
    global any
    global nl
David Byers's avatar
David Byers committed
296
    global verbose
Per Cederqvist's avatar
Per Cederqvist committed
297
298

    set test $testname
David Byers's avatar
David Byers committed
299
300
301
302
303
304
305

    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
        

Per Cederqvist's avatar
Per Cederqvist committed
306
307
308
309
310
311
    expect {
	-re "$regex" 	{pass "$test"}
	timeout 	{fail "$test (timeout)"}
	buffer_full 	{fail "$test (buffer_full)"}
	eof 		{fail "$test (eof)"; wait}
	-re "($any*)$nl" {
312
	    fail "$test (unexpected line '$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
313
	    exp_continue
Per Cederqvist's avatar
Per Cederqvist committed
314
	}
315
316
	-re "($any*)l2g> " {
	    fail "$test (unexpected incomplete line '$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
317
318
319
320
	}
    }
    unset test
}
Per Cederqvist's avatar
Per Cederqvist committed
321

322
323
324
325
326
proc spawn_lyskomd {arg} {
    global valgrind
    global spawn_id

    set cmd "spawn"
327
    if {$valgrind != ""} {
328
	set cmd "$cmd ./valgrind.wrap"
329
	# set cmd "$cmd -v"
330
331
	set cmd "$cmd --num-callers=40"
	set cmd "$cmd --leak-check=yes"
332
	set cmd "$cmd --logfile-fd=25"
333
334
335
336
337
338
339
340
341
342
343
    }
    set cmd "$cmd ../lyskomd"
    if { $arg == "" } {
	set cmd "$cmd -d config/lyskomd-config"
    } else {
	set cmd "$cmd $arg"
    }
    set pid [eval $cmd]
    return $pid
}

344
345
346
proc lyskomd_start {{aux_item_conf_file ""} \
	{extra_config ""} \
	{base_config ""} \
347
348
	{args ""} \
	{db_suffix ""}} {
349

Per Cederqvist's avatar
Per Cederqvist committed
350
351
352
353
    global spawn_id
    global server_id
    global test
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
354
355
    global attach
    global timeout
356
357
    global expect_active
    global expect_always
358
    global srcdir
David Byers's avatar
David Byers committed
359
    global clientport
360
    global aux_item_default_conf_file
361
    global lyskomd_pid
362
    global top_srcdir
363
    global debug_calls
364
365
    global mem_trace
    global MEMTRACE
366
367
368
369

    if { $aux_item_conf_file == "" } {
        set aux_item_conf_file $aux_item_default_conf_file
    }
370
371
372
373
374
375
376

    # 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"
377
    system "cp $top_srcdir/db-crypt/db/lyskomd-data$db_suffix db/lyskomd-data"
378
    system "cp $top_srcdir/db-crypt/db/lyskomd-texts db/"
379
    system "chmod 644 db/lyskomd-data db/lyskomd-texts"
380
381

    set cf [open "config/lyskomd-config" "w"]
David Byers's avatar
David Byers committed
382
    puts $cf "Client port: $clientport"
383
    puts $cf "Prefix: [pwd]"
David Byers's avatar
David Byers committed
384
385
386
387
388
    if { $base_config == "" } {
        if { [regexp -nocase "Max conferences" $extra_config] == 0 } {
            puts $cf "Max conferences: 2000"
        }
        if { [regexp -nocase "Max texts" $extra_config] == 0 } {
389
            puts $cf "Max texts: 20000"
David Byers's avatar
David Byers committed
390
        }
391
        puts $cf "Aux-item definition file: $aux_item_conf_file"
David Byers's avatar
David Byers committed
392
393
394
    } else {
        puts $cf $base_config
    }
395
    puts $cf $extra_config
David Byers's avatar
David Byers committed
396
397
    close $cf

398
    set pid [spawn_lyskomd $args]
399
    set lyskomd_pid $pid
David Byers's avatar
David Byers committed
400

Per Cederqvist's avatar
Per Cederqvist committed
401
    set server_id $spawn_id
Per Cederqvist's avatar
Per Cederqvist committed
402
    set expect_active($server_id) \
403
	    " -i $server_id eof { fail \"\$test (eof on lyskomd)\"; wait }"
Per Cederqvist's avatar
Per Cederqvist committed
404
    set expect_always($server_id) \
405
	    " -i $server_id buffer_full { fail \"\$test (buffer_full on lyskomd)\" } -i $server_id eof { fail \"\$test (eof on lyskomd)\" }"
Per Cederqvist's avatar
Per Cederqvist committed
406
407
408

    talk_to lyskomd
    set test "server started"
Per Cederqvist's avatar
Per Cederqvist committed
409
410
    set t $timeout
    set timeout [expr {2 * $timeout}]
411
    set debug_calls 0
412
413
    set mem_trace 0
    set unattached $attach
Per Cederqvist's avatar
Per Cederqvist committed
414
    expect {
415
416
417
418
419
420
421
422
423
424
425
426
427
428
	-re "Where does the trace want to go today. .stderr." {
	    pass "Tracing is activated ($MEMTRACE)"
	    if {$unattached} {
		send_user "Please attach to lyskomd pid $pid and hit RETURN\n"
		set timeout 3600
		set t 3600
		expect_user {
		    -re .
		}
		send_user "Continuing with timeout set to $timeout\n"
		set unattached 0
	    }
	    send "$MEMTRACE\n"
	    set mem_trace 1
429
            exp_continue
430
	}
431
432
	-re "WARNING: This server was compiled with --with-debug-calls" {
	    pass "debug calls are enabled"
433
	    set debug_calls 1
434
            exp_continue
435
	}
Per Cederqvist's avatar
Per Cederqvist committed
436
437
438
439
440
	-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
441
    set timeout $t
Per Cederqvist's avatar
Per Cederqvist committed
442

443
    if {$unattached} {
Per Cederqvist's avatar
Per Cederqvist committed
444
445
446
447
448
449
450
	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
451
452
}

David Byers's avatar
David Byers committed
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
proc lyskomd_fail_start {{aux_item_conf_file "" }
                         {extra_config ""}
                         {base_config ""}
                         {args ""}} {
    global spawn_id
    global server_id
    global test
    global nl
    global attach
    global timeout
    global expect_active
    global expect_always
    global srcdir
    global clientport
    global aux_item_default_conf_file
    global lyskomd_pid
469
    global top_srcdir
470
    global MEMTRACE
David Byers's avatar
David Byers committed
471
472
473
474
475
476
477
478
479
480
481

    if { $aux_item_conf_file == "" } {
        set aux_item_conf_file $aux_item_default_conf_file
    }

    # 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"
482
483
484
485
    system "cp $top_srcdir/db-crypt/db/lyskomd-data db/"
    system "cp $top_srcdir/db-crypt/db/lyskomd-texts db/"

    set cf [open "config/lyskomd-config" "w"]
David Byers's avatar
David Byers committed
486
487
488
489
    puts $cf "Client port: $clientport"
    if { $base_config == "" } {
        puts $cf "Max conferences: 2000"
        puts $cf "Max texts: 2000"
490
491
        puts $cf "Prefix: [pwd]"
        puts $cf "Aux-item definition file: $aux_item_conf_file"
David Byers's avatar
David Byers committed
492
493
494
495
496
497
    } else {
        puts $cf $base_config
    }
    puts $cf $extra_config
    close $cf

Per Cederqvist's avatar
Per Cederqvist committed
498
    set pid [spawn_lyskomd $args]
David Byers's avatar
David Byers committed
499
500
501
502
503
504
505
506
507
508
509
510
511
512
    set lyskomd_pid $pid

    set server_id $spawn_id
    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)\" }"

    talk_to lyskomd
    set test "server start failed"
    set t $timeout
    set timeout [expr {2 * $timeout}]
    
    expect {
513
514
515
	-re "Where does the trace want to go today. .stderr." {
	    pass "Tracing is activated ($MEMTRACE)"
	    send "$MEMTRACE\n"
516
            exp_continue
517
	}
David Byers's avatar
David Byers committed
518
519
520
521
522
523
524
525
526
527
528
529
530
531
        -re "Search for the core" { pass "$test" }
	timeout         {fail "$test (timeout)" }
	buffer_full 	{fail "$test (buffer_full)" }
	eof 		{fail "$test (eof)"; wait}
    }

    set timeout $t

    set test "server died"
    expect {
        -re "..*" { exp_continue }
        timeout   { fail "$test (timeout)" }
        eof       { pass "$test"; wait }
    }
Per Cederqvist's avatar
Per Cederqvist committed
532
    check_valgrind {}
David Byers's avatar
David Byers committed
533
534
}

David Byers's avatar
David Byers committed
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
proc check_memory_usage {} {
    set allocated_strings 0
    set allocated_blocks 0

    set f [ open "etc/memory-usage" ]
    while { [ gets $f line] >= 0 } {
        if { [regexp "Allocated blocks .grand total." $line] } {
            set allocated_blocks [lindex "$line" [expr [llength "$line"] - 1]]
        } elseif { [regexp "Allocated strings" $line] } {
            set allocated_strings [lindex "$line" [expr [llength "$line"] - 1]]
        }
    }
    close $f

    if { $allocated_blocks != 0 } {
        fail "Allocated blocks on exit"
    } else {
        pass "Allocated blocks on exit"
    }
    if { $allocated_strings != 0 } {
        fail "Allocated strings on exit"
    } else {
        pass "Allocated strings on exit"
    }
}

561
562
563
564
565
566
567
568
569
570
571
572
proc parse_valgrind_leak {f} {
    if {[gets $f line] < 0} {
	fail "valgrind EOF in leak summary"
	return 999
    }
    if {[regexp ":  *\[0-9\]* bytes in (\[0-9\]*) block" "$line" all blocks]} {
	return $blocks
    }
    fail "valgrind leak report parse error"
    return 998
}

573
574
575
576
577
578
579
580
proc check_valgrind {expected_leaks} {
    # The "expected_leaks" argument should be a such as:
    #
    #   {"Bug 99 & Bug 93" 4 3 9}
    #
    # that indicates that due to Bug 99 and Bug 93 there will be 4
    # definite leaks, 3 possible leaks, and 9 still reachable blocks.
    
581
582
    global valgrindix
    global valgrind
583
    global test
584

585
    if {$valgrind == ""} {
586
587
588
589
590
591
592
593
594
595
596
597
598
	return
    }

    set errfound 0
    set memfound 0
    set errcount 0
    set leakcount 0
    set tracefile "valgrind.log"

    set f [open $tracefile]
    while {[gets $f line] >= 0} {
	if {[regexp "ERROR SUMMARY: (\[0-9\]*) errors" $line match errs]} {
	    if {$errfound} {
599
		fail "check_valgrind logic error"
600
601
602
603
604
605
	    } else {
		set errfound 1
		set errcount $errs
	    }
	}
	if {[regexp "LEAK SUMMARY:" $line]} {
Per Cederqvist's avatar
Per Cederqvist committed
606
	    set memfound 1
607
608
609
	    set definite [parse_valgrind_leak $f]
	    set possible [parse_valgrind_leak $f]
	    set reachable [parse_valgrind_leak $f]
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
	    if {$expected_leaks != {}} {
		set xreason [lindex $expected_leaks 0]
		set exp_def [lindex $expected_leaks 1]
		set exp_pos [lindex $expected_leaks 2]
		set exp_rea [lindex $expected_leaks 3]

		setup_xfail "*-*-*" $xreason
		if {$exp_def == $definite
		    && $exp_pos == $possible
		    && $exp_rea == $reachable} {

		    fail "memory leaks: $definite definite, $possible possible"
		    
		    set definite 0
		    set possible 0
		    set reachable 0
		} else {
		    pass "wrong memory leak count found"
		}
	    }
630
631
632
633
634
635
	    set leakcount [expr $definite + $possible]
	    # Ignore up to 10 reachable blocks.  libc leaks some blocks...
	    if {$reachable > 10} {
		set leakcount "$reachable"
	    }
	}
Per Cederqvist's avatar
Per Cederqvist committed
636
637
638
	if {[regexp "No malloc'd blocks -- no leaks are possible" $line]} {
	    set memfound 1
	}
639
640
641
642
643
644
    }
    close $f
    if {$errfound == 0} {
	fail "no error summary in valgrind output"
    }

Per Cederqvist's avatar
Per Cederqvist committed
645
646
647
648
    if {$memfound == 0} {
	fail "no malloc summary in valgrind output"
    }

649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
    if {$errcount + $leakcount > 0} {
	while {[file exists "valgrind-$valgrindix.log"]} {
	    set valgrindix [expr $valgrindix + 1]
	}
	set saved "valgrind-$valgrindix.log"
	system "mv $tracefile $saved"
    }
	
    if {$errcount == 0} {
	pass "valgrind found no errors"
    } else {
	fail "valgrind found $errcount error(s).  See $saved."
    }
    if {$leakcount == 0} {
	pass "valgrind found no leaks"
    } else {
	if {$definite} {
	    fail "valgrind found $definite definite leaks.  See $saved."
	}
	if {$possible} {
	    fail "valgrind found $possible possible leaks.  See $saved."
	}
	if {$reachable} {
	    fail "valgrind found $reachable reachable blocks.  See $saved."
	}
    }
}

677
678
proc lyskomd_death {{expected_leaks {}}} {
    # See check_valgrind for a description of "expected_leaks".
Per Cederqvist's avatar
Per Cederqvist committed
679
680
681
682
683
684
    global spawn_id
    global server_id
    global test
    global nl

    talk_to lyskomd
685
686
    simple_expect ".*Press enter to terminate lyskomd"
    send "\n"
Per Cederqvist's avatar
Per Cederqvist committed
687
688
689
690
691
692
    set test "server died"
    expect {
	-re "..*" { exp_continue }
	timeout  { fail "$test (timeout)" }
	eof      { pass "$test"; wait }
    }
693
    system "cat etc/memory-usage >> usage.all"
David Byers's avatar
David Byers committed
694
    check_memory_usage
695
    check_valgrind $expected_leaks
Per Cederqvist's avatar
Per Cederqvist committed
696
    dbck_run
Per Cederqvist's avatar
Per Cederqvist committed
697
698
}

Per Cederqvist's avatar
Per Cederqvist committed
699
700
701
702
proc dbck_run {} {
    global nl
    global test
    global any_num
David Byers's avatar
Server:    
David Byers committed
703
    global DBCK_MEMTRACE
Per Cederqvist's avatar
Per Cederqvist committed
704
    global valgrind
Per Cederqvist's avatar
Per Cederqvist committed
705

Per Cederqvist's avatar
Per Cederqvist committed
706
707
708
709
710
    if {$valgrind != ""} {
	spawn ./valgrind.wrap --num-callers=40 --leak-check=yes --logfile-fd=25 ../dbck -d config/lyskomd-config
    } else {
	spawn ../dbck -d config/lyskomd-config
    }
Per Cederqvist's avatar
Per Cederqvist committed
711
712
713
714
715
716
    set test "dbck started"
    expect_after {
	timeout { fail "$test (timeout)" }
	eof { fail "$test (eof)" }
    }
    expect {
David Byers's avatar
Server:    
David Byers committed
717
718
719
	-re "^Where does the trace want to go today. .stderr.$nl" {
	    pass "Tracing is activated ($DBCK_MEMTRACE)"
	    send "$DBCK_MEMTRACE\n"
720
            exp_continue
David Byers's avatar
Server:    
David Byers committed
721
722
723
724
	}
	-re "^MSG: init_cache: using datafile\.$nl" { 
            pass "$test" 
        }
Per Cederqvist's avatar
Per Cederqvist committed
725
    }
David Byers's avatar
Server:    
David Byers committed
726

Per Cederqvist's avatar
Per Cederqvist committed
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
    set test "dbck sent second line"
    expect {
	-re "^Read $any_num confs/persons and $any_num texts, eof at $any_num$nl" {
	    pass "$test"
	}
    }
    set test "dbck sent final line"
    expect {
	-re "^Press enter to terminate dbck$nl" {
	    pass "$test"
	}
    }
    send "\n"
    set test "dbck died"
    expect {
	eof { pass "$test"; wait }
    }
    unset test
Per Cederqvist's avatar
Per Cederqvist committed
745
    check_valgrind {}
Per Cederqvist's avatar
Per Cederqvist committed
746
747
}
    
Per Cederqvist's avatar
Per Cederqvist committed
748
749
750
751
752
753
proc client_start {nr} {
    global client_id
    global clientport
    global spawn_id
    global test
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
754
755
756
    global expect_always
    global expect_active
    global srcdir
757
    global deep_any
Per Cederqvist's avatar
Per Cederqvist committed
758

Per Cederqvist's avatar
Per Cederqvist committed
759
    spawn python $srcdir/tcpconnect.py localhost $clientport MRK:client$nr
Per Cederqvist's avatar
Per Cederqvist committed
760
    set client_id($nr) $spawn_id
761
    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
762
763
    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
764
765
766

    talk_to client $nr

Per Cederqvist's avatar
Per Cederqvist committed
767
768
769
    simple_expect "Connecting to localhost $clientport" \
	    "client connects" meta
    simple_expect "Connected" "client connected" meta
Per Cederqvist's avatar
Per Cederqvist committed
770
771
}

David Byers's avatar
David Byers committed
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
proc client_start_fail {nr {response ""}} {
    global client_id
    global clientport
    global spawn_id
    global test
    global nl
    global expect_always
    global expect_active
    global srcdir
    global deep_any

    spawn python $srcdir/tcpconnect.py localhost $clientport MRK:client$nr
    set client_id($nr) $spawn_id
    set expect_active($client_id($nr)) " -i $client_id($nr) -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line \$expect_out(1,string))\"; exp_continue } "
    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)\" } "

    talk_to client $nr

    simple_expect "Connecting to localhost $clientport" \
	    "client connects" meta
    simple_expect "Connected" "client connected" meta

    if { $response != "" } {
        simple_expect "$response"
    }

    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
}

814
815
816
817
818
819
820
proc kill_client {nr} {
    global client_id
    global expect_always
    global expect_active
   
    close -i $client_id($nr)
    wait -i  $client_id($nr)
David Byers's avatar
David Byers committed
821
822
823
    unset expect_active($client_id($nr))
    unset expect_always($client_id($nr))
    fix_expect_after
824
825
826
827
828
829
}

proc suspend_client {} {
    send "\#suspend socket\n"
}

David Byers's avatar
David Byers committed
830
831
832
833
proc hose_client {} {
    send "\#hose socket\n"
}

834
835
836
837
proc resume_client {} {
    send "\#resume socket\n"
}

838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
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
866
867
868
869
proc talk_to {what {nr ""}} {
    global spawn_id
    global server_id
    global client_id
Per Cederqvist's avatar
Per Cederqvist committed
870
871
872
    global l2g_id
    global line_leader
    global meta_line_leader
873
    global current_client_nr
Per Cederqvist's avatar
Per Cederqvist committed
874
875
876

    set line_leader ""
    set meta_line_leader ""
Per Cederqvist's avatar
Per Cederqvist committed
877
878
879
880
881
882
883

    switch $what {
	lyskomd {
	    set spawn_id $server_id
	}
	client {
	    set spawn_id $client_id($nr)
Per Cederqvist's avatar
Per Cederqvist committed
884
885
886
887
	    set line_leader "MRK:client$nr"
	}
	l2g {
	    set spawn_id $l2g_id
Per Cederqvist's avatar
Per Cederqvist committed
888
889
890
891
892
893
	}
	default {
	    error "attempting to talk to $what"
	}
    }

Per Cederqvist's avatar
Per Cederqvist committed
894
895
896
897
898
    if {$line_leader != ""} {
	set meta_line_leader "${line_leader}meta: "
	set line_leader "${line_leader}: "
    }

Per Cederqvist's avatar
Per Cederqvist committed
899
    verbose "TALKING TO $spawn_id $what $nr"
Per Cederqvist's avatar
Per Cederqvist committed
900
    fix_expect_after
Per Cederqvist's avatar
Per Cederqvist committed
901
902
903
904
905
906
}

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

907
908
909
910
911
proc idholl {str} {
    global lyskomd_host;
    return [holl "$str@$lyskomd_host"]
}

912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
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
}
934
935
936
937
938
939

proc dump_statistics {} {
    global lyskomd_pid

    system "kill -USR1 $lyskomd_pid"
}