tools/hook-scripts/commit-access-control.pl.in - subversion - Git at Google

 #!/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
 #
 # ====================================================================
 # Copyright (c) 2000-2004 CollabNet.  All rights reserved.
 #
 # This software is licensed as described in the file COPYING, which
 # you should have received as part of this distribution.  The terms
 # are also available at http://subversion.tigris.org/license-1.html.
 # If newer versions of this license are posted there, you may use a
 # newer version instead, at your option.
 #
 # This software consists of voluntary contributions made by many
 # individuals.  For exact contribution history, see the revision
 # history and logs, available at http://subversion.tigris.org/.
 # ====================================================================

 # 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 = "@SVN_BINDIR@/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;
     }
 }
	#!/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
	#
	# ====================================================================
	# Copyright (c) 2000-2004 CollabNet. All rights reserved.
	#
	# This software is licensed as described in the file COPYING, which
	# you should have received as part of this distribution. The terms
	# are also available at http://subversion.tigris.org/license-1.html.
	# If newer versions of this license are posted there, you may use a
	# newer version instead, at your option.
	#
	# This software consists of voluntary contributions made by many
	# individuals. For exact contribution history, see the revision
	# history and logs, available at http://subversion.tigris.org/.
	# ====================================================================

	# 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 = "@SVN_BINDIR@/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;
	}
	}