File: db_reptest.tcl

package info (click to toggle)
db5.3 5.3.28%2Bdfsg2-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 158,500 kB
  • sloc: ansic: 448,411; java: 111,824; tcl: 80,544; sh: 44,264; cs: 33,697; cpp: 21,604; perl: 14,557; xml: 10,799; makefile: 4,077; javascript: 1,998; yacc: 1,003; awk: 965; sql: 801; erlang: 342; python: 216; php: 24; asm: 14
file content (1425 lines) | stat: -rw-r--r-- 38,475 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
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
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
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
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
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
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
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
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
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
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
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
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999, 2013 Oracle and/or its affiliates.  All rights reserved.
#
# $Id$
#
# TEST	db_reptest
# TEST	Wrapper to configure and run the db_reptest program.

#
# TODO:
# late client start.
# Number of message proc threads.
#

global last_nsites
set last_nsites 0

#
# There are several user-level procs that the user may invoke.
# 1. db_reptest - Runs randomized configurations in a loop.
# 2. basic_db_reptest - Runs a simple set configuration once,
#	as a smoke test.
# 3. restore_db_reptest 'dir' - Runs the configuration given in 'dir'
#	in a loop.  The purpose is either to reproduce a problem
#	that some configuration encountered, or test a fix.
# 4. db_reptest_prof - Runs a single randomized configuration
#	and generates gprof profiling information for that run.
# 5. basic_db_reptest_prof - Runs a simple set configuration and
#	generates gprof profiling information for that run.
# 6. restore_db_reptest_prof - Runs the configuration given in 'dir' and
#	generates gprof profiling information for one run.
#

#
# db_reptest - Run a randomized configuration.  Run the test
# 'count' times in a loop, or until 'stopstr' is seen in the OUTPUT
# files or if no count or string is given, it is an infinite loop.
#
proc db_reptest { { stopstr "" } {count -1} } {
	berkdb srand [pid]
	set cmd "db_reptest_int random"
	db_reptest_loop $cmd $stopstr $count
}

#
# Run a basic reptest.  The types are:
# Basic 0 - Two sites, start with site 1 as master, 5 worker threads, btree,
#	run 100 seconds, onesite remote knowledge.
# Basic 1 - Three sites, all sites start as client, 5 worker threads, btree
#	run 150 seconds, full remote knowledge.
#
proc basic_db_reptest { { basic 0 } } {
	global util_path

	if { [file exists $util_path/db_reptest] == 0 } {
		puts "Skipping db_reptest.  Is it built?"
		return
	}
	if { $basic == 0 } {
		db_reptest_int basic0
	}
	if { $basic == 1 } {
		db_reptest_int basic1
	}
}

proc basic_db_reptest_prof { { basic 0 } } {
	basic_db_reptest $basic
	generate_profiles
}

#
# Restore a configuration from the given directory and
# run that configuration in a loop 'count' times or until
# 'stopstr' is seen in the OUTPUT files or if no count or
# string is given, it is an infinite loop.
#
proc restore_db_reptest { restoredir { stopstr "" } { count -1 } } {
	set cmd "db_reptest_int restore $restoredir/SAVE_RUN"
	db_reptest_loop $cmd $stopstr $count
}

proc restore_db_reptest_prof { restoredir } {
	restore_db_reptest $restoredir "" 1
	generate_profiles
}

#
# Run a single randomized iteration and then generate the profile
# information for each site.
#
proc db_reptest_prof { } {
	berkdb srand [pid]
	set cmd "db_reptest_int random"
	db_reptest_loop $cmd "" 1
	generate_profiles
}

proc generate_profiles {} {
	global dirs
	global use
	global util_path

	#
	# Once it is complete, generate profile information.
	#
	for { set i 1 } { $i <= $use(nsites) } { incr i } {
		set gmon NULL
		set known_gmons \
		    { $dirs(env.$i)/db_reptest.gmon $dirs(env.$i)/gmon.out }
		foreach gfile $known_gmons {
			if { [file exists $gfile] } {
				set gmon $gfile
				break
			}
		}
		if { $gmon == "NULL" } {
			puts "No gmon file.  Was it built with profiling?"
			return
		}
		set prof_out db_reptest.$i.OUT
		set stat [catch {exec gprof $util_path/db_reptest \
		    $gmon >>& $prof_out} ret]
		if { $stat != 0 } {
			puts "FAIL: gprof: $ret"
		}
		error_check_good gprof $stat 0
		puts "Profiled output for site $i: $prof_out"
	}
}

proc db_reptest_profile { } {
	db_reptest_prof
}

#
# Wrapper to run the command in a loop, 'count' times.
#
proc db_reptest_loop { cmd stopstr count } {
	global util_path

	if { [file exists $util_path/db_reptest] == 0 } {
		puts "Skipping db_reptest.  Is it built?"
		return
	}
	set iteration 1
	set start_time [clock format [clock seconds] -format "%H:%M %D"]
	while { 1 } {
		puts -nonewline "ITERATION $iteration: "
		puts -nonewline \
		    [clock format [clock seconds] -format "%H:%M %D"]
		puts " (Started: $start_time)"

		#
		eval $cmd

		puts -nonewline "COMPLETED $iteration: "
		puts [clock format [clock seconds] -format "%H:%M %D"]
		incr iteration
		#
		# If we've been given a string to look for, run until we
		# see it.  Or if not, skip to the count check.
		#
		if { [string length $stopstr] > 0 } {
			set found [search_output $stopstr]
			if { $found } {
				break
			}
		}
		if { $count > 0 && $iteration > $count } {
			break
		}
	}
}

