Teach the update-paranoid to look at file differences
[git/git.git] / contrib / hooks / update-paranoid
CommitLineData
9398e5aa
SP
1#!/usr/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 abbrevations 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;
d47eed32
SP
105my @path_rules;
106my %diff_cache;
9398e5aa
SP
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
b767c792
SP
123sub git_value (@) {
124 open(T,'-|','git',@_); local $_ = <T>; chop; close T; $_;
125}
126
d47eed32
SP
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
b767c792
SP
134sub parse_config ($$$$) {
135 my $data = shift;
136 local $ENV{GIT_DIR} = shift;
137 my $br = shift;
138 my $fn = shift;
139 info "Loading $br:$fn";
140 open(I,'-|','git','cat-file','blob',"$br:$fn");
9398e5aa
SP
141 my $section = '';
142 while (<I>) {
143 chomp;
144 if (/^\s*$/ || /^\s*#/) {
145 } elsif (/^\[([a-z]+)\]$/i) {
b767c792 146 $section = lc $1;
9398e5aa 147 } elsif (/^\[([a-z]+)\s+"(.*)"\]$/i) {
b767c792 148 $section = join('.',lc $1,$2);
9398e5aa 149 } elsif (/^\s*([a-z][a-z0-9]+)\s*=\s*(.*?)\s*$/i) {
b767c792 150 push @{$data->{join('.',$section,lc $1)}}, $2;
9398e5aa 151 } else {
b767c792 152 deny "bad config file line $. in $br:$fn";
9398e5aa
SP
153 }
154 }
155 close I;
156}
157
158sub all_new_committers () {
159 local $ENV{GIT_DIR} = $git_dir;
160 $ENV{GIT_DIR} = $new_commit_check if -d $new_commit_check;
161
162 info "Getting committers of new commits.";
163 my %used;
164 open(T,'-|','git','rev-list','--pretty=raw',$new,'--not','--all');
165 while (<T>) {
166 next unless s/^committer //;
167 chop;
168 s/>.*$/>/;
169 info "Found $_." unless $used{$_}++;
170 }
171 close T;
172 info "No new commits." unless %used;
173 keys %used;
174}
175
176sub all_new_taggers () {
177 my %exists;
178 open(T,'-|','git','for-each-ref','--format=%(objectname)','refs/tags');
179 while (<T>) {
180 chop;
181 $exists{$_} = 1;
182 }
183 close T;
184
185 info "Getting taggers of new tags.";
186 my %used;
187 my $obj = $new;
188 my $obj_type = $new_type;
189 while ($obj_type eq 'tag') {
190 last if $exists{$obj};
191 $obj_type = '';
192 open(T,'-|','git','cat-file','tag',$obj);
193 while (<T>) {
194 chop;
195 if (/^object ([a-z0-9]{40})$/) {
196 $obj = $1;
197 } elsif (/^type (.+)$/) {
198 $obj_type = $1;
199 } elsif (s/^tagger //) {
200 s/>.*$/>/;
201 info "Found $_." unless $used{$_}++;
202 last;
203 }
204 }
205 close T;
206 }
207 info "No new tags." unless %used;
208 keys %used;
209}
210
211sub check_committers (@) {
212 my @bad;
213 foreach (@_) { push @bad, $_ unless $user_committer{$_}; }
214 if (@bad) {
215 print STDERR "\n";
216 print STDERR "You are not $_.\n" foreach (sort @bad);
217 deny "You cannot push changes not committed by you.";
218 }
219}
220
d47eed32
SP
221sub load_diff ($) {
222 my $base = shift;
223 my $d = $diff_cache{$base};
224 unless ($d) {
225 local $/ = "\0";
226 open(T,'-|','git','diff-tree',
227 '-r','--name-status','-z',
228 $base,$new) or return undef;
229 my %this_diff;
230 while (<T>) {
231 my $op = $_;
232 chop $op;
233
234 my $path = <T>;
235 chop $path;
236
237 $this_diff{$path} = $op;
238 }
239 close T or return undef;
240 $d = \%this_diff;
241 $diff_cache{$base} = $d;
242 }
243 return $d;
244}
245
9398e5aa
SP
246deny "No GIT_DIR inherited from caller" unless $git_dir;
247deny "Need a ref name" unless $ref;
248deny "Refusing funny ref $ref" unless $ref =~ s,^refs/,,;
249deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/;
250deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/;
251deny "Cannot determine who you are." unless $this_user;
252
253$repository_name = File::Spec->rel2abs($git_dir);
254$repository_name =~ m,/([^/]+)(?:\.git|/\.git)$,;
255$repository_name = $1;
256info "Updating in '$repository_name'.";
257
258my $op;
259if ($old =~ /^0{40}$/) { $op = 'C'; }
260elsif ($new =~ /^0{40}$/) { $op = 'D'; }
261else { $op = 'R'; }
262
263# This is really an update (fast-forward) if the
264# merge base of $old and $new is $old.
265#
266$op = 'U' if ($op eq 'R'
267 && $ref =~ m,^heads/,
268 && $old eq git_value('merge-base',$old,$new));
269
b767c792 270# Load the user's ACL file. Expand groups (user.memberof) one level.
9398e5aa
SP
271{
272 my %data = ('user.committer' => []);
b767c792
SP
273 parse_config(\%data,$acl_git,$acl_branch,"external/$repository_name.acl");
274
275 %data = (
276 'user.committer' => $data{'user.committer'},
277 'user.memberof' => [],
278 );
279 parse_config(\%data,$acl_git,$acl_branch,"users/$this_user.acl");
280
9398e5aa 281 %user_committer = map {$_ => $_} @{$data{'user.committer'}};
b767c792
SP
282 my $rule_key = "repository.$repository_name.allow";
283 my $rules = $data{$rule_key} || [];
284
285 foreach my $group (@{$data{'user.memberof'}}) {
286 my %g;
287 parse_config(\%g,$acl_git,$acl_branch,"groups/$group.acl");
288 my $group_rules = $g{$rule_key};
289 push @$rules, @$group_rules if $group_rules;
290 }
291
292RULE:
9398e5aa 293 foreach (@$rules) {
b767c792
SP
294 while (/\${user\.([a-z][a-zA-Z0-9]+)}/) {
295 my $k = lc $1;
296 my $v = $data{"user.$k"};
297 next RULE unless defined $v;
298 next RULE if @$v != 1;
299 next RULE unless defined $v->[0];
300 s/\${user\.$k}/$v->[0]/g;
301 }
302
d47eed32
SP
303 if (/^([AMD ]+)\s+of\s+([^\s]+)\s+for\s+([^\s]+)\s+diff\s+([^\s]+)$/) {
304 my ($ops, $pth, $ref, $bst) = ($1, $2, $3, $4);
305 $ops =~ s/ //g;
306 $pth =~ s/\\\\/\\/g;
307 $ref =~ s/\\\\/\\/g;
308 push @path_rules, [$ops, $pth, $ref, $bst];
309 } elsif (/^([AMD ]+)\s+of\s+([^\s]+)\s+for\s+([^\s]+)$/) {
310 my ($ops, $pth, $ref) = ($1, $2, $3);
311 $ops =~ s/ //g;
312 $pth =~ s/\\\\/\\/g;
313 $ref =~ s/\\\\/\\/g;
314 push @path_rules, [$ops, $pth, $ref, $old];
315 } elsif (/^([CDRU ]+)\s+for\s+([^\s]+)$/) {
9398e5aa
SP
316 my $ops = $1;
317 my $ref = $2;
318 $ops =~ s/ //g;
319 $ref =~ s/\\\\/\\/g;
320 push @allow_rules, [$ops, $ref];
321 } elsif (/^for\s+([^\s]+)$/) {
322 # Mentioned, but nothing granted?
323 } elsif (/^[^\s]+$/) {
324 s/\\\\/\\/g;
325 push @allow_rules, ['U', $_];
326 }
327 }
328}
329
330if ($op ne 'D') {
331 $new_type = git_value('cat-file','-t',$new);
332
333 if ($ref =~ m,^heads/,) {
334 deny "$ref must be a commit." unless $new_type eq 'commit';
335 } elsif ($ref =~ m,^tags/,) {
336 deny "$ref must be an annotated tag." unless $new_type eq 'tag';
337 }
338
339 check_committers (all_new_committers);
340 check_committers (all_new_taggers) if $new_type eq 'tag';
341}
342
343info "$this_user wants $op for $ref";
344foreach my $acl_entry (@allow_rules) {
345 my ($acl_ops, $acl_n) = @$acl_entry;
346 next unless $acl_ops =~ /^[CDRU]+$/; # Uhh.... shouldn't happen.
347 next unless $acl_n;
348 next unless $op =~ /^[$acl_ops]$/;
d47eed32
SP
349 next unless match_string $acl_n, $ref;
350
351 # Don't test path rules on branch deletes.
352 #
353 grant "Allowed by: $acl_ops for $acl_n" if $op eq 'D';
354
355 # Aggregate matching path rules; allow if there aren't
356 # any matching this ref.
357 #
358 my %pr;
359 foreach my $p_entry (@path_rules) {
360 my ($p_ops, $p_n, $p_ref, $p_bst) = @$p_entry;
361 next unless $p_ref;
362 push @{$pr{$p_bst}}, $p_entry if match_string $p_ref, $ref;
363 }
364 grant "Allowed by: $acl_ops for $acl_n" unless %pr;
9398e5aa 365
d47eed32
SP
366 # Allow only if all changes against a single base are
367 # allowed by file path rules.
368 #
369 my @bad;
370 foreach my $p_bst (keys %pr) {
371 my $diff_ref = load_diff $p_bst;
372 deny "Cannot difference trees." unless ref $diff_ref;
373
374 my %fd = %$diff_ref;
375 foreach my $p_entry (@{$pr{$p_bst}}) {
376 my ($p_ops, $p_n, $p_ref, $p_bst) = @$p_entry;
377 next unless $p_ops =~ /^[AMD]+$/;
378 next unless $p_n;
379
380 foreach my $f_n (keys %fd) {
381 my $f_op = $fd{$f_n};
382 next unless $f_op;
383 next unless $f_op =~ /^[$p_ops]$/;
384 delete $fd{$f_n} if match_string $p_n, $f_n;
385 }
386 last unless %fd;
387 }
388
389 if (%fd) {
390 push @bad, [$p_bst, \%fd];
391 } else {
392 # All changes relative to $p_bst were allowed.
393 #
394 grant "Allowed by: $acl_ops for $acl_n diff $p_bst";
395 }
396 }
397
398 foreach my $bad_ref (@bad) {
399 my ($p_bst, $fd) = @$bad_ref;
400 print STDERR "\n";
401 print STDERR "Not allowed to make the following changes:\n";
402 print STDERR "(base: $p_bst)\n";
403 foreach my $f_n (sort keys %$fd) {
404 print STDERR " $fd->{$f_n} $f_n\n";
405 }
406 }
407 deny "You are not permitted to $op $ref";
9398e5aa
SP
408}
409close A;
410deny "You are not permitted to $op $ref";