# This file is part of gitaclhook -*- perl -*- # Copyright (C) 2013 Sergey Poznyakoff # # 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 . 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;