#
# Internal version of db_reptest that all user-level procs
# eventually call.  It will configure a single run of
# db_reptest based on the configuration type specified
# in 'cfgtype'.  This proc will:
# Configure a run of db_reptest
# Run db_reptest
# Verify the sites after db_reptest completes.
#
proc db_reptest_int { cfgtype { restoredir NULL } } {
	source ./include.tcl
	global dirs
	global use

	env_cleanup $testdir

	set dirs(save) TESTDIR/SAVE_RUN
	set dirs(restore) $restoredir
	reptest_cleanup $dirs(save)

	#
	# Set up the array to indicate if we are going to use
	# a metadata dir or database data dir.  If we are using
	# datadirs, decide which one gets the created database.
	#
	get_datadirs $cfgtype use dirs

	#
	# Get all the default or random values needed for the test
	# and its args first.
	#
	set runtime 0
	#
	# Get number of sites first because pretty much everything else
	# after here depends on how many sites there are.
	#
	set use(nsites) [get_nsites $cfgtype $dirs(restore)]
	set use(lease) [get_lease $cfgtype $dirs(restore)]
	set use(peers) [get_peers $cfgtype]
	#
	# Get port information in case it needs to be converted for this
	# run.  A conversion will happen for a restored run if the current
	# baseport is different than the one used in restoredir.
	#
	set portlist [available_ports $use(nsites)]
	set baseport(curr) [expr [lindex $portlist 0] - 1]
	set baseport(orig) [get_orig_baseport $cfgtype $dirs(restore)]
	#
	# Only use kill if we have > 2 sites.
	# Returns a list.  An empty list means this will not be a kill test.
	# Otherwise the list has 3 values, the kill type and 2 kill sites.
	# See the 'get_kill' proc for a description of kill types.
	#
	set use(kill) ""
	set kill_type "NONE"
	set kill_site 0
	set kill_remover 0
	set site_remove 0
	if { $use(nsites) > 2 } {
		set use(kill) [get_kill $cfgtype \
		    $dirs(restore) $use(nsites) baseport]
		if { [llength $use(kill)] > 0 } {
			set kill_type [lindex $use(kill) 0]
			set kill_site [lindex $use(kill) 1]
			set kill_remover [lindex $use(kill) 2]
		} else {
			# If we are not doing a kill test, determine if
			# we are doing a remove test.
			set site_remove [get_remove $cfgtype $dirs(restore) \
			    $use(nsites)]
		}
	}
	if { $cfgtype != "restore" } {
		if { $use(lease) } {
			set use(master) 0
		} else {
			set use(master) [get_usemaster $cfgtype]
			if { $site_remove == $use(master) } {
				set site_remove 0
			}
		}
		set master_site [get_mastersite $cfgtype $use(master) $use(nsites)]
		set noelect [get_noelect $use(master)]
		set master2_site [get_secondary_master \
		    $noelect $master_site $kill_site $use(nsites)]
		set workers [get_workers $cfgtype $use(lease)]
		set dbtype [get_dbtype $cfgtype]
		set runtime [get_runtime $cfgtype]
		puts "Running: $use(nsites) sites, $runtime seconds."
		puts -nonewline "Running: "
		if { $use(createdir) } {
			puts -nonewline \
    "$use(datadir) datadirs, createdir DATA.$use(createdir), "
		}
		if { $use(metadir) } {
			puts -nonewline "METADIR, "
		}
		if { $kill_type == "DIE" || $kill_type == "REMOVE" } {
			puts -nonewline "kill site $kill_site, "
		}
		if { $kill_type == "LIVE_REM" } {
			puts -nonewline \
			    "live removal of site $kill_site by $kill_remover, "
		} elseif { $site_remove } {
			puts -nonewline "remove site $site_remove, "
		}
		if { $use(lease) } {
			puts "with leases."
		} elseif { $use(master) } {
			set master_text "master site $master_site"
			if { $noelect } {
				set master_text [concat $master_text \
				    "no elections"]
			}
			if { $master2_site } {
				set master_text [concat $master_text \
				    "secondary master site $master2_site"]
			}
			puts "$master_text."
		} else {
			puts "no master."
		}
	}
	#
	# This loop sets up the args to the invocation of db_reptest
	# for each site.
	#
	for { set i 1 } {$i <= $use(nsites) } { incr i } {
		set dirs(env.$i) TESTDIR/ENV$i
		set dirs(home.$i) ../ENV$i
		reptest_cleanup $dirs(env.$i)
		#
		# If we are restoring the args, just read them from the
		# saved location for this sites.  Otherwise build up
		# the args for each piece we need.
		#
		if { $cfgtype == "restore" } {
			set cid [open $dirs(restore)/DB_REPTEST_ARGS.$i r]
			set prog_args($i) [read $cid]
			close $cid
			#
			# Convert -K port number arguments to current
			# baseport if needed.  regsub -all substitutes
			# all occurrences of pattern, which is "-K "
			# and a number.  The result of regsub contains a tcl
			# expression with the number (\2, the second part of
			# the pattern), operators and variable names, e.g.:
			#   -K [expr 30104 - $baseport(orig) + $baseport(curr)]
			# and then subst evalutes the tcl expression.
			#
			if { $baseport(curr) != $baseport(orig) } {
				regsub -all {(-K )([0-9]+)} $prog_args($i) \
				    {-K [expr \2 - $baseport(orig) + \
				    $baseport(curr)]} prog_args($i)
				set prog_args($i) [subst $prog_args($i)]
			}
			if { $runtime == 0 } {
				set runtime [parse_runtime $prog_args($i)]
				puts "Runtime: $runtime"
			}
		} else {
			set nmsg [berkdb random_int 1 [expr $use(nsites) * 2]]
			set prog_args($i) \
			    "-v -c $workers -t $dbtype -T $runtime -m $nmsg "
			set prog_args($i) \
			    [concat $prog_args($i) "-h $dirs(home.$i)"]
			set prog_args($i) \
			    [concat $prog_args($i) "-o $use(nsites)"]
			#
			# Add in if this site should remove itself.
			#
			if { $site_remove == $i } {
				set prog_args($i) [concat $prog_args($i) "-r"]
			}
			#
			# Add in if this site should kill itself.
			#
			if { ($kill_type == "DIE" || $kill_type == "REMOVE") && \
			    $kill_site == $i} {
				set prog_args($i) [concat $prog_args($i) "-k"]
			}
			#
			# Add in if this site should remove a killed site.
			#
			if { $kill_remover == $i } {
				set kport [lindex $portlist \
				    [expr $kill_site - 1]]
				set prog_args($i) [concat $prog_args($i) \
				    "-K $kport"]
			}
			#
			# Add in if this site starts as a master or client.
			#
			if { $i == $master_site } {
				set state($i) MASTER
				set prog_args($i) [concat $prog_args($i) "-M"]
			} else {
				set state($i) CLIENT
				#
				# If we have a master, then we just want to
				# start as a client.  Otherwise start with
				# elections.
				#
				if { $use(master) } {
					set prog_args($i) \
					    [concat $prog_args($i) "-C"]
				} else {
					set prog_args($i) \
					    [concat $prog_args($i) "-E"]
				}
			}
			#
			# Add in if we are in no elections mode and if we are 
			# the secondary master.
			#
			if { $noelect } {
				set prog_args($i) [concat $prog_args($i) "-n"]
				if { $i == $master2_site } {
					set prog_args($i) \
					    [concat $prog_args($i) "-s"]
				}
			}
		}
		save_db_reptest $dirs(save) ARGS $i $prog_args($i)
	}

	# Now make the DB_CONFIG file for each site.
	reptest_make_config $cfgtype dirs state use $portlist baseport

	# Run the test
	run_db_reptest dirs $use(nsites) $runtime $use(lease)
	puts "Test run complete.  Verify."

	# Verify the test run.
	verify_db_reptest $use(nsites) dirs use $kill_site $site_remove

	# Show the summary files
	print_summary

}

