| #!/usr/bin/perl | 
 |  | 
 | use strict; | 
 | use File::Spec; | 
 |  | 
 | $ENV{PATH}     = '/opt/git/bin'; | 
 | my $acl_git    = '/vcs/acls.git'; | 
 | my $acl_branch = 'refs/heads/master'; | 
 | my $debug      = 0; | 
 |  | 
 | =doc | 
 | Invoked as: update refname old-sha1 new-sha1 | 
 |  | 
 | This script is run by git-receive-pack once for each ref that the | 
 | client is trying to modify.  If we exit with a non-zero exit value | 
 | then the update for that particular ref is denied, but updates for | 
 | other refs in the same run of receive-pack may still be allowed. | 
 |  | 
 | We are run after the objects have been uploaded, but before the | 
 | ref is actually modified.  We take advantage of that fact when we | 
 | look for "new" commits and tags (the new objects won't show up in | 
 | `rev-list --all`). | 
 |  | 
 | This script loads and parses the content of the config file | 
 | "users/$this_user.acl" from the $acl_branch commit of $acl_git ODB. | 
 | The acl file is a git-config style file, but uses a slightly more | 
 | restricted syntax as the Perl parser contained within this script | 
 | is not nearly as permissive as git-config. | 
 |  | 
 | Example: | 
 |  | 
 |   [user] | 
 |     committer = John Doe <john.doe@example.com> | 
 |     committer = John R. Doe <john.doe@example.com> | 
 |  | 
 |   [repository "acls"] | 
 |     allow = heads/master | 
 |     allow = CDUR for heads/jd/ | 
 |     allow = C    for ^tags/v\\d+$ | 
 |  | 
 | For all new commit or tag objects the committer (or tagger) line | 
 | within the object must exactly match one of the user.committer | 
 | values listed in the acl file ("HEAD:users/$this_user.acl"). | 
 |  | 
 | For a branch to be modified an allow line within the matching | 
 | repository section must be matched for both the refname and the | 
 | opcode. | 
 |  | 
 | Repository sections are matched on the basename of the repository | 
 | (after removing the .git suffix). | 
 |  | 
 | The opcode abbrevations are: | 
 |  | 
 |   C: create new ref | 
 |   D: delete existing ref | 
 |   U: fast-forward existing ref (no commit loss) | 
 |   R: rewind/rebase existing ref (commit loss) | 
 |  | 
 | if no opcodes are listed before the "for" keyword then "U" (for | 
 | fast-forward update only) is assumed as this is the most common | 
 | usage. | 
 |  | 
 | Refnames are matched by always assuming a prefix of "refs/". | 
 | This hook forbids pushing or deleting anything not under "refs/". | 
 |  | 
 | Refnames that start with ^ are Perl regular expressions, and the ^ | 
 | is kept as part of the regexp.  \\ is needed to get just one \, so | 
 | \\d expands to \d in Perl.  The 3rd allow line above is an example. | 
 |  | 
 | Refnames that don't start with ^ but that end with / are prefix | 
 | matches (2nd allow line above); all other refnames are strict | 
 | equality matches (1st allow line). | 
 |  | 
 | Anything pushed to "heads/" (ok, really "refs/heads/") must be | 
 | a commit.  Tags are not permitted here. | 
 |  | 
 | Anything pushed to "tags/" (err, really "refs/tags/") must be an | 
 | annotated tag.  Commits, blobs, trees, etc. are not permitted here. | 
 | Annotated tag signatures aren't checked, nor are they required. | 
 |  | 
 | The special subrepository of 'info/new-commit-check' can | 
 | be created and used to allow users to push new commits and | 
 | tags from another local repository to this one, even if they | 
 | aren't the committer/tagger of those objects.  In a nut shell | 
 | the info/new-commit-check directory is a Git repository whose | 
 | objects/info/alternates file lists this repository and all other | 
 | possible sources, and whose refs subdirectory contains symlinks | 
 | to this repository's refs subdirectory, and to all other possible | 
 | sources refs subdirectories.  Yes, this means that you cannot | 
 | use packed-refs in those repositories as they won't be resolved | 
 | correctly. | 
 |  | 
 | =cut | 
 |  | 
 | my $git_dir = $ENV{GIT_DIR}; | 
 | my $new_commit_check = "$git_dir/info/new-commit-check"; | 
 | my $ref = $ARGV[0]; | 
 | my $old = $ARGV[1]; | 
 | my $new = $ARGV[2]; | 
 | my $new_type; | 
 | my ($this_user) = getpwuid $<; # REAL_USER_ID | 
 | my $repository_name; | 
 | my %user_committer; | 
 | my @allow_rules; | 
 | my @path_rules; | 
 | my %diff_cache; | 
 |  | 
 | sub deny ($) { | 
 | 	print STDERR "-Deny-    $_[0]\n" if $debug; | 
 | 	print STDERR "\ndenied: $_[0]\n\n"; | 
 | 	exit 1; | 
 | } | 
 |  | 
 | sub grant ($) { | 
 | 	print STDERR "-Grant-   $_[0]\n" if $debug; | 
 | 	exit 0; | 
 | } | 
 |  | 
 | sub info ($) { | 
 | 	print STDERR "-Info-    $_[0]\n" if $debug; | 
 | } | 
 |  | 
 | sub git_value (@) { | 
 | 	open(T,'-|','git',@_); local $_ = <T>; chop; close T; $_; | 
 | } | 
 |  | 
 | sub match_string ($$) { | 
 | 	my ($acl_n, $ref) = @_; | 
 | 	   ($acl_n eq $ref) | 
 | 	|| ($acl_n =~ m,/$, && substr($ref,0,length $acl_n) eq $acl_n) | 
 | 	|| ($acl_n =~ m,^\^, && $ref =~ m:$acl_n:); | 
 | } | 
 |  | 
 | sub parse_config ($$$$) { | 
 | 	my $data = shift; | 
 | 	local $ENV{GIT_DIR} = shift; | 
 | 	my $br = shift; | 
 | 	my $fn = shift; | 
 | 	return unless git_value('rev-list','--max-count=1',$br,'--',$fn); | 
 | 	info "Loading $br:$fn"; | 
 | 	open(I,'-|','git','cat-file','blob',"$br:$fn"); | 
 | 	my $section = ''; | 
 | 	while (<I>) { | 
 | 		chomp; | 
 | 		if (/^\s*$/ || /^\s*#/) { | 
 | 		} elsif (/^\[([a-z]+)\]$/i) { | 
 | 			$section = lc $1; | 
 | 		} elsif (/^\[([a-z]+)\s+"(.*)"\]$/i) { | 
 | 			$section = join('.',lc $1,$2); | 
 | 		} elsif (/^\s*([a-z][a-z0-9]+)\s*=\s*(.*?)\s*$/i) { | 
 | 			push @{$data->{join('.',$section,lc $1)}}, $2; | 
 | 		} else { | 
 | 			deny "bad config file line $. in $br:$fn"; | 
 | 		} | 
 | 	} | 
 | 	close I; | 
 | } | 
 |  | 
 | sub all_new_committers () { | 
 | 	local $ENV{GIT_DIR} = $git_dir; | 
 | 	$ENV{GIT_DIR} = $new_commit_check if -d $new_commit_check; | 
 |  | 
 | 	info "Getting committers of new commits."; | 
 | 	my %used; | 
 | 	open(T,'-|','git','rev-list','--pretty=raw',$new,'--not','--all'); | 
 | 	while (<T>) { | 
 | 		next unless s/^committer //; | 
 | 		chop; | 
 | 		s/>.*$/>/; | 
 | 		info "Found $_." unless $used{$_}++; | 
 | 	} | 
 | 	close T; | 
 | 	info "No new commits." unless %used; | 
 | 	keys %used; | 
 | } | 
 |  | 
 | sub all_new_taggers () { | 
 | 	my %exists; | 
 | 	open(T,'-|','git','for-each-ref','--format=%(objectname)','refs/tags'); | 
 | 	while (<T>) { | 
 | 		chop; | 
 | 		$exists{$_} = 1; | 
 | 	} | 
 | 	close T; | 
 |  | 
 | 	info "Getting taggers of new tags."; | 
 | 	my %used; | 
 | 	my $obj = $new; | 
 | 	my $obj_type = $new_type; | 
 | 	while ($obj_type eq 'tag') { | 
 | 		last if $exists{$obj}; | 
 | 		$obj_type = ''; | 
 | 		open(T,'-|','git','cat-file','tag',$obj); | 
 | 		while (<T>) { | 
 | 			chop; | 
 | 			if (/^object ([a-z0-9]{40})$/) { | 
 | 				$obj = $1; | 
 | 			} elsif (/^type (.+)$/) { | 
 | 				$obj_type = $1; | 
 | 			} elsif (s/^tagger //) { | 
 | 				s/>.*$/>/; | 
 | 				info "Found $_." unless $used{$_}++; | 
 | 				last; | 
 | 			} | 
 | 		} | 
 | 		close T; | 
 | 	} | 
 | 	info "No new tags." unless %used; | 
 | 	keys %used; | 
 | } | 
 |  | 
 | sub check_committers (@) { | 
 | 	my @bad; | 
 | 	foreach (@_) { push @bad, $_ unless $user_committer{$_}; } | 
 | 	if (@bad) { | 
 | 		print STDERR "\n"; | 
 | 		print STDERR "You are not $_.\n" foreach (sort @bad); | 
 | 		deny "You cannot push changes not committed by you."; | 
 | 	} | 
 | } | 
 |  | 
 | sub load_diff ($) { | 
 | 	my $base = shift; | 
 | 	my $d = $diff_cache{$base}; | 
 | 	unless ($d) { | 
 | 		local $/ = "\0"; | 
 | 		my %this_diff; | 
 | 		if ($base =~ /^0{40}$/) { | 
 | 			# Don't load the diff at all; we are making the | 
 | 			# branch and have no base to compare to in this | 
 | 			# case.  A file level ACL makes no sense in this | 
 | 			# context.  Having an empty diff will allow the | 
 | 			# branch creation. | 
 | 			# | 
 | 		} else { | 
 | 			open(T,'-|','git','diff-tree', | 
 | 				'-r','--name-status','-z', | 
 | 				$base,$new) or return undef; | 
 | 			while (<T>) { | 
 | 				my $op = $_; | 
 | 				chop $op; | 
 |  | 
 | 				my $path = <T>; | 
 | 				chop $path; | 
 |  | 
 | 				$this_diff{$path} = $op; | 
 | 			} | 
 | 			close T or return undef; | 
 | 		} | 
 | 		$d = \%this_diff; | 
 | 		$diff_cache{$base} = $d; | 
 | 	} | 
 | 	return $d; | 
 | } | 
 |  | 
 | deny "No GIT_DIR inherited from caller" unless $git_dir; | 
 | deny "Need a ref name" unless $ref; | 
 | deny "Refusing funny ref $ref" unless $ref =~ s,^refs/,,; | 
 | deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/; | 
 | deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/; | 
 | deny "Cannot determine who you are." unless $this_user; | 
 | grant "No change requested." if $old eq $new; | 
 |  | 
 | $repository_name = File::Spec->rel2abs($git_dir); | 
 | $repository_name =~ m,/([^/]+)(?:\.git|/\.git)$,; | 
 | $repository_name = $1; | 
 | info "Updating in '$repository_name'."; | 
 |  | 
 | my $op; | 
 | if    ($old =~ /^0{40}$/) { $op = 'C'; } | 
 | elsif ($new =~ /^0{40}$/) { $op = 'D'; } | 
 | else                      { $op = 'R'; } | 
 |  | 
 | # This is really an update (fast-forward) if the | 
 | # merge base of $old and $new is $old. | 
 | # | 
 | $op = 'U' if ($op eq 'R' | 
 | 	&& $ref =~ m,^heads/, | 
 | 	&& $old eq git_value('merge-base',$old,$new)); | 
 |  | 
 | # Load the user's ACL file. Expand groups (user.memberof) one level. | 
 | { | 
 | 	my %data = ('user.committer' => []); | 
 | 	parse_config(\%data,$acl_git,$acl_branch,"external/$repository_name.acl"); | 
 |  | 
 | 	%data = ( | 
 | 		'user.committer' => $data{'user.committer'}, | 
 | 		'user.memberof' => [], | 
 | 	); | 
 | 	parse_config(\%data,$acl_git,$acl_branch,"users/$this_user.acl"); | 
 |  | 
 | 	%user_committer = map {$_ => $_} @{$data{'user.committer'}}; | 
 | 	my $rule_key = "repository.$repository_name.allow"; | 
 | 	my $rules = $data{$rule_key} || []; | 
 |  | 
 | 	foreach my $group (@{$data{'user.memberof'}}) { | 
 | 		my %g; | 
 | 		parse_config(\%g,$acl_git,$acl_branch,"groups/$group.acl"); | 
 | 		my $group_rules = $g{$rule_key}; | 
 | 		push @$rules, @$group_rules if $group_rules; | 
 | 	} | 
 |  | 
 | RULE: | 
 | 	foreach (@$rules) { | 
 | 		while (/\${user\.([a-z][a-zA-Z0-9]+)}/) { | 
 | 			my $k = lc $1; | 
 | 			my $v = $data{"user.$k"}; | 
 | 			next RULE unless defined $v; | 
 | 			next RULE if @$v != 1; | 
 | 			next RULE unless defined $v->[0]; | 
 | 			s/\${user\.$k}/$v->[0]/g; | 
 | 		} | 
 |  | 
 | 		if (/^([AMD ]+)\s+of\s+([^\s]+)\s+for\s+([^\s]+)\s+diff\s+([^\s]+)$/) { | 
 | 			my ($ops, $pth, $ref, $bst) = ($1, $2, $3, $4); | 
 | 			$ops =~ s/ //g; | 
 | 			$pth =~ s/\\\\/\\/g; | 
 | 			$ref =~ s/\\\\/\\/g; | 
 | 			push @path_rules, [$ops, $pth, $ref, $bst]; | 
 | 		} elsif (/^([AMD ]+)\s+of\s+([^\s]+)\s+for\s+([^\s]+)$/) { | 
 | 			my ($ops, $pth, $ref) = ($1, $2, $3); | 
 | 			$ops =~ s/ //g; | 
 | 			$pth =~ s/\\\\/\\/g; | 
 | 			$ref =~ s/\\\\/\\/g; | 
 | 			push @path_rules, [$ops, $pth, $ref, $old]; | 
 | 		} elsif (/^([CDRU ]+)\s+for\s+([^\s]+)$/) { | 
 | 			my $ops = $1; | 
 | 			my $ref = $2; | 
 | 			$ops =~ s/ //g; | 
 | 			$ref =~ s/\\\\/\\/g; | 
 | 			push @allow_rules, [$ops, $ref]; | 
 | 		} elsif (/^for\s+([^\s]+)$/) { | 
 | 			# Mentioned, but nothing granted? | 
 | 		} elsif (/^[^\s]+$/) { | 
 | 			s/\\\\/\\/g; | 
 | 			push @allow_rules, ['U', $_]; | 
 | 		} | 
 | 	} | 
 | } | 
 |  | 
 | if ($op ne 'D') { | 
 | 	$new_type = git_value('cat-file','-t',$new); | 
 |  | 
 | 	if ($ref =~ m,^heads/,) { | 
 | 		deny "$ref must be a commit." unless $new_type eq 'commit'; | 
 | 	} elsif ($ref =~ m,^tags/,) { | 
 | 		deny "$ref must be an annotated tag." unless $new_type eq 'tag'; | 
 | 	} | 
 |  | 
 | 	check_committers (all_new_committers); | 
 | 	check_committers (all_new_taggers) if $new_type eq 'tag'; | 
 | } | 
 |  | 
 | info "$this_user wants $op for $ref"; | 
 | foreach my $acl_entry (@allow_rules) { | 
 | 	my ($acl_ops, $acl_n) = @$acl_entry; | 
 | 	next unless $acl_ops =~ /^[CDRU]+$/; # Uhh.... shouldn't happen. | 
 | 	next unless $acl_n; | 
 | 	next unless $op =~ /^[$acl_ops]$/; | 
 | 	next unless match_string $acl_n, $ref; | 
 |  | 
 | 	# Don't test path rules on branch deletes. | 
 | 	# | 
 | 	grant "Allowed by: $acl_ops for $acl_n" if $op eq 'D'; | 
 |  | 
 | 	# Aggregate matching path rules; allow if there aren't | 
 | 	# any matching this ref. | 
 | 	# | 
 | 	my %pr; | 
 | 	foreach my $p_entry (@path_rules) { | 
 | 		my ($p_ops, $p_n, $p_ref, $p_bst) = @$p_entry; | 
 | 		next unless $p_ref; | 
 | 		push @{$pr{$p_bst}}, $p_entry if match_string $p_ref, $ref; | 
 | 	} | 
 | 	grant "Allowed by: $acl_ops for $acl_n" unless %pr; | 
 |  | 
 | 	# Allow only if all changes against a single base are | 
 | 	# allowed by file path rules. | 
 | 	# | 
 | 	my @bad; | 
 | 	foreach my $p_bst (keys %pr) { | 
 | 		my $diff_ref = load_diff $p_bst; | 
 | 		deny "Cannot difference trees." unless ref $diff_ref; | 
 |  | 
 | 		my %fd = %$diff_ref; | 
 | 		foreach my $p_entry (@{$pr{$p_bst}}) { | 
 | 			my ($p_ops, $p_n, $p_ref, $p_bst) = @$p_entry; | 
 | 			next unless $p_ops =~ /^[AMD]+$/; | 
 | 			next unless $p_n; | 
 |  | 
 | 			foreach my $f_n (keys %fd) { | 
 | 				my $f_op = $fd{$f_n}; | 
 | 				next unless $f_op; | 
 | 				next unless $f_op =~ /^[$p_ops]$/; | 
 | 				delete $fd{$f_n} if match_string $p_n, $f_n; | 
 | 			} | 
 | 			last unless %fd; | 
 | 		} | 
 |  | 
 | 		if (%fd) { | 
 | 			push @bad, [$p_bst, \%fd]; | 
 | 		} else { | 
 | 			# All changes relative to $p_bst were allowed. | 
 | 			# | 
 | 			grant "Allowed by: $acl_ops for $acl_n diff $p_bst"; | 
 | 		} | 
 | 	} | 
 |  | 
 | 	foreach my $bad_ref (@bad) { | 
 | 		my ($p_bst, $fd) = @$bad_ref; | 
 | 		print STDERR "\n"; | 
 | 		print STDERR "Not allowed to make the following changes:\n"; | 
 | 		print STDERR "(base: $p_bst)\n"; | 
 | 		foreach my $f_n (sort keys %$fd) { | 
 | 			print STDERR "  $fd->{$f_n} $f_n\n"; | 
 | 		} | 
 | 	} | 
 | 	deny "You are not permitted to $op $ref"; | 
 | } | 
 | close A; | 
 | deny "You are not permitted to $op $ref"; |