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 git_value (@) {
 122         open(T,'-|','git',@_); local $_ = <T>; chop; close T; $_;
 123 }
 124
 125 sub parse_config ($$$$) {
 126         my $data = shift;
 127         local $ENV{GIT_DIR} = shift;
 128         my $br = shift;
 129         my $fn = shift;
 130         info "Loading $br:$fn";
 131         open(I,'-|','git','cat-file','blob',"$br:$fn");
 132         my $section = '';
 133         while (<I>) {
 134                 chomp;
 135                 if (/^\s*$/ || /^\s*#/) {
 136                 } elsif (/^\[([a-z]+)\]$/i) {
 137                         $section = lc $1;
 138                 } elsif (/^\[([a-z]+)\s+"(.*)"\]$/i) {
 139                         $section = join('.',lc $1,$2);
 140                 } elsif (/^\s*([a-z][a-z0-9]+)\s*=\s*(.*?)\s*$/i) {
 141                         push @{$data->{join('.',$section,lc $1)}}, $2;
 142                 } else {
 143                         deny "bad config file line $. in $br:$fn";
 144                 }
 145         }
 146         close I;
 147 }
 148
 149 sub all_new_committers () {
 150         local $ENV{GIT_DIR} = $git_dir;
 151         $ENV{GIT_DIR} = $new_commit_check if -d $new_commit_check;
 152
 153         info "Getting committers of new commits.";
 154         my %used;
 155         open(T,'-|','git','rev-list','--pretty=raw',$new,'--not','--all');
 156         while (<T>) {
 157                 next unless s/^committer //;
 158                 chop;
 159                 s/>.*$/>/;
 160                 info "Found $_." unless $used{$_}++;
 161         }
 162         close T;
 163         info "No new commits." unless %used;
 164         keys %used;
 165 }
 166
 167 sub all_new_taggers () {
 168         my %exists;
 169         open(T,'-|','git','for-each-ref','--format=%(objectname)','refs/tags');
 170         while (<T>) {
 171                 chop;
 172                 $exists{$_} = 1;
 173         }
 174         close T;
 175
 176         info "Getting taggers of new tags.";
 177         my %used;
 178         my $obj = $new;
 179         my $obj_type = $new_type;
 180         while ($obj_type eq 'tag') {
 181                 last if $exists{$obj};
 182                 $obj_type = '';
 183                 open(T,'-|','git','cat-file','tag',$obj);
 184                 while (<T>) {
 185                         chop;
 186                         if (/^object ([a-z0-9]{40})$/) {
 187                                 $obj = $1;
 188                         } elsif (/^type (.+)$/) {
 189                                 $obj_type = $1;
 190                         } elsif (s/^tagger //) {
 191                                 s/>.*$/>/;
 192                                 info "Found $_." unless $used{$_}++;
 193                                 last;
 194                         }
 195                 }
 196                 close T;
 197         }
 198         info "No new tags." unless %used;
 199         keys %used;
 200 }
 201
 202 sub check_committers (@) {
 203         my @bad;
 204         foreach (@_) { push @bad, $_ unless $user_committer{$_}; }
 205         if (@bad) {
 206                 print STDERR "\n";
 207                 print STDERR "You are not $_.\n" foreach (sort @bad);
 208                 deny "You cannot push changes not committed by you.";
 209         }
 210 }
 211
 212 deny "No GIT_DIR inherited from caller" unless $git_dir;
 213 deny "Need a ref name" unless $ref;
 214 deny "Refusing funny ref $ref" unless $ref =~ s,^refs/,,;
 215 deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/;
 216 deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/;
 217 deny "Cannot determine who you are." unless $this_user;
 218
 219 $repository_name = File::Spec->rel2abs($git_dir);
 220 $repository_name =~ m,/([^/]+)(?:\.git|/\.git)$,;
 221 $repository_name = $1;
 222 info "Updating in '$repository_name'.";
 223
 224 my $op;
 225 if    ($old =~ /^0{40}$/) { $op = 'C'; }
 226 elsif ($new =~ /^0{40}$/) { $op = 'D'; }
 227 else                      { $op = 'R'; }
 228
 229 # This is really an update (fast-forward) if the
 230 # merge base of $old and $new is $old.
 231 #
 232 $op = 'U' if ($op eq 'R'
 233         && $ref =~ m,^heads/,
 234         && $old eq git_value('merge-base',$old,$new));
 235
 236 # Load the user's ACL file. Expand groups (user.memberof) one level.
 237 {
 238         my %data = ('user.committer' => []);
 239         parse_config(\%data,$acl_git,$acl_branch,"external/$repository_name.acl");
 240
 241         %data = (
 242                 'user.committer' => $data{'user.committer'},
 243                 'user.memberof' => [],
 244         );
 245         parse_config(\%data,$acl_git,$acl_branch,"users/$this_user.acl");
 246
 247         %user_committer = map {$_ => $_} @{$data{'user.committer'}};
 248         my $rule_key = "repository.$repository_name.allow";
 249         my $rules = $data{$rule_key} || [];
 250
 251         foreach my $group (@{$data{'user.memberof'}}) {
 252                 my %g;
 253                 parse_config(\%g,$acl_git,$acl_branch,"groups/$group.acl");
 254                 my $group_rules = $g{$rule_key};
 255                 push @$rules, @$group_rules if $group_rules;
 256         }
 257
 258 RULE:
 259         foreach (@$rules) {
 260                 while (/\${user\.([a-z][a-zA-Z0-9]+)}/) {
 261                         my $k = lc $1;
 262                         my $v = $data{"user.$k"};
 263                         next RULE unless defined $v;
 264                         next RULE if @$v != 1;
 265                         next RULE unless defined $v->[0];
 266                         s/\${user\.$k}/$v->[0]/g;
 267                 }
 268
 269                 if (/^([CDRU ]+)\s+for\s+([^\s]+)$/) {
 270                         my $ops = $1;
 271                         my $ref = $2;
 272                         $ops =~ s/ //g;
 273                         $ref =~ s/\\\\/\\/g;
 274                         push @allow_rules, [$ops, $ref];
 275                 } elsif (/^for\s+([^\s]+)$/) {
 276                         # Mentioned, but nothing granted?
 277                 } elsif (/^[^\s]+$/) {
 278                         s/\\\\/\\/g;
 279                         push @allow_rules, ['U', $_];
 280                 }
 281         }
 282 }
 283
 284 if ($op ne 'D') {
 285         $new_type = git_value('cat-file','-t',$new);
 286
 287         if ($ref =~ m,^heads/,) {
 288                 deny "$ref must be a commit." unless $new_type eq 'commit';
 289         } elsif ($ref =~ m,^tags/,) {
 290                 deny "$ref must be an annotated tag." unless $new_type eq 'tag';
 291         }
 292
 293         check_committers (all_new_committers);
 294         check_committers (all_new_taggers) if $new_type eq 'tag';
 295 }
 296
 297 info "$this_user wants $op for $ref";
 298 foreach my $acl_entry (@allow_rules) {
 299         my ($acl_ops, $acl_n) = @$acl_entry;
 300         next unless $acl_ops =~ /^[CDRU]+$/; # Uhh.... shouldn't happen.
 301         next unless $acl_n;
 302         next unless $op =~ /^[$acl_ops]$/;
 303
 304         grant "Allowed by: $acl_ops for $acl_n"
 305         if (
 306            ($acl_n eq $ref)
 307         || ($acl_n =~ m,/$, && substr($ref,0,length $acl_n) eq $acl_n)
 308         || ($acl_n =~ m,^\^, && $ref =~ m:$acl_n:)
 309         );
 310 }
 311 close A;
 312 deny "You are not permitted to $op $ref";