unix.exp 37 KB
Newer Older
1 2 3 4 5
# The values in this file can be overridden by creating localcfg.exp 
# and setting them there.  This is useful if you are working against
# the CVS repository and make a purely local change (such as setting
# the timeout value to a low value).

Per Cederqvist's avatar
Per Cederqvist committed
6 7
# 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
8 9 10 11 12 13 14 15 16

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

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

David Byers's avatar
Server:  
David Byers committed
17 18 19 20
if { ![info exists DBCK_MEMTRACE] } {
    set DBCK_MEMTRACE /dev/null
}

David Byers's avatar
David Byers committed
21 22 23 24 25 26 27 28 29 30 31
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
32 33

# Set this to 1 if test-l2g was linked with Electric Fence.
David Byers's avatar
David Byers committed
34 35 36 37 38
if { $EFENCE == "yes" } {
    set efence 1
} else {
    set efence 0
}
Per Cederqvist's avatar
Per Cederqvist committed
39

40 41
# 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
42

Per Cederqvist's avatar
Per Cederqvist committed
43 44
# Some of the machines we run the Xenofarm tests on are really, really
# slow, so we have to increase the timeout.
45
set timeout [expr {3 * $timeout + 2}]
Per Cederqvist's avatar
Per Cederqvist committed
46

47 48 49 50
# Set the timeout value to something small for quicker testing, if you
# have a fast enough machine.
#set timeout 5

51
# This constant is also defined in src/include/kom-config.h.
52
# It also affects VALGRIND_FD in ../Makefile.am.
53
set PROTECTED_FDS [expr 13 + 9]
54

55 56 57 58 59 60 61 62 63
# The file descriptor used for valgrind support.  We use the
# last of the protected FD:s.  If this changes, you must
# change VALGRIND_FD in ../Makefile.am.
if {$valgrind_fd != $PROTECTED_FDS - 1} {
    error "Mismatch between valgrind_fd ($valgrind_fd) and PROTECTED_FDS ($PROTECTED_FDS)"
}
set valgrind_fd [expr $PROTECTED_FDS - 1]


Per Cederqvist's avatar
Per Cederqvist committed
64
# Some useful constants.
Per Cederqvist's avatar
Per Cederqvist committed
65 66 67
set nl "\r?\n"
set any "\[ -\]"
set deep_any "\\\[ -\\\]"
Per Cederqvist's avatar
Per Cederqvist committed
68
set hollerith "\[0-9\]*H$any*"
Per Cederqvist's avatar
Per Cederqvist committed
69
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
70 71
# 1970-01-01 GMT, but with some fuzziness to allow for local time zones.
set epoch_time "0 0 \[0-9\]* (1|31) (0|11) (70|69) (4|3) (0|364) \[01\]"
Per Cederqvist's avatar
Per Cederqvist committed
72
set any_num "\[0-9\]\[0-9\]*"
Per Cederqvist's avatar
Per Cederqvist committed
73
set any_float "\[0-9\]\[-0-9e.+\]*"
74 75
# FIXME (bug 1069): Why doesn't this work?
# set any_float "\[0-9\]\[0-9\]*(\\.\[0-9\]*)?(e(+|-)\[0-9\]\[0-9\]\[0-9\]*"
Per Cederqvist's avatar
Per Cederqvist committed
76

77
# The port that is used for Protocol A connections by the test suite.
Per Cederqvist's avatar
Per Cederqvist committed
78
set clientport 53262
Per Cederqvist's avatar
Per Cederqvist committed
79

80
set aux_item_default_conf_file "$top_srcdir/run-support/aux-items.conf"
81

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

Per Cederqvist's avatar
Per Cederqvist committed
85 86 87
# State variables.
set line_leader ""
set meta_line_leader ""
Per Cederqvist's avatar
Per Cederqvist committed
88

89 90
# valgrind support
set valgrindix 0
91

Per Cederqvist's avatar
Per Cederqvist committed
92 93 94
# Save all broken memory-usage files.
set memix 0

Per Cederqvist's avatar
Per Cederqvist committed
95 96 97
# Recursive lock count.
set lock_count 0

Per Cederqvist's avatar
Per Cederqvist committed
98 99 100 101 102 103 104 105 106 107
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
108 109 110 111 112 113
proc obtain_lock {} {
    global lock_count
    global nl
    global spawn_id
    global lock_id
    global any
114
    global srcdir
115
    global python
Per Cederqvist's avatar
Per Cederqvist committed
116 117 118 119

    if {$lock_count == 0} {
	set redo 1
	while {$redo} {
120
	    spawn $python $srcdir/locksuite.py
Per Cederqvist's avatar
Per Cederqvist committed
121 122 123 124 125 126 127 128 129 130 131 132 133
	    set lock_id $spawn_id
	    expect {
		-re "^locking...$nl" {
		    exp_continue
		}
		-re "^waiting: socket (.*)$nl" {
		    warning "Test suite locked by socket $expect_out(1,string)" 0
		    exp_continue
		}
		-re "^waiting: file (.*)$nl" {
		    warning "Test suite locked by file $expect_out(1,string)" 0
		    exp_continue
		}
134
		-re "^failed: file ($any*) (\[^ :\]*):(\[0-9\]*)$nl" {
Per Cederqvist's avatar
Per Cederqvist committed
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
		    warning "failed to obtain lock due to $expect_out(1,string)"
		    warning "removing stale lock $expect_out(1,string)"
		    system "rm $expect_out(1,string)"
		    send "exit\n"
		    expect bye
		    expect eof
		    wait
		}
		-re "^locked$nl" {
		    set redo 0
		}
		timeout {
		    exp_continue
		}
		eof {
		    fail "obtaining lock failed"
		    wait
152
		    set redo 0
Per Cederqvist's avatar
Per Cederqvist committed
153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
		}
	    }
	}
    }
    set lock_count [expr {$lock_count + 1}]
}

