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         info "Loading $br:$fn";
 140         open(I,'-|','git','cat-file','blob',"$br:$fn");
 141         my $section = '';
 142         while (<I>) {
 143                 chomp;
 144                 if (/^\s*$/ || /^\s*#/) {
 145                 } elsif (/^\[([a-z]+)\]$/i) {
 146                         $section = lc $1;
 147                 } elsif (/^\[([a-z]+)\s+"(.*)"\]$/i) {
 148                         $section = join('.',lc $1,$2);
 149                 } elsif (/^\s*([a-z][a-z0-9]+)\s*=\s*(.*?)\s*$/i) {
 150                         push @{$data->{join('.',$section,lc $1)}}, $2;
 151                 } else {
 152                         deny "bad config file line $. in $br:$fn";
 153                 }
 154         }
 155         close I;
 156 }
 157
 158 sub 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
 176 sub 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
 211 sub 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
 221 sub 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
 246 deny "No GIT_DIR inherited from caller" unless $git_dir;
 247 deny "Need a ref name" unless $ref;
 248 deny "Refusing funny ref $ref" unless $ref =~ s,^refs/,,;
 249 deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/;
 250 deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/;
 251 deny "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;
 256 info "Updating in '$repository_name'.";
 257
 258 my $op;
 259 if    ($old =~ /^0{40}$/) { $op = 'C'; }
 260 elsif ($new =~ /^0{40}$/) { $op = 'D'; }
 261 else                      { $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
 270 # Load the user's ACL file. Expand groups (user.memberof) one level.
 271 {
 272         my %data = ('user.committer' => []);
 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
 281         %user_committer = map {$_ => $_} @{$data{'user.committer'}};
 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
 292 RULE:
 293         foreach (@$rules) {
 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
 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]+)$/) {
 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
 330 if ($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
 343 info "$this_user wants $op for $ref";
 344 foreach 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]$/;
 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;
 365
 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";
 408 }
 409 close A;
 410 deny "You are not permitted to $op $ref";