#
# Make a DB_CONFIG file for all sites in the group
#
proc reptest_make_config { cfgtype dirsarr starr usearr portlist baseptarr } {
	upvar $dirsarr dirs
	upvar $starr state
	upvar $baseptarr baseport
	upvar $usearr use
	global rporttype

	#
	# Generate global config values that should be the same
	# across all sites, such as number of sites and log size, etc.
	#
	set rporttype NULL
	set default_cfglist {
	{ "set_flags" "DB_TXN_NOSYNC" }
	{ "rep_set_request" "150000 2400000" }
	{ "rep_set_timeout" "db_rep_checkpoint_delay 0" }
	{ "rep_set_timeout" "db_rep_connection_retry 2000000" }
	{ "rep_set_timeout" "db_rep_heartbeat_monitor 1000000" }
	{ "rep_set_timeout" "db_rep_heartbeat_send 500000" }
	{ "set_cachesize"  "0 4194304 1" }
	{ "set_lg_max" "131072" }
	{ "set_lk_detect" "db_lock_default" }
	{ "set_verbose" "db_verb_recovery" }
	{ "set_verbose" "db_verb_replication" }
	}

	set acks { db_repmgr_acks_all db_repmgr_acks_all_peers \
	    db_repmgr_acks_none db_repmgr_acks_one db_repmgr_acks_one_peer \
	    db_repmgr_acks_quorum }

	#
	# 2site strict and ack policy must be the same on all sites.
	#
	if { $cfgtype == "random" } {
		if { $use(nsites) == 2 } {
			set strict [berkdb random_int 0 1]
		} else {
			set strict 0
		}
		if { $use(lease) } {
			#
			# 2site strict with leases must have ack policy of
			# one because quorum acks are ignored in this case,
			# resulting in lease expired panics on some platforms.
			#
			if { $strict } {
				set ackpolicy db_repmgr_acks_one
			} else {
				set ackpolicy db_repmgr_acks_quorum
			}
		} else {
			set done 0
			while { $done == 0 } {
				set acksz [expr [llength $acks] - 1]
				set myack [berkdb random_int 0 $acksz]
				set ackpolicy [lindex $acks $myack]
				#
				# Only allow the "none" policy with 2 sites
				# otherwise it can overwhelm the system and
				# it is a rarely used option.
				#
				if { $ackpolicy == "db_repmgr_acks_none" && \
				    $use(nsites) > 2 } {
					continue
				}
				#
				# Only allow "all" or "all_peers" policies
				# if not killing a site, otherwise the
				# unavailable site will cause the master
				# to ignore acks and blast the clients with
				# log records.
				#
				if { [llength $use(kill)] > 0 && \
				    ($ackpolicy == "db_repmgr_acks_all" || \
				    $ackpolicy == 
				    "db_repmgr_acks_all_peers") } {
					continue
				}
				set done 1
			}
		}
	} else {
		set ackpolicy db_repmgr_acks_one
	}
	#
	# Set known_master to the initial master or if one is not
	# assigned, randomly assign the group creator.
	#
	set known_master 0
	if { $cfgtype != "restore" } {
		for { set i 1 } { $i <= $use(nsites) } { incr i } {
			if { $state($i) == "MASTER" } {
				set known_master $i
			}
		}
		if { $known_master == 0 } {
			set known_master [berkdb random_int 1 $use(nsites)]
		}
	}
	for { set i 1 } { $i <= $use(nsites) } { incr i } {
		#
		# If we're restoring we just need to copy it.
		#
		if { $cfgtype == "restore" } {
			#
			# Convert DB_CONFIG port numbers to current baseport
			# if needed.
			#
			set restore_cfile $dirs(restore)/DB_CONFIG.$i
			set new_cfile $dirs(env.$i)/DB_CONFIG
			set new_save_cfile $dirs(save)/DB_CONFIG.$i
			if { $baseport(curr) != $baseport(orig) } {
				convert_config_ports $restore_cfile \
				    $new_cfile baseport
				file copy $new_cfile $new_save_cfile
			} else {
				file copy $restore_cfile $new_cfile
				file copy $restore_cfile $new_save_cfile
			}
			if { $use(metadir) } {
				file mkdir $dirs(env.$i)/METADIR
			}
			if { $use(datadir) } {
				for { set diri 1 } { $diri <= $use(datadir) } \
				    { incr diri } {
					file mkdir $dirs(env.$i)/DATA.$diri
				}
			}
			continue
		}
		#
		# Otherwise set up per-site config information
		#
		set cfglist $default_cfglist

		#
		# Add lease configuration if needed.  We're running all
		# locally, so there is no clock skew.
		#
		set allist [get_ack_lease_timeouts $use(lease)]
		if { $use(lease) } {
			#
			# We need to have an ack timeout > lease timeout.
			# Otherwise txns can get committed without waiting
			# long enough for leases to get granted.
			#
			lappend cfglist { "rep_set_config" "db_rep_conf_lease" }
			lappend cfglist { "rep_set_timeout" \
			    "db_rep_lease_timeout [lindex $allist 1]" }
			lappend cfglist { "rep_set_timeout" \
			    "db_rep_ack_timeout [lindex $allist 0]" }
		} else {
			lappend cfglist { "rep_set_timeout" \
			    "db_rep_ack_timeout [lindex $allist 0]" }
		}

		#
		# Add datadirs and the metadir, if needed.  If we are using
		# datadirs, then set which one is the create dir.
		#
		if { $use(metadir) } {
			file mkdir $dirs(env.$i)/METADIR
			lappend cfglist { "set_metadata_dir" "METADIR" }
		}
		if { $use(datadir) } {
			for { set diri 1 } { $diri <= $use(datadir) } \
			    { incr diri } {
				file mkdir $dirs(env.$i)/DATA.$diri
				#
				# Need to add to list in 2 steps otherwise
				# $diri in the list will not get evaluated
				# until later.
				#
				set litem [list add_data_dir DATA.$diri]
				lappend cfglist $litem
			}
			lappend cfglist { "set_create_dir" \
			    "DATA.$use(createdir)" }
		}

		#
		# Priority
		#
		if { $state($i) == "MASTER" } {
			lappend cfglist { "rep_set_priority" 100 }
		} else {
			if { $cfgtype == "random" } {
				set pri [berkdb random_int 10 25]
			} else {
				set pri 20
			}
			set litem [list rep_set_priority $pri]
			lappend cfglist $litem
		}
		#
		# Others: limit size, bulk, 2site strict
		#
		if { $cfgtype == "random" } {
			set limit_sz [berkdb random_int 15000 1000000]
			set bulk [berkdb random_int 0 1]
			if { $bulk } {
				lappend cfglist \
				    { "rep_set_config" "db_rep_conf_bulk" }
			}
			#
			# 2site strict was set above for all sites but
			# should only be used for sites in random configs.
			#
			if { $strict } {
				lappend cfglist { "rep_set_config" \
				    "db_repmgr_conf_2site_strict" }
			}
		} else {
			set limit_sz 100000
		}
		set litem [list rep_set_limit "0 $limit_sz"]
		lappend cfglist $litem
		set litem [list repmgr_set_ack_policy $ackpolicy]
		lappend cfglist $litem
		#
		# Now set up the local and remote ports.  If we are the
		# known_master (either master or group creator) set the
		# group creator flag on.
		#
		# Must use explicit 127.0.0.1 rather than localhost because
		# localhost can be configured differently on different
		# machines or platforms.  Use of localhost can cause 
		# available_ports to return ports that are actually in use.
		#
		set lport($i) [lindex $portlist [expr $i - 1]]
		if { $i == $known_master } {
			#
			# Any change to this generated syntax will probably
			# require a change to get_orig_baseport, which relies
			# on this ordering and these embedded spaces.
			#
			set litem [list repmgr_site \
			    "127.0.0.1 $lport($i) db_local_site on \
			    db_group_creator on"]
		} else {
			set litem [list repmgr_site \
			    "127.0.0.1 $lport($i) db_local_site on"]
		}
		lappend cfglist $litem
		set rport($i) [get_rport $portlist $i $use(nsites) \
		    $known_master $cfgtype]
		#
		# Declare all sites bootstrap helpers.
		#
		foreach p $rport($i) {
			if { $use(peers) } {
				set litem [list repmgr_site "127.0.0.1 $p \
				    db_bootstrap_helper on db_repmgr_peer on"]
			} else {
				set litem [list repmgr_site "127.0.0.1 $p \
				    db_bootstrap_helper on"]
			}
			#
			# If we have full knowledge, assume a legacy system.
			#
			if { $cfgtype == "full" } {
				lappend litem "db_legacy on"
			}
			lappend cfglist $litem
		}
		#
		# Now write out the DB_CONFIG file.
		#
		set cid [open $dirs(env.$i)/DB_CONFIG a]
		foreach c $cfglist {
			set carg [subst [lindex $c 0]]
			set cval [subst [lindex $c 1]]
			puts $cid "$carg $cval"
		}
		close $cid
		set cid [open $dirs(env.$i)/DB_CONFIG r]
		set cfg [read $cid]
		close $cid
	
		save_db_reptest $dirs(save) CONFIG $i $cfg
	}

}