proc release_lock {} {
    global lock_count
    global nl
    global spawn_id
    global lock_id

    if {$lock_count == 1} {
	set spawn_id $lock_id
	send "exit\n"
	expect {
	    -re "queued: socket (.*)$nl" {
		warning "Test suite blocked for $expect_out(1,string)" 0
		exp_continue
	    }
	    -re "bye$nl"
	}
	expect eof
	wait
    }
    if {$lock_count < 1} {
	error "lock already unlocked"
    } else {
	set lock_count [expr {$lock_count - 1}]
    }
}

Per Cederqvist's avatar
Per Cederqvist committed
186 187 188
proc l2g_start {} {
    global spawn_id
    global l2g
Per Cederqvist's avatar
Per Cederqvist committed
189
    global efence
Per Cederqvist's avatar
Per Cederqvist committed
190 191 192
    global l2g_id
    global deep_any
    global nl
193 194
    global expect_active
    global expect_always
195 196
    global test
    global MEMTRACE
Per Cederqvist's avatar
Per Cederqvist committed
197
    global valgrind
198
    global valgrind_fd
Per Cederqvist's avatar
Per Cederqvist committed
199

Per Cederqvist's avatar
Per Cederqvist committed
200 201
    obtain_lock

Per Cederqvist's avatar
Per Cederqvist committed
202
    if {$valgrind != ""} {
203
	spawn ./valgrind.wrap valgrind-l2g.log --suppressions=lyskomd.supp --num-callers=40 --leak-check=yes --logfile-fd=$valgrind_fd --show-reachable=yes $l2g
Per Cederqvist's avatar
Per Cederqvist committed
204 205 206
    } else {
	spawn $l2g
    }
Per Cederqvist's avatar
Per Cederqvist committed
207 208
    set l2g_id $spawn_id
    set expect_active($l2g_id) \
209
	    " -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)')\" } timeout { fail \"\$test (timeout on l2g)\" }"
Per Cederqvist's avatar
Per Cederqvist committed
210
    set expect_always($l2g_id) \
211
	    " -i $l2g_id full_buffer { fail \"\$test (full_buffer on l2g)\" }"
Per Cederqvist's avatar
Per Cederqvist committed
212 213

    talk_to l2g
Per Cederqvist's avatar
Per Cederqvist committed
214

215 216 217 218 219
    set test "starting l2g"
    expect {
	-re "^Where does the trace want to go today. .stderr.$nl" {
	    pass "Tracing is activated ($MEMTRACE)"
	    send "$MEMTRACE\n"
220
            exp_continue
221 222 223 224 225 226 227 228 229
	}
	-re "^l2g> " {
	    pass "$test"
	}
    }
    unset test
    send "\n"
    simple_expect "^EMPTY LINE" "noop command"

Per Cederqvist's avatar
Per Cederqvist committed
230 231 232 233 234
    if {$efence} {
	l2g_send "I9"
	l2g_send "a9 3 17"
	efence_blurb
    }
Per Cederqvist's avatar
Per Cederqvist committed
235 236 237 238 239
}

proc l2g_stop {} {
    global spawn_id

240 241
    l2g_send "q"
    simple_expect "test-l2g quitting"
242
    wait
Per Cederqvist's avatar
Per Cederqvist committed
243
    close
244
    check_valgrind valgrind-l2g.log 1 1 {}
Per Cederqvist's avatar
Per Cederqvist committed
245 246

    release_lock
Per Cederqvist's avatar
Per Cederqvist committed
247 248 249 250
}

proc l2g_send {str} {
    unanchored_expect "^l2g> " "prompt before $str"
251
    verbose "sending $str"
Per Cederqvist's avatar
Per Cederqvist committed
252 253 254
    send "$str\n"
}

Per Cederqvist's avatar
Per Cederqvist committed
255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274
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)"
    }

    verbose "evaluating $stmt" 2
    eval $stmt
}

proc simple_expect {regex {testname ""} {is_meta ""}} {
Per Cederqvist's avatar
Per Cederqvist committed
275 276 277
    global test
    global any
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
278 279
    global line_leader
    global meta_line_leader
David Byers's avatar
David Byers committed
280 281 282 283 284 285 286
    global verbose

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

Per Cederqvist's avatar
Per Cederqvist committed
288 289 290 291 292
    if {$is_meta == "meta"} {
	set ll $meta_line_leader
    } else {
	set ll $line_leader
    }
293 294 295 296 297 298

    if {[string range "$regex" 0 2] == "<<<"} {
	set regex "[string range "$regex" 3 end]"
	set ll ""
    }

Per Cederqvist's avatar
Per Cederqvist committed
299 300 301 302
    set test $testname
    if {$test == ""} {
	set test "looking for $regex"
    }
303 304 305 306 307 308 309 310 311 312 313 314
    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}
