mirror of
				https://github.com/MariaDB/server.git
				synced 2025-11-03 14:33:32 +03:00 
			
		
		
		
	
		
			
				
	
	
		
			231 lines
		
	
	
		
			6.5 KiB
		
	
	
	
		
			Tcl
		
	
	
	
	
	
			
		
		
	
	
			231 lines
		
	
	
		
			6.5 KiB
		
	
	
	
		
			Tcl
		
	
	
	
	
	
# See the file LICENSE for redistribution information.
 | 
						|
#
 | 
						|
# Copyright (c) 1996-2002
 | 
						|
#	Sleepycat Software.  All rights reserved.
 | 
						|
#
 | 
						|
# $Id: archive.tcl,v 11.20 2002/04/30 19:21:21 sue Exp $
 | 
						|
#
 | 
						|
# Options are:
 | 
						|
# -checkrec <checkpoint frequency"
 | 
						|
# -dir <dbhome directory>
 | 
						|
# -maxfilesize <maxsize of log file>
 | 
						|
proc archive { args } {
 | 
						|
	global alphabet
 | 
						|
	source ./include.tcl
 | 
						|
 | 
						|
	# Set defaults
 | 
						|
	set maxbsize [expr 8 * 1024]
 | 
						|
	set maxfile [expr 32 * 1024]
 | 
						|
	set checkrec 500
 | 
						|
	for { set i 0 } { $i < [llength $args] } {incr i} {
 | 
						|
		switch -regexp -- [lindex $args $i] {
 | 
						|
			-c.* { incr i; set checkrec [lindex $args $i] }
 | 
						|
			-d.* { incr i; set testdir [lindex $args $i] }
 | 
						|
			-m.* { incr i; set maxfile [lindex $args $i] }
 | 
						|
			default {
 | 
						|
				puts "FAIL:[timestamp] archive usage"
 | 
						|
	puts "usage: archive -checkrec <checkpt freq> \
 | 
						|
	    -dir <directory> -maxfilesize <max size of log files>"
 | 
						|
				return
 | 
						|
			}
 | 
						|
 | 
						|
		}
 | 
						|
	}
 | 
						|
 | 
						|
	# Clean out old log if it existed
 | 
						|
	puts "Archive: Log archive test"
 | 
						|
	puts "Unlinking log: error message OK"
 | 
						|
	env_cleanup $testdir
 | 
						|
 | 
						|
	# Now run the various functionality tests
 | 
						|
	set eflags "-create -txn -home $testdir \
 | 
						|
	    -log_buffer $maxbsize -log_max $maxfile"
 | 
						|
	set dbenv [eval {berkdb_env} $eflags]
 | 
						|
	error_check_bad dbenv $dbenv NULL
 | 
						|
	error_check_good dbenv [is_substr $dbenv env] 1
 | 
						|
 | 
						|
	set logc [$dbenv log_cursor]
 | 
						|
	error_check_good log_cursor [is_valid_logc $logc $dbenv] TRUE
 | 
						|
 | 
						|
	# The basic test structure here is that we write a lot of log
 | 
						|
	# records (enough to fill up 100 log files; each log file it
 | 
						|
	# small).  We take periodic checkpoints.  Between each pair
 | 
						|
	# of checkpoints, we refer to 2 files, overlapping them each
 | 
						|
	# checkpoint.  We also start transactions and let them overlap
 | 
						|
	# checkpoints as well.  The pattern that we try to create is:
 | 
						|
	# ---- write log records----|||||--- write log records ---
 | 
						|
	# -T1 T2 T3 --- D1 D2 ------CHECK--- CT1 --- D2 D3 CD1 ----CHECK
 | 
						|
	# where TX is begin transaction, CTx is commit transaction, DX is
 | 
						|
	# open data file and CDx is close datafile.
 | 
						|
 | 
						|
	set baserec "1:$alphabet:2:$alphabet:3:$alphabet:4:$alphabet"
 | 
						|
	puts "\tArchive.a: Writing log records; checkpoint every $checkrec records"
 | 
						|
	set nrecs $maxfile
 | 
						|
	set rec 0:$baserec
 | 
						|
 | 
						|
	# Begin transaction and write a log record
 | 
						|
	set t1 [$dbenv txn]
 | 
						|
	error_check_good t1:txn_begin [is_substr $t1 "txn"] 1
 | 
						|
 | 
						|
	set l1 [$dbenv log_put $rec]
 | 
						|
	error_check_bad l1:log_put [llength $l1] 0
 | 
						|
 | 
						|
	set lsnlist [list [lindex $l1 0]]
 | 
						|
 | 
						|
	set t2 [$dbenv txn]
 | 
						|
	error_check_good t2:txn_begin [is_substr $t2 "txn"] 1
 | 
						|
 | 
						|
	set l1 [$dbenv log_put $rec]
 | 
						|
	lappend lsnlist [lindex $l1 0]
 | 
						|
 | 
						|
	set t3 [$dbenv txn]
 | 
						|
	set l1 [$dbenv log_put $rec]
 | 
						|
	lappend lsnlist [lindex $l1 0]
 | 
						|
 | 
						|
	set txnlist [list $t1 $t2 $t3]
 | 
						|
	set db1 [eval {berkdb_open} "-create -mode 0644 -hash -env $dbenv ar1"]
 | 
						|
	set db2 [eval {berkdb_open} "-create -mode 0644 -btree -env $dbenv ar2"]
 | 
						|
	set dbcount 3
 | 
						|
	set dblist [list $db1 $db2]
 | 
						|
 | 
						|
	for { set i 1 } { $i <= $nrecs } { incr i } {
 | 
						|
		set rec $i:$baserec
 | 
						|
		set lsn [$dbenv log_put $rec]
 | 
						|
		error_check_bad log_put [llength $lsn] 0
 | 
						|
		if { [expr $i % $checkrec] == 0 } {
 | 
						|
			# Take a checkpoint
 | 
						|
			$dbenv txn_checkpoint
 | 
						|
			set ckp_file [lindex [lindex [$logc get -last] 0] 0]
 | 
						|
			catch { archive_command -h $testdir -a } res_log_full
 | 
						|
			if { [string first db_archive $res_log_full] == 0 } {
 | 
						|
				set res_log_full ""
 | 
						|
			}
 | 
						|
			catch { archive_command -h $testdir } res_log
 | 
						|
			if { [string first db_archive $res_log] == 0 } {
 | 
						|
				set res_log ""
 | 
						|
			}
 | 
						|
			catch { archive_command -h $testdir -l } res_alllog
 | 
						|
			catch { archive_command -h $testdir -a -s } \
 | 
						|
			    res_data_full
 | 
						|
			catch { archive_command -h $testdir -s } res_data
 | 
						|
			error_check_good nlogfiles [llength $res_alllog] \
 | 
						|
			    [lindex [lindex [$logc get -last] 0] 0]
 | 
						|
			error_check_good logs_match [llength $res_log_full] \
 | 
						|
			    [llength $res_log]
 | 
						|
			error_check_good data_match [llength $res_data_full] \
 | 
						|
			    [llength $res_data]
 | 
						|
 | 
						|
			# Check right number of log files
 | 
						|
			error_check_good nlogs [llength $res_log] \
 | 
						|
			    [expr [lindex $lsnlist 0] - 1]
 | 
						|
 | 
						|
			# Check that the relative names are a subset of the
 | 
						|
			# full names
 | 
						|
			set n 0
 | 
						|
			foreach x $res_log {
 | 
						|
				error_check_bad log_name_match:$res_log \
 | 
						|
				    [string first $x \
 | 
						|
				    [lindex $res_log_full $n]] -1
 | 
						|
				incr n
 | 
						|
			}
 | 
						|
 | 
						|
			set n 0
 | 
						|
			foreach x $res_data {
 | 
						|
				error_check_bad log_name_match:$res_data \
 | 
						|
				    [string first $x \
 | 
						|
				    [lindex $res_data_full $n]] -1
 | 
						|
				incr n
 | 
						|
			}
 | 
						|
 | 
						|
			# Begin/commit any transactions
 | 
						|
			set t [lindex $txnlist 0]
 | 
						|
			if { [string length $t] != 0 } {
 | 
						|
				error_check_good txn_commit:$t [$t commit] 0
 | 
						|
				set txnlist [lrange $txnlist 1 end]
 | 
						|
			}
 | 
						|
			set lsnlist [lrange $lsnlist 1 end]
 | 
						|
 | 
						|
			if { [llength $txnlist] == 0 } {
 | 
						|
				set t1 [$dbenv txn]
 | 
						|
				error_check_bad tx_begin $t1 NULL
 | 
						|
				error_check_good \
 | 
						|
				    tx_begin [is_substr $t1 $dbenv] 1
 | 
						|
				set l1 [lindex [$dbenv log_put $rec] 0]
 | 
						|
				lappend lsnlist [min $l1 $ckp_file]
 | 
						|
 | 
						|
				set t2 [$dbenv txn]
 | 
						|
				error_check_bad tx_begin $t2 NULL
 | 
						|
				error_check_good \
 | 
						|
				    tx_begin [is_substr $t2 $dbenv] 1
 | 
						|
				set l1 [lindex [$dbenv log_put $rec] 0]
 | 
						|
				lappend lsnlist [min $l1 $ckp_file]
 | 
						|
 | 
						|
				set t3 [$dbenv txn]
 | 
						|
				error_check_bad tx_begin $t3 NULL
 | 
						|
				error_check_good \
 | 
						|
				    tx_begin [is_substr $t3 $dbenv] 1
 | 
						|
				set l1 [lindex [$dbenv log_put $rec] 0]
 | 
						|
				lappend lsnlist [min $l1 $ckp_file]
 | 
						|
 | 
						|
				set txnlist [list $t1 $t2 $t3]
 | 
						|
			}
 | 
						|
 | 
						|
			# Open/close some DB files
 | 
						|
			if { [expr $dbcount % 2] == 0 } {
 | 
						|
				set type "-hash"
 | 
						|
			} else {
 | 
						|
				set type "-btree"
 | 
						|
			}
 | 
						|
			set db [eval {berkdb_open} \
 | 
						|
			    "-create -mode 0644 $type -env $dbenv ar$dbcount"]
 | 
						|
			error_check_bad db_open:$dbcount $db NULL
 | 
						|
			error_check_good db_open:$dbcount [is_substr $db db] 1
 | 
						|
			incr dbcount
 | 
						|
 | 
						|
			lappend dblist $db
 | 
						|
			set db [lindex $dblist 0]
 | 
						|
			error_check_good db_close:$db [$db close] 0
 | 
						|
			set dblist [lrange $dblist 1 end]
 | 
						|
 | 
						|
		}
 | 
						|
	}
 | 
						|
	# Commit any transactions still running.
 | 
						|
	puts "\tArchive.b: Commit any transactions still running."
 | 
						|
	foreach t $txnlist {
 | 
						|
		error_check_good txn_commit:$t [$t commit] 0
 | 
						|
	}
 | 
						|
 | 
						|
	# Close any files that are still open.
 | 
						|
	puts "\tArchive.c: Close open files."
 | 
						|
	foreach d $dblist {
 | 
						|
		error_check_good db_close:$db [$d close] 0
 | 
						|
	}
 | 
						|
 | 
						|
	# Close and unlink the file
 | 
						|
	error_check_good log_cursor_close [$logc close] 0
 | 
						|
	reset_env $dbenv
 | 
						|
}
 | 
						|
 | 
						|
proc archive_command { args } {
 | 
						|
	source ./include.tcl
 | 
						|
 | 
						|
	# Catch a list of files output by db_archive.
 | 
						|
	catch { eval exec $util_path/db_archive $args } output
 | 
						|
 | 
						|
	if { $is_windows_test == 1 || 1 } {
 | 
						|
		# On Windows, convert all filenames to use forward slashes.
 | 
						|
		regsub -all {[\\]} $output / output
 | 
						|
	}
 | 
						|
 | 
						|
	# Output the [possibly-transformed] list.
 | 
						|
	return $output
 | 
						|
}
 | 
						|
 | 
						|
proc min { a b } {
 | 
						|
	if {$a < $b} {
 | 
						|
		return $a
 | 
						|
	} else {
 | 
						|
		return $b
 | 
						|
	}
 | 
						|
}
 |