proc reptest_cleanup { dir } {
	#
	# For now, just completely remove it all.  We might want
	# to use env_cleanup at some point in the future.
	#
	fileremove -f $dir
	file mkdir $dir
}


proc save_db_reptest { savedir op site savelist } {
	#
	# Save a copy of the configuration and args used to run this
	# instance of the test.
	#
	if { $op == "CONFIG" } {
		set outfile $savedir/DB_CONFIG.$site
	} else {
		set outfile $savedir/DB_REPTEST_ARGS.$site
	}
	set cid [open $outfile a]
	puts -nonewline $cid $savelist
	close $cid
}

proc run_db_reptest { dirsarr numsites runtime use_lease } {
	source ./include.tcl
	upvar $dirsarr dirs
	global killed_procs

	set pids {}
	#
	# Wait three times workload run time plus an ack_timeout for each site
	# to kill a run.  The ack_timeout is especially significant for runs
	# where leases are in use because they take much longer to get started.
	#
	set ack_timeout [lindex [get_ack_lease_timeouts $use_lease] 0]
	set watch_time [expr $runtime * 3 + \
	    [expr $ack_timeout / 1000000] * $numsites]
	for {set i 1} {$i <= $numsites} {incr i} {
		lappend pids [exec $tclsh_path $test_path/wrap_reptest.tcl \
		    $dirs(save)/DB_REPTEST_ARGS.$i $dirs(env.$i) \
		    $dirs(save)/site$i.log &]
		tclsleep 1
	}
	watch_procs $pids 15 $watch_time
	set killed [llength $killed_procs]
	if { $killed > 0 } {
		error "Processes $killed_procs never finished"
	}
}