315
	    full_buffer 	   {fail "$test (full_buffer)"}
316 317 318 319 320 321
	}
    } else {
	expect {
	    -re "^$ll$regex$nl" {pass "$test"}
	    timeout 	        {fail "$test (timeout)"}
	    eof 		{fail "$test (eof)"; wait}
322
	    full_buffer 	{fail "$test (full_buffer)"}
323
	}
Per Cederqvist's avatar
Per Cederqvist committed
324 325 326 327
    }
    unset test
}

328 329 330 331 332 333 334 335 336 337 338 339
proc lyskomd_expect {regex} {
    global current_talk_what
    global current_talk_nr

    set what $current_talk_what
    set nr $current_talk_nr

    talk_to lyskomd
    simple_expect "$regex"
    talk_to $what $nr
}

Per Cederqvist's avatar
Per Cederqvist committed
340 341 342 343 344 345 346 347 348 349 350 351
proc client_expect {nr regex} {
    global current_talk_what
    global current_talk_nr

    set oldwhat $current_talk_what
    set oldnr $current_talk_nr

    talk_to client $nr
    simple_expect "$regex"
    talk_to $oldwhat $oldnr
}

352 353 354 355 356 357 358 359 360 361 362 363
proc client_good_bad_expect {nr good_regex bad_regex {xreason ""}} {
    global current_talk_what
    global current_talk_nr

    set oldwhat $current_talk_what
    set oldnr $current_talk_nr

    talk_to client $nr
    good_bad_expect "$good_regex" "$bad_regex" "$xreason"
    talk_to $oldwhat $oldnr
}

Per Cederqvist's avatar
Per Cederqvist committed
364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
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
    }
384 385 386 387 388
    set rest "[string range "$bad_regex" 1 end]"
    if {$rest != ""} {
	set rest " $rest"
    }
    set bad_regex "[string range "$bad_regex" 0 0]$refno$rest"
Per Cederqvist's avatar
Per Cederqvist committed
389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410

    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}
411
	full_buffer 	   {fail "$test (full_buffer)"}
Per Cederqvist's avatar
Per Cederqvist committed
412 413 414 415
    }
    unset test
}

416 417 418 419 420 421 422 423 424 425 426 427 428
proc client_extracting_expect {nr regex var grp} {
    global current_talk_what
    global current_talk_nr

    set oldwhat $current_talk_what
    set oldnr $current_talk_nr

    talk_to client $nr
    extracting_expect "$regex" $var $grp
    talk_to $oldwhat $oldnr
}


429 430 431 432 433 434
proc extracting_expect {regex var grp} {
    global test
    global any
    global nl
    global line_leader
    global $var
David Byers's avatar
David Byers committed
435
    global verbose
436 437 438

    set test "looking for $regex"

David Byers's avatar
David Byers committed
439 440 441 442
    if { $verbose } {
        puts -nonewline "."
        flush stdout
    }
443 444 445

    set $var ""

446 447 448
    expect {
	-re "^$line_leader$regex$nl" {
	    set $var $expect_out($grp,string)
449
	    pass "$test (extracted $expect_out($grp,string))"
450 451 452
	}
	timeout 	 {fail "$test (timeout)"}
	eof 		 {fail "$test (eof)"; wait}
453
	full_buffer 	{fail "$test (full_buffer)"}
454 455 456 457 458
    }
    unset test
}


Per Cederqvist's avatar
Per Cederqvist committed
459 460 461 462
proc unanchored_expect {regex testname} {
    global test
    global any
    global nl
David Byers's avatar
David Byers committed
463
    global verbose
Per Cederqvist's avatar
Per Cederqvist committed
464 465

    set test $testname
David Byers's avatar
David Byers committed
466 467 468 469 470 471 472

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

Per Cederqvist's avatar
Per Cederqvist committed
473 474 475
    expect {
	-re "$regex" 	{pass "$test"}
	timeout 	{fail "$test (timeout)"}
476
	full_buffer 	{fail "$test (full_buffer)"}
Per Cederqvist's avatar
Per Cederqvist committed
477 478
	eof 		{fail "$test (eof)"; wait}
	-re "($any*)$nl" {
479
	    fail "$test (unexpected line '$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
480
	    exp_continue
Per Cederqvist's avatar
Per Cederqvist committed
481
	}
482 483
	-re "($any*)l2g> " {
	    fail "$test (unexpected incomplete line '$expect_out(1,string)' waiting for '$regex')"
Per Cederqvist's avatar
Per Cederqvist committed
484 485 486 487
	}
    }
    unset test
}
Per Cederqvist's avatar
Per Cederqvist committed
488

