source ./include.tcl
global upgrade_dir
set upgrade_dir "$test_path/upgrade/databases"
global gen_upgrade
set gen_upgrade 0
global gen_dump
set gen_dump 0
global gen_chksum
set gen_chksum 0
global gen_upgrade_log
set gen_upgrade_log 0
global upgrade_dir
global upgrade_be
global upgrade_method
global upgrade_name
proc upgrade { { archived_test_loc "DEFAULT" } } {
source ./include.tcl
global test_names
global upgrade_dir
global tcl_platform
global saved_logvers
set saved_upgrade_dir $upgrade_dir
if { [big_endian] == 1 } {
set myendianness be
} else {
set myendianness le
}
set e $tcl_platform(byteOrder)
if { [file exists $archived_test_loc/logversion] == 1 } {
set fd [open $archived_test_loc/logversion r]
set saved_logvers [read $fd]
close $fd
} else {
puts "Old log version number must be available \
in $archived_test_loc/logversion"
return
}
fileremove -f UPGRADE.OUT
set o [open UPGRADE.OUT a]
puts -nonewline $o "Upgrade test started at: "
puts $o [clock format [clock seconds] -format "%H:%M %D"]
puts $o [berkdb version -string]
puts $o "Testing $e files"
puts -nonewline "Upgrade test started at: "
puts [clock format [clock seconds] -format "%H:%M %D"]
puts [berkdb version -string]
puts "Testing $e files"
if { $archived_test_loc == "DEFAULT" } {
puts $o "Using default archived databases in $upgrade_dir."
puts "Using default archived databases in $upgrade_dir."
} else {
set upgrade_dir $archived_test_loc
puts $o "Using archived databases in $upgrade_dir."
puts "Using archived databases in $upgrade_dir."
}
close $o
foreach version [glob $upgrade_dir/*] {
if { [string first CVS $version] != -1 } { continue }
regexp \[^\/\]*$ $version version
set dbendianness [string range $version end-1 end]
if { [string compare $myendianness $dbendianness] != 0 } {
puts "Skipping test of $version \
on $myendianness platform."
} else {
set release [string trim $version -lbe]
set o [open UPGRADE.OUT a]
puts $o "Files created on release $release"
close $o
puts "Files created on release $release"
foreach method [glob $upgrade_dir/$version/*] {
regexp \[^\/\]*$ $method method
set o [open UPGRADE.OUT a]
puts $o "\nTesting $method files"
close $o
puts "\tTesting $method files"
foreach file [lsort -dictionary \
[glob -nocomplain \
$upgrade_dir/$version/$method/*]] {
regexp (\[^\/\]*)\.tar\.gz$ \
$file dummy name
cleanup $testdir NULL 1
set curdir [pwd]
cd $testdir
set tarfd [open "|tar xf -" w]
cd $curdir
catch {exec gunzip -c \
"$upgrade_dir/$version/$method/$name.tar.gz" \
>@$tarfd}
close $tarfd
set f [open $testdir/$name.tcldump \
{RDWR CREAT}]
close $f
if { [file exists \
$testdir/$name-$myendianness.db] } {
if { [catch {exec $tclsh_path \
<< "source \
$test_path/test.tcl;\
_upgrade_test $testdir \
$version $method $name \
$myendianness" >>& \
UPGRADE.OUT } message] } {
set o [open \
UPGRADE.OUT a]
puts $o "FAIL: $message"
close $o
}
if { [catch {exec $tclsh_path\
<< "source \
$test_path/test.tcl;\
_db_load_test $testdir \
$version $method $name" >>&\
UPGRADE.OUT } message] } {
set o [open \
UPGRADE.OUT a]
puts $o "FAIL: $message"
close $o
}
}
if { [file exists \
$testdir/$name.prlog] } {
if { [catch {exec $tclsh_path \
<< "source \
$test_path/test.tcl;\
global saved_logvers;\
set saved_logvers \
$saved_logvers;\
_log_test $testdir \
$release $method \
$name" >>& \
UPGRADE.OUT } message] } {
set o [open \
UPGRADE.OUT a]
puts $o "FAIL: $message"
close $o
}
}
if { [file exists $testdir/$name.dmp] } {
file rename -force \
$testdir/$name.dmp $name.dmp
foreach test $test_names(plat) {
eval $test $method
}
discardline $name.dmp \
TEMPFILE "db_pagesize="
file copy -force \
TEMPFILE $name.dmp
discardline $testdir/$test.dmp \
TEMPFILE "db_pagesize="
file copy -force \
TEMPFILE $testdir/$test.dmp
error_check_good compare_dump \
[filecmp $name.dmp \
$testdir/$test.dmp] 0
fileremove $name.dmp
}
}
}
}
}
set upgrade_dir $saved_upgrade_dir
set o [open UPGRADE.OUT a]
puts -nonewline $o "Completed at: "
puts $o [clock format [clock seconds] -format "%H:%M %D"]
close $o
puts -nonewline "Completed at: "
puts [clock format [clock seconds] -format "%H:%M %D"]
return
}
proc _upgrade_test { temp_dir version method file endianness } {
source include.tcl
global errorInfo
global passwd
global encrypt
puts "Upgrade: $version $method $file $endianness"
if { [string match c-* $file] } {
set encrypt 1
}
set encargs ""
set upgradeargs ""
if { $encrypt == 1 } {
set encargs " -encryptany $passwd "
set upgradeargs " -P $passwd "
}
if { [catch \
{ set db [eval {berkdb open} $encargs \
$temp_dir/$file-$endianness.db] } res] } {
error_check_good old_version [is_substr $res DB_OLDVERSION] 1
} else {
error_check_good db_close [$db close] 0
}
set ret [catch {eval exec {$util_path/db_upgrade} $upgradeargs \
"$temp_dir/$file-$endianness.db" } message]
error_check_good dbupgrade $ret 0
error_check_good dbupgrade_verify [verify_dir $temp_dir "" 0 0 1] 0
upgrade_dump "$temp_dir/$file-$endianness.db" "$temp_dir/temp.dump"
error_check_good "Upgrade diff.$endianness: $version $method $file" \
[filecmp "$temp_dir/$file.tcldump" "$temp_dir/temp.dump"] 0
}
proc _db_load_test { temp_dir version method file } {
source include.tcl
global errorInfo
puts "Db_load: $version $method $file"
set ret [catch \
{exec $util_path/db_load -f "$temp_dir/$file.dump" \
"$temp_dir/upgrade.db"} message]
error_check_good \
"Upgrade load: $version $method $file $message" $ret 0
upgrade_dump "$temp_dir/upgrade.db" "$temp_dir/temp.dump"
error_check_good "Upgrade diff.1.1: $version $method $file" \
[filecmp "$temp_dir/$file.tcldump" "$temp_dir/temp.dump"] 0
}
proc _log_test { temp_dir release method file } {
source ./include.tcl
global saved_logvers
global passwd
puts "Check log file: $temp_dir $release $method $file"
set env [berkdb_env -create -log -home $testdir]
error_check_good is_valid_env [is_valid_env $env] TRUE
set current_logvers [get_log_vers $env]
error_check_good env_close [$env close] 0
error_check_good env_remove [berkdb envremove -home $testdir] 0
set logfiles [glob -nocomplain $temp_dir/*log.0*]
foreach logfile $logfiles {
set logname [string replace $logfile 0 \
[string last - $logfile]]
file rename -force $logfile $temp_dir/$logname
}
set ret [catch {exec $util_path/db_printlog -h $temp_dir \
> $temp_dir/logs.prlog} message]
if { [is_substr $message "magic number"] } {
set ret [catch {exec $util_path/db_printlog -h $temp_dir \
-P $passwd > $temp_dir/logs.prlog} message]
if { $ret == 1 } {
if { $current_logvers <= $saved_logvers } {
puts "db_printlog failed: $message"
}
}
}
set logoldver 8
if { $current_logvers > $saved_logvers &&\
$saved_logvers < $logoldver } {
error_check_good historic_log_version \
[is_substr $message "historic log version"] 1
} elseif { $current_logvers > $saved_logvers } {
error_check_good db_printlog:$message $ret 0
} elseif { $current_logvers == $saved_logvers } {
error_check_good db_printlog:$message $ret 0
error_check_good "Compare printlogs" [filecmp \
"$temp_dir/logs.prlog" "$temp_dir/$file.prlog"] 0
} elseif { $current_logvers < $saved_logvers } {
puts -nonewline "FAIL: current log version $current_logvers "
puts "cannot be less than saved log version $save_logvers."
}
}
proc gen_upgrade { dir { save_crypto 1 } { save_non_crypto 1 } } {
global gen_upgrade
global gen_upgrade_log
global gen_chksum
global gen_dump
global upgrade_dir
global upgrade_be
global upgrade_method
global upgrade_name
global valid_methods
global test_names
global parms
global encrypt
global passwd
source ./include.tcl
set upgrade_dir $dir
env_cleanup $testdir
fileremove -f GENERATE.OUT
set o [open GENERATE.OUT a]
puts -nonewline $o "Generating upgrade files. Started at: "
puts $o [clock format [clock seconds] -format "%H:%M %D"]
puts $o [berkdb version -string]
puts -nonewline "Generating upgrade files. Started at: "
puts [clock format [clock seconds] -format "%H:%M %D"]
puts [berkdb version -string]
close $o
set env [berkdb_env -create -log -home $testdir]
error_check_good is_valid_env [is_valid_env $env] TRUE
if { [file exists $dir] == 0 } {
file mkdir $dir
}
set lv [open $dir/logversion w]
puts $lv [get_log_vers $env]
close $lv
error_check_good env_close [$env close] 0
foreach method $valid_methods {
set o [open GENERATE.OUT a]
puts $o "\nGenerating $method files"
close $o
puts "\tGenerating $method files"
set upgrade_method $method
set gen_dump 1
foreach test $test_names(plat) {
set upgrade_name $test
foreach upgrade_be { 0 1 } {
eval $test $method
cleanup $testdir NULL
}
}
set gen_dump 0
set gen_upgrade 1
foreach test $test_names(test) {
if { [info exists parms($test)] != 1 } {
continue
}
set o [open GENERATE.OUT a]
puts $o "\t\tGenerating files for $test"
close $o
puts "\t\tGenerating files for $test"
if { $save_non_crypto == 1 } {
set encrypt 0
foreach upgrade_be { 0 1 } {
set upgrade_name $test
if [catch {exec $tclsh_path \
<< "source $test_path/test.tcl;\
global gen_upgrade upgrade_be;\
global upgrade_method upgrade_name;\
global encrypt;\
set encrypt $encrypt;\
set gen_upgrade 1;\
set upgrade_be $upgrade_be;\
set upgrade_method $upgrade_method;\
set upgrade_name $upgrade_name;\
run_method -$method $test" \
>>& GENERATE.OUT} res] {
puts "FAIL: run_method \
$test $method"
}
cleanup $testdir NULL 1
}
set gen_chksum 1
foreach upgrade_be { 0 1 } {
set upgrade_name $test
if { $test == "test001" } {
if { [catch {exec $tclsh_path \
<< "source $test_path/test.tcl;\
global gen_upgrade;\
global upgrade_be;\
global upgrade_method;\
global upgrade_name;\
global encrypt gen_chksum;\
set encrypt $encrypt;\
set gen_upgrade 1;\
set gen_chksum 1;\
set upgrade_be $upgrade_be;\
set upgrade_method \
$upgrade_method;\
set upgrade_name \
$upgrade_name;\
run_method -$method $test \
0 1 stdout -chksum" \
>>& GENERATE.OUT} res] } {
puts "FAIL: run_method \
$test $method \
-chksum: $res"
}
cleanup $testdir NULL 1
}
}
set gen_chksum 0
}
if { $save_crypto == 1 } {
set upgrade_be [big_endian]
set encrypt 1
set upgrade_name $test
if [catch {exec $tclsh_path \
<< "source $test_path/test.tcl;\
global gen_upgrade upgrade_be;\
global upgrade_method upgrade_name;\
global encrypt passwd;\
set encrypt $encrypt;\
set passwd $passwd;\
set gen_upgrade 1;\
set upgrade_be $upgrade_be;\
set upgrade_method $upgrade_method;\
set upgrade_name $upgrade_name;\
run_secmethod $method $test" \
>>& GENERATE.OUT} res] {
puts "FAIL: run_secmethod \
$test $method"
}
cleanup $testdir NULL 1
}
}
set gen_upgrade 0
}
set upgrade_be [big_endian]
set o [open GENERATE.OUT a]
puts $o "\tGenerating log files"
close $o
puts "\tGenerating log files"
set gen_upgrade_log 1
if { $save_non_crypto == 1 } {
set encrypt 0
if [catch {exec $tclsh_path << "source $test_path/test.tcl;\
global gen_upgrade_log upgrade_be upgrade_dir;\
global encrypt;\
set encrypt $encrypt;\
set gen_upgrade_log $gen_upgrade_log; \
set upgrade_be $upgrade_be;\
set upgrade_dir $upgrade_dir;\
run_recds" >>& GENERATE.OUT} res] {
puts "FAIL: run_recds: $res"
}
}
if { $save_crypto == 1 } {
set encrypt 1
if [catch {exec $tclsh_path << "source $test_path/test.tcl;\
global gen_upgrade_log upgrade_be upgrade_dir;\
global encrypt;\
set encrypt $encrypt;\
set gen_upgrade_log $gen_upgrade_log; \
set upgrade_be $upgrade_be;\
set upgrade_dir $upgrade_dir;\
run_recds " >>& GENERATE.OUT} res] {
puts "FAIL: run_recds with crypto: $res"
}
}
set gen_upgrade_log 0
set o [open GENERATE.OUT a]
puts -nonewline $o "Completed at: "
puts $o [clock format [clock seconds] -format "%H:%M %D"]
puts -nonewline "Completed at: "
puts [clock format [clock seconds] -format "%H:%M %D"]
close $o
}
proc save_upgrade_files { dir } {
global upgrade_dir
global upgrade_be
global upgrade_method
global upgrade_name
global gen_upgrade
global gen_upgrade_log
global gen_dump
global encrypt
global gen_chksum
global passwd
source ./include.tcl
set vers [berkdb version]
set maj [lindex $vers 0]
set min [lindex $vers 1]
if { [big_endian] } {
set myendianness be
} else {
set myendianness le
}
if { $upgrade_be == 1 } {
set version_dir "$myendianness-$maj.${min}be"
set en be
} else {
set version_dir "$myendianness-$maj.${min}le"
set en le
}
set dest $upgrade_dir/$version_dir/$upgrade_method
exec mkdir -p $dest
if { $gen_upgrade == 1 } {
set dbfiles [glob -nocomplain $dir/*.db]
set dumpflag ""
if { $encrypt == 1 } {
set upgrade_name c-$upgrade_name
set dumpflag " -P $passwd "
}
if { $gen_chksum == 1 } {
set upgrade_name s-$upgrade_name
}
foreach dbfile $dbfiles {
set basename [string range $dbfile \
[expr [string length $dir] + 1] end-3]
set newbasename $upgrade_name-$basename
if { [catch {eval exec $util_path/db_dump -k $dumpflag \
$dbfile > $dir/$newbasename.dump} res] } {
puts "FAIL: $res"
}
upgrade_dump $dbfile $dir/$newbasename.tcldump
file rename $dbfile $dir/$newbasename-$en.db
foreach dbq \
[glob -nocomplain $dir/__dbq.$basename.db.*] {
set s [string length $dir/__dbq.]
set newname [string replace $dbq $s \
[expr [string length $basename] + $s - 1] \
$newbasename-$en]
file rename $dbq $newname
}
set cwd [pwd]
cd $dir
catch {eval exec tar -cvf $dest/$newbasename.tar \
[glob $newbasename* __dbq.$newbasename-$en.db.*]}
catch {exec gzip -9v $dest/$newbasename.tar} res
cd $cwd
}
}
if { $gen_upgrade_log == 1 } {
set logfiles [glob -nocomplain $dir/log.*]
if { [llength $logfiles] > 0 } {
set count 0
while { [file exists \
$dest/$upgrade_name-$count-log.tar.gz] \
== 1 } {
incr count
}
set newname $upgrade_name-$count-log
if {[catch {exec $util_path/db_printlog -h $dir > \
$dir/$newname.prlog} res] != 0} {
puts "Regular printlog failed, try encryption"
eval {exec $util_path/db_printlog} -h $dir \
-P $passwd > $dir/$newname.prlog
}
foreach logfile $logfiles {
set lognum [string range $logfile \
end-9 end]
file rename $logfile $dir/$newname.$lognum
}
set cwd [pwd]
cd $dir
catch {eval exec tar -cvf $dest/$newname.tar \
[glob $newname*]}
catch {exec gzip -9v $dest/$newname.tar}
cd $cwd
}
}
if { $gen_dump == 1 } {
set dumpfiles [glob -nocomplain $dir/*.dmp]
foreach dumpfile $dumpfiles {
set basename [string range $dumpfile \
[expr [string length $dir] + 1] end-4]
set newbasename $upgrade_name-$basename
file rename $dumpfile $dir/$newbasename.dmp
set cwd [pwd]
cd $dir
catch {eval exec tar -cvf $dest/$newbasename.tar \
[glob $newbasename.dmp]}
catch {exec gzip -9v $dest/$newbasename.tar} res
cd $cwd
}
}
}
proc upgrade_dump { database file {stripnulls 0} } {
global errorInfo
global encrypt
global passwd
set encargs ""
if { $encrypt == 1 } {
set encargs " -encryptany $passwd "
}
set db [eval {berkdb open} -rdonly $encargs $database]
set dbc [$db cursor]
set f [open $file w+]
fconfigure $f -encoding binary -translation binary
set key_list ""
set pair [$dbc get -first]
while { 1 } {
if { [llength $pair] == 0 } {
break
}
set k [lindex [lindex $pair 0] 0]
lappend key_list $k
set pair [$dbc get -next]
}
set uniq_keys ""
foreach key $key_list {
if { [info exists existence_list($key)] == 0 } {
lappend uniq_keys $key
}
set existence_list($key) 1
}
set key_list $uniq_keys
set key_list [lsort -command _comp $key_list]
set i 0
foreach key $key_list {
set pair [$dbc get -set $key]
if { $stripnulls != 0 } {
set key [strip_null $key]
}
set data_list {}
catch { while { [llength $pair] != 0 } {
set data [lindex [lindex $pair 0] 1]
if { $stripnulls != 0 } {
set data [strip_null $data]
}
lappend data_list [list $data]
set pair [$dbc get -nextdup]
} }
set data_list [lsort -command _comp $data_list]
puts -nonewline $f [binary format i [string length $key]]
puts -nonewline $f $key
puts -nonewline $f [binary format i [llength $data_list]]
for { set j 0 } { $j < [llength $data_list] } { incr j } {
puts -nonewline $f [binary format i [string length \
[concat [lindex $data_list $j]]]]
puts -nonewline $f [concat [lindex $data_list $j]]
}
if { [llength $data_list] == 0 } {
puts "WARNING: zero-length data list"
}
incr i
}
close $f
error_check_good upgrade_dump_c_close [$dbc close] 0
error_check_good upgrade_dump_db_close [$db close] 0
}
proc _comp { a b } {
if { 0 } {
set a [strip_null [concat $a]]
set b [strip_null [concat $b]]
} else {
set an [string first "\0" $a]
set bn [string first "\0" $b]
if { $an != -1 } {
set a [string range $a 0 [expr $an - 1]]
}
if { $bn != -1 } {
set b [string range $b 0 [expr $bn - 1]]
}
}
return [string compare $a $b]
}
proc strip_null { str } {
set len [string length $str]
set last [expr $len - 1]
set termchar [string range $str $last $last]
if { [string compare $termchar \0] == 0 } {
set ret [string range $str 0 [expr $last - 1]]
} else {
set ret $str
}
return $ret
}
proc get_log_vers { env } {
set stat [$env log_stat]
foreach pair $stat {
set msg [lindex $pair 0]
set val [lindex $pair 1]
if { $msg == "Log file Version" } {
return $val
}
}
puts "FAIL: Log file Version not found in log_stat"
return 0
}