#!/usr/bin/perl -s
use strict;
use warnings;

use lib $ENV{GL_LIBDIR};
use Gitolite::Rc;
use Gitolite::Common;
use Gitolite::Conf::Load;

our ( $q, $s, $h );    # quiet, show, help

=for usage
Usage:  gitolite access [-q|-s] <repo> <user> <perm> <ref>

Print access rights for arguments given.  The string printed has the word
DENIED in it if access was denied.  With '-q', returns only an exit code
(shell truth, not perl truth -- 0 is success).  For '-s', see below.

  - repo: mandatory
  - user: mandatory
  - perm: defauts to '+'.  Valid values: R, W, +, C, D, M
  - ref:  defauts to 'any'.  See notes below

Notes:
  - ref: something like 'master', or 'refs/tags/v1.0', or even a VREF if you
    know what they look like.

    The 'any' ref is special -- it ignores deny rules, thus simulating
    gitolite's behaviour during the pre-git access check (see 'deny-rules'
    section in rules.html for details).

  - batch mode: see src/triggers/post-compile/update-git-daemon-access-list
    for a good example that shows how to test several repos in one invocation.
    This is orders of magnitude faster than running the command multiple
    times; you'll notice if you have more than a hundred or so repos.

  - '-s' shows the rules (conf file name, line number, and rule) that were
    considered and how they fared.

  - you can also test the ability to create wild repos if you set GL_USER to
    the username and use ^C as the permission to check for.
=cut

usage() if not @ARGV >= 2 or $h;

my ( $repo, $user, $aa, $ref ) = @ARGV;
# default access is '+'
$aa  ||= '+';
# default ref is 'any'
$ref ||= 'any';
# fq the ref if needed
$ref =~ s(^)(refs/heads/) if $ref and $ref ne 'any' and $ref !~ m(^(refs|VREF)/);
_die "invalid perm" if not( $aa and $aa =~ /^(R|W|\+|C|D|M|\^C)$/ );
_die "invalid ref name" if not( $ref and $ref =~ $REF_OR_FILENAME_PATT );

my $ret = '';

if ( $repo ne '%' and $user ne '%' ) {
    # single repo, single user; no STDIN
    $ret = access( $repo, $user, adjust_aa($repo, $aa), $ref );

    show($ret) if $s;

    # adjust for fallthru in VREFs
    $ret =~ s/DENIED by fallthru/allowed by fallthru/ if $ref =~ m(^VREF/);

    if ( $ret =~ /DENIED/ ) {
        print "$ret\n" unless $q;
        exit 1;
    }

    print "$ret\n" unless $q;
    exit 0;
}

$repo = '' if $repo eq '%';
$user = '' if $user eq '%';

_die "'-q' and '-s' meaningless in pipe mode" if $q or $s;
@ARGV = ();
while (<>) {
    my @in = split;
    my $r  = $repo || shift @in;
    my $u  = $user || shift @in;
    $ret = access( $r, $u, adjust_aa($r, $aa), $ref );
    print "$r\t$u\t$ret\n";
}

sub adjust_aa {
    my ($repo, $aa) = @_;
    $aa = 'W' if $aa eq 'C' and not option($repo, 'CREATE_IS_C');
    $aa = '+' if $aa eq 'D' and not option($repo, 'DELETE_IS_D');
    $aa = 'W' if $aa eq 'M' and not option($repo, 'MERGE_CHECK');
    return $aa;
}

sub show {
    my $ret = shift;
    die "repo already exists; ^C won't work\n" if $ret =~ /DENIED by existence/;

    my $in = $rc{RULE_TRACE} or die "this should not happen! $ret";

    print STDERR "legend:";
    print STDERR "
    d => skipped deny rule due to ref unknown or 'any',
    r => skipped due to refex not matching,
    p => skipped due to perm (W, +, etc) not matching,
    D => explicitly denied,
    A => explicitly allowed,
    F => fallthru; access denied for normal refs, allowed for VREFs

";

    my %rule_info = read_ri($in);    # get rule info data for all traced rules
                                     # this means conf filename, line number, and content of the line

    # the rule-trace info is a set of pairs of a number plus a string.  Only
    # the last character in a string is valid (and has meanings shown above).
    # At the end there may be a final 'f'
    my @in = split ' ', $in;
    while (@in) {
        $in = shift @in;
        if ( $in =~ /^\d+$/ ) {
            my $res = shift @in or die "this should not happen either!";
            my $m = chop($res);
            printf "  %s %20s:%-6s %s\n", $m,
                                          $rule_info{$in}{fn},
                                          $rule_info{$in}{ln},
                                          $rule_info{$in}{cl};
        } elsif ( $in eq 'F' ) {
            printf "  %s %20s\n", $in, "(fallthru)";
        } else {
            die "and finally, this also should not happen!";
        }
    }
    print "\n";
}

sub read_ri {
    my %rules = map { $_ => 1 } $_[0] =~ /(\d+)/g;
    # contains a series of rule numbers, each of which we must search in
    # $GL_ADMIN_BASE/.gitolite/conf/rule_info

    my %rule_info;
    for ( slurp( $ENV{GL_ADMIN_BASE} . "/conf/rule_info" ) ) {
        my ( $r, $f, $l ) = split ' ', $_;
        next unless $rules{$r};
        $rule_info{$r}{fn} = $f;
        $rule_info{$r}{ln} = $l;
        $rule_info{$r}{cl} = conf_lines( $f, $l );

        # a wee bit of optimisation, in case the rule_info file is huge and
        # what we want is up near the beginning
        delete $rules{$r};
        last unless %rules;
    }
    return %rule_info;
}

{
    my %conf_lines;

    sub conf_lines {
        my ( $file, $line ) = @_;
        $line--;

        unless ( $conf_lines{$file} ) {
            $conf_lines{$file} = [ slurp( $ENV{GL_ADMIN_BASE} . "/conf/$file" ) ];
            chomp( @{ $conf_lines{$file} } );
        }
        return $conf_lines{$file}[$line];
    }
}