489
proc spawn_lyskomd {logfile arg} {
490 491
    global valgrind
    global spawn_id
492
    global valgrind_fd
493 494

    set cmd "spawn"
495
    if {$valgrind != ""} {
496
	set cmd "$cmd ./valgrind.wrap"
497
	set cmd "$cmd $logfile"
498
	# set cmd "$cmd -v"
499
	set cmd "$cmd --num-callers=40"
500
	set cmd "$cmd --suppressions=lyskomd.supp"
501
	set cmd "$cmd --leak-check=yes"
502
	set cmd "$cmd --logfile-fd=$valgrind_fd"
503
	set cmd "$cmd --show-reachable=yes"
504 505 506
    }
    set cmd "$cmd ../lyskomd"
    if { $arg == "" } {
507
	set cmd "$cmd -f config/lyskomd-config"
508 509 510 511 512 513 514
    } else {
	set cmd "$cmd $arg"
    }
    set pid [eval $cmd]
    return $pid
}

Per Cederqvist's avatar
Per Cederqvist committed
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533
proc unpack_db {basename} {
    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/lyskomd.0/$basename.data db/lyskomd-data"
    system "cp $srcdir/lyskomd.0/$basename.texts db/lyskomd-texts"
    system "chmod 644 db/lyskomd-data db/lyskomd-texts"
    if {[file exists "$srcdir/lyskomd.0/$basename.nr"]} {
	system "cp $srcdir/lyskomd.0/$basename.nr db/number.txt"
	system "chmod 644 db/number.txt"
    }
}

534 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 561
proc set_debug_calls {} {
    global debug_calls
    global line_leader
    global nl
    global test

    set test "Testing for debug calls"
    set debug_calls 2
    expect {
	-re "^${line_leader}WARNING: This server was compiled with --with-debug-calls\\.$nl" {
	    expect -re "^${line_leader}It isn.t safe to use in a production environment.$nl"
	    pass "$test (enabled)"
	    set debug_calls 1
	}
	-re "^${line_leader}Debug calls are disabled, as they should be\\.$nl" {
	    pass "$test (disabled)"
	    set debug_calls 0
	}
	timeout         {fail "$test (timeout)"}
	full_buffer 	{fail "$test (full_buffer)"}
	eof 		{fail "$test (eof)"; wait}
    }
    if {$debug_calls == 2} {
	fail "$test (no info found)"
	set debug_calls 0
    }
}

