| #!/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; |
| } |
| |
