--- /dev/null
+#!/usr/bin/env perl
+
+# ====================================================================
+# commit-access-control.pl: check if the user that submitted the
+# transaction TXN-NAME has the appropriate rights to perform the
+# commit in repository REPOS using the permissions listed in the
+# configuration file CONF_FILE.
+#
+# $HeadURL$
+# $LastChangedDate$
+# $LastChangedBy$
+# $LastChangedRevision$
+#
+# Usage: commit-access-control.pl REPOS TXN-NAME CONF_FILE
+#
+# ====================================================================
+# 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.
+# ====================================================================
+
+# Turn on warnings the best way depending on the Perl version.
+BEGIN {
+ if ( $] >= 5.006_000)
+ { require warnings; import warnings; }
+ else
+ { $^W = 1; }
+}
+
+use strict;
+use Carp;
+use Config::IniFiles 2.27;
+
+######################################################################
+# Configuration section.
+
+# Svnlook path.
+my $svnlook = "/usr/bin/svnlook";
+
+# Since the path to svnlook depends upon the local installation
+# preferences, check that the required program exists to insure that
+# the administrator has set up the script properly.
+{
+ my $ok = 1;
+ foreach my $program ($svnlook)
+ {
+ if (-e $program)
+ {
+ unless (-x $program)
+ {
+ warn "$0: required program `$program' is not executable, ",
+ "edit $0.\n";
+ $ok = 0;
+ }
+ }
+ else
+ {
+ warn "$0: required program `$program' does not exist, edit $0.\n";
+ $ok = 0;
+ }
+ }
+ exit 1 unless $ok;
+}
+
+######################################################################
+# Initial setup/command-line handling.
+
+&usage unless @ARGV == 3;
+
+my $repos = shift;
+my $txn = shift;
+my $cfg_filename = shift;
+
+unless (-e $repos)
+ {
+ &usage("$0: repository directory `$repos' does not exist.");
+ }
+unless (-d $repos)
+ {
+ &usage("$0: repository directory `$repos' is not a directory.");
+ }
+unless (-e $cfg_filename)
+ {
+ &usage("$0: configuration file `$cfg_filename' does not exist.");
+ }
+unless (-r $cfg_filename)
+ {
+ &usage("$0: configuration file `$cfg_filename' is not readable.");
+ }
+
+# Define two constant subroutines to stand for read-only or read-write
+# access to the repository.
+sub ACCESS_READ_ONLY () { 'read-only' }
+sub ACCESS_READ_WRITE () { 'read-write' }
+
+######################################################################
+# Load the configuration file and validate it.
+my $cfg = Config::IniFiles->new(-file => $cfg_filename);
+unless ($cfg)
+ {
+ die "$0: error in loading configuration file `$cfg_filename'",
+ @Config::IniFiles::errors ? ":\n@Config::IniFiles::errors\n"
+ : ".\n";
+ }
+
+# Go through each section of the configuration file, validate that
+# each section has the required parameters and complain about unknown
+# parameters. Compile any regular expressions.
+my @sections = $cfg->Sections;
+{
+ my $ok = 1;
+ foreach my $section (@sections)
+ {
+ # First check for any unknown parameters.
+ foreach my $param ($cfg->Parameters($section))
+ {
+ next if $param eq 'match';
+ next if $param eq 'users';
+ next if $param eq 'access';
+ warn "$0: config file `$cfg_filename' section `$section' parameter ",
+ "`$param' is being ignored.\n";
+ $cfg->delval($section, $param);
+ }
+
+ my $access = $cfg->val($section, 'access');
+ if (defined $access)
+ {
+ unless ($access eq ACCESS_READ_ONLY or $access eq ACCESS_READ_WRITE)
+ {
+ warn "$0: config file `$cfg_filename' section `$section' sets ",
+ "`access' to illegal value `$access'.\n";
+ $ok = 0;
+ }
+ }
+ else
+ {
+ warn "$0: config file `$cfg_filename' section `$section' does ",
+ "not set `access' parameter.\n";
+ $ok = 0;
+ }
+
+ my $match_regex = $cfg->val($section, 'match');
+ if (defined $match_regex)
+ {
+ # To help users that automatically write regular expressions
+ # that match the beginning of absolute paths using ^/,
+ # remove the / character because subversion paths, while
+ # they start at the root level, do not begin with a /.
+ $match_regex =~ s#^\^/#^#;
+
+ my $match_re;
+ eval { $match_re = qr/$match_regex/ };
+ if ($@)
+ {
+ warn "$0: config file `$cfg_filename' section `$section' ",
+ "`match' regex `$match_regex' does not compile:\n$@\n";
+ $ok = 0;
+ }
+ else
+ {
+ $cfg->newval($section, 'match_re', $match_re);
+ }
+ }
+ else
+ {
+ warn "$0: config file `$cfg_filename' section `$section' does ",
+ "not set `match' parameter.\n";
+ $ok = 0;
+ }
+ }
+ exit 1 unless $ok;
+}
+
+######################################################################
+# Harvest data using svnlook.
+
+# Change into /tmp so that svnlook diff can create its .svnlook
+# directory.
+my $tmp_dir = '/tmp';
+chdir($tmp_dir)
+ or die "$0: cannot chdir `$tmp_dir': $!\n";
+
+# Get the author from svnlook.
+my @svnlooklines = &read_from_process($svnlook, 'author', $repos, '-t', $txn);
+my $author = shift @svnlooklines;
+unless (length $author)
+ {
+ die "$0: txn `$txn' has no author.\n";
+ }
+
+# Figure out what directories have changed using svnlook..
+my @dirs_changed = &read_from_process($svnlook, 'dirs-changed', $repos,
+ '-t', $txn);
+
+# Lose the trailing slash in the directory names if one exists, except
+# in the case of '/'.
+my $rootchanged = 0;
+for (my $i=0; $i<@dirs_changed; ++$i)
+ {
+ if ($dirs_changed[$i] eq '/')
+ {
+ $rootchanged = 1;
+ }
+ else
+ {
+ $dirs_changed[$i] =~ s#^(.+)[/\\]$#$1#;
+ }
+ }
+
+# Figure out what files have changed using svnlook.
+my @files_changed;
+foreach my $line (&read_from_process($svnlook, 'changed', $repos, '-t', $txn))
+ {
+ # Split the line up into the modification code and path, ignoring
+ # property modifications.
+ if ($line =~ /^.. (.*)$/)
+ {
+ push(@files_changed, $1);
+ }
+ }
+
+# Create the list of all modified paths.
+my @changed = (@dirs_changed, @files_changed);
+
+# There should always be at least one changed path. If there are
+# none, then there maybe something fishy going on, so just exit now
+# indicating that the commit should not proceed.
+unless (@changed)
+ {
+ die "$0: no changed paths found in txn `$txn'.\n";
+ }
+
+######################################################################
+# Populate the permissions table.
+
+# Set a hash keeping track of the access rights to each path. Because
+# this is an access control script, set the default permissions to
+# read-only.
+my %permissions;
+foreach my $path (@changed)
+ {
+ $permissions{$path} = ACCESS_READ_ONLY;
+ }
+
+foreach my $section (@sections)
+ {
+ # Decide if this section should be used. It should be used if
+ # there are no users listed at all for this section, or if there
+ # are users listed and the author is one of them.
+ my $use_this_section;
+
+ # If there are any users listed, then check if the author of this
+ # commit is listed in the list. If not, then delete the section,
+ # because it won't apply.
+ #
+ # The configuration file can list users like this on multiple
+ # lines:
+ # users = joe@mysite.com betty@mysite.com
+ # users = bob@yoursite.com
+
+ # Because of the way Config::IniFiles works, check if there are
+ # any users at all with the scalar return from val() and if there,
+ # then get the array value to get all users.
+ my $users = $cfg->val($section, 'users');
+ if (defined $users and length $users)
+ {
+ my $match_user = 0;
+ foreach my $entry ($cfg->val($section, 'users'))
+ {
+ unless ($match_user)
+ {
+ foreach my $user (split(' ', $entry))
+ {
+ if ($author eq $user)
+ {
+ $match_user = 1;
+ last;
+ }
+ }
+ }
+ }
+
+ $use_this_section = $match_user;
+ }
+ else
+ {
+ $use_this_section = 1;
+ }
+
+ next unless $use_this_section;
+
+ # Go through each modified path and match it to the regular
+ # expression and set the access right if the regular expression
+ # matches.
+ my $access = $cfg->val($section, 'access');
+ my $match_re = $cfg->val($section, 'match_re');
+ foreach my $path (@changed)
+ {
+ $permissions{$path} = $access if $path =~ $match_re;
+ }
+ }
+
+# Go through all the modified paths and see if any permissions are
+# read-only. If so, then fail the commit.
+my @failed_paths;
+foreach my $path (@changed)
+ {
+ if ($permissions{$path} ne ACCESS_READ_WRITE)
+ {
+ push(@failed_paths, $path);
+ }
+ }
+
+if (@failed_paths)
+ {
+ warn "$0: user `$author' does not have permission to commit to ",
+ @failed_paths > 1 ? "these paths:\n " : "this path:\n ",
+ join("\n ", @failed_paths), "\n";
+ exit 1;
+ }
+else
+ {
+ exit 0;
+ }
+
+sub usage
+{
+ warn "@_\n" if @_;
+ die "usage: $0 REPOS TXN-NAME CONF_FILE\n";
+}
+
+sub safe_read_from_pipe
+{
+ unless (@_)
+ {
+ croak "$0: safe_read_from_pipe passed no arguments.\n";
+ }
+ print "Running @_\n";
+ my $pid = open(SAFE_READ, '-|');
+ unless (defined $pid)
+ {
+ die "$0: cannot fork: $!\n";
+ }
+ unless ($pid)
+ {
+ open(STDERR, ">&STDOUT")
+ or die "$0: cannot dup STDOUT: $!\n";
+ exec(@_)
+ or die "$0: cannot exec `@_': $!\n";
+ }
+ my @output;
+ while (<SAFE_READ>)
+ {
+ chomp;
+ push(@output, $_);
+ }
+ close(SAFE_READ);
+ my $result = $?;
+ my $exit = $result >> 8;
+ my $signal = $result & 127;
+ my $cd = $result & 128 ? "with core dump" : "";
+ if ($signal or $cd)
+ {
+ warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
+ }
+ if (wantarray)
+ {
+ return ($result, @output);
+ }
+ else
+ {
+ return $result;
+ }
+}
+
+sub read_from_process
+ {
+ unless (@_)
+ {
+ croak "$0: read_from_process passed no arguments.\n";
+ }
+ my ($status, @output) = &safe_read_from_pipe(@_);
+ if ($status)
+ {
+ if (@output)
+ {
+ die "$0: `@_' failed with this output:\n", join("\n", @output), "\n";
+ }
+ else
+ {
+ die "$0: `@_' failed with no output.\n";
+ }
+ }
+ else
+ {
+ return @output;
+ }
+}