562 563 564
proc lyskomd_start {{aux_item_conf_file ""} \
	{extra_config ""} \
	{base_config ""} \
565
	{args ""} \
Per Cederqvist's avatar
Per Cederqvist committed
566 567 568 569 570 571
	{db_suffix ""} \
	{log_messages {}} \
	{init_db 1} \
	{want_stale 0} \
	{confs 6} \
	{texts 1} \
572
	{nogarb 0} \
573 574
	{db_messages {}} \
	{pre_lock_messages {}}} {
575

Per Cederqvist's avatar
Per Cederqvist committed
576 577 578
    global spawn_id
    global server_id
    global test
579
    global deep_any
Per Cederqvist's avatar
Per Cederqvist committed
580
    global nl
Per Cederqvist's avatar
Per Cederqvist committed
581 582
    global attach
    global timeout
583 584
    global expect_active
    global expect_always
David Byers's avatar
David Byers committed
585
    global clientport
586
    global aux_item_default_conf_file
587
    global lyskomd_pid
588
    global top_srcdir
589 590
    global mem_trace
    global MEMTRACE
591 592
    global line_leader
    global any
593

Per Cederqvist's avatar
Per Cederqvist committed
594 595
    obtain_lock

596 597 598
    if { $aux_item_conf_file == "" } {
        set aux_item_conf_file $aux_item_default_conf_file
    }
599 600 601 602 603

    # Check that we are in in the correct directory before removing
    # directories...
    set f [open "../lyskomd" "r"]
    close $f
604 605 606 607 608 609 610 611
    if {$init_db} {
	system "rm -rf db etc"
	system "mkdir db etc"
	system "cp $top_srcdir/db-crypt/db/lyskomd-data$db_suffix db/lyskomd-data"
	system "cp $top_srcdir/db-crypt/db/lyskomd-texts db/"
	system "cp $top_srcdir/db-crypt/db/number.txt db/"
	system "chmod 644 db/lyskomd-data db/lyskomd-texts db/number.txt"
    }
612 613

    set cf [open "config/lyskomd-config" "w"]
David Byers's avatar
David Byers committed
614
    puts $cf "Client port: $clientport"
615
    puts $cf "Prefix: [pwd]"
616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638

    # FIXME (bug 1088): For now, we continue to use the pre-2.1.0 file names.
    puts $cf "Data file: db/lyskomd-data"
    puts $cf "Backup file: db/lyskomd-backup"
    puts $cf "Backup file 2: db/lyskomd-backup-prev"
    puts $cf "Lock file: db/lyskomd-lock"
    puts $cf "Text file: db/lyskomd-texts"
    puts $cf "Number file: db/number.txt"
    puts $cf "Number temp file: db/number.tmp"
    puts $cf "Text backup file: db/lyskomd-texts-backup"
    puts $cf "Backup export directory: exportdb"
    puts $cf "Log file: etc/server-log"
    if {[regexp -nocase "Log statistics:" $extra_config] == 0
	&& [regexp -nocase "Log statistics:" $base_config] == 0} {
	puts $cf "Log statistics: etc/lyskomd-log"
    }
    puts $cf "Pid file: etc/pid"
    puts $cf "Memory usage file: etc/memory-usage"
    puts $cf "Status file: etc/status"
    puts $cf "Connection status file: etc/connections.txt"
    puts $cf "Connection status temp file: etc/connections.tmp"
    puts $cf "Core directory: cores"

David Byers's avatar
David Byers committed
639
    if { $base_config == "" } {
640
        if { [regexp -nocase "Max conferences:" $extra_config] == 0 } {
David Byers's avatar
David Byers committed
641 642
            puts $cf "Max conferences: 2000"
        }
643
        if { [regexp -nocase "Max texts:" $extra_config] == 0 } {
644
            puts $cf "Max texts: 20000"
David Byers's avatar
David Byers committed
645
        }
646
	if { [regexp -nocase "DNS log threshold:" $extra_config] == 0 } {
647 648
	    puts $cf "DNS log threshold: 3600"
	}
649 650 651
	if { [regexp -nocase "Sync interval:" $extra_config] == 0 } {
	    puts $cf "Sync interval: 1 day"
	}
652 653 654 655 656 657
	if { [regexp -nocase "Connect timeout:" $extra_config] == 0 } {
	    puts $cf "Connect timeout: 1 day"
	}
	if { [regexp -nocase "Login timeout:" $extra_config] == 0 } {
	    puts $cf "Login timeout: 1 day"
	}
658
        puts $cf "Aux-item definition file: $aux_item_conf_file"
David Byers's avatar
David Byers committed
659 660 661
    } else {
        puts $cf $base_config
    }
662
    puts $cf $extra_config
David Byers's avatar
David Byers committed
663 664
    close $cf

665
    set pid [spawn_lyskomd valgrind-lyskomd.log $args]
666
    set lyskomd_pid $pid
David Byers's avatar
David Byers committed
667

Per Cederqvist's avatar
Per Cederqvist committed
668
    set server_id $spawn_id
Per Cederqvist's avatar
Per Cederqvist committed
669
    set expect_active($server_id) \
670
	    " -i $server_id -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line from lyskomd: \$expect_out(1,string))\"; exp_continue } -i $server_id eof { fail \"\$test (eof on lyskomd)\"; wait } timeout { fail \"\$test (timeout on lyskomd)\" }"
Per Cederqvist's avatar
Per Cederqvist committed
671
    set expect_always($server_id) \
672
	    " -i $server_id full_buffer { fail \"\$test (full_buffer on lyskomd)\" } -i $server_id eof { fail \"\$test (eof on lyskomd)\" }"
Per Cederqvist's avatar
Per Cederqvist committed
673 674 675

    talk_to lyskomd
    set test "server started"
Per Cederqvist's avatar
Per Cederqvist committed
676 677
    set t $timeout
    set timeout [expr {2 * $timeout}]
678 679
    set mem_trace 0
    set unattached $attach
Per Cederqvist's avatar
Per Cederqvist committed
680
    expect {
681
	-re "^Where does the trace want to go today. .stderr." {
682 683 684 685 686 687 688 689 690 691 692 693 694
	    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
695
            exp_continue
696
	}
697 698 699
	-re "^${line_leader}... Version $any* .process $any*. started.$nl" {
	}
	timeout         {fail "$test (timeout)"}
700
	full_buffer 	{fail "$test (full_buffer)"}
701 702 703
	eof 		{fail "$test (eof)"; wait}
    }

704 705 706 707 708 709
    set_debug_calls

    foreach prelockmsg $pre_lock_messages {
	simple_expect "$prelockmsg"
    }

710
    set stale 0
711 712
    set test "Lock created"
    expect {
713 714 715 716 717 718 719 720 721
	-re "^${line_leader}Removed stale lock file left by ($any*):($any*).$nl" {
	    if {$stale == 1} {
		fail "$test (more than one stale lock file removed)"
	    } elseif {$want_stale == 0} {
		fail "$test (lyskomd removed a stale lock file)"
	    }
	    set stale 1
	    exp_continue
	}
722 723 724
	-re "^${line_leader}Created lock ($any*)$nl" {
	    pass "$test (lock file $expect_out(1,string)"
	}
Per Cederqvist's avatar
Per Cederqvist committed
725
	timeout         {fail "$test (timeout)"}
726
	full_buffer 	{fail "$test (full_buffer)"}
Per Cederqvist's avatar
Per Cederqvist committed
727
	eof 		{fail "$test (eof)"; wait}
728
    }   
Per Cederqvist's avatar
Per Cederqvist committed
729
    set timeout $t
730 731 732
    if {$stale == 0 && $want_stale == 1} {
	fail "$test (no stale lock file removed)"
    }
733 734 735 736 737 738 739 740 741
    unset test

    simple_expect "Listening for clients on $clientport."
    simple_expect "Database = [pwd]/db/lyskomd-data"
    simple_expect "Backup = [pwd]/db/lyskomd-backup"
    simple_expect "2nd Backup = [pwd]/db/lyskomd-backup-prev"
    simple_expect "Lock File = [pwd]/db/lyskomd-lock"
    simple_expect "MSG: init_cache: using datafile."
    simple_expect "Database saved on $any*"
742 743 744 745 746

    foreach dbmsg $db_messages {
	simple_expect "$dbmsg"
    }

Per Cederqvist's avatar
Per Cederqvist committed
747
    simple_expect "Read $confs confs/persons and $texts texts"
748 749 750 751 752

    foreach logmsg $log_messages {
	simple_expect "$logmsg"
    }

Per Cederqvist's avatar
Per Cederqvist committed
753 754 755 756
    if {$nogarb == 0} {
	simple_expect "MSG: garb started."
	simple_expect "MSG: garb ready. 0 texts deleted."
    }
Per Cederqvist's avatar
Per Cederqvist committed
757

758
    if {$unattached} {
Per Cederqvist's avatar
Per Cederqvist committed
759 760 761 762 763 764 765
	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
766 767
}

768 769
proc lyskomd_fail_start {log_messages
			 {aux_item_conf_file "" }
David Byers's avatar
David Byers committed
770 771
                         {extra_config ""}
                         {base_config ""}
772 773
                         {args ""}
			 {pre_lock_messages {}}} {
David Byers's avatar
David Byers committed
774 775 776
    global spawn_id
    global server_id
    global test
777 778
    global deep_any
    global any
David Byers's avatar
David Byers committed
779
    global nl
780
    global line_leader
David Byers's avatar
David Byers committed
781 782 783 784 785 786
    global timeout
    global expect_active
    global expect_always
    global clientport
    global aux_item_default_conf_file
    global lyskomd_pid
787
    global top_srcdir
788
    global MEMTRACE
David Byers's avatar
David Byers committed
789

Per Cederqvist's avatar
Per Cederqvist committed
790 791
    obtain_lock

David Byers's avatar
David Byers committed
792 793 794 795 796 797 798 799 800 801
    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"
802 803
    system "cp $top_srcdir/db-crypt/db/lyskomd-data db/"
    system "cp $top_srcdir/db-crypt/db/lyskomd-texts db/"
804
    system "cp $top_srcdir/db-crypt/db/number.txt db/"
805 806

    set cf [open "config/lyskomd-config" "w"]
David Byers's avatar
David Byers committed
807 808 809 810
    puts $cf "Client port: $clientport"
    if { $base_config == "" } {
        puts $cf "Max conferences: 2000"
        puts $cf "Max texts: 2000"
811 812
        puts $cf "Prefix: [pwd]"
        puts $cf "Aux-item definition file: $aux_item_conf_file"
David Byers's avatar
David Byers committed
813 814 815 816 817 818
    } else {
        puts $cf $base_config
    }
    puts $cf $extra_config
    close $cf

819
    set pid [spawn_lyskomd valgrind-lyskomdfail.log $args]
David Byers's avatar
David Byers committed
820 821 822 823
    set lyskomd_pid $pid

    set server_id $spawn_id
    set expect_active($server_id) \
824
	    " -i $server_id -re \"($deep_any*)$nl\" { fail \"\$test (unexpected line from lyskomd: \$expect_out(1,string))\"; exp_continue } -i $server_id eof { fail \"\$test (eof on lyskomd)\"; wait } timeout { fail \"\$test (timeout on lyskomd)\" }"
David Byers's avatar
David Byers committed
825
    set expect_always($server_id) \
826
	    " -i $server_id full_buffer { fail \"\$test (full_buffer on lyskomd)\" } -i $server_id eof { fail \"\$test (eof on lyskomd)\" }"
David Byers's avatar
David Byers committed
827 828 829 830 831 832 833

    talk_to lyskomd
    set test "server start failed"
    set t $timeout
    set timeout [expr {2 * $timeout}]
    
    expect {
834
	-re "^Where does the trace want to go today. .stderr." {
835 836
	    pass "Tracing is activated ($MEMTRACE)"
	    send "$MEMTRACE\n"
837
            exp_continue
838
	}
839 840
	-re "^${line_leader}... Version $any* .process $any*. started.$nl" {
	}
David Byers's avatar
David Byers committed
841
	timeout         {fail "$test (timeout)" }
842
	full_buffer 	{fail "$test (full_buffer)" }
David Byers's avatar
David Byers committed
843 844 845
	eof 		{fail "$test (eof)"; wait}
    }

846 847
    foreach prelockmsg $pre_lock_messages {
	simple_expect "$prelockmsg"
848 849
    }

850 851
    set_debug_calls

852 853 854 855 856 857
    foreach logmsg $log_messages {
	simple_expect "$logmsg"
    }
    simple_expect "Previous message is fatal. Will dump core now."
    simple_expect "Search for the core in [pwd]"

David Byers's avatar
David Byers committed
858 859 860 861 862 863 864
    set timeout $t

    set test "server died"
    expect {
        timeout   { fail "$test (timeout)" }
        eof       { pass "$test"; wait }
    }
865
    check_valgrind valgrind-lyskomdfail.log 0 0 {}
Per Cederqvist's avatar
Per Cederqvist committed
866 867

    release_lock
David Byers's avatar
David Byers committed
868 869
}

David Byers's avatar
David Byers committed
870
proc check_memory_usage {} {
Per Cederqvist's avatar
Per Cederqvist committed
871 872
    global memix

873 874 875
    set allocated_strings unknown
    set allocated_blocks unknown
    set existing_confs unknown
David Byers's avatar
David Byers committed
876 877 878 879 880 881 882

    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]]
