tools/dev/stress.pl - subversion - Git at Google


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

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