stress.pl

subversion-1.4.3-1.tar.gz 配置svn的源码

#!/usr/bin/perl -w

# 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 ) = @_;
    my $wc_dir = "wcstress.$$";
    mkdir "$wc_dir", 0755 or die "$stress: mkdir wcstress.$$: $!\n";
    my $svn_cmd = "svn co $url $wc_dir";
    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 ( $wc_dir, $wait_for_key, $disable_status, $resolve_conflicts ) = @_;
    my $svn_cmd = "svn st -u $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 $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 ( $wc_dir, $wait_for_key, $disable_status, $resolve_conflicts ) = @_;
    status_update $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 $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
                                    |
                                    Your[ ]file[ ]or[ ]directory[ ]
                                    \'[^\']+\'
                                    [ ]is[ ]probably[ ]out-of-date
                                   )
                                   /x )
            or ( $dbrecover and  ( /^svn:[ ]
                                   (
                                    bdb:[ ]PANIC
                                    |
                                    DB_RUNRECOVERY
                                   )
                                   /x ));