883 884 885
        } elseif { [regexp "Existing confs:" $line] } {
	    set existing_confs [lindex "$line" [expr [llength "$line"] - 1]]
	}
David Byers's avatar
David Byers committed
886 887 888 889
    }
    close $f

    if { $allocated_blocks != 0 } {
Per Cederqvist's avatar
Per Cederqvist committed
890 891 892 893 894 895
	while {[file exists "memory-usage-$memix.log"]} {
	    set memix [expr $memix + 1]
	}
	set saved "memory-usage-$memix.log"
	system "mv etc/memory-usage $saved"
        fail "Allocated blocks on exit (see $saved)"
David Byers's avatar
David Byers committed
896 897 898 899 900 901 902 903
    } else {
        pass "Allocated blocks on exit"
    }
    if { $allocated_strings != 0 } {
        fail "Allocated strings on exit"
    } else {
        pass "Allocated strings on exit"
    }
904 905 906 907 908
    if { $existing_confs != 0 } {
        fail "Existing conferences on exit"
    } else {
        pass "Existing conferences on exit"
    }
David Byers's avatar
David Byers committed
909 910
}

911 912 913 914 915 916 917 918 919 920 921 922
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
}

923
proc check_valgrind {logfile need_leaks need_errs expected_leaks} {
924 925
    # The "expected_leaks" argument should be a such as:
    #
926
    #   {"Bug 99 & Bug 93" 4 3 9 11}
927 928
    #
    # that indicates that due to Bug 99 and Bug 93 there will be 4
929 930
    # definite leaks, 3 possible leaks, 9 still reachable blocks, and
    # 11 suppressed leaks.
931
    
932 933
    global valgrindix
    global valgrind
934
    global test
935

936
    if {$valgrind == ""} {
937 938 939 940 941 942 943 944
	return
    }

    set errfound 0
    set memfound 0
    set errcount 0
    set leakcount 0

945 946 947 948 949 950 951 952 953 954 955
    # Rename the file.  $saved holds the new name.
    while {[file exists "valgrind-$valgrindix.log"]} {
	set valgrindix [expr $valgrindix + 1]
    }
    set saved "valgrind-$valgrindix.log"
    system "mv $logfile $saved"

    # Should the log file be kept?
    set keep 0

    set f [open $saved]
956 957 958
    while {[gets $f line] >= 0} {
	if {[regexp "ERROR SUMMARY: (\[0-9\]*) errors" $line match errs]} {
	    if {$errfound} {
959 960
		fail "check_valgrind logic error due to $saved"
		set keep 1
961 962 963 964 965 966
	    } else {
		set errfound 1
		set errcount $errs
	    }
	}
	if {[regexp "LEAK SUMMARY:" $line]} {
Per Cederqvist's avatar
Per Cederqvist committed
967
	    set memfound 1
968 969 970
	    set definite [parse_valgrind_leak $f]
	    set possible [parse_valgrind_leak $f]
	    set reachable [parse_valgrind_leak $f]
971
	    set suppressed [parse_valgrind_leak $f]
972 973 974 975 976
	    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]
977
		set exp_sup [lindex $expected_leaks 4]
978 979 980 981

		setup_xfail "*-*-*" $xreason
		if {$exp_def == $definite
		    && $exp_pos == $possible
982 983
		    && $exp_rea == $reachable
		    && $exp_sup == $suppressed} {
984 985 986 987 988 989

		    fail "memory leaks: $definite definite, $possible possible"
		    
		    set definite 0
		    set possible 0
		    set reachable 0
990
		    set suppressed 0
991 992 993 994
		} else {
		    pass "wrong memory leak count found"
		}
	    }
995 996 997 998
	    set leakcount [expr $definite + $possible + $reachable]
	    # Ignore up to 25 suppressed blocks.
	    if {$suppressed > 25} {
	    	set leakcount "$suppressed"
999 1000
	    }
	}
