Index: pre-commit-access-control-hook.pl =================================================================== --- pre-commit-access-control-hook.pl (revision 0) +++ pre-commit-access-control-hook.pl (revision 0) @@ -0,0 +1,861 @@ +#! /usr/local/bin/perl +# pre-commit-access-control-hook.pl +######################################################################## + +######################################################################## +# ACCESS CONTROL HOOK FOR SUBVERSION +# +# Programmed by David Weintraub +# Date: 6-June-2005 +# Revision: $Id: pre-commit-access-control-hook.pl 265 2005-08-10 17:06:42Z weintraub $ +# Purpose: +# To control access to files and properties. This program +# parses a control file that contains the various permission +# definitions. These can define a "Group" to be used for file +# permissioning, a property that must be set for a particular +# file, or a file permission and who is allowed to edit or not +# edit that file. +# +# See comentary in control-file.template for more information. +# +######################################################################## + +######################################################################## +# PERL MODULES +# +use Getopt::Long 2.34; +use Config::IniFiles 2.38; +# +######################################################################## + +######################################################################## +# CONSTANTS +# +*DEFAULT_CONTROL_FILE = \"./control-file"; + our $DEFAULT_CONTROL_FILE; +*DEFAULT_DEBUG_LEVEL = \0; + our $DEFAULT_DEBUG_LEVEL; +#*SVNLOOK_DEFAULT = \"/usr/bin/svnlook"; +*SVNLOOK_DEFAULT = \"/usr/local/bin/svnlook"; + our $SVNLOOK_DEFAULT; + +# +# ####IniFile Groups +# + +*GROUP_GROUP = \"group"; + our $GROUP_GROUP; +*FILE_GROUP = \"file"; + our $FILE_GROUP; +*PROP_GROUP = \"Property"; + our $PROP_GROUP; +*REVPROP_GROUP = \"revprop"; + our $REVPROP_GROUP; +*BANNED_GROUP = \"ban"; + our $BANNED_GROUP; + +# +# ####Permission Types for File Read/Write Access +# + +*READ_PERM = \"read-only"; + our $READ_PERM; +*WRITE_PERM = \"read-write"; + our $WRITE_PERM; +*ADD_PERM = \"add-only"; + our $ADD_PERM; + +# +# ####Types for "Values" for Properties and Revision Properties +# + +*REGEX_TYPE = \"regex"; + our $REGEX_TYPE; +*STRING_TYPE = \"string"; + our $STRING_TYPE; +*NUMBER_TYPE = \"number"; + our $NUMBER_TYPE; + +# +# ####Group Specification Parameters +# + +*GROUP_USERS_STR = \"users"; + our $GROUP_USERS_STR; + +# +# ####File "Read/Write" Specifications Parameters +# + +*FILE_PATTERN_STR = \"match"; + our $FILE_PATTERN_STR; +*PERM_STR = \"access"; + our $PERM_STR; +*FILE_MEMBER_STR = \"users"; + our $FILE_MEMBER_STR; + +# +# ####Property and Revision Property Permission Specification Parameters +# + +*PROP_PATTERN_STR = \"match"; + our $PROP_PATTERN_STR; +*PROP_STR = \"property"; + our $PROP_STR; +*PROP_VAL_STR = \"value"; + our $PROP_VAL_STR; +*PROP_VAL_TYPE_STR = \"type"; + our $PROP_VAL_TYPE_STR; + +# +# ####Banned File Name Specification Parameters +# + +*BANNED_PATTERN_STR = \"match"; + our $BANNED_PATTERN_STR; +# +######################################################################## + +######################################################################## +# USAGE +# +our $USAGE = <] (-r|-t) \\ + [-debug ] [-svnlook ] + where: + : Control File used for determining permissions + defaults to $DEFAULT_CONTROL_FILE. + : Revision Number of archive (for testing) + : Transaction Number of Commit + : The debug level to implement>. Default + is $DEFAULT_DEBUG_LEVEL (zero means no debugging messages) + : Full Path to Repository + : The svnlook command including the full path to + the command. +EOF +# +######################################################################## + +######################################################################## +# PRAGMAS +# +use strict; +use warnings; +# +######################################################################## + +######################################################################## +# OTHER VARIABLES +# +my %groupHash; #Hash of Lists containing group definitions +my @propList; #Array of Hash containing property definitions +my @revPropList; #Array of Hash containing rev property definitions +my @fileList; #Array of Hash containing File Perm definitions +my @bannedFileList; #Array Containing Names of Banned Files +my @sectionList; #Array Containing various Groups of the Ini File +my %sectionHash; #Translates Section Array into Hash lookup +my $svnlookCmd; #The full path and command of "svnlook" +my $lineNumber = 0; +my $author; #Name of user who made the changes +my $cfPtr; #Pointer to Control File's Ini Parameters +my @errorList = (); #List of parsing error from Control File +# +######################################################################## + +######################################################################## +# GET COMMAND LINE OPTIONS +# +my $transactionNum; +my $revisionNum; +my $controlFile; +my $option; +my $repository; +my $debugLevel; + +GetOptions( + "t=s" => \$transactionNum, + "r=i" => \$revisionNum, + "file=s" => \$controlFile, + "debug=i" => \$debugLevel, + "svnlook=s" => \$svnlookCmd +); + +if ($revisionNum and $transactionNum) { + die qq(You cannot specify both a revision and transaction number\n) . + qq($USAGE\n); +} + +unless ($controlFile) { + $controlFile = $DEFAULT_CONTROL_FILE; +} + +unless ($repository = $ARGV[0]) { + die qq(You must specify a repository\n$USAGE\n); +} + +unless ($svnlookCmd) { + $svnlookCmd = $SVNLOOK_DEFAULT; +} + +if ($revisionNum) { + $option = "-r $revisionNum"; +} elsif ($transactionNum) { + $option = "-t $transactionNum"; +} else { + die qq(You must specify either the "-t" or "-r" option\n$USAGE\n); +} + +unless ($debugLevel) { + $debugLevel = $DEFAULT_DEBUG_LEVEL; +} + +######################################################################## +# SUBROUTINE DEBUG +# +sub debug { + if (($debugLevel > 0) && ($_[1] <= $debugLevel)) { + print " " x ($_[1] - 1) if ($_[1] >= 1); + print qq($_[0]\n); + } +} +# +######################################################################## + +######################################################################## +# SUBROUTINE ADD GROUP +# +# Purpose: To add a list of names to the groupHash (Which is a hash of lists) +# +sub addGroup { + my $sectionName = $_[0]; #Ini Parameter Section Name + (my $group = $sectionName) =~ s/^group\s+//; + if($group =~ /\s/) + { + push(@errorList, + qq(Ini Section "$group" has a space in group's name!)); + } + my $members = $cfPtr->val("$sectionName", "$GROUP_USERS_STR"); + + $members =~ s/^\s*//; #Strip Leading Spaces + $members =~ s/\s*$//; #Strip Trailing Spaces + $members =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + unless($members) { + push (@errorList, + qq(Ini Section "$group" has no parameter "$GROUP_USERS_STR" in ) . + qq(file "$controlFile")); + return 1; + } + $group =~ s/^@//; #Remove "@" if on group + foreach my $member (split(/(\s*(\s|,)\s*)/, $members)) { + $member =~ s/\s//g; + $member = lc($member); #Case is insignificant + if($member =~ /^@/) { #This is a group! + $member =~ s/^@//; #Name of Group + if (defined($groupHash{$member})) { + push(@{$groupHash{"$group"}}, @{$groupHash{"$member"}}); + } else { + push(@errorList, + qq(Line #$lineNumber: Group "$member" undefined)); + } + } else { + push(@{$groupHash{"$group"}}, "$member"); + } + } + return 0; +} +# +######################################################################## + +######################################################################## +# SUBROUTINE ADD PROPERTY +# +sub addProp { + my $section = $_[0]; + my $filePattern = $cfPtr->val("$section", "$PROP_PATTERN_STR"); + + $filePattern =~ s/^\s*//; #Strip Leading Spaces + $filePattern =~ s/\s*$//; #Strip Trailing Spaces + $filePattern =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + my $property = $cfPtr->val("$section", "$PROP_STR"); + + $property =~ s/^\s*//; #Strip Leading Spaces + $property =~ s/\s*$//; #Strip Trailing Spaces + $property =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + my $propValue = $cfPtr->val("$section", "$PROP_VAL_STR"); + + $propValue =~ s/^\s*//; #Strip Leading Spaces + $propValue =~ s/\s*$//; #Strip Trailing Spaces + $propValue =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + my $valType = $cfPtr->val("$section", "$PROP_VAL_TYPE_STR"); + + $valType =~ s/^\s*//; #Strip Leading Spaces + $valType =~ s/\s*$//; #Strip Trailing Spaces + $valType =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + unless($filePattern) { + push(@errorList, + qq(Missing parameter "$PROP_PATTERN_STR" in section "$section" ) . + qq(in IniFile "$controlFile")); + } + unless($property) { + push(@errorList, + qq(Missing parameter "$PROP_STR" in section "$section" ) . + qq(in IniFile "$controlFile")); + } + unless($propValue) { + push(@errorList, + qq(Missing parameter "$PROP_VAL_STR" in section "$section" ) . + qq(in IniFile "$controlFile")); + } + unless($valType) { + push(@errorList, + qq(Missing parameter "$PROP_VAL_TYPE_STR" in ) . + qq(section "$section" in IniFile "$controlFile")); + } + unless($valType =~ /^($REGEX_TYPE|$STRING_TYPE|$NUMBER_TYPE)$/i) { + push(@errorList, + qq(Invalid parameter "type" = "$valType" in section "$section" ) . + qq(in IniFile "$controlFile")); + } + my $subscript = $#propList + 1; #Next free entry in @propList + + $filePattern =~ s/^\^\//\^/; #Change "^/" to "^" at start of regex + $propList[$subscript]->{"file"} = $filePattern; + $propList[$subscript]->{"type"} = $valType; + $propList[$subscript]->{"property"} = $property; + $propList[$subscript]->{"value"} = $propValue; + + return 0; +} +# +######################################################################## + +######################################################################## +# SUBROUTINE ADD REVISION PROPERTY +# +sub addRevProp { + my $section = $_[0]; + my $property = $cfPtr->val("$section", "$PROP_STR"); + + $property =~ s/^\s*//; #Strip Leading Spaces + $property =~ s/\s*$//; #Strip Trailing Spaces + $property =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + my $propValue = $cfPtr->val("$section", "$PROP_VAL_STR"); + + $propValue =~ s/^\s*//; #Strip Leading Spaces + $propValue =~ s/\s*$//; #Strip Trailing Spaces + $propValue =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + my $propType = $cfPtr->val("$section", "$PROP_VAL_TYPE_STR"); + + $propType =~ s/^\s*//; #Strip Leading Spaces + $propType =~ s/\s*$//; #Strip Trailing Spaces + $propType =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + + my $subscript = $#revPropList + 1; #Next free entry in @propList + +# +# ####Check Property Type +# + unless($property) { + push(@errorList, + qq("Missing Parameter "$PROP_STR" in section "$section" ) . + qq(in IniFile "$controlFile)); + } + unless($propValue) { + push(@errorList, + qq("Missing Parameter "$PROP_VAL_STR" in section "$section" ) . + qq(in IniFile "$controlFile)); + } + unless($propType =~ /^($REGEX_TYPE|$STRING_TYPE|$NUMBER_TYPE)$/) { + push(@errorList, + qq("Invalid Parameter "$PROP_VAL_TYPE_STR" value = "$propType" ) . + qq(in section "$section" in IniFile "$controlFile)); + } + unless($propType) { + push(@errorList, + qq("Missing Parameter "type" in section "$section" ) . + qq(in IniFile "$controlFile)); + } + $revPropList[$subscript]->{"property"} = $property; + $revPropList[$subscript]->{"value"} = $propValue; + $revPropList[$subscript]->{"type"} = $propType; + + return 0; +} +# +######################################################################## + +######################################################################## +# SUBROUTINE ADD FILE +# +# Purpose: To add a new file permission "record" to a List of Files +# The record consists of a +# * File Regex ("pattern") +# * Permission ("permission") of either "a", "w", or "r" +# * A hash of users with that permission ("member") +# +sub addFile { + my $section = $_[0]; + + my $filePattern = $cfPtr->val("$section", "$FILE_PATTERN_STR"); + + $filePattern =~ s/^\s*//; #Strip Leading Spaces + $filePattern =~ s/\s*$//; #Strip Trailing Spaces + $filePattern =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + my $permission = $cfPtr->val("$section", "$PERM_STR"); + + $permission =~ s/^\s*//; #Strip Leading Spaces + $permission =~ s/\s*$//; #Strip Trailing Spaces + $permission =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + my $members = $cfPtr->val("$section", "$FILE_MEMBER_STR"); + + $members =~ s/^\s*//; #Strip Leading Spaces + $members =~ s/\s*$//; #Strip Trailing Spaces + $members =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + + unless($filePattern) { + push(@errorList, qq(Missing parameter "$FILE_PATTERN_STR" ) . + qq(in section "$section" in IniFile "$controlFile)); + } + + unless ($permission =~ /^($READ_PERM|$WRITE_PERM|$ADD_PERM)$/i) { + push (@errorList, qq(Bad $PERM_STR "$permission" ) . + qq(in section "$section" in IniFile "$controlFile")); + } + + unless($members) { + push (@errorList, qq(Missing parameter "$FILE_MEMBER_STR" ) . + qq(in section "$section in IniFile "$controlFile)); + } + + + $filePattern =~ s/^\^\//\^/; #Change "^/" to "^" at start of regex + my $subscript = $#fileList + 1; #Subscript of fileList Array + $filePattern =~ s//$author/g; + $fileList[$subscript]->{"$FILE_PATTERN_STR"} = $filePattern; +# +# ####Check File Permissions +# + + $fileList[$subscript]->{"permission"} = lc($permission); + +# +# ####Parse Group Permissions +# + + my @memberList = (); + foreach my $member (split(/\s*(,|\s)\s*/, $members)) { + $member =~ s/\s//g; + if ($member eq "\@ALL") { #Special Case: Line for All Users + @memberList = (); + $memberList[0] = "\@ALL"; + last; #All are included. Nothing else to parse + } + $member = lc($member); #Case is insignificant + if($member =~ /^@/) { #This is a group! + $member =~ s/^@//; #Name of Group + if (defined($groupHash{$member})) { + push(@memberList, @{$groupHash{"$member"}}); + } else { + push(@errorList, + qq(Invalid Group \@$member in parameter ) . + qq("$FILE_MEMBER_STR" in section "$section" in ) . + qq(IniFile "$controlFile)); + } + } else { + push(@memberList, "$member"); + } + } + +# +# ####Reformat member group into a hash + + foreach my $member (@memberList) { + $fileList[$subscript]->{"member"}->{"$member"} = 1; + } + return 0; +} +# +######################################################################## + +######################################################################## +# SUBROUTINE ADD BANNED FILE +# +# Purpose: To add a new file name "record" to a List of Files +# that are not allowed to be committed. +# +# The record consists of a +# * File Regex ("pattern") +# +sub addBannedFile { + my $section = $_[0]; + my $filePattern = $cfPtr->val("$section", "$BANNED_PATTERN_STR"); + + $filePattern =~ s/^\s*//; #Strip Leading Spaces + $filePattern =~ s/\s*$//; #Strip Trailing Spaces + $filePattern =~ s/^"(.*)"$/$1/; #Strip Containing Quotes + + (my $reason = $section) =~ s/^$BANNED_GROUP\s+//; + + unless ($filePattern) + { + push(@errorList, qq(Missing parameter "$FILE_PATTERN_STR" from ) . + qq(section "$section" in iniFile "$controlFile"\n)); + } + + my $subscript = $#bannedFileList + 1; #Subscript of fileList Array + $bannedFileList[$subscript]->{"file"} = $filePattern; + $bannedFileList[$subscript]->{"reason"} = $reason; + + return 0; +} +# +######################################################################## + +######################################################################## +# OPEN THE CONTROL FILE +# +unless (-f "$controlFile") { + die "Cannot open file \"$controlFile\" for reading\n"; +} + $cfPtr = Config::IniFiles->new( + -allowcontinue=>1, + -nocase=>1, + -file=>"$controlFile" +); + +if (not defined($cfPtr)) +{ + print STDERR "Error in Parameter file\n"; + my $errors = join ("\n\t\t", @Config::IniFiles::errors); + print qq(\tErrors are:\n\t\t "$errors\n"); + exit 1; +} + +select(STDERR); #Only STDERR lines print out + +# +# ####Need Author for replacing in Parameters +# + +chomp ($author = qx($svnlookCmd author $option $repository)); +# +######################################################################## + +######################################################################## +# ADD GROUPS +# +foreach my $group ($cfPtr->GroupMembers("$GROUP_GROUP")) { + addGroup("$group"); +} +# +######################################################################## + +######################################################################## +# ADD PROPERTIES +# +foreach my $property ($cfPtr->GroupMembers("$PROP_GROUP")) { + addProp("$property"); +} +# +######################################################################## + +######################################################################## +# ADD REVPROPS +# +foreach my $revprop ($cfPtr->GroupMembers("$REVPROP_GROUP")) { + addRevProp("$revprop"); +} +# +######################################################################## + +######################################################################## +# ADD FILES +# +foreach my $file ($cfPtr->GroupMembers("$FILE_GROUP")) { + addFile("$file"); +} +# +######################################################################## + +######################################################################## +# ADD BANNED FILES +# +foreach my $bannedFile ($cfPtr->GroupMembers("$BANNED_GROUP")) { + addBannedFile("$bannedFile"); +} +# +######################################################################## + +######################################################################## +# CHECK FOR ERRORS +# +if (@errorList) { + print qq(Commit failed due to parsing errors in file "$controlFile"\n); + for my $error (@errorList) { + print " $error\n"; + } + print "Number of errors: " . scalar(@errorList) . "\n"; + exit 2; +} +# +######################################################################## + +######################################################################## +# GET INFORMATION ABOUT THE FILES CHANGED +# + +my $cmd = qq("$svnlookCmd" changed $option "$repository"); +open (CHANGED, "$cmd|") + or die qq(Cannot execute the command "$cmd"\n"); + +my @changeList = (); +my @checkPropList = (); +my @addList = (); + +while () { + chomp; + /([\S]+)\s+(.*)/; #Can't use "split". Filename may have spaces + my $status = $1; + my $file = $2; + + if ($status =~ /^U/) { + push (@changeList, $file); #File Modified (Need "write" permission) + push (@checkPropList, $file); #Check Property + } + elsif ($status =~ /^A/) { + push (@addList, "$file"); #File Added (Need "write" or "add" perm) + push (@checkPropList, $file); #Check Property + } + elsif ($status =~ /^D/) { + push (@changeList, $file); #File Modified (Need "write" permission) + } + elsif ($status =~ /^.U/) #File Prop Modified! + { + push (@checkPropList, $file); + } + else + { + die qq(Can't interpret change: "$_"\n); + } +} +# +######################################################################## + +######################################################################## +# FOR EACH FILE, SEE IF YOU HAVE THE PERMISSION TO CHANGE THE FILE +# +# Flag Status: +# 1: Specified Yes (Allowed and default) +# 0: Specifed No (Not Allowed) +# +my @userRejectList = (); #List of rejected files + +# +# ####Check for Modifications (User is either not specified or given "w") +# + +foreach my $file (@changeList) { + my $userWriteFlag = 1; #User Write Permission Not Specified + foreach my $fileEntry (@fileList) { + if ($file =~ /$fileEntry->{"$FILE_PATTERN_STR"}/) { #File =~ pattern + if (($fileEntry->{"member"}->{"$author"}) or + ($fileEntry->{"member"}->{"\@ALL"})) { + if ($fileEntry->{"permission"} =~ /^$WRITE_PERM$/i) { + $userWriteFlag = 1; + } + else { #File has either "add" or "read" permission on it + $userWriteFlag = 0; #User doesn't have permission + } #Checking File Permission + } #If Permission applies to user + } #If pattern matches + } + if ($userWriteFlag == 0) { + push (@userRejectList, qq(No permission to change file "$file")); + } +} + +# +# ####Check for Additions (User not specified or given "a" or "w") +# + +foreach my $file (@addList) { + +# +# ####Checking for Add Permissions for Control-File "file:" Specs +# + + my $userWriteFlag = 1; #User Write Permission Not Specified + foreach my $fileEntry (@fileList) { + if ($file =~ /$fileEntry->{"$FILE_PATTERN_STR"}/) { #File =~ pattern + if (($fileEntry->{"member"}->{"$author"}) or + ($fileEntry->{"member"}->{"\@ALL"})) { + if (($fileEntry->{"permission"} =~ /^$ADD_PERM$/i) && + ($file =~ /\/$/)) #Only Add Directories! + { + $userWriteFlag = 1; + } + elsif ($fileEntry->{"permission"} =~ /^$WRITE_PERM$/i) { + $userWriteFlag = 1; #User has write perm + } + else { + $userWriteFlag = 0; #User doesn't have permission + } #Checking File Permission + } #If Permission applies to user + } #If pattern matches + } # For each entry in File Permission List + + if ($userWriteFlag == 0) { + push (@userRejectList, qq(No permission to add file "$file")); + } + +# +# ####Checking for Banned Files in Control-File "banned:" Specs +# + + foreach my $fileEntry (@bannedFileList) { + if ($file =~ /$fileEntry->{"file"}/) { #File =~ pattern + push (@userRejectList, qq("$file" can't be added to respostory. ) . + qq(Banned!\n\t $fileEntry->{reason})); + } + } +} +# +######################################################################## + +######################################################################## +# CHECK PROPERTIES +# +foreach my $file (@checkPropList) { + foreach my $fileEntry(@propList) { + if ($file =~ /$fileEntry->{"file"}/) { #Check Property + my $property = $fileEntry->{"property"}; + my $cmd = qq("$svnlookCmd" propget $option ) . + qq("$repository" "$fileEntry->{property}" "$file" 2> /dev/null); + my $tempVal = qx($cmd); + unless (my $propValue = qx($cmd)) { + push(@userRejectList, + qq(Property "$property" needed for file "$file".\n) . + qq( Must match $fileEntry->{type} ) . + qq('$fileEntry->{value}'.)); + } else { #Property Found: Is it a good value? + chomp ($propValue); + if ($fileEntry->{"type"} eq "$REGEX_TYPE") { + if ($propValue !~ /$fileEntry->{"value"}/) { + push (@userRejectList, + qq(Property "$property" for file "$file" ) . + qq(is invalid.\n) . + qq( Must match regex ) . + qq(/$fileEntry->{value}/.)); + } + } + elsif ($fileEntry->{"type"} eq "$STRING_TYPE") { + if ($propValue ne $fileEntry->{"value"}) { + push (@userRejectList, + qq(Property "$property" for file "$file" ) . + qq( is invalid.\n) . + qq( Must match string ) . + qq("$fileEntry->{value}".)); + } + } + else { #Assume it is a number + if ($propValue != $fileEntry->{"value"}) { + push (@userRejectList, + qq(Property "$property" for file "$file" ) . + qq(is invalid.\n) . + qq( Must match number ) . + qq($fileEntry->{value}.)); + } + } + } + } #If @propList has this file for this property + } #For each file entry found in @propList +} +# +######################################################################## + +######################################################################## +# CHECK REVISION PROPERTIES +# +foreach my $propEntry (@revPropList) { + my $cmd; + my $property = $propEntry->{"property"}; + + +# +# ####Kludge: This is a kludge. The "-t" flag really doesn't work on +# the "svn propget --revprop" command. However, it would be nice +# to have a way to check the log message anyway, so I will simply +# kludge the "svnlook propget --revprop svn:log" to "svnlook log". +# + + if (("$property" eq "svn:log") and ($option =~ /^-t/)) + { + $cmd = qq("$svnlookCmd" log $option "$repository" 2> /dev/null); + } + else + { + $cmd = qq($svnlookCmd propget --revprop $option ) . + qq("$repository" "$property" #2> /dev/null); + } + unless(my $propValue = qx($cmd)) { + push (@userRejectList, + qq(Revision Property "$property" must be set!\n) . + qq( Must be a $propEntry->{type} set to ) . + qq("$propEntry->{value}".)); + } else { #Revision Property does exist! + chomp ($propValue); + if ($propEntry->{"type"} eq "$REGEX_TYPE") { + if ($propValue !~ /$propEntry->{"value"}/) { + push (@userRejectList, + qq(Revision Property "$property" is invalid.\n) . + qq( Currently set to "$propValue".\n) . + qq( Must match regex /$propEntry->{"value"}/.)); + } + } + elsif ($propEntry->{"type"} eq "$STRING_TYPE") { + if ($propValue ne "$propEntry->{value}") { + push (@userRejectList, + qq(Revision Property "$property" is invalid.\n) . + qq( Currently set to "$propValue".\n) . + qq( Must match string "$propEntry->{"value"}".)); + } + } + else { #Assume it's a number + if ($propValue != $propEntry->{"value"}) { + push (@userRejectList, + qq(Revision Property "$property" is invalid.\n) . + qq( Currently set to "$propValue".\n) . + qq( Must match number "$propEntry->{"value"}".)); + } + } + } +} +# +######################################################################## + +######################################################################## +# CHECK USER REJECT LIST +# +if(scalar @userRejectList) { + print "ERROR: Commit failed for the following reasons:\n"; + foreach my $entry (@userRejectList) { + print " $entry\n"; + } + exit 2; +} else { #Commit is fine + exit 0; +} +# +######################################################################## Property changes on: pre-commit-access-control-hook.pl ___________________________________________________________________ Name: svn:executable + * Index: commit-access-control.pl.in =================================================================== --- commit-access-control.pl.in (revision 16291) +++ commit-access-control.pl.in (working copy) @@ -1,406 +0,0 @@ -#!/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 () - { - 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; - } -} Index: control-file.template.ini =================================================================== --- control-file.template.ini (revision 0) +++ control-file.template.ini (revision 0) @@ -0,0 +1,219 @@ +;======================================================================= +; WARNING: +; The Config::Inifile module will pick up trailing spaces on lines! +; For example, if you set a line like: +; +; property = svn:keywords +; +; and there is a space after the word "svn:keywords", then the +; property will become "svn:keywords " and not "svn:keywords". +; This is very difficult to debug. (I know, I spent 40 minutes +; debugging my control file before I realize the problem). So, +; verify that you do not have trailing spaces on the end of lines. +; where you don't want them! +; +; +; NOTE: +; The hook strips spaces before and after parameter values. If you +; want to include spaces at the end or the beginning of your +; parameter values, use double quotes. The hook script will remove +; double quotes at the very beginning or end of a parameter value +; (i.e. after striping leading and ending spaces). +; +;======================================================================= +;======================================================================= +; GROUP DEFINITIONS +; These must be defined first before you set file commit permissions +;======================================================================= + +[group dev1] +users = bob, carol, ted, alice + +[group dev2] +users = lucy, ricky, ethel, fred + +[group alldev] +users = @dev1 @dev2 + +[group admins] +users = rowen, martin + +;======================================================================= +; FILE COMMIT PERMISSIONS +;======================================================================= + +;======================================================================= +; DEFAULT IS READ ONLY ACCESS IN WHOLE ARCHIVE +; +[file Give Everyone Read Only Access] +match = .* +access = read-only +users = @ALL + +[file However, Admins Default is Write Everywhere] +match = .* +access = read-write +users = @admins +; +;======================================================================= + +;======================================================================= +; TRUNK - GIVE USERS ACCESS TO PARTICULAR PROJECTS +; +[file Everyone has Write Access to Their Personal Directory] +match = ^trunk// +access = read-write +users = @ALL +; +; PROJECTS - GIVE ACCESS TO THOSE INVOLVED IN PARTICULAR PROJECTS +; +[file Proj #1 and #2 on Trunk] +match = ^trunk/(proj1|proj2)/ +access = read-write +users = @dev1 + +[file Proj #3 on Trunk] +match = ^trunk/proj3/ +access = read-write +users = @dev2 + +[file Proj #4 on Trunk] +match = ^trunk/proj4 +access = read-write +users = @alldev + +[file don't let Fred touch Makefiles] +match = [Mm]akefile$ +access = read-only +users = fred +; +;======================================================================= + +;======================================================================= +; BRANCHES +; +[file Everyone Has Write Access To Their Private Branch] +match = ^branches// +access = read-write +users = @ALL +; +; +[file Open Whatever Branches To Whatever Users] +match = ^branches/rel1.0/ +access = read-write +users = fred, alice +; +;======================================================================= + +;======================================================================= +; TAGS +; This uses the "add-only" access control. This means that you are +; allowed to add a new diretory to that point (via "svn cp"), but not +; commit any changes. Note that the "match" parameters are arranged +; to prevent users from adding "tags" to subdirectories of other tags +; +[file Everyone Has Add-Only Access to Their Private Tag Directory] +match = ^tags//[^/]+/$ +access = add-only +users = @ALL + +[file Even Admins Should Have Add-Only Access] +match = ^tags/[^/]*/$ +access = add-only +users = @admins + +[file Allow Ethel to fix missing files in REL1.0] +match = ^tags/REL1.0/ +access = read-write +users = ethel +; +;======================================================================= + + +;======================================================================= +; BANNED FILE NAMES +;======================================================================= + +[ban Illegal MS-DOS Filenames are Not Allowed] +match = (con|aux|prn|com[1-4])\. + +[ban Filenames Cannot Contain Chars That Cause Problems in Subversion] +match = @ + +[ban Filenames Cannot Contain Spaces] +match = ( ) + +[ban Filenames Cannot Contain Illegal MS-DOS Filename Characters] +match = (\\|:|\*|\?|\"|<|>|\|) + + +;======================================================================= +; PROPERTIES +;======================================================================= + +[property Make Sure at Least Keyword Id Expands in Scripts and Code] +match = \.(c|cc|cpp|h|hpp|sh|ksh|pl) +property = svn:keywords +value = Id +type = regex + +[property All Unix Scripts Should have Unix Line Ending] +match = \.(ksh|sh) +property = svn:eol-style +value = LF +type = string + +;======================================================================= +; BUG TRACKING PROPERTIES +; This makes sure that all folders have the right "bugtraq" properties, +; so that TortoiseSVN works correctly +; +[property Set Label for Box Where Defect ID is Entered] +match = /proj[1-4]/.*/$ +property = bugtraq:label +value = Defect ID: +type = string + +[property Set URL to Reference Defect] +match = /proj[1-4]/.*/$ +property = bugtraq:url +value = http://mywebserver/bug/view.php?id=%BUGID% +type = string + +[property Set Log Message String] +match = /proj[1-4]/.*/$ +property = bugtraq:message +value = Fixed Defect ID: %BUGID% +type = string + +[property Set That Defect IDs are Numeric] +match = /proj[1-4]/.*/$ +property = bugtraq:number +value = ^(yes|true)$ +type = regex + +[property Set to warn if you didn't put a defect ID] +match = /proj[1-4]/.*/$ +property = bugtraq:warnifnoissue +value = ^(yes|true)$ +type = regex + +[property Set lock on all Microsoft Word Documents And Other Binary Docs] +match = .*\.(doc|jpg|gif|uil)$ +property = svn:needs-lock +value = .* +type = regex +; +;======================================================================= + +;======================================================================= +; REVISION PROPERTIES +; The Only Valid Revprop for pre-commit is svn:log. However, if you use +; the pre-commit-access-control.pl hook as a pre-revprop-change hook, +; you can do a lot more with this section. +;======================================================================= + +[revprop Log Message Must Be At Least 10 Charaters Log] +property = svn:log +value = .{10,} +type = regex Property changes on: control-file.template.ini ___________________________________________________________________ Name: svn:executable + * Index: Control-File-Document.txt =================================================================== --- Control-File-Document.txt (revision 0) +++ Control-File-Document.txt (revision 0) @@ -0,0 +1,267 @@ +pre-commit-access-control-hook.pl Control File Layout + +INTRODUCTION + +The pre-commit-access-control-hook.pl script is a Perl script that has +been designed to be used as a pre-commit hook. This hook replaces the +former commit-access-control.pl hook script. Like that former +commit-access-control.pl hook script, this script uses a control file +to define who has read-only or read-write permission on particular +files in the Subversion source archive. And, like the previous +commit-access-control.pl script, the control file is in the Windows +IniFile format. + +However, this script also will prevent users from modifying (but not +creating) tags, verfiy that properties are correctly set on files, and +make sure certain file names cannot be used. For example, you may want +to avoid file names with special symbols that can cause problems with +Subversion, or you might want to avoid file names that are invalid on +your OS. For example, Unix files may contain the ":" character, but +this is not allowed on MacOS X and Windows. Or, you might want to +prevent a file called "con.*" since this is not allowed under Windows. + +FORMAT OF THE CONTROL FILE + +As mentioned above, the Control File is in Windows IniFile format. +Each section contains a section name that is surrounded with square +brackets. Under each section is a series of parameters that are each +associated with a particular value. Each section must have a an unique +name, and with in each section, each parameter must be unique. +However, the same parameter may appear under different sections. + +In addition, this script takes advantage of the Config::IniFiles Perl +module use of the Group concept. The first word in each section's name +is the name of the group that section is in. For example: + +[file things that go bump in the night] + +The section is still called "file things that go bump in the night", +but it is also a member of the group "file" since the first word in +the section is the string "file". + +Also, all parameter names, groups, and section names are converted to +lower case in order for case not to be significant when parsing the +control file. The following two sections are identical: + +[FILE Things That Go Bump in the Night] +[file thIngS tHaT gO bUMP iN THE NiGht] + +FILE GROUPS + +The File Groups are very similar to the ones found in the old +commit-access-control.pl script, and the format of this section is +ALMOST compatible with the commit-access-control.pl script. The only +difference is that the first word of each section must be "File" (not +case sensitive). Otherwise, the format is identical. + +To recap, each section begins with a section heading that consists of +the text in square brackets. The first word of the section heading +must be "file" and the rest of the section must be a unique identifier +of this section. The format is shown below: + +[file ] +match = +access = (read-only|read-write|add-only) +users = + +The is a description for this particular file +access. The text is not important since it isn't really used in the +script, but it must be a unique section name. + +The is a Perl regular expression matching a set of file +names in your Subversion archive. You can use the entire extended Perl +regular expression syntax for this item. However, you do not surround +your selection by forward slashes as you would in a Perl program. + +The is the type of access you want to grant to this set of +files. Read-Only means that the user cannot commit files that match +the "match" parameter. Read-Write means that the user can commit files and +directories that match the "match" parameter. + +New to this version of the script is the "Add-Only" value for the +"access" parameter. Add-Only allows you to add only directories to the +set of directories that match the "match" parmater. This is mainly for +tags where you want to be able to create tags, but not have the tags +modified once they've been created Tags should be static, and thought +of as a snapshot of your configuration at a particular point in time. + +The last parmeter is the user parameter. This is a space and/or comma +separated list of users whose access rights are affected by this +section. New to this parameter is the use of groups. Groups are +defined below, but are simply a convinient way to refer to a group of +users. Group names begin with a "@" to distinguish them from +individual user names. A special group called "@ALL" refers to a +special group that contains all users. + +EXAMPLES: + +[file Start with Read-Only access for all users in the entire archive] +match = .* +access = read-only +users = @ALL + +[file Users can only create tags and not modify them] +match = ^tags/[^/]+$ +access = add-only +users @ALL + +[file Builders Allowed to Modify Build Scripts] +match = ^trunk/build/.* +access = read-write +users = @build + +[file Developers can touch everything else] +match = ^trunk/!(build)/.* +access = read-write +users = @developers + +[file Don't let Marvin change the Makefiles!] +match = /[mM]akefile[^/$] +access = read-only +users = marvin + +GROUP GROUPS + +As mentioned above, you can now put users into groups for easier +manipulation. If a user moves from one development group to another, +or is added or removed from the project, you only have to add or +remove the user's name from the relevent group instead of having to +run through the entire script looking for their name. + +A group section heading starts with the word "group" and the second +word in the section heading is the group's name. The only parameter is +the user parameter. Format is shown below: + +[group ] +users = + +Where is a comma/space separated list of users. Yes, the +users parameter can also include other groups, but those groups must +be defined ABOVE this group definition. No funky recursive definisions +allowed. + +Examples: + +;Administrators Group +[group admins] +users = david, harry + +;Developers Group. Note Harry is in both groups +[group developers] +users = tom, dick, harry + +[group demigods] +users = @admins @developers + +[group managers] +users = bob, ted, carol, alice + +[group sales] +users = dopy, sleepy, doc, sneezy + +[group doofuses] +users @managers, @sales + + +PROPERTIES GROUPS + +The Property groups allow you to enforce rules about which files and +directories must have properties and the value of those properties. +The format is the following: + +[property ] +match = +property = +value = +type = (regex|string|number) + +The "match" parameter is the Perl regular expression that gives you +the group of files this section applies to. The "property" parameter +is the name of the property. This is NOT a regular expression. It is +an actual property. The "value" parameter is the value that property +should take. This can be specified as a string, a number, or as a Perl +regular expression. The "type" parameter is used to tell the hook how +to interpret the "value" parameter. + +Examples: + +[property All C Header files, C , and .sh Scripts should have $Id$ expansion] +match = \.(sh|ksh|pl|c|h|c\+\+|cc|cpp)$ +property = svn:keywords +value = Id +type = regex + +[property MS-Word docs need to be locked before modifying] +match = \.doc +property = svn:needs-lock +value = * +type = string + +[property Set directory properties for bug tracking] +match = .*/$ +property = bugtraq:message +value = Fixed Defect ID: %BUG% +type = string + +REVPROP GROUPS + +The Revprop Groups are designed to set the revision properties on a +commit transaction. Unfortunately, it doesn't quite work. Subversion +doesn't allow you to set revision properties on a commit except for +svn:log, svn:author, and svn:date. And, except for svn:log, these three +properties cannot set by the user on a commit. To make matters worse, +there is a bug in Subversion that treats the '-t' flag in the "svnlook +propset -revprop" command useless. Until this defect is fixed and the +problem of setting revision properties on commit is solved, there +really isn't very much you can do with this section. + +The only thing you can do is verify that the 'svn:log' property (which +is your commit message) is in the correct format. However, if you use +this hook as a pre-revprop-change hook too, this section becomes a bit +more useful. + +The format is the following: + +[revprop +value = +type = (perlRegex|string|number) + +These parameters have the same value as described in the Property +Group. Notice there is no "match" parameter. + +Examples: + +[revprop Make sure the Log comment contains some comment] +property = svn:log +value = \S+ +type = regex + + +BAN GROUPS + +Sometimes, it is necessary to prevent users from creating certain file +names. For example, if you have a project that works on both Unix and +PCs, the Unix developers can create a file called "con.sh" which +would not be permitted on a Windows PC. You also might want to prevent +files that contain "@" signs since this confuses Subversion. + +The Ban Group format is below: + +[ban ] +match = + +The name of the group must start with "ban". The reason helps give +this section a unique identifier, but unlike the other sections, the +reason will print out when a commit fails to help explain why the +commit was rejected. The "match" parameter is a Perl regular +expression that will match various banned file names. + +Examples: + +[ban File is an illegal MS-Windows File Name] +match = /(con|prt|aux|com[0-9]|lpr[0-9])\. + +[ban We don't allow files with "@" in them. It drives Subversion crazy] +match = @ + Property changes on: Control-File-Document.txt ___________________________________________________________________ Name: svn:executable + * Index: commit-email.pl.in =================================================================== --- commit-email.pl.in (revision 16291) +++ commit-email.pl.in (working copy) @@ -1,605 +0,0 @@ -#!/usr/bin/env perl - -# ==================================================================== -# commit-email.pl: send a commit email for commit REVISION in -# repository REPOS to some email addresses. -# -# For usage, see the usage subroutine or run the script with no -# command line arguments. -# -# $HeadURL$ -# $LastChangedDate$ -# $LastChangedBy$ -# $LastChangedRevision$ -# -# ==================================================================== -# 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; - -###################################################################### -# Configuration section. - -# Sendmail path. -my $sendmail = "/usr/sbin/sendmail"; - -# Svnlook path. -my $svnlook = "@SVN_BINDIR@/svnlook"; - -# By default, when a file is deleted from the repository, svnlook diff -# prints the entire contents of the file. If you want to save space -# in the log and email messages by not printing the file, then set -# $no_diff_deleted to 1. -my $no_diff_deleted = 0; -# By default, when a file is added to the repository, svnlook diff -# prints the entire contents of the file. If you want to save space -# in the log and email messages by not printing the file, then set -# $no_diff_added to 1. -my $no_diff_added = 0; - -# End of Configuration section. -###################################################################### - -# Since the path to svnlook depends upon the local installation -# preferences, check that the required programs exist to insure that -# the administrator has set up the script properly. -{ - my $ok = 1; - foreach my $program ($sendmail, $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. - -# Each value in this array holds a hash reference which contains the -# associated email information for one project. Start with an -# implicit rule that matches all paths. -my @project_settings_list = (&new_project); - -# Process the command line arguments till there are none left. The -# first two arguments that are not used by a command line option are -# the repository path and the revision number. -my $repos; -my $rev; - -# Use the reference to the first project to populate. -my $current_project = $project_settings_list[0]; - -# This hash matches the command line option to the hash key in the -# project. If a key exists but has a false value (''), then the -# command line option is allowed but requires special handling. -my %opt_to_hash_key = ('--from' => 'from_address', - '-h' => 'hostname', - '-l' => 'log_file', - '-m' => '', - '-r' => 'reply_to', - '-s' => 'subject_prefix'); - -while (@ARGV) - { - my $arg = shift @ARGV; - if ($arg =~ /^-/) - { - my $hash_key = $opt_to_hash_key{$arg}; - unless (defined $hash_key) - { - die "$0: command line option `$arg' is not recognized.\n"; - } - - unless (@ARGV) - { - die "$0: command line option `$arg' is missing a value.\n"; - } - my $value = shift @ARGV; - - if ($hash_key) - { - $current_project->{$hash_key} = $value; - } - else - { - # Here handle -m. - unless ($arg eq '-m') - { - die "$0: internal error: should only handle -m here.\n"; - } - $current_project = &new_project; - $current_project->{match_regex} = $value; - push(@project_settings_list, $current_project); - } - } - elsif ($arg =~ /^-/) - { - die "$0: command line option `$arg' is not recognized.\n"; - } - else - { - if (! defined $repos) - { - $repos = $arg; - } - elsif (! defined $rev) - { - $rev = $arg; - } - else - { - push(@{$current_project->{email_addresses}}, $arg); - } - } - } - -# If the revision number is undefined, then there were not enough -# command line arguments. -&usage("$0: too few arguments.") unless defined $rev; - -# Check the validity of the command line arguments. Check that the -# revision is an integer greater than 0 and that the repository -# directory exists. -unless ($rev =~ /^\d+/ and $rev > 0) - { - &usage("$0: revision number `$rev' must be an integer > 0."); - } -unless (-e $repos) - { - &usage("$0: repos directory `$repos' does not exist."); - } -unless (-d _) - { - &usage("$0: repos directory `$repos' is not a directory."); - } - -# Check that all of the regular expressions can be compiled and -# compile them. -{ - my $ok = 1; - for (my $i=0; $i<@project_settings_list; ++$i) - { - my $match_regex = $project_settings_list[$i]->{match_regex}; - - # To help users that automatically write regular expressions - # that match the root directory 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: -m regex #$i `$match_regex' does not compile:\n$@\n"; - $ok = 0; - next; - } - $project_settings_list[$i]->{match_re} = $match_re; - } - exit 1 unless $ok; -} - -###################################################################### -# Harvest data using svnlook. - -# Change into suitable directory so that svnlook diff can create its .svnlook -# directory. This could be removed - it's only for compatibility with -# 1.0.x svnlook - from 1.1.0, svnlook will be sensible about choosing a -# temporary directory all by itself. -my $tmp_dir = ( -d $ENV{'TEMP'} ? $ENV{'TEMP'} : '/tmp' ); -chdir($tmp_dir) - or die "$0: cannot chdir `$tmp_dir': $!\n"; - -# Get the author, date, and log from svnlook. -my @svnlooklines = &read_from_process($svnlook, 'info', $repos, '-r', $rev); -my $author = shift @svnlooklines; -my $date = shift @svnlooklines; -shift @svnlooklines; -my @log = map { "$_\n" } @svnlooklines; - -# Figure out what directories have changed using svnlook. -my @dirschanged = &read_from_process($svnlook, 'dirs-changed', $repos, - '-r', $rev); - -# Lose the trailing slash in the directory names if one exists, except -# in the case of '/'. -my $rootchanged = 0; -for (my $i=0; $i<@dirschanged; ++$i) - { - if ($dirschanged[$i] eq '/') - { - $rootchanged = 1; - } - else - { - $dirschanged[$i] =~ s#^(.+)[/\\]$#$1#; - } - } - -# Figure out what files have changed using svnlook. -@svnlooklines = &read_from_process($svnlook, 'changed', $repos, '-r', $rev); - -# Parse the changed nodes. -my @adds; -my @dels; -my @mods; -foreach my $line (@svnlooklines) - { - my $path = ''; - my $code = ''; - - # Split the line up into the modification code and path, ignoring - # property modifications. - if ($line =~ /^(.). (.*)$/) - { - $code = $1; - $path = $2; - } - - if ($code eq 'A') - { - push(@adds, $path); - } - elsif ($code eq 'D') - { - push(@dels, $path); - } - else - { - push(@mods, $path); - } - } - -# Get the diff from svnlook. -my @no_diff_deleted = $no_diff_deleted ? ('--no-diff-deleted') : (); -my @no_diff_added = $no_diff_added ? ('--no-diff-added') : (); -my @difflines = &read_from_process($svnlook, 'diff', $repos, - '-r', $rev, @no_diff_deleted, - @no_diff_added); - -###################################################################### -# Modified directory name collapsing. - -# Collapse the list of changed directories only if the root directory -# was not modified, because otherwise everything is under root and -# there's no point in collapsing the directories, and only if more -# than one directory was modified. -my $commondir = ''; -my @dirschanged_orig = @dirschanged; -if (!$rootchanged and @dirschanged > 1) - { - my $firstline = shift @dirschanged; - my @commonpieces = split('/', $firstline); - foreach my $line (@dirschanged) - { - my @pieces = split('/', $line); - my $i = 0; - while ($i < @pieces and $i < @commonpieces) - { - if ($pieces[$i] ne $commonpieces[$i]) - { - splice(@commonpieces, $i, @commonpieces - $i); - last; - } - $i++; - } - } - unshift(@dirschanged, $firstline); - - if (@commonpieces) - { - $commondir = join('/', @commonpieces); - my @new_dirschanged; - foreach my $dir (@dirschanged) - { - if ($dir eq $commondir) - { - $dir = '.'; - } - else - { - $dir =~ s#^\Q$commondir/\E##; - } - push(@new_dirschanged, $dir); - } - @dirschanged = @new_dirschanged; - } - } -my $dirlist = join(' ', @dirschanged); - -###################################################################### -# Assembly of log message. - -# Put together the body of the log message. -my @body; -push(@body, "Author: $author\n"); -push(@body, "Date: $date\n"); -push(@body, "New Revision: $rev\n"); -push(@body, "\n"); -if (@adds) - { - @adds = sort @adds; - push(@body, "Added:\n"); - push(@body, map { " $_\n" } @adds); - } -if (@dels) - { - @dels = sort @dels; - push(@body, "Removed:\n"); - push(@body, map { " $_\n" } @dels); - } -if (@mods) - { - @mods = sort @mods; - push(@body, "Modified:\n"); - push(@body, map { " $_\n" } @mods); - } -push(@body, "Log:\n"); -push(@body, @log); -push(@body, "\n"); -push(@body, map { /[\r\n]+$/ ? $_ : "$_\n" } @difflines); - -# Go through each project and see if there are any matches for this -# project. If so, send the log out. -foreach my $project (@project_settings_list) - { - my $match_re = $project->{match_re}; - my $match = 0; - foreach my $path (@dirschanged_orig, @adds, @dels, @mods) - { - if ($path =~ $match_re) - { - $match = 1; - last; - } - } - - next unless $match; - - my @email_addresses = @{$project->{email_addresses}}; - my $userlist = join(' ', @email_addresses); - my $to = join(', ', @email_addresses); - my $from_address = $project->{from_address}; - my $hostname = $project->{hostname}; - my $log_file = $project->{log_file}; - my $reply_to = $project->{reply_to}; - my $subject_prefix = $project->{subject_prefix}; - my $subject; - - if ($commondir ne '') - { - $subject = "r$rev - in $commondir: $dirlist"; - } - else - { - $subject = "r$rev - $dirlist"; - } - if ($subject_prefix =~ /\w/) - { - $subject = "$subject_prefix $subject"; - } - my $mail_from = $author; - - if ($from_address =~ /\w/) - { - $mail_from = $from_address; - } - elsif ($hostname =~ /\w/) - { - $mail_from = "$mail_from\@$hostname"; - } - - my @head; - push(@head, "To: $to\n"); - push(@head, "From: $mail_from\n"); - push(@head, "Subject: $subject\n"); - push(@head, "Reply-to: $reply_to\n") if $reply_to; - - ### Below, we set the content-type etc, but see these comments - ### from Greg Stein on why this is not a full solution. - # - # From: Greg Stein - # Subject: Re: svn commit: rev 2599 - trunk/tools/cgi - # To: dev@subversion.tigris.org - # Date: Fri, 19 Jul 2002 23:42:32 -0700 - # - # Well... that isn't strictly true. The contents of the files - # might not be UTF-8, so the "diff" portion will be hosed. - # - # If you want a truly "proper" commit message, then you'd use - # multipart MIME messages, with each file going into its own part, - # and labeled with an appropriate MIME type and charset. Of - # course, we haven't defined a charset property yet, but no biggy. - # - # Going with multipart will surely throw out the notion of "cut - # out the patch from the email and apply." But then again: the - # commit emailer could see that all portions are in the same - # charset and skip the multipart thang. - # - # etc etc - # - # Basically: adding/tweaking the content-type is nice, but don't - # think that is the proper solution. - push(@head, "Content-Type: text/plain; charset=UTF-8\n"); - push(@head, "Content-Transfer-Encoding: 8bit\n"); - - push(@head, "\n"); - - if ($sendmail =~ /\w/ and @email_addresses) - { - # Open a pipe to sendmail. - my $command = "$sendmail -f$mail_from $userlist"; - if (open(SENDMAIL, "| $command")) - { - print SENDMAIL @head, @body; - close SENDMAIL - or warn "$0: error in closing `$command' for writing: $!\n"; - } - else - { - warn "$0: cannot open `| $command' for writing: $!\n"; - } - } - - # Dump the output to logfile (if its name is not empty). - if ($log_file =~ /\w/) - { - if (open(LOGFILE, ">> $log_file")) - { - print LOGFILE @head, @body; - close LOGFILE - or warn "$0: error in closing `$log_file' for appending: $!\n"; - } - else - { - warn "$0: cannot open `$log_file' for appending: $!\n"; - } - } - } - -exit 0; - -sub usage -{ - warn "@_\n" if @_; - die "usage: $0 REPOS REVNUM [[-m regex] [options] [email_addr ...]] ...\n", - "options are\n", - " --from email_address Email address for 'From:' (overrides -h)\n", - " -h hostname Hostname to append to author for 'From:'\n", - " -l logfile Append mail contents to this log file\n", - " -m regex Regular expression to match committed path\n", - " -r email_address Email address for 'Reply-To:'\n", - " -s subject_prefix Subject line prefix\n", - "\n", - "This script supports a single repository with multiple projects,\n", - "where each project receives email only for commits that modify that\n", - "project. A project is identified by using the -m command line\n", - "with a regular expression argument. If a commit has a path that\n", - "matches the regular expression, then the entire commit matches.\n", - "Any of the following -h, -l, -r and -s command line options and\n", - "following email addresses are associated with this project. The\n", - "next -m resets the -h, -l, -r and -s command line options and the\n", - "list of email addresses.\n", - "\n", - "To support a single project conveniently, the script initializes\n", - "itself with an implicit -m . rule that matches any modifications\n", - "to the repository. Therefore, to use the script for a single\n", - "project repository, just use the other comand line options and\n", - "a list of email addresses on the command line. If you do not want\n", - "a project that matches the entire repository, then use a -m with a\n", - "regular expression before any other command line options or email\n", - "addresses.\n"; -} - -# Return a new hash data structure for a new empty project that -# matches any modifications to the repository. -sub new_project -{ - return {email_addresses => [], - from_address => '', - hostname => '', - log_file => '', - match_regex => '.', - reply_to => '', - subject_prefix => ''}; -} - -# Start a child process safely without using /bin/sh. -sub safe_read_from_pipe -{ - unless (@_) - { - croak "$0: safe_read_from_pipe passed no arguments.\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 () - { - s/[\r\n]+$//; - 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; - } -} - -# Use safe_read_from_pipe to start a child process safely and return -# the output if it succeeded or an error message followed by the output -# if it failed. -sub read_from_process -{ - unless (@_) - { - croak "$0: read_from_process passed no arguments.\n"; - } - my ($status, @output) = &safe_read_from_pipe(@_); - if ($status) - { - return ("$0: `@_' failed with this output:", @output); - } - else - { - return @output; - } -} Index: pre-commit =================================================================== --- pre-commit (revision 0) +++ pre-commit (revision 0) @@ -0,0 +1,27 @@ +#!/bin/sh +# pre-commit +######################################################################## + +######################################################################## +# CONSTANTS +# +REPOS="$1" +TXN="$2" +CWD="/usr/subversion/repos/hooks" +SVNLOOK="/usr/local/bin/svnlook" + +DEBUG_LEVEL=0 # 0: No debug, >=1: Debug +ACCESS_HOOK="$CWD/pre-commit-access-control-hook.pl" +CONTROL_FILE="$CWD/control-file.ini" + +# +######################################################################## + +######################################################################## +# PRE-COMMIT HOOK +# +$ACCESS_HOOK -debug $DEBUG_LEVEL -svnlook \ + $SVNLOOK -file $CONTROL_FILE -t $TXN $REPOS +exit $? +# +######################################################################## Property changes on: pre-commit ___________________________________________________________________ Name: svn:executable + * Index: commit-access-control.cfg.example =================================================================== --- commit-access-control.cfg.example (revision 16291) +++ commit-access-control.cfg.example (working copy) @@ -1,74 +0,0 @@ -# This is a sample configuration file for commit-access-control.pl. -# -# $Id$ -# -# This file uses the Windows ini style, where the file consists of a -# number of sections, each section starts with a unique section name -# in square brackets. Parameters in each section are specified as -# Name = Value. Any spaces around the equal sign will be ignored. If -# there are multiple sections with exactly the same section name, then -# the parameters in those sections will be added together to produce -# one section with cumulative parameters. -# -# The commit-access-control.pl script reads these sections in order, -# so later sections may overwrite permissions granted or removed in -# previous sections. -# -# Each section has three valid parameters. Any other parameters are -# ignored. -# access = (read-only|read-write) -# -# This parameter is a required parameter. Valid values are -# `read-only' and `read-write'. -# -# The access rights to apply to modified files and directories -# that match the `match' regular expression described later on. -# -# match = PERL_REGEX -# -# This parameter is a required parameter and its value is a Perl -# regular expression. -# -# To help users that automatically write regular expressions that -# match the beginning of absolute paths using ^/, the script -# removes the / character because subversion paths, while they -# start at the root level, do not begin with a /. -# -# users = username1 [username2 [username3 [username4 ...]]] -# or -# users = username1 [username2] -# users = username3 username4 -# -# This parameter is optional. The usernames listed here must be -# exact usernames. There is no regular expression matching for -# usernames. You may specify all the usernames that apply on one -# line or split the names up on multiple lines. -# -# The access rights from `access' are applied to ALL modified -# paths that match the `match' regular expression only if NO -# usernames are specified in the section or if one of the listed -# usernames matches the author of the commit. -# -# By default, because you're using commit-access-control.pl in the -# first place to protect your repository, the script sets the -# permissions to all files and directories in the repository to -# read-only, so if you want to open up portions of the repository, -# you'll need to edit this file. -# -# NOTE: NEVER GIVE DIFFERENT SECTIONS THE SAME SECTION NAME, OTHERWISE -# THE PARAMETERS FOR THOSE SECTIONS WILL BE MERGED TOGETHER INTO ONE -# SECTION AND YOUR SECURITY MAY BE COMPROMISED. - -[Make everything read-only for all users] -match = .* -access = read-only - -[Make project1 read-write for users Jane and Joe] -match = ^(branches|tags|trunk)/project1 -users = jane joe -access = read-write - -[However, we don't trust Joe with project1's Makefile] -match = ^(branches|tags|trunk)/project1/Makefile -users = joe -access = read-only