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