Per Cederqvist's avatar
Per Cederqvist committed
1001 1002 1003
	if {[regexp "No malloc'd blocks -- no leaks are possible" $line]} {
	    set memfound 1
	}
1004 1005
    }
    close $f
1006 1007 1008
    if {$errfound == 0 && $need_errs == 1} {
	fail "no error summary in valgrind output $saved"
	set keep 1
1009 1010
    }

1011 1012 1013
    if {$memfound == 0 && $need_leaks == 1} {
	fail "no malloc summary in valgrind output $saved"
	set keep 1
Per Cederqvist's avatar
Per Cederqvist committed
1014 1015
    }

1016 1017 1018 1019
    if {$errcount == 0} {
	pass "valgrind found no errors"
    } else {
	fail "valgrind found $errcount error(s).  See $saved."
1020
	set keep 1
1021 1022 1023 1024 1025 1026
    }
    if {$leakcount == 0} {
	pass "valgrind found no leaks"
    } else {
	if {$definite} {
	    fail "valgrind found $definite definite leaks.  See $saved."
1027
	    set keep 1
1028 1029 1030
	}
	if {$possible} {
	    fail "valgrind found $possible possible leaks.  See $saved."
1031
	    set keep 1
1032 1033 1034
	}
	if {$reachable} {
	    fail "valgrind found $reachable reachable blocks.  See $saved."
1035 1036 1037 1038
	    set keep 1
	}
	if {$suppressed} {
	    fail "valgrind found $suppressed suppressed blocks.  See $saved."
1039
	    set keep 1
1040 1041
	}
    }
