1#!/usr/local/bin/perl
2
3use strict;
4use File::Spec;
5
6$ENV{PATH}     = '/opt/git/bin';
7my $acl_git    = '/vcs/acls.git';
8my $acl_branch = 'refs/heads/master';
9my $debug      = 0;
10
11=doc
12Invoked as: update refname old-sha1 new-sha1
13
14This script is run by git-receive-pack once for each ref that the
15client is trying to modify.  If we exit with a non-zero exit value
16then the update for that particular ref is denied, but updates for
17other refs in the same run of receive-pack may still be allowed.
18
19We are run after the objects have been uploaded, but before the
20ref is actually modified.  We take advantage of that fact when we
21look for "new" commits and tags (the new objects won't show up in
22`rev-list --all`).
23
24This script loads and parses the content of the config file
25"users/$this_user.acl" from the $acl_branch commit of $acl_git ODB.
26The acl file is a git-config style file, but uses a slightly more
27restricted syntax as the Perl parser contained within this script
28is not nearly as permissive as git-config.
29
30Example:
31
32  [user]
33    committer = John Doe <john.doe@example.com>
34    committer = John R. Doe <john.doe@example.com>
35
36  [repository "acls"]
37    allow = heads/master
38    allow = CDUR for heads/jd/
39    allow = C    for ^tags/v\\d+$
40
41For all new commit or tag objects the committer (or tagger) line
42within the object must exactly match one of the user.committer
43values listed in the acl file ("HEAD:users/$this_user.acl").
44
45For a branch to be modified an allow line within the matching
46repository section must be matched for both the refname and the
47opcode.
48
49Repository sections are matched on the basename of the repository
50(after removing the .git suffix).
51
52The opcode abbreviations are:
53
54  C: create new ref
55  D: delete existing ref
56  U: fast-forward existing ref (no commit loss)
57  R: rewind/rebase existing ref (commit loss)
58
59if no opcodes are listed before the "for" keyword then "U" (for
60fast-forward update only) is assumed as this is the most common
61usage.
62
63Refnames are matched by always assuming a prefix of "refs/".
64This hook forbids pushing or deleting anything not under "refs/".
65
66Refnames that start with ^ are Perl regular expressions, and the ^
67is kept as part of the regexp.  \\ is needed to get just one \, so
68\\d expands to \d in Perl.  The 3rd allow line above is an example.
69
70Refnames that don't start with ^ but that end with / are prefix
71matches (2nd allow line above); all other refnames are strict
72equality matches (1st allow line).
73
74Anything pushed to "heads/" (ok, really "refs/heads/") must be
75a commit.  Tags are not permitted here.
76
77Anything pushed to "tags/" (err, really "refs/tags/") must be an
78annotated tag.  Commits, blobs, trees, etc. are not permitted here.
79Annotated tag signatures aren't checked, nor are they required.
80
81The special subrepository of 'info/new-commit-check' can
82be created and used to allow users to push new commits and
83tags from another local repository to this one, even if they
84aren't the committer/tagger of those objects.  In a nut shell
85the info/new-commit-check directory is a Git repository whose
86objects/info/alternates file lists this repository and all other
87possible sources, and whose refs subdirectory contains symlinks
88to this repository's refs subdirectory, and to all other possible
89sources refs subdirectories.  Yes, this means that you cannot
90use packed-refs in those repositories as they won't be resolved
91correctly.
92
93=cut
94
95my $git_dir = $ENV{GIT_DIR};
96my $new_commit_check = "$git_dir/info/new-commit-check";
97my $ref = $ARGV[0];
98my $old = $ARGV[1];
99my $new = $ARGV[2];
100my $new_type;
101my ($this_user) = getpwuid $<; # REAL_USER_ID
102my $repository_name;
103my %user_committer;
104my @allow_rules;
105my @path_rules;
106my %diff_cache;
107
108sub deny ($) {
109	print STDERR "-Deny-    $_[0]\n" if $debug;
110	print STDERR "\ndenied: $_[0]\n\n";
111	exit 1;
112}
113
114sub grant ($) {
115	print STDERR "-Grant-   $_[0]\n" if $debug;
116	exit 0;
117}
118
119sub info ($) {
120	print STDERR "-Info-    $_[0]\n" if $debug;
121}
122
123sub git_value (@) {
124	open(T,'-|','git',@_); local $_ = <T>; chop; close T; $_;
125}
126
127sub match_string ($$) {
128	my ($acl_n, $ref) = @_;
129	   ($acl_n eq $ref)
130	|| ($acl_n =~ m,/$, && substr($ref,0,length $acl_n) eq $acl_n)
131	|| ($acl_n =~ m,^\^, && $ref =~ m:$acl_n:);
132}
133
134sub parse_config ($$$$) {
135	my $data = shift;
136	local $ENV{GIT_DIR} = shift;
137	my $br = shift;
138	my $fn = shift;
139	return unless git_value('rev-list','--max-count=1',$br,'--',$fn);
140	info "Loading $br:$fn";
141	open(I,'-|','git','cat-file','blob',"$br:$fn");
142	my $section = '';
143	while (<I>) {
144		chomp;
145		if (/^\s*$/ || /^\s*#/) {
146		} elsif (/^\[([a-z]+)\]$/i) {
147			$section = lc $1;
148		} elsif (/^\[([a-z]+)\s+"(.*)"\]$/i) {
149			$section = join('.',lc $1,$2);
150		} elsif (/^\s*([a-z][a-z0-9]+)\s*=\s*(.*?)\s*$/i) {
151			push @{$data->{join('.',$section,lc $1)}}, $2;
152		} else {
153			deny "bad config file line $. in $br:$fn";
154		}
155	}
156	close I;
157}
158
159sub all_new_committers () {
160	local $ENV{GIT_DIR} = $git_dir;
161	$ENV{GIT_DIR} = $new_commit_check if -d $new_commit_check;
162
163	info "Getting committers of new commits.";
164	my %used;
165	open(T,'-|','git','rev-list','--pretty=raw',$new,'--not','--all');
166	while (<T>) {
167		next unless s/^committer //;
168		chop;
169		s/>.*$/>/;
170		info "Found $_." unless $used{$_}++;
171	}
172	close T;
173	info "No new commits." unless %used;
174	keys %used;
175}
176
177sub all_new_taggers () {
178	my %exists;
179	open(T,'-|','git','for-each-ref','--format=%(objectname)','refs/tags');
180	while (<T>) {
181		chop;
182		$exists{$_} = 1;
183	}
184	close T;
185
186	info "Getting taggers of new tags.";
187	my %used;
188	my $obj = $new;
189	my $obj_type = $new_type;
190	while ($obj_type eq 'tag') {
191		last if $exists{$obj};
192		$obj_type = '';
193		open(T,'-|','git','cat-file','tag',$obj);
194		while (<T>) {
195			chop;
196			if (/^object ([a-z0-9]{40})$/) {
197				$obj = $1;
198			} elsif (/^type (.+)$/) {
199				$obj_type = $1;
200			} elsif (s/^tagger //) {
201				s/>.*$/>/;
202				info "Found $_." unless $used{$_}++;
203				last;
204			}
205		}
206		close T;
207	}
208	info "No new tags." unless %used;
209	keys %used;
210}
211
212sub check_committers (@) {
213	my @bad;
214	foreach (@_) { push @bad, $_ unless $user_committer{$_}; }
215	if (@bad) {
216		print STDERR "\n";
217		print STDERR "You are not $_.\n" foreach (sort @bad);
218		deny "You cannot push changes not committed by you.";
219	}
220}
221
222sub load_diff ($) {
223	my $base = shift;
224	my $d = $diff_cache{$base};
225	unless ($d) {
226		local $/ = "\0";
227		my %this_diff;
228		if ($base =~ /^0{40}$/) {
229			# Don't load the diff at all; we are making the
230			# branch and have no base to compare to in this
231			# case.  A file level ACL makes no sense in this
232			# context.  Having an empty diff will allow the
233			# branch creation.
234			#
235		} else {
236			open(T,'-|','git','diff-tree',
237				'-r','--name-status','-z',
238				$base,$new) or return undef;
239			while (<T>) {
240				my $op = $_;
241				chop $op;
242
243				my $path = <T>;
244				chop $path;
245
246				$this_diff{$path} = $op;
247			}
248			close T or return undef;
249		}
250		$d = \%this_diff;
251		$diff_cache{$base} = $d;
252	}
253	return $d;
254}
255
256deny "No GIT_DIR inherited from caller" unless $git_dir;
257deny "Need a ref name" unless $ref;
258deny "Refusing funny ref $ref" unless $ref =~ s,^refs/,,;
259deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/;
260deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/;
261deny "Cannot determine who you are." unless $this_user;
262grant "No change requested." if $old eq $new;
263
264$repository_name = File::Spec->rel2abs($git_dir);
265$repository_name =~ m,/([^/]+)(?:\.git|/\.git)$,;
266$repository_name = $1;
267info "Updating in '$repository_name'.";
268
269my $op;
270if    ($old =~ /^0{40}$/) { $op = 'C'; }
271elsif ($new =~ /^0{40}$/) { $op = 'D'; }
272else                      { $op = 'R'; }
273
274# This is really an update (fast-forward) if the
275# merge base of $old and $new is $old.
276#
277$op = 'U' if ($op eq 'R'
278	&& $ref =~ m,^heads/,
279	&& $old eq git_value('merge-base',$old,$new));
280
281# Load the user's ACL file. Expand groups (user.memberof) one level.
282{
283	my %data = ('user.committer' => []);
284	parse_config(\%data,$acl_git,$acl_branch,"external/$repository_name.acl");
285
286	%data = (
287		'user.committer' => $data{'user.committer'},
288		'user.memberof' => [],
289	);
290	parse_config(\%data,$acl_git,$acl_branch,"users/$this_user.acl");
291
292	%user_committer = map {$_ => $_} @{$data{'user.committer'}};
293	my $rule_key = "repository.$repository_name.allow";
294	my $rules = $data{$rule_key} || [];
295
296	foreach my $group (@{$data{'user.memberof'}}) {
297		my %g;
298		parse_config(\%g,$acl_git,$acl_branch,"groups/$group.acl");
299		my $group_rules = $g{$rule_key};
300		push @$rules, @$group_rules if $group_rules;
301	}
302
303RULE:
304	foreach (@$rules) {
305		while (/\${user\.([a-z][a-zA-Z0-9]+)}/) {
306			my $k = lc $1;
307			my $v = $data{"user.$k"};
308			next RULE unless defined $v;
309			next RULE if @$v != 1;
310			next RULE unless defined $v->[0];
311			s/\${user\.$k}/$v->[0]/g;
312		}
313
314		if (/^([AMD ]+)\s+of\s+([^\s]+)\s+for\s+([^\s]+)\s+diff\s+([^\s]+)$/) {
315			my ($ops, $pth, $ref, $bst) = ($1, $2, $3, $4);
316			$ops =~ s/ //g;
317			$pth =~ s/\\\\/\\/g;
318			$ref =~ s/\\\\/\\/g;
319			push @path_rules, [$ops, $pth, $ref, $bst];
320		} elsif (/^([AMD ]+)\s+of\s+([^\s]+)\s+for\s+([^\s]+)$/) {
321			my ($ops, $pth, $ref) = ($1, $2, $3);
322			$ops =~ s/ //g;
323			$pth =~ s/\\\\/\\/g;
324			$ref =~ s/\\\\/\\/g;
325			push @path_rules, [$ops, $pth, $ref, $old];
326		} elsif (/^([CDRU ]+)\s+for\s+([^\s]+)$/) {
327			my $ops = $1;
328			my $ref = $2;
329			$ops =~ s/ //g;
330			$ref =~ s/\\\\/\\/g;
331			push @allow_rules, [$ops, $ref];
332		} elsif (/^for\s+([^\s]+)$/) {
333			# Mentioned, but nothing granted?
334		} elsif (/^[^\s]+$/) {
335			s/\\\\/\\/g;
336			push @allow_rules, ['U', $_];
337		}
338	}
339}
340
341if ($op ne 'D') {
342	$new_type = git_value('cat-file','-t',$new);
343
344	if ($ref =~ m,^heads/,) {
345		deny "$ref must be a commit." unless $new_type eq 'commit';
346	} elsif ($ref =~ m,^tags/,) {
347		deny "$ref must be an annotated tag." unless $new_type eq 'tag';
348	}
349
350	check_committers (all_new_committers);
351	check_committers (all_new_taggers) if $new_type eq 'tag';
352}
353
354info "$this_user wants $op for $ref";
355foreach my $acl_entry (@allow_rules) {
356	my ($acl_ops, $acl_n) = @$acl_entry;
357	next unless $acl_ops =~ /^[CDRU]+$/; # Uhh.... shouldn't happen.
358	next unless $acl_n;
359	next unless $op =~ /^[$acl_ops]$/;
360	next unless match_string $acl_n, $ref;
361
362	# Don't test path rules on branch deletes.
363	#
364	grant "Allowed by: $acl_ops for $acl_n" if $op eq 'D';
365
366	# Aggregate matching path rules; allow if there aren't
367	# any matching this ref.
368	#
369	my %pr;
370	foreach my $p_entry (@path_rules) {
371		my ($p_ops, $p_n, $p_ref, $p_bst) = @$p_entry;
372		next unless $p_ref;
373		push @{$pr{$p_bst}}, $p_entry if match_string $p_ref, $ref;
374	}
375	grant "Allowed by: $acl_ops for $acl_n" unless %pr;
376
377	# Allow only if all changes against a single base are
378	# allowed by file path rules.
379	#
380	my @bad;
381	foreach my $p_bst (keys %pr) {
382		my $diff_ref = load_diff $p_bst;
383		deny "Cannot difference trees." unless ref $diff_ref;
384
385		my %fd = %$diff_ref;
386		foreach my $p_entry (@{$pr{$p_bst}}) {
387			my ($p_ops, $p_n, $p_ref, $p_bst) = @$p_entry;
388			next unless $p_ops =~ /^[AMD]+$/;
389			next unless $p_n;
390
391			foreach my $f_n (keys %fd) {
392				my $f_op = $fd{$f_n};
393				next unless $f_op;
394				next unless $f_op =~ /^[$p_ops]$/;
395				delete $fd{$f_n} if match_string $p_n, $f_n;
396			}
397			last unless %fd;
398		}
399
400		if (%fd) {
401			push @bad, [$p_bst, \%fd];
402		} else {
403			# All changes relative to $p_bst were allowed.
404			#
405			grant "Allowed by: $acl_ops for $acl_n diff $p_bst";
406		}
407	}
408
409	foreach my $bad_ref (@bad) {
410		my ($p_bst, $fd) = @$bad_ref;
411		print STDERR "\n";
412		print STDERR "Not allowed to make the following changes:\n";
413		print STDERR "(base: $p_bst)\n";
414		foreach my $f_n (sort keys %$fd) {
415			print STDERR "  $fd->{$f_n} $f_n\n";
416		}
417	}
418	deny "You are not permitted to $op $ref";
419}
420close A;
421deny "You are not permitted to $op $ref";
422