Merge branch 'gfi-maint' into gfi-master
[git] / contrib / hooks / update-paranoid
1 #!/usr/bin/perl
2
3 use strict;
4 use File::Spec;
5
6 $ENV{PATH}     = '/opt/git/bin';
7 my $acl_git    = '/vcs/acls.git';
8 my $acl_branch = 'refs/heads/master';
9 my $debug      = 0;
10
11 =doc
12 Invoked as: update refname old-sha1 new-sha1
13
14 This script is run by git-receive-pack once for each ref that the
15 client is trying to modify.  If we exit with a non-zero exit value
16 then the update for that particular ref is denied, but updates for
17 other refs in the same run of receive-pack may still be allowed.
18
19 We are run after the objects have been uploaded, but before the
20 ref is actually modified.  We take advantage of that fact when we
21 look for "new" commits and tags (the new objects won't show up in
22 `rev-list --all`).
23
24 This script loads and parses the content of the config file
25 "users/$this_user.acl" from the $acl_branch commit of $acl_git ODB.
26 The acl file is a git-config style file, but uses a slightly more
27 restricted syntax as the Perl parser contained within this script
28 is not nearly as permissive as git-config.
29
30 Example:
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
41 For all new commit or tag objects the committer (or tagger) line
42 within the object must exactly match one of the user.committer
43 values listed in the acl file ("HEAD:users/$this_user.acl").
44
45 For a branch to be modified an allow line within the matching
46 repository section must be matched for both the refname and the
47 opcode.
48
49 Repository sections are matched on the basename of the repository
50 (after removing the .git suffix).
51
52 The 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
59 if no opcodes are listed before the "for" keyword then "U" (for
60 fast-forward update only) is assumed as this is the most common
61 usage.
62
63 Refnames are matched by always assuming a prefix of "refs/".
64 This hook forbids pushing or deleting anything not under "refs/".
65
66 Refnames that start with ^ are Perl regular expressions, and the ^
67 is 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
70 Refnames that don't start with ^ but that end with / are prefix
71 matches (2nd allow line above); all other refnames are strict
72 equality matches (1st allow line).
73
74 Anything pushed to "heads/" (ok, really "refs/heads/") must be
75 a commit.  Tags are not permitted here.
76
77 Anything pushed to "tags/" (err, really "refs/tags/") must be an
78 annotated tag.  Commits, blobs, trees, etc. are not permitted here.
79 Annotated tag signatures aren't checked, nor are they required.
80
81 The special subrepository of 'info/new-commit-check' can
82 be created and used to allow users to push new commits and
83 tags from another local repository to this one, even if they
84 aren't the committer/tagger of those objects.  In a nut shell
85 the info/new-commit-check directory is a Git repository whose
86 objects/info/alternates file lists this repository and all other
87 possible sources, and whose refs subdirectory contains symlinks
88 to this repository's refs subdirectory, and to all other possible
89 sources refs subdirectories.  Yes, this means that you cannot
90 use packed-refs in those repositories as they won't be resolved
91 correctly.
92
93 =cut
94
95 my $git_dir = $ENV{GIT_DIR};
96 my $new_commit_check = "$git_dir/info/new-commit-check";
97 my $ref = $ARGV[0];
98 my $old = $ARGV[1];
99 my $new = $ARGV[2];
100 my $new_type;
101 my ($this_user) = getpwuid $<; # REAL_USER_ID
102 my $repository_name;
103 my %user_committer;
104 my @allow_rules;
105
106 sub deny ($) {
107         print STDERR "-Deny-    $_[0]\n" if $debug;
108         print STDERR "\ndenied: $_[0]\n\n";
109         exit 1;
110 }
111
112 sub grant ($) {
113         print STDERR "-Grant-   $_[0]\n" if $debug;
114         exit 0;
115 }
116
117 sub info ($) {
118         print STDERR "-Info-    $_[0]\n" if $debug;
119 }
120
121 sub parse_config ($$) {
122         my ($data, $fn) = @_;
123         info "Loading $fn";
124         open(I,'-|','git',"--git-dir=$acl_git",'cat-file','blob',$fn);
125         my $section = '';
126         while (<I>) {
127                 chomp;
128                 if (/^\s*$/ || /^\s*#/) {
129                 } elsif (/^\[([a-z]+)\]$/i) {
130                         $section = $1;
131                 } elsif (/^\[([a-z]+)\s+"(.*)"\]$/i) {
132                         $section = "$1.$2";
133                 } elsif (/^\s*([a-z][a-z0-9]+)\s*=\s*(.*?)\s*$/i) {
134                         push @{$data->{"$section.$1"}}, $2;
135                 } else {
136                         deny "bad config file line $. in $fn";
137                 }
138         }
139         close I;
140 }
141
142 sub all_new_committers () {
143         local $ENV{GIT_DIR} = $git_dir;
144         $ENV{GIT_DIR} = $new_commit_check if -d $new_commit_check;
145
146         info "Getting committers of new commits.";
147         my %used;
148         open(T,'-|','git','rev-list','--pretty=raw',$new,'--not','--all');
149         while (<T>) {
150                 next unless s/^committer //;
151                 chop;
152                 s/>.*$/>/;
153                 info "Found $_." unless $used{$_}++;
154         }
155         close T;
156         info "No new commits." unless %used;
157         keys %used;
158 }
159
160 sub all_new_taggers () {
161         my %exists;
162         open(T,'-|','git','for-each-ref','--format=%(objectname)','refs/tags');
163         while (<T>) {
164                 chop;
165                 $exists{$_} = 1;
166         }
167         close T;
168
169         info "Getting taggers of new tags.";
170         my %used;
171         my $obj = $new;
172         my $obj_type = $new_type;
173         while ($obj_type eq 'tag') {
174                 last if $exists{$obj};
175                 $obj_type = '';
176                 open(T,'-|','git','cat-file','tag',$obj);
177                 while (<T>) {
178                         chop;
179                         if (/^object ([a-z0-9]{40})$/) {
180                                 $obj = $1;
181                         } elsif (/^type (.+)$/) {
182                                 $obj_type = $1;
183                         } elsif (s/^tagger //) {
184                                 s/>.*$/>/;
185                                 info "Found $_." unless $used{$_}++;
186                                 last;
187                         }
188                 }
189                 close T;
190         }
191         info "No new tags." unless %used;
192         keys %used;
193 }
194
195 sub check_committers (@) {
196         my @bad;
197         foreach (@_) { push @bad, $_ unless $user_committer{$_}; }
198         if (@bad) {
199                 print STDERR "\n";
200                 print STDERR "You are not $_.\n" foreach (sort @bad);
201                 deny "You cannot push changes not committed by you.";
202         }
203 }
204
205 sub git_value (@) {
206         open(T,'-|','git',@_); local $_ = <T>; chop; close T;
207         $_;
208 }
209
210 deny "No GIT_DIR inherited from caller" unless $git_dir;
211 deny "Need a ref name" unless $ref;
212 deny "Refusing funny ref $ref" unless $ref =~ s,^refs/,,;
213 deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/;
214 deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/;
215 deny "Cannot determine who you are." unless $this_user;
216
217 $repository_name = File::Spec->rel2abs($git_dir);
218 $repository_name =~ m,/([^/]+)(?:\.git|/\.git)$,;
219 $repository_name = $1;
220 info "Updating in '$repository_name'.";
221
222 my $op;
223 if    ($old =~ /^0{40}$/) { $op = 'C'; }
224 elsif ($new =~ /^0{40}$/) { $op = 'D'; }
225 else                      { $op = 'R'; }
226
227 # This is really an update (fast-forward) if the
228 # merge base of $old and $new is $old.
229 #
230 $op = 'U' if ($op eq 'R'
231         && $ref =~ m,^heads/,
232         && $old eq git_value('merge-base',$old,$new));
233
234 # Load the user's ACL file.
235 {
236         my %data = ('user.committer' => []);
237         parse_config(\%data, "$acl_branch:users/$this_user.acl");
238         %user_committer = map {$_ => $_} @{$data{'user.committer'}};
239         my $rules = $data{"repository.$repository_name.allow"} || [];
240         foreach (@$rules) {
241                 if (/^([CDRU ]+)\s+for\s+([^\s]+)$/) {
242                         my $ops = $1;
243                         my $ref = $2;
244                         $ops =~ s/ //g;
245                         $ref =~ s/\\\\/\\/g;
246                         push @allow_rules, [$ops, $ref];
247                 } elsif (/^for\s+([^\s]+)$/) {
248                         # Mentioned, but nothing granted?
249                 } elsif (/^[^\s]+$/) {
250                         s/\\\\/\\/g;
251                         push @allow_rules, ['U', $_];
252                 }
253         }
254 }
255
256 if ($op ne 'D') {
257         $new_type = git_value('cat-file','-t',$new);
258
259         if ($ref =~ m,^heads/,) {
260                 deny "$ref must be a commit." unless $new_type eq 'commit';
261         } elsif ($ref =~ m,^tags/,) {
262                 deny "$ref must be an annotated tag." unless $new_type eq 'tag';
263         }
264
265         check_committers (all_new_committers);
266         check_committers (all_new_taggers) if $new_type eq 'tag';
267 }
268
269 info "$this_user wants $op for $ref";
270 foreach my $acl_entry (@allow_rules) {
271         my ($acl_ops, $acl_n) = @$acl_entry;
272         next unless $acl_ops =~ /^[CDRU]+$/; # Uhh.... shouldn't happen.
273         next unless $acl_n;
274         next unless $op =~ /^[$acl_ops]$/;
275
276         grant "Allowed by: $acl_ops for $acl_n"
277         if (
278            ($acl_n eq $ref)
279         || ($acl_n =~ m,/$, && substr($ref,0,length $acl_n) eq $acl_n)
280         || ($acl_n =~ m,^\^, && $ref =~ m:$acl_n:)
281         );
282 }
283 close A;
284 deny "You are not permitted to $op $ref";