1042 1043 1044 1045

    if {$keep == 0} {
	system rm $saved
    }
1046 1047
}

1048
proc lyskomd_death {{expected_leaks {}} {reason 5}} {
1049
    # See check_valgrind for a description of "expected_leaks".
Per Cederqvist's avatar
Per Cederqvist committed
1050 1051 1052
    global spawn_id
    global server_id
    global test
1053
    global any
Per Cederqvist's avatar
Per Cederqvist committed
1054
    global nl
1055 1056
    global expect_active
    global expect_always
Per Cederqvist's avatar
Per Cederqvist committed
1057 1058

    talk_to lyskomd
1059
    if {$reason == "signal"} {
1060 1061 1062 1063 1064
	simple_expect "Signal TERM received. Shutting down server."
    } elseif {$reason == "sighup"} {
	simple_expect "Signal HUP received. Shutting down server. Please use SIGTERM instead."
    } elseif {$reason == "sigint"} {
	simple_expect "Signal INT received. Shutting down server. Please use SIGTERM instead."
1065 1066
    } elseif {$reason == "restart_kom"} {
	simple_expect "Search for the core in $any*"
1067 1068 1069
    } else {
	simple_expect "shutdown initiated by person $reason $any*"
    }
1070 1071 1072 1073 1074
    if {$reason != "restart_kom"} {
	simple_expect "../lyskomd terminated normally."
	simple_expect "Press enter to terminate lyskomd"
	send "\n"
    }
Per Cederqvist's avatar
Per Cederqvist committed
1075 1076 1077 1078 1079
    set test "server died"
    expect {
	timeout  { fail "$test (timeout)" }
	eof      { pass "$test"; wait }
    }
1080 1081 1082 1083 1084
    unset expect_active($server_id)
    unset expect_always($server_id)
    unset spawn_id
    fix_expect_after

1085 1086 1087 1088 1089
    if {$reason != "restart_kom"} {
	system "cat etc/memory-usage >> usage.all"
	check_memory_usage
	check_valgrind valgrind-lyskomd.log 1 1 $expected_leaks
    }
Per Cederqvist's avatar
Per Cederqvist committed
1090
    dbck_run
Per Cederqvist's avatar
Per Cederqvist committed
1091 1092

    release_lock
Per Cederqvist's avatar
Per Cederqvist committed
1093 1094
}

Per Cederqvist's avatar
Per Cederqvist committed
1095 1096 1097 1098
proc kill_lyskomd {} {
    global lyskomd_pid
    global test
    global spawn_id
1099 1100 1101
    global expect_active
    global expect_always
    global server_id
Per Cederqvist's avatar
Per Cederqvist committed
1102 1103 1104 1105 1106 1107 1108 1109

    talk_to lyskomd
    system "kill -KILL $lyskomd_pid"
    set test "server died"
    expect {
	timeout  { fail "$test (timeout)" }
	eof      { pass "$test"; wait }
    }
1110 1111 1112 1113 1114
    unset expect_active($server_id)
    unset expect_always($server_id)
    unset spawn_id
    fix_expect_after

Per Cederqvist's avatar
Per Cederqvist committed
1115 1116 1117
    release_lock
}

1118
proc dbck_run {{extra_lines {}}} {
Per Cederqvist's avatar
Per Cederqvist committed
1119
    global nl
1120
    global any
Per Cederqvist's avatar
Per Cederqvist committed
1121 1122
    global test
    global any_num
David Byers's avatar
Server:  
David Byers committed
1123
    global DBCK_MEMTRACE
Per Cederqvist's avatar
Per Cederqvist committed
1124
    global valgrind
1125
    global spawn_id
1126
    global valgrind_fd
Per Cederqvist's avatar
Per Cederqvist committed
1127

Per Cederqvist's avatar
Per Cederqvist committed
1128
    if {$valgrind != ""} {
1129
	spawn ./valgrind.wrap valgrind-dbck.log --suppressions=lyskomd.supp --num-callers=40 --logfile-fd=$valgrind_fd --show-reachable=yes ../dbck -d config/lyskomd-config
Per Cederqvist's avatar
Per Cederqvist committed
1130 1131 1132
    } else {
	spawn ../dbck -d config/lyskomd-config
    }
Per Cederqvist's avatar
Per Cederqvist committed
1133 1134 1135 1136 1137 1138
    set test "dbck started"
    expect_after {
	timeout { fail "$test (timeout)" }
	eof { fail "$test (eof)" }
    }
    expect {
David Byers's avatar
Server:  
David Byers committed
1139 1140 1141
	-re "^Where does the trace want to go today. .stderr.$nl" {
	    pass "Tracing is activated ($DBCK_MEMTRACE)"
	    send "$DBCK_MEMTRACE\n"
1142
            exp_continue
David Byers's avatar
Server:  
David Byers committed
1143 1144 1145 1146
	}
	-re "^MSG: init_cache: using datafile\.$nl" { 
            pass "$test" 
        }
Per Cederqvist's avatar
Per Cederqvist committed
1147
    }
David Byers's avatar
Server:  
David Byers committed