fb2aca3628783fbd80d96cb029cb600fcad51a29
   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;
 105
 106sub deny ($) {
 107        print STDERR "-Deny-    $_[0]\n" if $debug;
 108        print STDERR "\ndenied: $_[0]\n\n";
 109        exit 1;
 110}
 111
 112sub grant ($) {
 113        print STDERR "-Grant-   $_[0]\n" if $debug;
 114        exit 0;
 115}
 116
 117sub info ($) {
 118        print STDERR "-Info-    $_[0]\n" if $debug;
 119}
 120
 121sub git_value (@) {
 122        open(T,'-|','git',@_); local $_ = <T>; chop; close T; $_;
 123}
 124
 125sub 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
 149sub 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
 167sub 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
 202sub 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
 212deny "No GIT_DIR inherited from caller" unless $git_dir;
 213deny "Need a ref name" unless $ref;
 214deny "Refusing funny ref $ref" unless $ref =~ s,^refs/,,;
 215deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/;
 216deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/;
 217deny "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;
 222info "Updating in '$repository_name'.";
 223
 224my $op;
 225if    ($old =~ /^0{40}$/) { $op = 'C'; }
 226elsif ($new =~ /^0{40}$/) { $op = 'D'; }
 227else                      { $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
 258RULE:
 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
 284if ($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
 297info "$this_user wants $op for $ref";
 298foreach 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}
 311close A;
 312deny "You are not permitted to $op $ref";