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 my @path_rules;
 106 my %diff_cache;
 107
 108 sub deny ($) {
 109         print STDERR "-Deny-    $_[0]\n" if $debug;
 110         print STDERR "\ndenied: $_[0]\n\n";
 111         exit 1;
 112 }
 113
 114 sub grant ($) {
 115         print STDERR "-Grant-   $_[0]\n" if $debug;
 116         exit 0;
 117 }
 118
 119 sub info ($) {
 120         print STDERR "-Info-    $_[0]\n" if $debug;
 121 }
 122
 123 sub git_value (@) {
 124         open(T,'-|','git',@_); local $_ = <T>; chop; close T; $_;
 125 }
 126
 127 sub 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
 134 sub 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
 159 sub 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
 177 sub 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
 212 sub 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
 222 sub 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
 256 deny "No GIT_DIR inherited from caller" unless $git_dir;
 257 deny "Need a ref name" unless $ref;
 258 deny "Refusing funny ref $ref" unless $ref =~ s,^refs/,,;
 259 deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/;
 260 deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/;
 261 deny "Cannot determine who you are." unless $this_user;
 262
 263 $repository_name = File::Spec->rel2abs($git_dir);
 264 $repository_name =~ m,/([^/]+)(?:\.git|/\.git)$,;
 265 $repository_name = $1;
 266 info "Updating in '$repository_name'.";
 267
 268 my $op;
 269 if    ($old =~ /^0{40}$/) { $op = 'C'; }
 270 elsif ($new =~ /^0{40}$/) { $op = 'D'; }
 271 else                      { $op = 'R'; }
 272
 273 # This is really an update (fast-forward) if the
 274 # merge base of $old and $new is $old.
 275 #
 276 $op = 'U' if ($op eq 'R'
 277         && $ref =~ m,^heads/,
 278         && $old eq git_value('merge-base',$old,$new));
 279
 280 # Load the user's ACL file. Expand groups (user.memberof) one level.
 281 {
 282         my %data = ('user.committer' => []);
 283         parse_config(\%data,$acl_git,$acl_branch,"external/$repository_name.acl");
 284
 285         %data = (
 286                 'user.committer' => $data{'user.committer'},
 287                 'user.memberof' => [],
 288         );
 289         parse_config(\%data,$acl_git,$acl_branch,"users/$this_user.acl");
 290
 291         %user_committer = map {$_ => $_} @{$data{'user.committer'}};
 292         my $rule_key = "repository.$repository_name.allow";
 293         my $rules = $data{$rule_key} || [];
 294
 295         foreach my $group (@{$data{'user.memberof'}}) {
 296                 my %g;
 297                 parse_config(\%g,$acl_git,$acl_branch,"groups/$group.acl");
 298                 my $group_rules = $g{$rule_key};
 299                 push @$rules, @$group_rules if $group_rules;
 300         }
 301
 302 RULE:
 303         foreach (@$rules) {
 304                 while (/\${user\.([a-z][a-zA-Z0-9]+)}/) {
 305                         my $k = lc $1;
 306                         my $v = $data{"user.$k"};
 307                         next RULE unless defined $v;
 308                         next RULE if @$v != 1;
 309                         next RULE unless defined $v->[0];
 310                         s/\${user\.$k}/$v->[0]/g;
 311                 }
 312
 313                 if (/^([AMD ]+)\s+of\s+([^\s]+)\s+for\s+([^\s]+)\s+diff\s+([^\s]+)$/) {
 314                         my ($ops, $pth, $ref, $bst) = ($1, $2, $3, $4);
 315                         $ops =~ s/ //g;
 316                         $pth =~ s/\\\\/\\/g;
 317                         $ref =~ s/\\\\/\\/g;
 318                         push @path_rules, [$ops, $pth, $ref, $bst];
 319                 } elsif (/^([AMD ]+)\s+of\s+([^\s]+)\s+for\s+([^\s]+)$/) {
 320                         my ($ops, $pth, $ref) = ($1, $2, $3);
 321                         $ops =~ s/ //g;
 322                         $pth =~ s/\\\\/\\/g;
 323                         $ref =~ s/\\\\/\\/g;
 324                         push @path_rules, [$ops, $pth, $ref, $old];
 325                 } elsif (/^([CDRU ]+)\s+for\s+([^\s]+)$/) {
 326                         my $ops = $1;
 327                         my $ref = $2;
 328                         $ops =~ s/ //g;
 329                         $ref =~ s/\\\\/\\/g;
 330                         push @allow_rules, [$ops, $ref];
 331                 } elsif (/^for\s+([^\s]+)$/) {
 332                         # Mentioned, but nothing granted?
 333                 } elsif (/^[^\s]+$/) {
 334                         s/\\\\/\\/g;
 335                         push @allow_rules, ['U', $_];
 336                 }
 337         }
 338 }
 339
 340 if ($op ne 'D') {
 341         $new_type = git_value('cat-file','-t',$new);
 342
 343         if ($ref =~ m,^heads/,) {
 344                 deny "$ref must be a commit." unless $new_type eq 'commit';
 345         } elsif ($ref =~ m,^tags/,) {
 346                 deny "$ref must be an annotated tag." unless $new_type eq 'tag';
 347         }
 348
 349         check_committers (all_new_committers);
 350         check_committers (all_new_taggers) if $new_type eq 'tag';
 351 }
 352
 353 info "$this_user wants $op for $ref";
 354 foreach my $acl_entry (@allow_rules) {
 355         my ($acl_ops, $acl_n) = @$acl_entry;
 356         next unless $acl_ops =~ /^[CDRU]+$/; # Uhh.... shouldn't happen.
 357         next unless $acl_n;
 358         next unless $op =~ /^[$acl_ops]$/;
 359         next unless match_string $acl_n, $ref;
 360
 361         # Don't test path rules on branch deletes.
 362         #
 363         grant "Allowed by: $acl_ops for $acl_n" if $op eq 'D';
 364
 365         # Aggregate matching path rules; allow if there aren't
 366         # any matching this ref.
 367         #
 368         my %pr;
 369         foreach my $p_entry (@path_rules) {
 370                 my ($p_ops, $p_n, $p_ref, $p_bst) = @$p_entry;
 371                 next unless $p_ref;
 372                 push @{$pr{$p_bst}}, $p_entry if match_string $p_ref, $ref;
 373         }
 374         grant "Allowed by: $acl_ops for $acl_n" unless %pr;
 375
 376         # Allow only if all changes against a single base are
 377         # allowed by file path rules.
 378         #
 379         my @bad;
 380         foreach my $p_bst (keys %pr) {
 381                 my $diff_ref = load_diff $p_bst;
 382                 deny "Cannot difference trees." unless ref $diff_ref;
 383
 384                 my %fd = %$diff_ref;
 385                 foreach my $p_entry (@{$pr{$p_bst}}) {
 386                         my ($p_ops, $p_n, $p_ref, $p_bst) = @$p_entry;
 387                         next unless $p_ops =~ /^[AMD]+$/;
 388                         next unless $p_n;
 389
 390                         foreach my $f_n (keys %fd) {
 391                                 my $f_op = $fd{$f_n};
 392                                 next unless $f_op;
 393                                 next unless $f_op =~ /^[$p_ops]$/;
 394                                 delete $fd{$f_n} if match_string $p_n, $f_n;
 395                         }
 396                         last unless %fd;
 397                 }
 398
 399                 if (%fd) {
 400                         push @bad, [$p_bst, \%fd];
 401                 } else {
 402                         # All changes relative to $p_bst were allowed.
 403                         #
 404                         grant "Allowed by: $acl_ops for $acl_n diff $p_bst";
 405                 }
 406         }
 407
 408         foreach my $bad_ref (@bad) {
 409                 my ($p_bst, $fd) = @$bad_ref;
 410                 print STDERR "\n";
 411                 print STDERR "Not allowed to make the following changes:\n";
 412                 print STDERR "(base: $p_bst)\n";
 413                 foreach my $f_n (sort keys %$fd) {
 414                         print STDERR "  $fd->{$f_n} $f_n\n";
 415                 }
 416         }
 417         deny "You are not permitted to $op $ref";
 418 }
 419 close A;
 420 deny "You are not permitted to $op $ref";