proc verify_db_reptest { num_sites dirsarr usearr kill site_rem } {
	upvar $dirsarr dirs
	upvar $usearr use

	set startenv 1
	set cmpeid 2
	if { $kill == 1 || $site_rem == 1 } {
		set startenv 2
		set cmpeid 3
	}
	set envbase [berkdb_env_noerr -home $dirs(env.$startenv)]
	set datadir ""
	if { $use(createdir) } {
		set datadir DATA.$use(createdir)
	}
	for { set i $cmpeid } { $i <= $num_sites } { incr i } {
		if { $i == $kill || $i == $site_rem } {
			continue
		}
		set cmpenv [berkdb_env_noerr -home $dirs(env.$i)]
		puts "Compare $dirs(env.$startenv) with $dirs(env.$i)"
		#
		# Compare 2 envs.  We assume the name of the database that
		# db_reptest creates and know it is 'am1.db'.
		# We want as other args:
		# 0 - compare_shared_portion
		# 1 - match databases
		# 0 - don't compare logs (for now)
		rep_verify $dirs(env.$startenv) $envbase $dirs(env.$i) $cmpenv \
		    0 1 0 am1.db $datadir
		$cmpenv close
	}
	$envbase close
}

proc get_nsites { cfgtype restoredir } {
	global last_nsites

	#
	# Figure out the number of sites.  We use 'glob' to get all of
	# the valid DB_CONFIG files in the restoredir.  That command uses
	# a single digit match, so the maximum number of sites must be <= 9.
	# Match DB_CONFIG.# so that it does not consider anything like an
	# emacs save file.
	#
	set maxsites 5
	#
	# If someone changes maxsites to be too big, it will break the
	# 'glob' below.  Catch that now.
	#
	if { $maxsites > 9 } {
		error "Max sites too large."
	}
	if { $cfgtype == "restore" } {
		set ret [catch {glob $restoredir/DB_CONFIG.\[1-$maxsites\]} \
		    result]
		if { $ret != 0 } {
			error "Could not get config list: $result"
		}
		return [llength $result]
	}
	if { $cfgtype == "random" } {
		#
		# Sometimes 'random' doesn't seem to do a good job.  I have
		# seen on all iterations after the first one, nsites is
		# always 2, 100% of the time.  Add this bit to make sure
		# this nsites values is different from the last iteration.
		#
		set n [berkdb random_int 2 $maxsites]
		while { $n == $last_nsites } {
			set n [berkdb random_int 2 $maxsites]
puts "Getting random nsites between 2 and $maxsites.  Got $n, last_nsites $last_nsites"
		}
		set last_nsites $n
		return $n
	}
	if { $cfgtype == "basic0" } {
		return 2
	}
	if { $cfgtype == "basic1" } {
		return 3
	}
	return -1
}

#
# Run with master leases?  25%/75% (use a master lease 25% of the time).
#
proc get_lease { cfgtype restoredir } {
	#
	# The number of sites must be the same for all.  Read the
	# first site's saved DB_CONFIG file if we're restoring since
	# we only know we have at least 1 site.
	#
	if { $cfgtype == "restore" } {
		set uselease 0
		set cid [open $restoredir/DB_CONFIG.1 r]
		while { [gets $cid cfglist] } {
#			puts "Read in: $cfglist"
			if { [llength $cfglist] == 0 } {
				break;
			}
			set cfg [lindex $cfglist 0]
			if { $cfg == "rep_set_config" } {
				set lease [lindex $cfglist 1]
				if { $lease == "db_rep_conf_lease" } {
					set uselease 1
					break;
				}
			}
		}
		close $cid
		return $uselease
	}
	if { $cfgtype == "random" } {
		set leases { 1 0 0 0 }
		set len [expr [llength $leases] - 1]
		set i [berkdb random_int 0 $len]
		return [lindex $leases $i]
	}
	if { $cfgtype == "basic0" } {
		return 0
	}
	if { $cfgtype == "basic1" } {
		return 0
	}
}

