#!/opt2/perl/bin/perl

##
## Invoked as: update refname old-sha1 new-sha1
##

##
## Reads 'info/allowed-users' to determine access.
## Each line in allowed-users is two regex patterns
## to be applied to the refname and the username.
##
##    Example:
##         AURD:refs/heads/sp/     spearce
##         U:refs/heads/env-dev$   spearce|bob|smith
##
## The first line gives UNIX user 'spearce' access to create (A),
## update (U), rewind (R) and delete (D) branches under the path
## 'refs/heads/sp/.  The second line gives UNIX users 'spearce',
## 'bob', and 'smith' access to update (U) *only* refs/heads/env-dev.
##

##
## Reads 'info/allowed-committers' to verify committer
## names within all incoming commits.   Each line in
## allowed-committers is the UNIX username and the Git
## committer string (from git-var GIT_COMMITTER_IDENT).
## A user may only push a tag or commit in which they
## were the committer or the tagger.
##
##    Example:
##         spearce  Shawn O. Pearce <spearce@spearce.org>
##         spearce  Shawn Pearce <spearce@spearce.org>
##         bob      Bobby Brown <bb@example.com>
##
## The first two lines says that UNIX user 'spearce' may use the
## either committer name and email shown.
##

use strict;
local $ENV{PATH} = '/sw/git/bin';
my $debug = 0;
my $git_dir = $ENV{GIT_DIR};
my $committers = "$git_dir/info/allowed-committers";
my $acl = "$git_dir/info/allowed-users";
my $new_commit_check = "$git_dir/info/new-commit-check";

my $ref = $ARGV[0];
my $old = $ARGV[1];
my $new = $ARGV[2];
my $new_type;
my ($this_user) = getpwuid $<; # REAL_USER_ID

sub deny ($)
{
	print STDERR "-Deny-    $_[0]\n" if $debug;
	print STDERR "\ndenied: $_[0]\n\n";
	exit 1;
}

sub grant ($)
{
	print STDERR "-Grant-   $_[0]\n" if $debug;
	exit 0;
}

sub info ($)
{
	print STDERR "-Info-    $_[0]\n" if $debug;
}

sub all_new_committers ()
{
	local $ENV{GIT_DIR} = $git_dir;
	$ENV{GIT_DIR} = $new_commit_check if -d $new_commit_check;

	info "Getting committers of new commits.";
	my %used;
	open(T, '-|', 'git-rev-list','--pretty=raw',$new,'--not','--all');
	while (<T>)
	{
		next unless s/^committer //;
		chop;
		s/>.*$/>/;
		info "Found $_." unless $used{$_}++;
	}
	close T;
	info "No new commits." unless %used;
	%used;
}

sub all_new_taggers ()
{
	my %exists;
	open(T, '-|', 'git-for-each-ref',
		'--format=%(objectname)','refs/tags');
	while (<T>)
	{
		chop;
		$exists{$_} = 1;
	}
	close T;

	info "Getting taggers of new tags.";
	my %used;
	my $obj = $new;
	my $obj_type = $new_type;
	while ($obj_type eq 'tag')
	{
		last if $exists{$obj};
		$obj_type = '';
		open(T, '-|', 'git-cat-file', 'tag', $obj);
		while (<T>)
		{
			chop;
			if (/^object ([a-z0-9]{40})$/)
			{
				$obj = $1;
			}
			elsif (/^type (.+)$/)
			{
				$obj_type = $1;
			}
			elsif (s/^tagger //)
			{
				s/>.*$/>/;
				info "Found $_." unless $used{$_}++;
				last;
			}
		}
		close T;
	}
	info "No new tags." unless %used;
	%used;
}

sub check_committers (%)
{
	my %used = @_;
	return unless %used;

	info "Checking committer strings for $this_user";
	open(A, $committers) or deny "Cannot read $committers";
	info "Scanning $committers";
	while (<A>)
	{
		chomp;
		next if /^#/ || /^\s*$/;
		my ($unix_user, $cstr) = split /\s+/, $_, 2;
		next unless $this_user eq $unix_user;

		if ($used{$cstr})
		{
			info "$cstr allowed by line $.";
			delete $used{$cstr};
		}
	}
	close A;

	if (%used)
	{
		print STDERR "\n";
		print STDERR "You are not $_.\n" foreach (sort keys %used);
		deny "You cannot push changes not committed by you.";
	}
}

deny "Need a ref name" unless $ref;
deny "Bad old value $old" unless $old =~ /^[a-z0-9]{40}$/;
deny "Bad new value $new" unless $new =~ /^[a-z0-9]{40}$/;
deny "Cannot determine who you are." unless $this_user;

my $op = '';
my %op_desc = (
	'A' => 'create',
	'D' => 'delete',
	'R' => 'rewind',
	'U' => 'update',
	);

if ($old =~ /^0{40}$/)
{
	$op = 'A';
}
elsif ($new =~ /^0{40}$/)
{
	$op = 'D';
}
else
{
	$op = 'R';
}

if ($op eq 'R' && $ref =~ m,^refs/heads/,)
{
	open(T, '-|', 'git-merge-base', $old, $new);
	my $base = <T>;
	close T;
	chop $base;
	$op = 'U' if $base eq $old;
}

deny "Operation '$op' not permitted." unless $op_desc{$op};

if ($op ne 'D')
{
	open(T, '-|', 'git-cat-file', '-t', $new);
	$new_type = <T>;
	close T;
	chop $new_type;

	if ($ref =~ m,^refs/heads/env-([^/]+)$,)
	{
		open(T, '-|', 'git-repo-config', "buildenv.$1.name");
		my $env_name = <T>;
		close T;
		if ($env_name)
		{
			deny "$ref must be an annotated tag."
				unless $new_type eq 'tag';
		}
		else
		{
			deny "$ref must be a commit." unless $new_type eq 'commit';
		}
	}
	elsif ($ref =~ m,^refs/heads/,)
	{
		deny "$ref must be a commit." unless $new_type eq 'commit';
	}
	elsif ($ref =~ m,^refs/tags/,)
	{
		deny "$ref must be an annotated tag." unless $new_type eq 'tag';
	}

	check_committers (all_new_committers);
	check_committers (all_new_taggers) if $new_type eq 'tag';
}

info "Requesting $op_desc{$op} of $ref";
info "Checking access for $this_user to $ref";
open(A, $acl) or deny "No such file: $acl";
info "Scanning $acl";
while (<A>)
{
	chomp;
	next if /^#/ || /^\s*$/;
	my ($ref_pat, $user_pat) = split /\s+/, $_, 2;
	my $op_pat = 'AU';
	$op_pat = $1 if $ref_pat =~ s/^([ADRU]+)://;

	if ($ref =~ m:^$ref_pat:
		&& $this_user =~ /^(?:$user_pat)$/
		&& $op =~ /^[$op_pat]$/)
	{
		grant "Allowed by line $.";
	}
}
close A;

deny "You are not permitted to $op_desc{$op} $ref.";