# See the file LICENSE for redistribution information.
#
# Copyright (c) 1999-2003
#	Sleepycat Software.  All rights reserved.
#
# $Id: upgrade.tcl,v 11.32 2003/10/02 15:09:36 sandstro Exp $

source ./include.tcl

global upgrade_dir
# set upgrade_dir "$test_path/upgrade_test"
set upgrade_dir "$test_path/upgrade/databases"

global gen_upgrade
set gen_upgrade 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 upgrade_dir
	global tcl_platform
	global saved_logvers

	set saved_upgrade_dir $upgrade_dir

	# Identify endianness of the machine running upgrade.
	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

		# Test only files where the endianness of the db matches
		# the endianness of the test platform.  These are the
		# meaningful tests:
		# 1.  File generated on le, tested on le
		# 2.  File generated on be, tested on be
		# 3.  Byte-swapped file generated on le, tested on be
		# 4.  Byte-swapped file generated on be, tested on le
		#
		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

					# We exec a separate tclsh for each
					# separate subtest to keep the
					# testing process from consuming a
					# tremendous amount of memory.
					#
					# First we test the .db files.
					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
						}
					}
					# Then we test log files.
					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
						}
					}
				}
			}
		}
	}
	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"]

	# Don't provide a return value.
	return
}

proc _upgrade_test { temp_dir version method file endianness } {
	source include.tcl
	global errorInfo
	global encrypt

	puts "Upgrade: $version $method $file $endianness"

	# Check whether we're working with an encrypted file.
	if { [string match c-* $file] } {
		set encrypt 1
	}
	set ret [berkdb upgrade "$temp_dir/$file-$endianness.db"]
	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"

	# Get log version number of current system
	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

	# Rename recd001-x-log.000000000n to log.000000000n.
	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
	}

	# Use db_printlog to dump the logs.  If the current log file
	# version is greater than the saved log file version, the log
	# files are expected to be unreadable.  If the log file is
	# readable, check that the current printlog dump matches the
	# archived printlog.
 	#
	set ret [catch {exec $util_path/db_printlog -h $temp_dir \
	    > $temp_dir/logs.prlog} message]
	if { [is_substr $message "magic number"] } {
		# The failure is probably due to encryption, try
		# crypto printlog.
		set ret [catch {exec $util_path/db_printlog -h $temp_dir \
		    -P $passwd > $temp_dir/logs.prlog} message]
		if { $ret == 1 } {
			puts "db_printlog failed: $message"
		}
	}
	if { $current_logvers > $saved_logvers } {
		error_check_good unreadable_log_version \
		    [is_substr $message "unreadable log version"] 1
	} else {
		error_check_good db_printlog:$message $ret 0
		# Compare logs.prlog and $file.prlog (should match)
		error_check_good "Compare printlogs" [filecmp \
		    "$temp_dir/logs.prlog" "$temp_dir/$file.prlog"] 0
	}
}

proc gen_upgrade { dir { save_crypto 1 } { save_non_crypto 1 } } {
	global gen_upgrade
	global gen_upgrade_log
	global gen_chksum
	global upgrade_dir
	global upgrade_be
	global upgrade_method
	global upgrade_name
	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

	# Create a file that contains the log version number.
	# If necessary, create the directory to contain the file.
	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

	# Generate test databases for each access method and endianness.
	set gen_upgrade 1
	foreach method \
	    "btree rbtree hash recno rrecno frecno queue queueext" {
		set o [open GENERATE.OUT a]
		puts $o "\nGenerating $method files"
		close $o
		puts "\tGenerating $method files"
		set upgrade_method $method
#set test_names(test) ""
		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
				}
				# Save checksummed files for only one test.
				# Checksumming should work in all or no cases.
				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
			}
			# Save encrypted db's only of native endianness. 
			# Encrypted files are not portable across endianness.
			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 to the native value so log files go to the
	# right place.
	set upgrade_be [big_endian]

	# Generate log files.
	set o [open GENERATE.OUT a]
	puts $o "\tGenerating log files"
	close $o
	puts "\tGenerating log files"

	set gen_upgrade_log 1
	# Pass the global variables and their values to the new tclsh.
	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 encrypt
	global gen_chksum
	global passwd
	source ./include.tcl

	set vers [berkdb version]
	set maj [lindex $vers 0]
	set min [lindex $vers 1]

	# Is this machine big or little endian?  We want to mark
	# the test directories appropriately, since testing
	# little-endian databases generated by a big-endian machine,
	# and/or vice versa, is interesting.
	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 } {
		# Save db files from test001 - testxxx.
		set dbfiles [glob -nocomplain $dir/*.db]
		set dumpflag ""
		# Encrypted files are identified by the prefix "c-".
		if { $encrypt == 1 } {
			set upgrade_name c-$upgrade_name
			set dumpflag " -P $passwd "
		}
		# Checksummed files are identified by the prefix "s-". 
		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

			# db_dump file
			if { [catch {eval exec $util_path/db_dump -k $dumpflag \
			    $dbfile > $dir/$newbasename.dump} res] } {
				puts "FAIL: $res"
			}

			# tcl_dump file
			upgrade_dump $dbfile $dir/$newbasename.tcldump

			# Rename dbfile and any dbq files.
			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 } {
		# Save log files from recd tests.
		set logfiles [glob -nocomplain $dir/log.*]
		if { [llength $logfiles] > 0 } {
			# More than one log.0000000001 file may be produced
			# per recd test, so we generate unique names:
			# recd001-0-log.0000000001, recd001-1-log.0000000001,
			# and so on.
			# We may also have log.0000000001, log.0000000002,
			# and so on, and they will all be dumped together
			# by db_printlog.
			set count 0
			while { [file exists \
			    $dest/$upgrade_name-$count-log.tar.gz] \
			    == 1 } {
				incr count
			}
			set newname $upgrade_name-$count-log

			# Run db_printlog on all the log files
			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
			}

			# Rename each log file so we can identify which
			# recd test created it.
			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
		}
	}
}

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} $encargs $database]
	set dbc [$db cursor]

	set f [open $file w+]
	fconfigure $f -encoding binary -translation binary

	#
	# Get a sorted list of keys
	#
	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]
	}

	# Discard duplicated keys;  we now have a key for each
	# duplicate, not each unique key, and we don't want to get each
	# duplicate multiple times when we iterate over key_list.
	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]

	#
	# Get the data for each key
	#
	set i 0
	foreach key $key_list {
		set pair [$dbc get -set $key]
		if { $stripnulls != 0 } {
			# the Tcl interface to db versions before 3.X
			# added nulls at the end of all keys and data, so
			# we provide functionality to strip that out.
			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]
		} }
		#lsort -command _comp data_list
		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 } {
	# XXX
		set a [strip_null [concat $a]]
		set b [strip_null [concat $b]]
		#return [expr [concat $a] < [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]]
		}
	}
	#puts "$a $b"
	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
}