#
# Do a kill test about half the time.  We randomly choose a
# site number to kill, it could be a master or a client.  If
# we want to remove the site from the group, randomly choose
# a site to do the removal.
#
# We return a list with the kill type and the sites.  Return
# an empty list if we don't kill any site.  There are a few variants:
#
# 1: Die - A site just kills itself but remains part of the group.
# Return a list {DIE deadsite# 0}.
# 2: Removal - A site kills itself, and some site will also remove
# the dead site from the group. (Could be the same site that is dying,
# in which case the removal is done right before it exits.)
# {REMOVE deadsite# removalsite#}.
# 3. Live removal - Some site removes another live site from the group.
# (Could be itself.)
# {LIVE_REM killsite# removalsite#}.
#
proc get_kill { cfgtype restoredir num_sites basept } {
	upvar $basept baseport

	set nokill ""
	if { $cfgtype == "restore" } {
		set ksite 0
		set localkill 0
		set rkill 0
		set rsite 0
		set kport 0
		set ktype NONE
		for { set i 1 } { $i <= $num_sites } { incr i } {
			set cid [open $restoredir/DB_REPTEST_ARGS.$i r]
			# !!!
			# We currently assume the args file is 1 line.
			#
			gets $cid arglist
			close $cid
#			puts "Read in: $arglist"
			set dokill [lsearch $arglist "-k"]
			set dorem [lsearch $arglist "-K"]
			#
			# Only 1 of those args should ever be set for a given
			# input line.  We need to look at all sites in order
			# to determine the kill type.  If we find both -k and
			# -K, the site will be the same, so overwriting it
			# no matter what order the sites, is okay.
			#
			if { $dokill >= 0 } {
				set ksite $i
				set localkill 1
			}
			#
			# If it is a remote removal kill type, we are
			# the site doing the removing and we need to get
			# the site to remove from the arg.  $dorem is the
			# index of the arg, so + 1 is the site number.
			# The site in the arg is the port number so grab
			# the site number out of it.
			#
			if { $dorem >= 0 } {
				set rkill 1
				set kport [lindex $arglist [expr $dorem + 1]]
				set ksite [expr $kport - $baseport(orig)]
				# Convert kport to current baseport if needed.
				if { $baseport(curr) != $baseport(orig) } {
					set kport [expr $kport - \
					    $baseport(orig) + $baseport(curr)]
				}
				set rsite $i
			}
		}
		#
		# If we have a remote kill, then we decide the kill type
		# based on whether the killed site will be dead or alive.
		# If we found no site to kill/remove, we know it is not
		# a kill test.
		#
		if { $ksite == 0 } {
			return $nokill
		} else {
			#
			# See proc comment for a definition of each kill type.
			#
			if { $localkill == 1 && $rkill == 0 } {
				set ktype DIE
			}
			if { $localkill == 1 && $rkill == 1 } {
				set ktype REMOVE
			}
			if { $localkill == 0 && $rkill == 2 } {
				set ktype LIVE_REM
			}
			return [list $ktype $ksite $rsite]
		}
	}
	if { $cfgtype == "random" } {
		# Do a kill and/or removal test half the time.
		set k { 0 0 0 1 1 1 0 1 1 0 }
		set len [expr [llength $k] - 1]
		set i [berkdb random_int 0 $len]
		set dokill [lindex $k $i]
		set i [berkdb random_int 0 $len]
		set dorem [lindex $k $i]
		#
		# Set up for the possibilities listed above.
		#
		if { $dokill == 0 && $dorem == 0 } {
			return $nokill
		}
		#
		# Choose which sites to kill and do removal.
		#
		set ksite [berkdb random_int 1 $num_sites]
		set rsite [berkdb random_int 1 $num_sites]
		if { $dokill == 1 && $dorem == 0 } {
			set ktype DIE
			set rsite 0
		}
		if { $dokill == 1 && $dorem == 1 } {
			set ktype REMOVE
		}
		if { $dokill == 0 && $dorem == 1 } {
			set ktype LIVE_REM
		}
		return [list $ktype $ksite $rsite]
	}
	if { $cfgtype == "basic0" || $cfgtype == "basic1" } {
		return $nokill
	} else {
		error "Get_kill: Invalid config type $cfgtype"
	}
}

#
# If we want to run a remove/rejoin, which site?  This proc
# will return a site number of a site to remove/rejoin or
# it will return 0 if no removal test.  Sites are numbered
# starting at 1.
#
proc get_remove { cfgtype restoredir nsites } {
	set rsite 0
	if { $cfgtype == "random" } {
		# Do a remove test half the time we're called.
		set k { 0 0 0 1 1 1 0 1 1 0 }
		set len [expr [llength $k] - 1]
		set i [berkdb random_int 0 $len]
		if { [lindex $k $i] == 1 } {
			set rsite [berkdb random_int 1 $nsites]
		}
	} elseif { $cfgtype == "restore" } {
		#
		# If we're restoring we still need to know if a site is
		# running its own removal test so we know to skip it for verify.
		#
		for { set i 1 } { $i <= $nsites } { incr i } {
			set cid [open $restoredir/DB_REPTEST_ARGS.$i r]
			# !!!
			# We currently assume the args file is 1 line.
			# This code also assumes only 1 site ever does removal.
			#
			gets $cid arglist
			close $cid
#			puts "Read in: $arglist"
			set dorem [lsearch $arglist "-r"]
			if { $dorem >= 0 } {
				set rsite $i
				#
				# If we find one, we know no other site will
				# be doing removal.  So stop now.
				#
				break
			}
		}
	}
	return $rsite
}

