3 # ====================================================================
4 # commit-access-control.pl: check if the user that submitted the
5 # transaction TXN-NAME has the appropriate rights to perform the
6 # commit in repository REPOS using the permissions listed in the
7 # configuration file CONF_FILE.
12 # $LastChangedRevision$
14 # Usage: commit-access-control.pl REPOS TXN-NAME CONF_FILE
16 # ====================================================================
17 # Licensed to the Apache Software Foundation (ASF) under one
18 # or more contributor license agreements. See the NOTICE file
19 # distributed with this work for additional information
20 # regarding copyright ownership. The ASF licenses this file
21 # to you under the Apache License, Version 2.0 (the
22 # "License"); you may not use this file except in compliance
23 # with the License. You may obtain a copy of the License at
25 # http://www.apache.org/licenses/LICENSE-2.0
27 # Unless required by applicable law or agreed to in writing,
28 # software distributed under the License is distributed on an
29 # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
30 # KIND, either express or implied. See the License for the
31 # specific language governing permissions and limitations
33 # ====================================================================
35 # Turn on warnings the best way depending on the Perl version.
38 { require warnings; import warnings; }
45 use Config::IniFiles 2.27;
47 ######################################################################
48 # Configuration section.
51 my $svnlook = "/usr/bin/svnlook";
53 # Since the path to svnlook depends upon the local installation
54 # preferences, check that the required program exists to insure that
55 # the administrator has set up the script properly.
58 foreach my $program ($svnlook)
64 warn "$0: required program `$program' is not executable, ",
71 warn "$0: required program `$program' does not exist, edit $0.\n";
78 ######################################################################
79 # Initial setup/command-line handling.
81 &usage unless @ARGV == 3;
85 my $cfg_filename = shift;
89 &usage("$0: repository directory `$repos' does not exist.");
93 &usage("$0: repository directory `$repos' is not a directory.");
95 unless (-e $cfg_filename)
97 &usage("$0: configuration file `$cfg_filename' does not exist.");
99 unless (-r $cfg_filename)
101 &usage("$0: configuration file `$cfg_filename' is not readable.");
104 # Define two constant subroutines to stand for read-only or read-write
105 # access to the repository.
106 sub ACCESS_READ_ONLY () { 'read-only' }
107 sub ACCESS_READ_WRITE () { 'read-write' }
109 ######################################################################
110 # Load the configuration file and validate it.
111 my $cfg = Config::IniFiles->new(-file => $cfg_filename);
114 die "$0: error in loading configuration file `$cfg_filename'",
115 @Config::IniFiles::errors ? ":\n@Config::IniFiles::errors\n"
119 # Go through each section of the configuration file, validate that
120 # each section has the required parameters and complain about unknown
121 # parameters. Compile any regular expressions.
122 my @sections = $cfg->Sections;
125 foreach my $section (@sections)
127 # First check for any unknown parameters.
128 foreach my $param ($cfg->Parameters($section))
130 next if $param eq 'match';
131 next if $param eq 'users';
132 next if $param eq 'access';
133 warn "$0: config file `$cfg_filename' section `$section' parameter ",
134 "`$param' is being ignored.\n";
135 $cfg->delval($section, $param);
138 my $access = $cfg->val($section, 'access');
141 unless ($access eq ACCESS_READ_ONLY or $access eq ACCESS_READ_WRITE)
143 warn "$0: config file `$cfg_filename' section `$section' sets ",
144 "`access' to illegal value `$access'.\n";
150 warn "$0: config file `$cfg_filename' section `$section' does ",
151 "not set `access' parameter.\n";
155 my $match_regex = $cfg->val($section, 'match');
156 if (defined $match_regex)
158 # To help users that automatically write regular expressions
159 # that match the beginning of absolute paths using ^/,
160 # remove the / character because subversion paths, while
161 # they start at the root level, do not begin with a /.
162 $match_regex =~ s#^\^/#^#;
165 eval { $match_re = qr/$match_regex/ };
168 warn "$0: config file `$cfg_filename' section `$section' ",
169 "`match' regex `$match_regex' does not compile:\n$@\n";
174 $cfg->newval($section, 'match_re', $match_re);
179 warn "$0: config file `$cfg_filename' section `$section' does ",
180 "not set `match' parameter.\n";
187 ######################################################################
188 # Harvest data using svnlook.
190 # Change into /tmp so that svnlook diff can create its .svnlook
192 my $tmp_dir = '/tmp';
194 or die "$0: cannot chdir `$tmp_dir': $!\n";
196 # Get the author from svnlook.
197 my @svnlooklines = &read_from_process($svnlook, 'author', $repos, '-t', $txn);
198 my $author = shift @svnlooklines;
199 unless (length $author)
201 die "$0: txn `$txn' has no author.\n";
204 # Figure out what directories have changed using svnlook..
205 my @dirs_changed = &read_from_process($svnlook, 'dirs-changed', $repos,
208 # Lose the trailing slash in the directory names if one exists, except
209 # in the case of '/'.
211 for (my $i=0; $i<@dirs_changed; ++$i)
213 if ($dirs_changed[$i] eq '/')
219 $dirs_changed[$i] =~ s#^(.+)[/\\]$#$1#;
223 # Figure out what files have changed using svnlook.
225 foreach my $line (&read_from_process($svnlook, 'changed', $repos, '-t', $txn))
227 # Split the line up into the modification code and path, ignoring
228 # property modifications.
229 if ($line =~ /^.. (.*)$/)
231 push(@files_changed, $1);
235 # Create the list of all modified paths.
236 my @changed = (@dirs_changed, @files_changed);
238 # There should always be at least one changed path. If there are
239 # none, then there maybe something fishy going on, so just exit now
240 # indicating that the commit should not proceed.
243 die "$0: no changed paths found in txn `$txn'.\n";
246 ######################################################################
247 # Populate the permissions table.
249 # Set a hash keeping track of the access rights to each path. Because
250 # this is an access control script, set the default permissions to
253 foreach my $path (@changed)
255 $permissions{$path} = ACCESS_READ_ONLY;
258 foreach my $section (@sections)
260 # Decide if this section should be used. It should be used if
261 # there are no users listed at all for this section, or if there
262 # are users listed and the author is one of them.
263 my $use_this_section;
265 # If there are any users listed, then check if the author of this
266 # commit is listed in the list. If not, then delete the section,
267 # because it won't apply.
269 # The configuration file can list users like this on multiple
271 # users = joe@mysite.com betty@mysite.com
272 # users = bob@yoursite.com
274 # Because of the way Config::IniFiles works, check if there are
275 # any users at all with the scalar return from val() and if there,
276 # then get the array value to get all users.
277 my $users = $cfg->val($section, 'users');
278 if (defined $users and length $users)
281 foreach my $entry ($cfg->val($section, 'users'))
285 foreach my $user (split(' ', $entry))
287 if ($author eq $user)
296 $use_this_section = $match_user;
300 $use_this_section = 1;
303 next unless $use_this_section;
305 # Go through each modified path and match it to the regular
306 # expression and set the access right if the regular expression
308 my $access = $cfg->val($section, 'access');
309 my $match_re = $cfg->val($section, 'match_re');
310 foreach my $path (@changed)
312 $permissions{$path} = $access if $path =~ $match_re;
316 # Go through all the modified paths and see if any permissions are
317 # read-only. If so, then fail the commit.
319 foreach my $path (@changed)
321 if ($permissions{$path} ne ACCESS_READ_WRITE)
323 push(@failed_paths, $path);
329 warn "$0: user `$author' does not have permission to commit to ",
330 @failed_paths > 1 ? "these paths:\n " : "this path:\n ",
331 join("\n ", @failed_paths), "\n";
342 die "usage: $0 REPOS TXN-NAME CONF_FILE\n";
345 sub safe_read_from_pipe
349 croak "$0: safe_read_from_pipe passed no arguments.\n";
351 print "Running @_\n";
352 my $pid = open(SAFE_READ, '-|');
353 unless (defined $pid)
355 die "$0: cannot fork: $!\n";
359 open(STDERR, ">&STDOUT")
360 or die "$0: cannot dup STDOUT: $!\n";
362 or die "$0: cannot exec `@_': $!\n";
372 my $exit = $result >> 8;
373 my $signal = $result & 127;
374 my $cd = $result & 128 ? "with core dump" : "";
377 warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
381 return ($result, @output);
389 sub read_from_process
393 croak "$0: read_from_process passed no arguments.\n";
395 my ($status, @output) = &safe_read_from_pipe(@_);
400 die "$0: `@_' failed with this output:\n", join("\n", @output), "\n";
404 die "$0: `@_' failed with no output.\n";