Rewrite gitaclhook in a modular way.

The new version provides two storage engines: File and LDAP.

* git/MANIFEST: New file.
* git/Makefile.PL: New file.
* git/gitaclhook: Rewrite.
* git/lib/GitACL.pm: New file.
* git/lib/GitACL/File.pm: New file.
* git/lib/GitACL/LDAP.pm: New file.

3 files changed, 377 insertions, 0 deletions

diff --git a/lib/GitACL.pm b/lib/GitACL.pm
new file mode 100644
index 0000000..c8ba2dd
--- /dev/null
+++ b/lib/GitACL.pm
@@ -0,0 +1,235 @@
+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;
diff --git a/lib/GitACL/File.pm b/lib/GitACL/File.pm
new file mode 100644
index 0000000..77f3b70
--- /dev/null
+++ b/lib/GitACL/File.pm
@@ -0,0 +1,42 @@
+package GitACL::File;
+use parent 'GitACL';
+
+sub check_acl {
+    my $self = shift;
+    my $fd;
+    my $line = 0;
+    my @ret;
+    
+    my $filename = GitACL::git_value('config', 'hooks.aclfile');
+    $self->allow("no ACL configured for $self->project_name")
+	unless defined($filename);
+
+    open($fd, "<", $filename)
+	or $self->deny("cannot open configuration file: $!");
+    while (<$fd>) {
+	++$line;
+	chomp;
+	s/^\s+//;
+	s/\s+$//;
+	s/#.*//;
+	next if ($_ eq "");
+	my @x = split(/\s+/, $_, 5);
+
+	my @res = $self->match_tuple(\@x);
+	if ($res[0] == 0) {
+	    $self->debug(2, "$filename:$line: $res[1]");
+	    next;
+	}
+	close($fd);
+	if ($res[1]) {
+	    $res[0]->($self, $res[1], "$filename:$line");
+	} else {
+	    $res[0]->($self, "$filename:$line");
+	}
+	exit(127);
+    }
+    close($fd);
+    $self->allow("default rule");
+}
+
+1;
diff --git a/lib/GitACL/LDAP.pm b/lib/GitACL/LDAP.pm
new file mode 100644
index 0000000..daa5b72
--- /dev/null
+++ b/lib/GitACL/LDAP.pm
@@ -0,0 +1,100 @@
+package GitACL::LDAP;
+use parent 'GitACL';
+use strict;
+use Net::LDAP;
+
+sub parse_ldap_conf {
+    my $self = shift;
+    my $filename = GitACL::git_value('config', 'hooks.aclldapconf') ||
+	           "/etc/ldap.conf";
+
+    my $fd;
+    open($fd, "<", $filename) or
+	$self->deny("cannot open file $filename: $!");
+    while (<$fd>) {
+	chomp;
+	s/^\s+//;
+	s/\s+$//;
+	s/#.*//;
+	next if ($_ eq "");
+	my @x = split(/\s+/, $_, 2);
+	$self->{"ldap_".$x[0]} = $x[1];
+    }
+    close(fd);
+}	    
+
+sub check_acl($) {
+    my $self = shift;
+    my $filter = "(&(objectClass=gitACL)(|(gitAclProject=$self->{project_name})(gitAclProject=all)))";
+    my %searchargs;
+
+    $self->parse_ldap_conf();
+    
+    $searchargs{filter} = $filter;
+    
+    $self->debug(2, "connecting to the database");
+    my $ldap = Net::LDAP->new($self->{ldap_uri})
+	or $self->deny("unable to connect to LDAP server $self->{ldap_uri}: $@");
+    $self->debug(2, "searching for $filter");
+    my $sres = $ldap->search(base => $self->{ldap_base},
+			     filter => $filter);
+    $self->deny("an error occurred while searching: ".
+		ldap_error_text($sres->code))
+        if ($sres->code);
+    $self->debug(2, "got ".$sres->entries." entries");
+    my @entries = sort {
+	my $pa = $a->get_value('gitAclProject');
+	my $pb = $b->get_value('gitAclProject');
+
+	if ($pa ne $pb) {
+	    if ($pa eq "all") {
+		return 1;
+	    } else {
+		return -1;
+	    }
+	} elsif ($a->exists('gitAclOrder')) {
+	    if ($b->exists('gitAclOrder')) {
+		return $a->get_value('gitAclOrder') <=> $b->get_value('gitAclOrder');
+	    } else {
+		return 1;
+	    }
+	} elsif ($b->exists('gitAclOrder')) {
+	    return -1;
+	} else {
+	    my @aa = $a->attributes(nooptions => 1);
+	    my @ab = $b->attributes(nooptions => 1);
+	    return $#ab <=> $#aa;
+	}
+    } $sres->entries;
+
+    foreach my $ent (@entries) {
+	my @x;
+	push(@x, $ent->get_value('gitAclVerb'));
+	push(@x, $ent->get_value('gitAclProject'));
+	push(@x, $ent->exists('gitAclUser') ?
+	     $ent->get_value('gitAclUser') : "all");
+	push(@x, $ent->get_value('gitAclOp'))
+	    if $ent->exists('gitAclOp');
+	push(@x, $ent->get_value('gitAclRef'))
+	    if $ent->exists('gitAclRef');
+
+	my @res = $self->match_tuple(\@x);
+	if ($res[0] == 0) {
+	    $self->debug(2, $ent->dn.": $res[1]");
+	    next;
+	}
+	$ldap->unbind;
+	if ($res[1]) {
+	    $res[0]->($self, $res[1], $ent->dn);
+	} else {
+	    $res[0]->($self, $ent->dn);
+	}
+	exit(127);
+    }
+    $ldap->unbind;
+    $self->allow("default rule");
+}
+
+1;
+
+