diff options
Diffstat (limited to 'tools/dev/stress.pl')
| -rwxr-xr-x | tools/dev/stress.pl | 498 |
1 files changed, 498 insertions, 0 deletions
diff --git a/tools/dev/stress.pl b/tools/dev/stress.pl new file mode 100755 index 0000000..5b76be3 --- /dev/null +++ b/tools/dev/stress.pl @@ -0,0 +1,498 @@ +#!/usr/bin/perl -w +# ==================================================================== +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. +# ==================================================================== + +# A script that allows some simple testing of Subversion, in +# particular concurrent read, write and read-write access by the 'svn' +# client. It can also create working copy trees containing a large +# number of files and directories. All repository access is via the +# 'svnadmin' and 'svn' commands. +# +# This script constructs a repository, and populates it with +# files. Then it loops making changes to a subset of the files and +# committing the tree. Thus when two, or more, instances are run in +# parallel there is concurrent read and write access. Sometimes a +# commit will fail due to a commit conflict. This is expected, and is +# automatically resolved by updating the working copy. +# +# Each file starts off containing: +# A0 +# 0 +# A1 +# 1 +# A2 +# . +# . +# A9 +# 9 +# +# The script runs with an ID in the range 0-9, and when it modifies a +# file it modifes the line that starts with its ID. Thus scripts with +# different IDs will make changes that can be merged automatically. +# +# The main loop is then: +# +# step 1: modify a random selection of files +# +# step 2: optional sleep or wait for RETURN keypress +# +# step 3: update the working copy automatically merging out-of-date files +# +# step 4: try to commit, if not successful go to step 3 otherwise go to step 1 +# +# To allow break-out of potentially infinite loops, the script will +# terminate if it detects the presence of a "stop file", the path to +# which is specified with the -S option (default ./stop). This allows +# the script to be stopped without any danger of interrupting an 'svn' +# command, which experiment shows may require Berkeley db_recover to +# be used on the repository. +# +# Running the Script +# ================== +# +# Use three xterms all with shells on the same directory. In the +# first xterm run (note, this will remove anything called repostress +# in the current directory) +# +# % stress.pl -c -s1 +# +# When the message "Committed revision 1." scrolls pass use the second +# xterm to run +# +# % stress.pl -s1 +# +# Both xterms will modify, update and commit separate working copies to +# the same repository. +# +# Use the third xterm to touch a file 'stop' to cause the scripts to +# exit cleanly, i.e. without interrupting an svn command. +# +# To run a third, fourth, etc. instance of the script use -i +# +# % stress.pl -s1 -i2 +# % stress.pl -s1 -i3 +# +# Running several instances at once will cause a *lot* of disk +# activity. I have run ten instances simultaneously on a Linux tmpfs +# (RAM based) filesystem -- watching ten xterms scroll irregularly +# can be quite hypnotic! + +use strict; +use IPC::Open3; +use Getopt::Std; +use File::Find; +use File::Path; +use File::Spec::Functions; +use Cwd; + +# The name of this script, for error messages. +my $stress = 'stress.pl'; + +# When testing BDB 4.4 and later with DB_RECOVER enabled, the criteria +# for a failed update and commit are a bit looser than otherwise. +my $dbrecover = undef; + +# Repository check/create +sub init_repo + { + my ( $repo, $create, $no_sync, $fsfs ) = @_; + if ( $create ) + { + rmtree([$repo]) if -e $repo; + my $svnadmin_cmd = "svnadmin create $repo"; + $svnadmin_cmd .= " --fs-type bdb" if not $fsfs; + $svnadmin_cmd .= " --bdb-txn-nosync" if $no_sync; + system( $svnadmin_cmd) and die "$stress: $svnadmin_cmd: failed: $?\n"; + open ( CONF, ">>$repo/conf/svnserve.conf") + or die "$stress: open svnserve.conf: $!\n"; + print CONF "[general]\nanon-access = write\n"; + close CONF or die "$stress: close svnserve.conf: $!\n"; + } + $repo = getcwd . "/$repo" if not file_name_is_absolute $repo; + $dbrecover = 1 if -e "$repo/db/__db.register"; + print "$stress: BDB automatic database recovery enabled\n" if $dbrecover; + return $repo; + } + +# Check-out a working copy +sub check_out + { + my ( $url, $options ) = @_; + my $wc_dir = "wcstress.$$"; + mkdir "$wc_dir", 0755 or die "$stress: mkdir wcstress.$$: $!\n"; + my $svn_cmd = "svn co $url $wc_dir $options"; + system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; + return $wc_dir; + } + +# Print status and update. The update is to do any required merges. +sub status_update + { + my ( $options, $wc_dir, $wait_for_key, $disable_status, + $resolve_conflicts ) = @_; + my $svn_cmd = "svn st -u $options $wc_dir"; + if ( not $disable_status ) { + print "Status:\n"; + system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; + } + print "Press return to update/commit\n" if $wait_for_key; + read STDIN, $wait_for_key, 1 if $wait_for_key; + print "Updating:\n"; + $svn_cmd = "svn up --non-interactive $options $wc_dir"; + + # Check for conflicts during the update. If any exist, we resolve them. + my $pid = open3(\*UPDATE_WRITE, \*UPDATE_READ, \*UPDATE_ERR_READ, + $svn_cmd); + my @conflicts = (); + while ( <UPDATE_READ> ) + { + print; + s/\r*$//; # [Windows compat] Remove trailing \r's + if ( /^C (.*)$/ ) + { + push(@conflicts, ($1)) + } + } + + # Print any errors. + my $acceptable_error = 0; + while ( <UPDATE_ERR_READ> ) + { + print; + if ($dbrecover) + { + s/\r*$//; # [Windows compat] Remove trailing \r's + $acceptable_error = 1 if ( /^svn:[ ] + ( + bdb:[ ]PANIC + | + DB_RUNRECOVERY + ) + /x ); + } + } + + # Close up the streams. + close UPDATE_ERR_READ or die "$stress: close UPDATE_ERR_READ: $!\n"; + close UPDATE_WRITE or die "$stress: close UPDATE_WRITE: $!\n"; + close UPDATE_READ or die "$stress: close UPDATE_READ: $!\n"; + + # Get commit subprocess exit status + die "$stress: waitpid: $!\n" if $pid != waitpid $pid, 0; + die "$stress: unexpected update fail: exit status: $?\n" + unless $? == 0 or ( $? == 256 and $acceptable_error ); + + if ($resolve_conflicts) + { + foreach my $conflict (@conflicts) + { + $svn_cmd = "svn resolved $conflict"; + system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; + } + } + } + +# Print status, update and commit. The update is to do any required +# merges. Returns 0 if the commit succeeds and 1 if it fails due to a +# conflict. +sub status_update_commit + { + my ( $options, $wc_dir, $wait_for_key, $disable_status, + $resolve_conflicts ) = @_; + status_update $options, $wc_dir, $wait_for_key, $disable_status, \ + $resolve_conflicts; + print "Committing:\n"; + # Use current time as log message + my $now_time = localtime; + # [Windows compat] Must use double quotes for the log message. + my $svn_cmd = "svn ci $options $wc_dir -m \"$now_time\""; + + # Need to handle the commit carefully. It could fail for all sorts + # of reasons, but errors that indicate a conflict are "acceptable" + # while other errors are not. Thus there is a need to check the + # return value and parse the error text. + my $pid = open3(\*COMMIT_WRITE, \*COMMIT_READ, \*COMMIT_ERR_READ, + $svn_cmd); + print while ( <COMMIT_READ> ); + + # Look for acceptable errors, ones we expect to occur due to conflicts + my $acceptable_error = 0; + while ( <COMMIT_ERR_READ> ) + { + print; + s/\r*$//; # [Windows compat] Remove trailing \r's + $acceptable_error = 1 if ( /^svn:[ ] + ( + .*out[ ]of[ ]date + | + Conflict[ ]at + | + Baseline[ ]incorrect + | + ) + /ix ) + or ( $dbrecover and ( /^svn:[ ] + ( + bdb:[ ]PANIC + | + DB_RUNRECOVERY + ) + /x )); + + + } + close COMMIT_ERR_READ or die "$stress: close COMMIT_ERR_READ: $!\n"; + close COMMIT_WRITE or die "$stress: close COMMIT_WRITE: $!\n"; + close COMMIT_READ or die "$stress: close COMMIT_READ: $!\n"; + + # Get commit subprocess exit status + die "$stress: waitpid: $!\n" if $pid != waitpid $pid, 0; + die "$stress: unexpected commit fail: exit status: $?\n" + if ( $? != 0 and $? != 256 ) or ( $? == 256 and $acceptable_error != 1 ); + + return $? == 256 ? 1 : 0; + } + +# Get a list of all versioned files in the working copy +{ + my @get_list_of_files_helper_array; + sub GetListOfFilesHelper + { + $File::Find::prune = 1 if $File::Find::name =~ m[/.svn]; + return if $File::Find::prune or -d; + push @get_list_of_files_helper_array, $File::Find::name; + } + sub GetListOfFiles + { + my ( $wc_dir ) = @_; + @get_list_of_files_helper_array = (); + find( \&GetListOfFilesHelper, $wc_dir); + return @get_list_of_files_helper_array; + } +} + +# Populate a working copy +sub populate + { + my ( $dir, $dir_width, $file_width, $depth, $pad, $props ) = @_; + return if not $depth--; + + for my $nfile ( 1..$file_width ) + { + my $filename = "$dir/foo$nfile"; + open( FOO, ">$filename" ) or die "$stress: open $filename: $!\n"; + + for my $line ( 0..9 ) + { + print FOO "A$line\n$line\n" + or die "$stress: write to $filename: $!\n"; + map { print FOO $_ x 255, "\n"; } ("a", "b", "c", "d") + foreach (1..$pad); + } + print FOO "\$HeadURL: \$\n" + or die "$stress: write to $filename: $!\n" if $props; + close FOO or die "$stress: close $filename: $!\n"; + + my $svn_cmd = "svn add $filename"; + system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; + + if ( $props ) + { + $svn_cmd = "svn propset svn:eol-style native $filename"; + system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; + + $svn_cmd = "svn propset svn:keywords HeadURL $filename"; + system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; + } + } + + if ( $depth ) + { + for my $ndir ( 1..$dir_width ) + { + my $dirname = "$dir/bar$ndir"; + my $svn_cmd = "svn mkdir $dirname"; + system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; + + populate( "$dirname", $dir_width, $file_width, $depth, $pad, + $props ); + } + } + } + +# Modify a versioned file in the working copy +sub ModFile + { + my ( $filename, $mod_number, $id ) = @_; + + # Read file into memory replacing the line that starts with our ID + open( FOO, "<$filename" ) or die "$stress: open $filename: $!\n"; + my @lines = map { s[(^$id.*)][$1,$mod_number]; $_ } <FOO>; + close FOO or die "$stress: close $filename: $!\n"; + + # Write the memory back to the file + open( FOO, ">$filename" ) or die "$stress: open $filename: $!\n"; + print FOO or die "$stress: print $filename: $!\n" foreach @lines; + close FOO or die "$stress: close $filename: $!\n"; + } + +sub ParseCommandLine + { + my %cmd_opts; + my $usage = " +usage: stress.pl [-cdfhprW] [-i num] [-n num] [-s secs] [-x num] [-o options] + [-D num] [-F num] [-N num] [-P num] [-R path] [-S path] + [-U url] + +where + -c cause repository creation + -d don't make the status calls + -f use --fs-type fsfs during repository creation + -h show this help information (other options will be ignored) + -i the ID (valid IDs are 0 to 9, default is 0 if -c given, 1 otherwise) + -n the number of sets of changes to commit + -p add svn:eol-style and svn:keywords properties to the files + -r perform update-time conflict resolution + -s the sleep delay (-1 wait for key, 0 none) + -x the number of files to modify in each commit + -o options to pass for subversion client + -D the number of sub-directories per directory in the tree + -F the number of files per directory in the tree + -N the depth of the tree + -P the number of 10K blocks with which to pad the file + -R the path to the repository + -S the path to the file whose presence stops this script + -U the URL to the repository (file:///<-R path> by default) + -W use --bdb-txn-nosync during repository creation +"; + + # defaults + $cmd_opts{'D'} = 2; # number of subdirs per dir + $cmd_opts{'F'} = 2; # number of files per dir + $cmd_opts{'N'} = 2; # depth + $cmd_opts{'P'} = 0; # padding blocks + $cmd_opts{'R'} = "repostress"; # repository name + $cmd_opts{'S'} = "stop"; # path of file to stop the script + $cmd_opts{'U'} = "none"; # URL + $cmd_opts{'W'} = 0; # create with --bdb-txn-nosync + $cmd_opts{'c'} = 0; # create repository + $cmd_opts{'d'} = 0; # disable status + $cmd_opts{'f'} = 0; # create with --fs-type fsfs + $cmd_opts{'h'} = 0; # help + $cmd_opts{'i'} = 0; # ID + $cmd_opts{'n'} = 200; # sets of changes + $cmd_opts{'p'} = 0; # add file properties + $cmd_opts{'r'} = 0; # conflict resolution + $cmd_opts{'s'} = -1; # sleep interval + $cmd_opts{'x'} = 4; # files to modify + $cmd_opts{'o'} = ""; # no options passed + + getopts( 'cdfhi:n:prs:x:o:D:F:N:P:R:S:U:W', \%cmd_opts ) or die $usage; + + # print help info (and exit nicely) if requested + if ( $cmd_opts{'h'} ) + { + print( $usage ); + exit 0; + } + + # default ID if not set + $cmd_opts{'i'} = 1 - $cmd_opts{'c'} if not $cmd_opts{'i'}; + die $usage if $cmd_opts{'i'} !~ /^[0-9]$/; + + return %cmd_opts; + } + +############################################################################ +# Main + +# Why the fixed seed? I use this script for more than stress testing, +# I also use it to create test repositories. When creating a test +# repository, while I don't care exactly which files get modified, I +# find it useful for the repositories to be reproducible, i.e. to have +# the same files modified each time. When using this script for +# stress testing one could remove this fixed seed and Perl will +# automatically use a pseudo-random seed. However it doesn't much +# matter, the stress testing really depends on the real-time timing +# differences between mutiple instances of the script, rather than the +# randomness of the chosen files. +srand 123456789; + +my %cmd_opts = ParseCommandLine(); + +my $repo = init_repo( $cmd_opts{'R'}, $cmd_opts{'c'}, $cmd_opts{'W'}, + $cmd_opts{'f'} ); + +# [Windows compat] +# Replace backslashes in the path, and tweak the number of slashes +# in the scheme separator to make the URL always correct. +my $urlsep = ($repo =~ m/^\// ? '//' : '///'); +$repo =~ s/\\/\//g; + +# Make URL from path if URL not explicitly specified +$cmd_opts{'U'} = "file:$urlsep$repo" if $cmd_opts{'U'} eq "none"; + +my $wc_dir = check_out $cmd_opts{'U'}, $cmd_opts{'o'}; + +if ( $cmd_opts{'c'} ) + { + my $svn_cmd = "svn mkdir $wc_dir/trunk"; + system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; + populate( "$wc_dir/trunk", $cmd_opts{'D'}, $cmd_opts{'F'}, $cmd_opts{'N'}, + $cmd_opts{'P'}, $cmd_opts{'p'} ); + status_update_commit $cmd_opts{'o'}, $wc_dir, 0, 1 + and die "$stress: populate checkin failed\n"; + } + +my @wc_files = GetListOfFiles $wc_dir; +die "$stress: not enough files in repository\n" + if $#wc_files + 1 < $cmd_opts{'x'}; + +my $wait_for_key = $cmd_opts{'s'} < 0; + +my $stop_file = $cmd_opts{'S'}; + +for my $mod_number ( 1..$cmd_opts{'n'} ) + { + my @chosen; + for ( 1..$cmd_opts{'x'} ) + { + # Extract random file from list and modify it + my $mod_file = splice @wc_files, int rand $#wc_files, 1; + ModFile $mod_file, $mod_number, $cmd_opts{'i'}; + push @chosen, $mod_file; + } + # Reinstate list of files, the order doesn't matter + push @wc_files, @chosen; + + if ( $cmd_opts{'x'} > 0 ) { + # Loop committing until successful or the stop file is created + 1 while not -e $stop_file + and status_update_commit $cmd_opts{'o'}, $wc_dir, $wait_for_key, \ + $cmd_opts{'d'}, $cmd_opts{'r'}; + } else { + status_update $cmd_opts{'o'}, $wc_dir, $wait_for_key, $cmd_opts{'d'}, \ + $cmd_opts{'r'}; + } + + # Break out of loop, or sleep, if required + print( "stop file '$stop_file' detected\n" ), last if -e $stop_file; + sleep $cmd_opts{'s'} if $cmd_opts{'s'} > 0; + } + |