# This file is part of gitaclhook -*- perl -*-
# Copyright (C) 2013 Sergey Poznyakoff <gray@gnu.org>
#
# Gitaclhook is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
#
# Gitaclhook is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with gitaclhook.  If not, see <http://www.gnu.org/licenses/>.

package GitACL;

use strict;
use File::Spec;

my %opstr = ('C' => 'create',
	     'D' => 'delete',
	     'U' => 'update',
	     'R' => 'rewind/rebase');

sub debug($$$) {
    my ($self,$level,$msg) = @_;
    if ($level <= $self->{debug}) {
	print STDERR "debug: $msg\n";
    }
}

sub logmsg($$$;$) {
    my $self = shift;
    return 0 unless $self->{logfile};

    my $status = shift;
    my $message = shift;
    my $loc = shift;
    my $fd;

    open($fd, $self->{logfile});
    if ($loc) {
	print $fd "$status:$loc: $message\n";
    } else {
	print $fd "$status: $message\n";
    }
    close($fd);
}

sub deny($$;$) {
    my ($self, $msg, $loc) = @_;

    $self->logmsg("DENY",
		  "$self->{project_name}:$self->{user_name}:".
		  "$opstr{$self->{op}}:$self->{ref}:$self->{old}:$self->{new}: $msg",
		  $loc);

    $self->debug(1, "denied by $loc") if $loc;
    print STDERR "denied: $msg\n" unless $self->{quiet};
    exit 1;
}

sub allow($$) {
    my ($self, $loc) = @_;
    $self->logmsg("ALLOW",
		  "$self->{project_name}:$self->{user_name}:$opstr{$self->{op}}:$self->{ref}:$self->{old}:$self->{new}",
		  $loc);
    $self->debug(1, "allow $loc");
    exit 0;
}

sub info($$) {
    my ($self, $msg) = @_;
    $self->logmsg("INFO", $msg);
    print STDERR "info: $msg\n" if $self->{debug};
}

sub get_project_name($) {
    my $dir = shift;
    
    File::Spec->rel2abs($dir) =~ m,/([^/]+)(?:\.git|/\.git)$,;
    return $1;
}

sub git_value(@) {
    my $fd;
    
    open($fd,'-|','git',@_);
    local $_ = <$fd>;
    chop;
    close($fd);
    return $_;
}

sub match_user($$) {
    my ($self, $expr) = @_;
    return 1 if ($expr eq 'all');
    return 0 if ($expr eq 'none');
    if ($expr =~ /^%(.+)/) {
	my ($name,$passwd,$gid,$members) = getgrnam($1) or return 0;
	my @a = split(/\s+/,$members);
	for (my $i = 0; $i <= $#a; $i++) {
	    return 1 if $a[$i] eq $self->{user_name};
	}
    } elsif ($expr eq $self->{user_name}) {
	return 1;
    }
    return 0;
}

sub match_ref($$) {
    my ($self, $expr) = @_;

    return ($self->{ref} =~ /$expr/) if ($expr =~ /^\^/);
    return ("$self->{ref}/" eq $expr or index($self->{ref}, $expr) == 0)
	if ($expr =~ /\/$/);
    return $self->{ref} eq $expr;
}