#
# Use peers or only the master for requests? 25%/75% (use a peer 25%
# of the time and master 75%)
#
proc get_peers { cfgtype } {
	if { $cfgtype == "random" } {
		set peer { 0 0 0 1 }
		set len [expr [llength $peer] - 1]
		set i [berkdb random_int 0 $len]
		return [lindex $peer $i]
	} else {
		return 0
	}
}

#
# Start with a master or all clients?  25%/75% (use a master 25%
# of the time and have all clients 75%)
#
proc get_usemaster { cfgtype } {
	if { $cfgtype == "random" } {
		set mst { 1 0 0 0 }
		set len [expr [llength $mst] - 1]
		set i [berkdb random_int 0 $len]
		return [lindex $mst $i]
	}
	if { $cfgtype == "basic0" } {
		return 1
	}
	if { $cfgtype == "basic1" } {
		return 0
	}
}

#
# If we use a master, which site?  This proc will return
# the site number of the mastersite, or it will return
# 0 if no site should start as master.  Sites are numbered
# starting at 1.
#
proc get_mastersite { cfgtype usemaster nsites } {
	if { $usemaster == 0 } {
		return 0
	}
	if { $cfgtype == "random" } {
		return [berkdb random_int 1 $nsites]
	}
	if { $cfgtype == "basic0" } {
		return 1
	}
	if { $cfgtype == "basic1" } {
		return 0
	}
}

#
# If we are using a master, use no elections 20% of the time.
#
proc get_noelect { usemaster } {
	if { $usemaster } {
		set noelect { 0 0 1 0 0 }
		set len [expr [llength $noelect] - 1]
		set i [berkdb random_int 0 $len]
		return [lindex $noelect $i]
	} else {
		return 0
	}
}

#
# If we are using no elections mode and we are going to kill the initial
# master, select a different site to start up as master after the initial
# master is killed.
#
proc get_secondary_master { noelect master_site kill nsites } {
	if { $noelect == 0 || $kill != $master_site} {
		return 0
	}
	set master2_site [berkdb random_int 1 $nsites]
	while { $master2_site == $master_site } {
		set master2_site [berkdb random_int 1 $nsites]		
	}
	return $master2_site
}

#
# This is the number of worker threads performing the workload.
# This is not the number of message processing threads.
#
# Scale back the number of worker threads if leases are in use.
# The timing with leases can be fairly sensitive and since all sites
# run on the local machine, too many workers on every site can
# overwhelm the system, causing lost messages and delays that make
# the tests fail.  Rather than try to tweak timeouts, just reduce
# the workloads a bit.
#
proc get_workers { cfgtype lease } {
	if { $cfgtype == "random" } {
		if { $lease } {
			return [berkdb random_int 2 4]
		} else {
			return [berkdb random_int 2 8]
		}
	}
	if { $cfgtype == "basic0" || $cfgtype == "basic1" } {
		return 5
	}
}

proc get_dbtype { cfgtype } {
	if { $cfgtype == "random" } {
		#
		# 50% btree, 25% queue 12.5% hash 12.5% recno
		# We favor queue only because there is special handling
		# for queue in internal init.
		#
#		set methods {btree btree btree btree queue queue hash recno}
		set methods {btree btree btree btree hash recno}
		set len [expr [llength $methods] - 1]
		set i [berkdb random_int 0 $len]
		return [lindex $methods $i]
	}
	if { $cfgtype == "basic0" || $cfgtype == "basic1" } {
		return btree
	}
}

proc get_runtime { cfgtype } {
	if { $cfgtype == "random" } {
		return [berkdb random_int 100 500]
	}
	if { $cfgtype == "basic0" } {
		return 100
	}
	if { $cfgtype == "basic1" } {
		return 150
	}
}

proc get_rport { portlist i num_sites known_master cfgtype} {
	global rporttype

	if { $cfgtype == "random" && $rporttype == "NULL" } {
		set types {backcirc forwcirc full onesite}
		set len [expr [llength $types] - 1]
		set rindex [berkdb random_int 0 $len]
		set rporttype [lindex $types $rindex]
	}
	if { $cfgtype == "basic0" } {
		set rporttype onesite
	}
	if { $cfgtype == "basic1" } {
		set rporttype full
	}
	#
	# This produces a circular knowledge ring.  Either forward
	# or backward.  In the forwcirc, ENV1 knows (via -r) about
	# ENV2, ENV2 knows about ENV3, ..., ENVX knows about ENV1.
	#
	if { $rporttype == "forwcirc" } {
		if { $i != $num_sites } {
			return [list [lindex $portlist $i]]
		} else {
			return [list [lindex $portlist 0]]
		}
	}
	if { $rporttype == "backcirc" } {
		if { $i != 1 } {
			return [list [lindex $portlist [expr $i - 2]]]
		} else {
			return [list [lindex $portlist [expr $num_sites - 1]]]
		}
	}
	#
	# This produces a configuration where site N does not know
	# about any other site and every other site knows about site N.
	# Site N must either be the master or group creator.
	# NOTE: Help_site_i subtracts one because site numbers
	# are 1-based and list indices are 0-based.
	#
	if { $rporttype == "onesite" } {
		set helper_site [expr $known_master - 1]
		if { $i == $known_master } {
			return {}
		}
		return [lindex $portlist $helper_site]
	}
	#
	# This produces a fully connected configuration
	#
	if { $rporttype == "full" } {
		set rlist {}
		for { set site 1 } { $site <= $num_sites } { incr site } {
			if { $site != $i } {
				lappend rlist \
				    [lindex $portlist [expr $site - 1]]
			}
		}
		return $rlist
	}
}

