global queueenv
global queuedbs
global machids
global perm_sent_list
set perm_sent_list {}
global perm_rec_list
set perm_rec_list {}
global elect_timeout
set elect_timeout 50000000
set drop 0
proc repl_envsetup { envargs largs test {nclients 1} {droppct 0} { oob 0 } } {
source ./include.tcl
global clientdir
global drop drop_msg
global masterdir
global repenv
global testdir
env_cleanup $testdir
replsetup $testdir/MSGQUEUEDIR
set masterdir $testdir/MASTERDIR
file mkdir $masterdir
if { $droppct != 0 } {
set drop 1
set drop_msg [expr 100 / $droppct]
} else {
set drop 0
}
for { set i 0 } { $i < $nclients } { incr i } {
set clientdir($i) $testdir/CLIENTDIR.$i
file mkdir $clientdir($i)
}
repladd 1
set logmax [expr 3 * 1024 * 1024]
set masterenv [eval {berkdb_env -create -log_max $logmax} $envargs \
-lock_max 10000 \
{-home $masterdir -txn nosync -rep_master -rep_transport \
[list 1 replsend]}]
error_check_good master_env [is_valid_env $masterenv] TRUE
set repenv(master) $masterenv
for { set i 0 } { $i < $nclients } { incr i } {
set envid [expr $i + 2]
repladd $envid
set clientenv [eval {berkdb_env -create} $envargs -txn nosync \
{-cachesize { 0 10000000 0 }} -lock_max 10000 \
{ -home $clientdir($i) -rep_client -rep_transport \
[list $envid replsend]}]
error_check_good client_env [is_valid_env $clientenv] TRUE
set repenv($i) $clientenv
}
set repenv($i) NULL
append largs " -env $masterenv "
repl_envprocq $test $nclients $oob
return $largs
}
proc repl_envprocq { test { nclients 1 } { oob 0 }} {
global repenv
global drop
set masterenv $repenv(master)
for { set i 0 } { 1 } { incr i } {
if { $repenv($i) == "NULL"} {
break
}
}
error_check_good i_nclients $nclients $i
berkdb debug_check
puts -nonewline "\t$test: Processing master/$i client queues"
set rand_skip 0
if { $oob } {
puts " out-of-order"
} else {
puts " in order"
}
set do_check 1
set droprestore $drop
while { 1 } {
set nproced 0
if { $oob } {
set rand_skip [berkdb random_int 2 10]
}
incr nproced [replprocessqueue $masterenv 1 $rand_skip]
for { set i 0 } { $i < $nclients } { incr i } {
set envid [expr $i + 2]
if { $oob } {
set rand_skip [berkdb random_int 2 10]
}
set n [replprocessqueue $repenv($i) \
$envid $rand_skip]
incr nproced $n
}
if { $nproced == 0 } {
for { set i 0 } { $i < $nclients } { incr i } {
set clientenv $repenv($i)
set stats [$clientenv rep_stat]
set queued [getstats $stats \
{Total log records queued}]
error_check_bad queued_stats \
$queued -1
set requested [getstats $stats \
{Log records requested}]
error_check_bad requested_stats \
$requested -1
if { $queued != 0 && $do_check != 0 } {
error_check_good num_requested \
[expr $requested < $queued] 1
}
$clientenv rep_request 1 1
}
if { $drop != 0 } {
set drop 0
set do_check 0
$masterenv rep_flush
berkdb debug_check
puts "\t$test: Flushing Master"
} else {
break
}
}
}
for { set i 0 } { $i < $nclients } { incr i } {
set clientenv $repenv($i)
$clientenv rep_request 4 128
}
set drop $droprestore
}
proc repl_envver0 { test method { nclients 1 } } {
global clientdir
global masterdir
global repenv
set t1 $masterdir/t1
set t2 $masterdir/t2
set t3 $masterdir/t3
set omethod [convert_method $method]
set cwd [pwd]
cd $masterdir
set stat [catch {glob test*.db} dbs]
cd $cwd
if { $stat == 1 } {
return
}
foreach testfile $dbs {
open_and_dump_file $testfile $repenv(master) $masterdir/t2 \
repl_noop dump_file_direction "-first" "-next"
if { [string compare [convert_method $method] -recno] != 0 } {
filesort $t2 $t3
file rename -force $t3 $t2
}
for { set i 0 } { $i < $nclients } { incr i } {
puts "\t$test: Verifying client $i database $testfile contents."
open_and_dump_file $testfile $repenv($i) \
$t1 repl_noop dump_file_direction "-first" "-next"
if { [string compare $omethod "-recno"] != 0 } {
filesort $t1 $t3
} else {
catch {file copy -force $t1 $t3} ret
}
error_check_good diff_files($t2,$t3) [filecmp $t2 $t3] 0
}
}
}
proc repl_verdel { test method { nclients 1 } } {
global clientdir
global masterdir
global repenv
set cwd [pwd]
cd $masterdir
set stat [catch {glob test*.db} dbs]
cd $cwd
if { $stat == 1 } {
return
}
foreach testfile $dbs {
puts "\t$test: Deleting all items from the master."
set txn [$repenv(master) txn]
error_check_good txn_begin [is_valid_txn $txn \
$repenv(master)] TRUE
set db [berkdb_open -txn $txn -env $repenv(master) $testfile]
error_check_good reopen_master [is_valid_db $db] TRUE
set dbc [$db cursor -txn $txn]
error_check_good reopen_master_cursor \
[is_valid_cursor $dbc $db] TRUE
for { set dbt [$dbc get -first] } { [llength $dbt] > 0 } \
{ set dbt [$dbc get -next] } {
error_check_good del_item [$dbc del] 0
}
error_check_good dbc_close [$dbc close] 0
error_check_good txn_commit [$txn commit] 0
error_check_good db_close [$db close] 0
repl_envprocq $test $nclients
for { set i 0 } { $i < $nclients } { incr i } {
puts "\t$test: Verifying client database $i is empty."
set db [berkdb_open -env $repenv($i) $testfile]
error_check_good reopen_client($i) \
[is_valid_db $db] TRUE
set dbc [$db cursor]
error_check_good reopen_client_cursor($i) \
[is_valid_cursor $dbc $db] TRUE
error_check_good client($i)_empty \
[llength [$dbc get -first]] 0
error_check_good dbc_close [$dbc close] 0
error_check_good db_close [$db close] 0
}
}
}
proc repl_noop { k d } {
return
}
proc repl_envclose { test envargs } {
source ./include.tcl
global clientdir
global encrypt
global masterdir
global repenv
global testdir
if { [lsearch $envargs "-encrypta*"] !=-1 } {
set encrypt 1
}
set drop 0
set do_check 0
berkdb debug_check
puts "\t$test: Checkpointing master."
error_check_good masterenv_ckp [$repenv(master) txn_checkpoint] 0
for { set ncli 0 } { 1 } { incr ncli } {
if { $repenv($ncli) == "NULL" } {
break
}
}
repl_envprocq $test $ncli
error_check_good masterenv_close [$repenv(master) close] 0
verify_dir $masterdir "\t$test: " 0 0 1
for { set i 0 } { $i < $ncli } { incr i } {
error_check_good client($i)_close [$repenv($i) close] 0
verify_dir $clientdir($i) "\t$test: " 0 0 1
}
replclose $testdir/MSGQUEUEDIR
}
proc replclose { queuedir } {
global queueenv queuedbs machids
foreach m $machids {
set db $queuedbs($m)
error_check_good dbr_close [$db close] 0
}
error_check_good qenv_close [$queueenv close] 0
set machids {}
}
proc replsetup { queuedir } {
global queueenv queuedbs machids
file mkdir $queuedir
set queueenv \
[berkdb_env -create -txn nosync -lock_max 20000 -home $queuedir]
error_check_good queueenv [is_valid_env $queueenv] TRUE
if { [info exists queuedbs] } {
unset queuedbs
}
set machids {}
return $queueenv
}
proc replsend { control rec fromid toid flags lsn } {
global queuedbs queueenv machids
global drop drop_msg
global perm_sent_list
if { $flags == "perm" } {
lappend perm_sent_list $lsn
}
if { $drop != 0 } {
incr drop
if { $drop == $drop_msg } {
set drop 1
return 0
}
}
if { $toid == -1 } {
set machlist $machids
} else {
if { [info exists queuedbs($toid)] != 1 } {
error "replsend: machid $toid not found"
}
set machlist [list $toid]
}
foreach m $machlist {
if { $m == $fromid } {
continue
}
set db $queuedbs($m)
set txn [$queueenv txn]
$db put -txn $txn -append [list $control $rec $fromid]
error_check_good replsend_commit [$txn commit] 0
}
return 0
}
proc replclear { machid } {
global queuedbs queueenv
if { [info exists queuedbs($machid)] != 1 } {
error "FAIL: replclear: machid $machid not found"
}
set db $queuedbs($machid)
set txn [$queueenv txn]
set dbc [$db cursor -txn $txn]
for { set dbt [$dbc get -rmw -first] } { [llength $dbt] > 0 } \
{ set dbt [$dbc get -rmw -next] } {
error_check_good replclear($machid)_del [$dbc del] 0
}
error_check_good replclear($machid)_dbc_close [$dbc close] 0
error_check_good replclear($machid)_txn_commit [$txn commit] 0
}
proc repladd { machid } {
global queueenv queuedbs machids
if { [info exists queuedbs($machid)] == 1 } {
error "FAIL: repladd: machid $machid already exists"
}
set queuedbs($machid) [berkdb open -auto_commit \
-env $queueenv -create -recno -renumber repqueue$machid.db]
error_check_good repqueue_create [is_valid_db $queuedbs($machid)] TRUE
lappend machids $machid
}
proc replprocessqueue { dbenv machid { skip_interval 0 } { hold_electp NONE } \
{ newmasterp NONE } { dupmasterp NONE } { errp NONE } } {
global queuedbs queueenv errorCode
global perm_response
set perm_response ""
global perm_rec_list
if { [string compare $hold_electp NONE] != 0 } {
upvar $hold_electp hold_elect
}
set hold_elect 0
if { [string compare $newmasterp NONE] != 0 } {
upvar $newmasterp newmaster
}
set newmaster 0
if { [string compare $dupmasterp NONE] != 0 } {
upvar $dupmasterp dupmaster
}
set dupmaster 0
if { [string compare $errp NONE] != 0 } {
upvar $errp errorp
}
set errorp 0
set nproced 0
set txn [$queueenv txn]
set dbc [$queuedbs($machid) cursor -txn $txn]
error_check_good process_dbc($machid) \
[is_valid_cursor $dbc $queuedbs($machid)] TRUE
for { set dbt [$dbc get -first] } \
{ [llength $dbt] != 0 } \
{ set dbt [$dbc get -next] } {
set data [lindex [lindex $dbt 0] 1]
if { $skip_interval != 0 } {
if { $nproced % $skip_interval == 1 } {
incr nproced
continue
}
}
set recno [lindex [lindex $dbt 0] 0]
error_check_good dbc_process_close [$dbc close] 0
error_check_good txn_commit [$txn commit] 0
set ret [catch {$dbenv rep_process_message \
[lindex $data 2] [lindex $data 0] [lindex $data 1]} res]
set txn [$queueenv txn]
set dbc [$queuedbs($machid) cursor -txn $txn]
set dbt [$dbc get -set $recno]
if { [is_substr $res ISPERM] || [is_substr $res NOTPERM] } {
set perm_response $res
set lsn [lindex $perm_response 1]
lappend perm_rec_list $lsn
}
if { $ret != 0 } {
if { [string compare $errp NONE] != 0 } {
set errorp $res
} else {
error "FAIL:[timestamp]\
rep_process_message returned $res"
}
}
incr nproced
$dbc del
if { $ret == 0 } {
set rettype [lindex $res 0]
set retval [lindex $res 1]
if { [is_substr $rettype HOLDELECTION] } {
set hold_elect 1
}
if { [is_substr $rettype DUPMASTER] } {
set dupmaster 1
}
if { [is_substr $rettype NOTPERM] || \
[is_substr $rettype ISPERM] } {
set lsnfile [lindex $retval 0]
set lsnoff [lindex $retval 1]
}
if { [is_substr $rettype NEWMASTER] } {
set newmaster $retval
break
}
}
if { $errorp == 1 } {
break
}
if { $hold_elect == 1 } {
break
}
if { $dupmaster == 1 } {
break
}
}
error_check_good dbc_close [$dbc close] 0
error_check_good txn_commit [$txn commit] 0
return $nproced
}
set run_repl_flag "-run_repl"
proc extract_repl_args { args } {
global run_repl_flag
for { set arg [lindex $args [set i 0]] } \
{ [string length $arg] > 0 } \
{ set arg [lindex $args [incr i]] } {
if { [string compare $arg $run_repl_flag] == 0 } {
return [lindex $args [expr $i + 1]]
}
}
return ""
}
proc delete_repl_args { args } {
global run_repl_flag
set ret {}
for { set arg [lindex $args [set i 0]] } \
{ [string length $arg] > 0 } \
{ set arg [lindex $args [incr i]] } {
if { [string compare $arg $run_repl_flag] != 0 } {
lappend ret $arg
} else {
incr i
}
}
return $ret
}
global elect_serial
global elections_in_progress
set elect_serial 0
proc start_election { pfx qdir envstring nsites pri timeout {err "none"}} {
source ./include.tcl
global elect_serial elect_timeout elections_in_progress machids
set filelist {}
set ret [catch {glob $testdir/ELECTION*.$elect_serial} result]
if { $ret == 0 } {
set filelist [concat $filelist $result]
}
foreach f $filelist {
fileremove -f $f
}
set oid [open $testdir/ELECTION_SOURCE.$elect_serial w]
puts $oid "source $test_path/test.tcl"
puts $oid "replsetup $qdir"
foreach i $machids { puts $oid "repladd $i" }
puts $oid "set env_cmd \{$envstring\}"
puts $oid "set dbenv \[eval \$env_cmd -errfile \
$testdir/ELECTION_ERRFILE.$elect_serial -errpfx $pfx \]"
puts $oid "\$dbenv test abort $err"
puts $oid "set res \[catch \{\$dbenv rep_elect $nsites $pri \
$elect_timeout\} ret\]"
puts $oid "set r \[open \$testdir/ELECTION_RESULT.$elect_serial w\]"
puts $oid "if \{\$res == 0 \} \{"
puts $oid "puts \$r \"NEWMASTER \$ret\""
puts $oid "\} else \{"
puts $oid "puts \$r \"ERROR \$ret\""
puts $oid "\}"
if { $err != "none" } {
puts $oid "\$dbenv test abort none"
puts $oid "set res \[catch \{\$dbenv rep_elect $nsites $pri \
$elect_timeout\} ret\]"
puts $oid "if \{\$res == 0 \} \{"
puts $oid "puts \$r \"NEWMASTER \$ret\""
puts $oid "\} else \{"
puts $oid "puts \$r \"ERROR \$ret\""
puts $oid "\}"
}
puts $oid "close \$r"
close $oid
set t [open "|$tclsh_path >& $testdir/ELECTION_OUTPUT.$elect_serial" w]
puts $t "source ./include.tcl"
puts $t "source $testdir/ELECTION_SOURCE.$elect_serial"
flush $t
set elections_in_progress($elect_serial) $t
return $elect_serial
}
proc check_election { id newmasterp } {
source ./include.tcl
if { $id == "INVALID" } {
return 0
}
upvar $newmasterp newmaster
set newmaster 0
set res [catch {open $testdir/ELECTION_RESULT.$id} nmid]
if { $res != 0 } {
return 0
}
while { [gets $nmid val] != -1 } {
set str [lindex $val 0]
if { [is_substr $str NEWMASTER] } {
set newmaster [lindex $val 1]
}
}
close $nmid
return 1
}
proc close_election { i } {
global elections_in_progress
set t $elections_in_progress($i)
puts $t "replclose \$testdir/MSGQUEUEDIR"
puts $t "\$dbenv close"
close $t
unset elections_in_progress($i)
}
proc cleanup_elections { } {
global elect_serial elections_in_progress
for { set i 0 } { $i <= $elect_serial } { incr i } {
if { [info exists elections_in_progress($i)] != 0 } {
close_election $i
}
}
set elect_serial 0
}
proc rep_test { method env db {nentries 10000} {start 0} {skip 1} } {
source ./include.tcl
puts "\t\tRep_test: $method $nentries key/data pairs starting at $start"
set did [open $dict]
if { $skip == 1 } {
for { set count 0 } { $count < $start } { incr count } {
gets $did str
}
}
set pflags ""
set gflags ""
set txn ""
if { [is_record_based $method] == 1 } {
append gflags " -recno"
}
puts "\t\tRep_test.a: put/get loop"
set count 0
while { [gets $did str] != -1 && $count < $nentries } {
if { [is_record_based $method] == 1 } {
global kvals
set key [expr $count + 1 + $start]
if { 0xffffffff > 0 && $key > 0xffffffff } {
set key [expr $key - 0x100000000]
}
if { $key == 0 || $key - 0xffffffff == 1 } {
incr key
incr count
}
set kvals($key) [pad_data $method $str]
} else {
set key $str
set str [reverse $str]
}
set t [$env txn]
error_check_good txn [is_valid_txn $t $env] TRUE
set txn "-txn $t"
set ret [eval \
{$db put} $txn $pflags {$key [chop_data $method $str]}]
error_check_good put $ret 0
error_check_good txn [$t commit] 0
if { $count % 5 == 0 } {
error_check_good txn_checkpoint($count) \
[$env txn_checkpoint] 0
}
incr count
}
close $did
}