1#!/usr/local/bin/perl -w 2# ==================================================================== 3# Licensed to the Apache Software Foundation (ASF) under one 4# or more contributor license agreements. See the NOTICE file 5# distributed with this work for additional information 6# regarding copyright ownership. The ASF licenses this file 7# to you under the Apache License, Version 2.0 (the 8# "License"); you may not use this file except in compliance 9# with the License. You may obtain a copy of the License at 10# 11# http://www.apache.org/licenses/LICENSE-2.0 12# 13# Unless required by applicable law or agreed to in writing, 14# software distributed under the License is distributed on an 15# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 16# KIND, either express or implied. See the License for the 17# specific language governing permissions and limitations 18# under the License. 19# ==================================================================== 20 21# A script that allows some simple testing of Subversion, in 22# particular concurrent read, write and read-write access by the 'svn' 23# client. It can also create working copy trees containing a large 24# number of files and directories. All repository access is via the 25# 'svnadmin' and 'svn' commands. 26# 27# This script constructs a repository, and populates it with 28# files. Then it loops making changes to a subset of the files and 29# committing the tree. Thus when two, or more, instances are run in 30# parallel there is concurrent read and write access. Sometimes a 31# commit will fail due to a commit conflict. This is expected, and is 32# automatically resolved by updating the working copy. 33# 34# Each file starts off containing: 35# A0 36# 0 37# A1 38# 1 39# A2 40# . 41# . 42# A9 43# 9 44# 45# The script runs with an ID in the range 0-9, and when it modifies a 46# file it modifes the line that starts with its ID. Thus scripts with 47# different IDs will make changes that can be merged automatically. 48# 49# The main loop is then: 50# 51# step 1: modify a random selection of files 52# 53# step 2: optional sleep or wait for RETURN keypress 54# 55# step 3: update the working copy automatically merging out-of-date files 56# 57# step 4: try to commit, if not successful go to step 3 otherwise go to step 1 58# 59# To allow break-out of potentially infinite loops, the script will 60# terminate if it detects the presence of a "stop file", the path to 61# which is specified with the -S option (default ./stop). This allows 62# the script to be stopped without any danger of interrupting an 'svn' 63# command, which experiment shows may require Berkeley db_recover to 64# be used on the repository. 65# 66# Running the Script 67# ================== 68# 69# Use three xterms all with shells on the same directory. In the 70# first xterm run (note, this will remove anything called repostress 71# in the current directory) 72# 73# % stress.pl -c -s1 74# 75# When the message "Committed revision 1." scrolls pass use the second 76# xterm to run 77# 78# % stress.pl -s1 79# 80# Both xterms will modify, update and commit separate working copies to 81# the same repository. 82# 83# Use the third xterm to touch a file 'stop' to cause the scripts to 84# exit cleanly, i.e. without interrupting an svn command. 85# 86# To run a third, fourth, etc. instance of the script use -i 87# 88# % stress.pl -s1 -i2 89# % stress.pl -s1 -i3 90# 91# Running several instances at once will cause a *lot* of disk 92# activity. I have run ten instances simultaneously on a Linux tmpfs 93# (RAM based) filesystem -- watching ten xterms scroll irregularly 94# can be quite hypnotic! 95 96use strict; 97use IPC::Open3; 98use Getopt::Std; 99use File::Find; 100use File::Path; 101use File::Spec::Functions; 102use Cwd; 103 104# The name of this script, for error messages. 105my $stress = 'stress.pl'; 106 107# When testing BDB 4.4 and later with DB_RECOVER enabled, the criteria 108# for a failed update and commit are a bit looser than otherwise. 109my $dbrecover = undef; 110 111# Repository check/create 112sub init_repo 113 { 114 my ( $repo, $create, $no_sync, $fsfs ) = @_; 115 if ( $create ) 116 { 117 rmtree([$repo]) if -e $repo; 118 my $svnadmin_cmd = "svnadmin create $repo"; 119 $svnadmin_cmd .= " --fs-type bdb" if not $fsfs; 120 $svnadmin_cmd .= " --bdb-txn-nosync" if $no_sync; 121 system( $svnadmin_cmd) and die "$stress: $svnadmin_cmd: failed: $?\n"; 122 open ( CONF, ">>$repo/conf/svnserve.conf") 123 or die "$stress: open svnserve.conf: $!\n"; 124 print CONF "[general]\nanon-access = write\n"; 125 close CONF or die "$stress: close svnserve.conf: $!\n"; 126 } 127 $repo = getcwd . "/$repo" if not file_name_is_absolute $repo; 128 $dbrecover = 1 if -e "$repo/db/__db.register"; 129 print "$stress: BDB automatic database recovery enabled\n" if $dbrecover; 130 return $repo; 131 } 132 133# Check-out a working copy 134sub check_out 135 { 136 my ( $url, $options ) = @_; 137 my $wc_dir = "wcstress.$$"; 138 mkdir "$wc_dir", 0755 or die "$stress: mkdir wcstress.$$: $!\n"; 139 my $svn_cmd = "svn co $url $wc_dir $options"; 140 system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; 141 return $wc_dir; 142 } 143 144# Print status and update. The update is to do any required merges. 145sub status_update 146 { 147 my ( $options, $wc_dir, $wait_for_key, $disable_status, 148 $resolve_conflicts ) = @_; 149 my $svn_cmd = "svn st -u $options $wc_dir"; 150 if ( not $disable_status ) { 151 print "Status:\n"; 152 system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; 153 } 154 print "Press return to update/commit\n" if $wait_for_key; 155 read STDIN, $wait_for_key, 1 if $wait_for_key; 156 print "Updating:\n"; 157 $svn_cmd = "svn up --non-interactive $options $wc_dir"; 158 159 # Check for conflicts during the update. If any exist, we resolve them. 160 my $pid = open3(\*UPDATE_WRITE, \*UPDATE_READ, \*UPDATE_ERR_READ, 161 $svn_cmd); 162 my @conflicts = (); 163 while ( <UPDATE_READ> ) 164 { 165 print; 166 s/\r*$//; # [Windows compat] Remove trailing \r's 167 if ( /^C (.*)$/ ) 168 { 169 push(@conflicts, ($1)) 170 } 171 } 172 173 # Print any errors. 174 my $acceptable_error = 0; 175 while ( <UPDATE_ERR_READ> ) 176 { 177 print; 178 if ($dbrecover) 179 { 180 s/\r*$//; # [Windows compat] Remove trailing \r's 181 $acceptable_error = 1 if ( /^svn:[ ] 182 ( 183 bdb:[ ]PANIC 184 | 185 DB_RUNRECOVERY 186 ) 187 /x ); 188 } 189 } 190 191 # Close up the streams. 192 close UPDATE_ERR_READ or die "$stress: close UPDATE_ERR_READ: $!\n"; 193 close UPDATE_WRITE or die "$stress: close UPDATE_WRITE: $!\n"; 194 close UPDATE_READ or die "$stress: close UPDATE_READ: $!\n"; 195 196 # Get commit subprocess exit status 197 die "$stress: waitpid: $!\n" if $pid != waitpid $pid, 0; 198 die "$stress: unexpected update fail: exit status: $?\n" 199 unless $? == 0 or ( $? == 256 and $acceptable_error ); 200 201 if ($resolve_conflicts) 202 { 203 foreach my $conflict (@conflicts) 204 { 205 $svn_cmd = "svn resolved $conflict"; 206 system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; 207 } 208 } 209 } 210 211# Print status, update and commit. The update is to do any required 212# merges. Returns 0 if the commit succeeds and 1 if it fails due to a 213# conflict. 214sub status_update_commit 215 { 216 my ( $options, $wc_dir, $wait_for_key, $disable_status, 217 $resolve_conflicts ) = @_; 218 status_update $options, $wc_dir, $wait_for_key, $disable_status, \ 219 $resolve_conflicts; 220 print "Committing:\n"; 221 # Use current time as log message 222 my $now_time = localtime; 223 # [Windows compat] Must use double quotes for the log message. 224 my $svn_cmd = "svn ci $options $wc_dir -m \"$now_time\""; 225 226 # Need to handle the commit carefully. It could fail for all sorts 227 # of reasons, but errors that indicate a conflict are "acceptable" 228 # while other errors are not. Thus there is a need to check the 229 # return value and parse the error text. 230 my $pid = open3(\*COMMIT_WRITE, \*COMMIT_READ, \*COMMIT_ERR_READ, 231 $svn_cmd); 232 print while ( <COMMIT_READ> ); 233 234 # Look for acceptable errors, ones we expect to occur due to conflicts 235 my $acceptable_error = 0; 236 while ( <COMMIT_ERR_READ> ) 237 { 238 print; 239 s/\r*$//; # [Windows compat] Remove trailing \r's 240 $acceptable_error = 1 if ( /^svn:[ ] 241 ( 242 .*out[ ]of[ ]date 243 | 244 Conflict[ ]at 245 | 246 Baseline[ ]incorrect 247 | 248 ) 249 /ix ) 250 or ( $dbrecover and ( /^svn:[ ] 251 ( 252 bdb:[ ]PANIC 253 | 254 DB_RUNRECOVERY 255 ) 256 /x )); 257 258 259 } 260 close COMMIT_ERR_READ or die "$stress: close COMMIT_ERR_READ: $!\n"; 261 close COMMIT_WRITE or die "$stress: close COMMIT_WRITE: $!\n"; 262 close COMMIT_READ or die "$stress: close COMMIT_READ: $!\n"; 263 264 # Get commit subprocess exit status 265 die "$stress: waitpid: $!\n" if $pid != waitpid $pid, 0; 266 die "$stress: unexpected commit fail: exit status: $?\n" 267 if ( $? != 0 and $? != 256 ) or ( $? == 256 and $acceptable_error != 1 ); 268 269 return $? == 256 ? 1 : 0; 270 } 271 272# Get a list of all versioned files in the working copy 273{ 274 my @get_list_of_files_helper_array; 275 sub GetListOfFilesHelper 276 { 277 $File::Find::prune = 1 if $File::Find::name =~ m[/.svn]; 278 return if $File::Find::prune or -d; 279 push @get_list_of_files_helper_array, $File::Find::name; 280 } 281 sub GetListOfFiles 282 { 283 my ( $wc_dir ) = @_; 284 @get_list_of_files_helper_array = (); 285 find( \&GetListOfFilesHelper, $wc_dir); 286 return @get_list_of_files_helper_array; 287 } 288} 289 290# Populate a working copy 291sub populate 292 { 293 my ( $dir, $dir_width, $file_width, $depth, $pad, $props ) = @_; 294 return if not $depth--; 295 296 for my $nfile ( 1..$file_width ) 297 { 298 my $filename = "$dir/foo$nfile"; 299 open( FOO, ">$filename" ) or die "$stress: open $filename: $!\n"; 300 301 for my $line ( 0..9 ) 302 { 303 print FOO "A$line\n$line\n" 304 or die "$stress: write to $filename: $!\n"; 305 map { print FOO $_ x 255, "\n"; } ("a", "b", "c", "d") 306 foreach (1..$pad); 307 } 308 print FOO "\$HeadURL: \$\n" 309 or die "$stress: write to $filename: $!\n" if $props; 310 close FOO or die "$stress: close $filename: $!\n"; 311 312 my $svn_cmd = "svn add $filename"; 313 system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; 314 315 if ( $props ) 316 { 317 $svn_cmd = "svn propset svn:eol-style native $filename"; 318 system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; 319 320 $svn_cmd = "svn propset svn:keywords HeadURL $filename"; 321 system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; 322 } 323 } 324 325 if ( $depth ) 326 { 327 for my $ndir ( 1..$dir_width ) 328 { 329 my $dirname = "$dir/bar$ndir"; 330 my $svn_cmd = "svn mkdir $dirname"; 331 system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; 332 333 populate( "$dirname", $dir_width, $file_width, $depth, $pad, 334 $props ); 335 } 336 } 337 } 338 339# Modify a versioned file in the working copy 340sub ModFile 341 { 342 my ( $filename, $mod_number, $id ) = @_; 343 344 # Read file into memory replacing the line that starts with our ID 345 open( FOO, "<$filename" ) or die "$stress: open $filename: $!\n"; 346 my @lines = map { s[(^$id.*)][$1,$mod_number]; $_ } <FOO>; 347 close FOO or die "$stress: close $filename: $!\n"; 348 349 # Write the memory back to the file 350 open( FOO, ">$filename" ) or die "$stress: open $filename: $!\n"; 351 print FOO or die "$stress: print $filename: $!\n" foreach @lines; 352 close FOO or die "$stress: close $filename: $!\n"; 353 } 354 355sub ParseCommandLine 356 { 357 my %cmd_opts; 358 my $usage = " 359usage: stress.pl [-cdfhprW] [-i num] [-n num] [-s secs] [-x num] [-o options] 360 [-D num] [-F num] [-N num] [-P num] [-R path] [-S path] 361 [-U url] 362 363where 364 -c cause repository creation 365 -d don't make the status calls 366 -f use --fs-type fsfs during repository creation 367 -h show this help information (other options will be ignored) 368 -i the ID (valid IDs are 0 to 9, default is 0 if -c given, 1 otherwise) 369 -n the number of sets of changes to commit 370 -p add svn:eol-style and svn:keywords properties to the files 371 -r perform update-time conflict resolution 372 -s the sleep delay (-1 wait for key, 0 none) 373 -x the number of files to modify in each commit 374 -o options to pass for subversion client 375 -D the number of sub-directories per directory in the tree 376 -F the number of files per directory in the tree 377 -N the depth of the tree 378 -P the number of 10K blocks with which to pad the file 379 -R the path to the repository 380 -S the path to the file whose presence stops this script 381 -U the URL to the repository (file:///<-R path> by default) 382 -W use --bdb-txn-nosync during repository creation 383"; 384 385 # defaults 386 $cmd_opts{'D'} = 2; # number of subdirs per dir 387 $cmd_opts{'F'} = 2; # number of files per dir 388 $cmd_opts{'N'} = 2; # depth 389 $cmd_opts{'P'} = 0; # padding blocks 390 $cmd_opts{'R'} = "repostress"; # repository name 391 $cmd_opts{'S'} = "stop"; # path of file to stop the script 392 $cmd_opts{'U'} = "none"; # URL 393 $cmd_opts{'W'} = 0; # create with --bdb-txn-nosync 394 $cmd_opts{'c'} = 0; # create repository 395 $cmd_opts{'d'} = 0; # disable status 396 $cmd_opts{'f'} = 0; # create with --fs-type fsfs 397 $cmd_opts{'h'} = 0; # help 398 $cmd_opts{'i'} = 0; # ID 399 $cmd_opts{'n'} = 200; # sets of changes 400 $cmd_opts{'p'} = 0; # add file properties 401 $cmd_opts{'r'} = 0; # conflict resolution 402 $cmd_opts{'s'} = -1; # sleep interval 403 $cmd_opts{'x'} = 4; # files to modify 404 $cmd_opts{'o'} = ""; # no options passed 405 406 getopts( 'cdfhi:n:prs:x:o:D:F:N:P:R:S:U:W', \%cmd_opts ) or die $usage; 407 408 # print help info (and exit nicely) if requested 409 if ( $cmd_opts{'h'} ) 410 { 411 print( $usage ); 412 exit 0; 413 } 414 415 # default ID if not set 416 $cmd_opts{'i'} = 1 - $cmd_opts{'c'} if not $cmd_opts{'i'}; 417 die $usage if $cmd_opts{'i'} !~ /^[0-9]$/; 418 419 return %cmd_opts; 420 } 421 422############################################################################ 423# Main 424 425# Why the fixed seed? I use this script for more than stress testing, 426# I also use it to create test repositories. When creating a test 427# repository, while I don't care exactly which files get modified, I 428# find it useful for the repositories to be reproducible, i.e. to have 429# the same files modified each time. When using this script for 430# stress testing one could remove this fixed seed and Perl will 431# automatically use a pseudo-random seed. However it doesn't much 432# matter, the stress testing really depends on the real-time timing 433# differences between mutiple instances of the script, rather than the 434# randomness of the chosen files. 435srand 123456789; 436 437my %cmd_opts = ParseCommandLine(); 438 439my $repo = init_repo( $cmd_opts{'R'}, $cmd_opts{'c'}, $cmd_opts{'W'}, 440 $cmd_opts{'f'} ); 441 442# [Windows compat] 443# Replace backslashes in the path, and tweak the number of slashes 444# in the scheme separator to make the URL always correct. 445my $urlsep = ($repo =~ m/^\// ? '//' : '///'); 446$repo =~ s/\\/\//g; 447 448# Make URL from path if URL not explicitly specified 449$cmd_opts{'U'} = "file:$urlsep$repo" if $cmd_opts{'U'} eq "none"; 450 451my $wc_dir = check_out $cmd_opts{'U'}, $cmd_opts{'o'}; 452 453if ( $cmd_opts{'c'} ) 454 { 455 my $svn_cmd = "svn mkdir $wc_dir/trunk"; 456 system( $svn_cmd ) and die "$stress: $svn_cmd: failed: $?\n"; 457 populate( "$wc_dir/trunk", $cmd_opts{'D'}, $cmd_opts{'F'}, $cmd_opts{'N'}, 458 $cmd_opts{'P'}, $cmd_opts{'p'} ); 459 status_update_commit $cmd_opts{'o'}, $wc_dir, 0, 1 460 and die "$stress: populate checkin failed\n"; 461 } 462 463my @wc_files = GetListOfFiles $wc_dir; 464die "$stress: not enough files in repository\n" 465 if $#wc_files + 1 < $cmd_opts{'x'}; 466 467my $wait_for_key = $cmd_opts{'s'} < 0; 468 469my $stop_file = $cmd_opts{'S'}; 470 471for my $mod_number ( 1..$cmd_opts{'n'} ) 472 { 473 my @chosen; 474 for ( 1..$cmd_opts{'x'} ) 475 { 476 # Extract random file from list and modify it 477 my $mod_file = splice @wc_files, int rand $#wc_files, 1; 478 ModFile $mod_file, $mod_number, $cmd_opts{'i'}; 479 push @chosen, $mod_file; 480 } 481 # Reinstate list of files, the order doesn't matter 482 push @wc_files, @chosen; 483 484 if ( $cmd_opts{'x'} > 0 ) { 485 # Loop committing until successful or the stop file is created 486 1 while not -e $stop_file 487 and status_update_commit $cmd_opts{'o'}, $wc_dir, $wait_for_key, \ 488 $cmd_opts{'d'}, $cmd_opts{'r'}; 489 } else { 490 status_update $cmd_opts{'o'}, $wc_dir, $wait_for_key, $cmd_opts{'d'}, \ 491 $cmd_opts{'r'}; 492 } 493 494 # Break out of loop, or sleep, if required 495 print( "stop file '$stop_file' detected\n" ), last if -e $stop_file; 496 sleep $cmd_opts{'s'} if $cmd_opts{'s'} > 0; 497 } 498 499