#
# We need to have an ack timeout > lease timeout. Otherwise txns can get 
# committed without waiting long enough for leases to get granted.  We
# return a list {acktimeout# leasetimeout#}, with leasetimeout#=0 if leases
# are not in use.
#
proc get_ack_lease_timeouts { useleases } {
	if { $useleases } {
		return [list 20000000 10000000]
	} else {
		return [list 5000000 0]
	}
}

#
# Use datadir half the time.  Then pick how many and which datadir
# the database should reside in.  Use a metadata dir 25% of the time.
#
proc get_datadirs { cfgtype usearr dirarr } {
	upvar $usearr use
	upvar $dirarr dir

	set use(datadir) 0
	set use(createdir) 0
	set use(metadir) 0
	if { $cfgtype == "random" } {
		set meta { 0 0 0 1 }
		#
		# Randomly pick if we use datadirs, and if so, how many, up to 4.
		# Although we may create several datadirs, we only choose one
		# of them in which to create the database.
		#
		set data { 0 0 0 0 1 2 3 4 }
		set mlen [expr [llength $meta] - 1]
		set dlen [expr [llength $data] - 1]
		set im [berkdb random_int 0 $mlen]
		set id [berkdb random_int 0 $dlen]
		set use(datadir) [lindex $data $id]
		set use(metadir) [lindex $meta $im]
		#
		# If we're using datadirs, then randomly pick the creation dir.
		#
		if { $use(datadir) != 0 } {
			set use(createdir) [berkdb random_int 1 $use(datadir)]
		}
	} elseif { $cfgtype == "restore" } {
		set cid [open $dir(restore)/DB_CONFIG.1 r]
		set cfg [read $cid]
		# Look for metadata_dir, add_data_dir and set_create_dir.
		set use(metadir) [regexp -all {(set_metadata_dir)} $cfg]
		set use(datadir) [regexp -all {(add_data_dir)} $cfg]
		if { $use(datadir) } {
			set c [regexp {(set_create_dir )(DATA.[0-9])} $cfg m cr]
			#
			# We need to extract the directory number from the
			# createdir directory name.  I.e., DATA.2 needs '2'.
			#
			regexp {(DATA.)([0-9])} $m match d use(createdir)
		}
		close $cid
	}
	return 0
}

#
# Get the original baseport for a configuration to be restored by using
# the local site port number for its first site because every configuration
# will have a first site.
#
proc get_orig_baseport { cfgtype { restoredir NULL } } {
	if { $cfgtype != "restore" } {
		return 0
	} else {
		set cid [open $restoredir/DB_CONFIG.1 r]
		set cfg [read $cid]
		# Look for a number between "127.0.0.1" and "db_local_site on".
		# The spaces after 127.0.0.1 and before db_local_site are
		# significant in the pattern match.
		regexp {(127.0.0.1 )([0-9]+)( db_local_site on)} $cfg \
		    match p1 pnum
		close $cid
		return [expr $pnum - 1]
	}
}

#
# Convert DB_CONFIG file port numbers following "127.0.0.1 " to use a 
# different baseport.  regsub -all substitutes all occurrences of pattern,
# which is "127.0.0.1 " and a number.  The result of regsub contains a tcl
# expression with the number (\2, the second part of the pattern), operators
# and variable names, e.g.:
#     -K [expr 30104 - $baseport(orig) + $baseport(curr)]
# and then subst evalutes the tcl expression.
#
# Writes a converted copy of orig_file to new_file.
#
proc convert_config_ports { orig_file new_file basept } {
	upvar $basept baseport

	set cid [open $orig_file r]
	set cfg [read $cid]
	regsub -all {(127.0.0.1 )([0-9]+)} $cfg \
	    {127.0.0.1 [expr \2 - $baseport(orig) + $baseport(curr)]} cfg
	set cfg [subst $cfg]
	close $cid
	set cid [open $new_file a]
	puts -nonewline $cid $cfg
	close $cid
	return 0
}

proc parse_runtime { progargs } {
	set i [lsearch $progargs "-T"]
	set val [lindex $progargs [expr $i + 1]]
	return $val
}

proc print_summary { } {
	source ./include.tcl

	set ret [catch {glob $testdir/summary.*} result]
	if { $ret == 0 } {
		set sumfiles $result
	} else {
		puts "Could not get summary list: $result"
		return 1
	}
	foreach f $sumfiles {
		puts "====   $f   ===="
		set ret [catch {open $f} fd]
		if { $ret != 0 } {
			puts "Error opening $f: $fd"
			continue
		}
		while { [gets $fd line] >= 0 } {
			puts "$line"
		}
		close $fd
	}
	return 0
}

proc search_output { stopstr } {
	source ./include.tcl

	set ret [catch {glob $testdir/E*/OUTPUT} result]
	if { $ret == 0 } {
		set outfiles $result
	} else {
		puts "Could not find any OUTPUT files: $result"
		return 0
	}
	set found 0
	foreach f $outfiles {
		set ret [catch {exec grep $stopstr $f > /dev/null} result]
		if { $ret == 0 } {
			puts "$f: Match found: $stopstr"
			set found 1
		}
	}
	return $found
}