sub match_tuple($$) {
    my ($self, $tuple) = @_;
    my @x = @{$tuple};

    return ( \&deny, "malformed line" ) unless $#x >= 2;
    return ( \&deny, "unknown keyword" )
    	unless ($x[0] eq 'allow' || $x[0] eq 'deny');

    return ( 0, "project mismatch" )
    	if ($x[1] ne "*" and $x[1] ne $self->{project_name});
    return ( 0, "user mismatch" )
    	unless $self->match_user($x[2]);
    return ( 0, "op mismatch" )
    	if ($#x >= 3 && index(uc $x[3], $self->{op}) == -1);
    return ( 0, "ref mismatch" )
    	if ($#x == 4 && !$self->match_ref($x[4]));
    if ($x[0] eq 'allow') {
    	return ( \&allow );
    } else {
    	my $s = "you are not permitted to " . $opstr{$self->{op}} . " $self->{ref}";
    	return ( \&deny, $s );
    }
}

sub new {
    my $type = shift;
    my $class = ref($type) || $type;
    my $obj = bless {}, $class;

    if ($#_ == 0) {
	$type = shift;
	%{$obj} = %{$type};
    	return $obj;
    }

    my %args = @_;

    if (defined($args{git_dir})) {
	$obj->{git_dir} = $ENV{GIT_DIR} = $args{git_dir};
    } elsif (defined($ENV{GIT_DIR})) {
	$obj->{git_dir} = $ENV{GIT_DIR};
    } else {
	$obj->deny("no GIT_DIR");
    }
	
    if (defined($args{debug})) {
	$obj->{debug} = $args{debug};
    } else {
	$obj->{debug} = git_value('config', '--bool', 'hooks.acldebug') ||
	                $ENV{GIT_UPDATE_DEBUG} > 0;
    }

    if (defined($args{logfile})) {
	$obj->{logfile} = $args{logfile};
    } else {
	$obj->{logfile} = git_value('config', 'hooks.acllog');
    }
    if ($obj->{logfile} && $obj->{logfile} !~ /[>|]/) {
	$obj->{logfile} = ">>$obj->{logfile}";
    }

    if (defined($args{quiet})) {
	$obj->{quiet} = $args{quiet};
    } elsif (!$obj->{debug}) {
	$obj->{quiet} = git_value('config', 'hooks.aclquiet');
    }
    
    if (defined($args{user})) {
	$obj->{user_name} = $args{user};
    } else {
	my ($u) = getpwuid $<;
	$obj->{user_name} = $u;
    }
    $obj->deny("no such user") unless $obj->{user_name};
    my $httpdusr = git_value('config', 'hooks.httpd-user');
    if (defined($httpdusr) and $obj->{user_name} eq $httpdusr) {
	$obj->deny("need authenticated user") unless $ENV{AUTH_TYPE};
	$obj->{user_name} = $ENV{REMOTE_USER};
    }

    $obj->{project_name} = get_project_name($obj->{git_dir});

    $obj->deny("need a ref name") unless defined($args{ref});
    $obj->deny("bogus ref $args{ref}") unless $args{ref} =~ s,^refs/,,;
    $obj->{ref} = $args{ref};

    $obj->deny("bad old value $args{old}")
	unless $args{old} =~ /^[a-z0-9]{40}$/;
    $obj->{old} = $args{old};
    $obj->deny("bad new value $args{new}")
	unless $args{new} =~ /^[a-z0-9]{40}$/;
    $obj->{new} = $args{new};
    $obj->allow("no change requested") if $obj->{old} eq $obj->{new};

    if ($obj->{old} =~ /^0{40}$/) {
	$obj->{op} = 'C';
    } elsif ($obj->{new} =~ /^0{40}$/) {
	$obj->{op} = 'D';
    } elsif ($obj->{ref} =~ m,^heads/, &&
	     $obj->{old} eq git_value('merge-base',$obj->{old},$obj->{new})) {
	$obj->{op} = 'U';
    } else {
	$obj->{op} = 'R';
    }

    if (defined($args{op})) {
	# Hope they know what they're doing
	$obj->deny("invalid op") unless defined($opstr{$args{op}});
	$obj->{op} = $args{op};
    }
    
    return $obj;
}

sub check {
    my $self = shift;

    $self->info("$self->{user_name} requested $opstr{$self->{op}} ".
		"on $self->{ref} in $self->{project_name}");
    
    my $type = git_value('config', 'hooks.acltype');
    $type = "File" unless $type;
    
    my $r = eval("use GitACL::$type; GitACL::$type->new(\$self);");
    $self->deny("unsupported acltype: $@") unless $r;

    $r->check_acl;
}

1;