#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

# === add-auth-keys ===

# part of the gitolite (GL) suite

# (1) - "compiles" ~/.ssh/authorized_keys from the list of pub-keys
# (2) - also "compiles" the user-friendly GL conf file into something easier
#       to parse.  We're doing this because both the gl-auth-command and the
#       (gl-)update hook need this, and it seems easier to do this than
#       replicate the parsing code in both those places.  As a bonus, it's
#       probably more efficient.

# how run:      manual, by GL admin
# when:
#     - anytime a pubkey is added/deleted
#     - anytime gitolite.conf is changed
# input:
#     - GL_CONF (default: ~/.gitolite/gitolite.conf)
#     - GL_KEYDIR (default: ~/.gitolite/keydir)
# output:
#     - ~/.ssh/authorized_keys (dictated by sshd)
#     - GL_CONF_COMPILED (default: ~/.gitolite/gitolite.conf-compiled.pm)
# security:
#     - touches a very critical system file that manages the restrictions on
#       incoming users.  Be sure to audit AUTH_COMMAND and AUTH_OPTIONS (see
#       below) on any change to this script
#     - no security checks within program.  The GL admin runs this manually

# warnings:
#     - if the "start" line exists, but the "end" line does not, you lose the
#       rest of the existing authkey file.  In general, "don't do that (TM)",
#       but we do have a "vim -d" popping up so you can see the changes being
#       made, just in case...

# ----------------------------------------------------------------------------
#       common definitions
# ----------------------------------------------------------------------------

our ($GL_ADMINDIR, $GL_CONF, $GL_KEYDIR, $GL_CONF_COMPILED, $REPO_BASE);

# now that this thing *may* be run via "push to admin", any errors have to
# grab the admin's ATTENTION so he won't miss them among the other messages a
# typical push generates
my $ATTN = "\n\t\t***** ERROR *****\n       ";

my $glrc = $ENV{HOME} . "/.gitolite.rc";
die "$ATTN parse $glrc failed: " . ($! or $@) unless do $glrc;

# ----------------------------------------------------------------------------
#       definitions specific to this program
# ----------------------------------------------------------------------------

# command and options for authorized_keys
my $AUTH_COMMAND="$GL_ADMINDIR/src/gl-auth-command";
my $AUTH_OPTIONS="no-port-forwarding,no-X11-forwarding,no-agent-forwarding,no-pty";
# note that REPONAME_PATT allows a "/" also, which USERNAME_PATT doesn't
my $REPONAME_PATT=qr(^\@?[0-9a-zA-Z][0-9a-zA-Z._/-]*$);     # very simple pattern
my $USERNAME_PATT=qr(^\@?[0-9a-zA-Z][0-9a-zA-Z._-]*$);      # very simple pattern

# groups can now represent user groups or repo groups
my %groups = ();
my %repos = ();

# set a restrictive umask, just in case
umask(0077);

# ----------------------------------------------------------------------------
#       subroutines
# ----------------------------------------------------------------------------

sub wrap_chdir {
    chdir($_[0]) or die "$ATTN chdir $_[0] failed: $! at ", (caller)[1], " line ", (caller)[2], "\n";
}

sub wrap_open {
    open (my $fh, $_[0], $_[1]) or die "$ATTN open $_[1] failed: $! at ", (caller)[1], " line ", (caller)[2], "\n" .
            ( $_[2] || '' );    # suffix custom error message if given
    return $fh;
}

sub expand_list
{
    my @list = @_;
    my @new_list = ();

    for my $item (@list)
    {
        # we test with the slightly more relaxed pattern here; we'll catch the
        # "/" in user name thing later; it doesn't affect security anyway
        die "$ATTN bad user or repo name $item\n" unless $item =~ $REPONAME_PATT;
        if ($item =~ /^@/)      # nested group
        {
            die "$ATTN undefined group $item\n" unless $groups{$item};
            # add those names to the list
            push @new_list, @{ $groups{$item} };
        }
        else
        {
            push @new_list, $item;
        }
    }

    return @new_list;
}

# ----------------------------------------------------------------------------
#       "compile" GL conf
# ----------------------------------------------------------------------------

my $conf_fh = wrap_open( "<", $GL_CONF );

# the syntax is fairly simple, so we parse it inline

my @repos;
while (<$conf_fh>)
{
    # normalise whitespace; keeps later regexes very simple
    s/=/ = /;
    s/\s+/ /g;
    s/^ //;
    s/ $//;
    # kill comments
    s/#.*//;
    # and blank lines
    next unless /\S/;

    # user or repo groups
    if (/^(@\S+) = (.*)/)
    {
        push @{ $groups{$1} }, expand_list( split(' ', $2) );
        # again, we take the more "relaxed" pattern
        die "$ATTN bad group $1\n" unless $1 =~ $REPONAME_PATT;
    }
    # repo(s)
    elsif (/^repo (.*)/)
    {
        # grab the list and expand any @stuff in it
        @repos = split ' ', $1;
        @repos = expand_list ( @repos );
    }
    # actual permission line
    elsif (/^(R|RW|RW\+) (.* )?= (.+)/)
    {
        # split perms to separate out R, W, and +
        my @perms = split //, $1;
        my @refs; @refs = split(' ', $2) if $2;
        my @users = split ' ', $3;

        # if no ref is given, this PERM applies to all refs
        @refs = qw(refs/.*) unless @refs;
        # fully qualify refs that dont start with "refs/"; prefix them with
        # "refs/heads/"
        @refs = map { m(^refs/) or s(^)(refs/heads/); $_ } @refs;

        # expand the user list, unless it is just "@all"
        @users = expand_list ( @users )
            unless (@users == 1 and $users[0] eq '@all');
        do  { die "$ATTN bad username $_\n" unless $_ =~ $USERNAME_PATT } for @users;

        # ok, we can finally populate the %repos hash
        for my $repo (@repos)       # each repo in the current stanza
        {
            for my $perm (@perms)
            {
                for my $user (@users)
                {
                    push @{ $repos{$repo}{$perm}{$user} }, @refs;
                }
            }
        }
    }
    else
    {
        die "$ATTN can't make head or tail of '$_'\n";
    }
}

my $compiled_fh = wrap_open( ">", $GL_CONF_COMPILED );
print $compiled_fh Data::Dumper->Dump([\%repos], [qw(*repos)]);
close $compiled_fh or die "$ATTN close compiled-conf failed: $!\n";

# ----------------------------------------------------------------------------
#       any new repos created?
# ----------------------------------------------------------------------------

# modern gits allow cloning from an empty repo, so we just create it.  Gitosis
# did not have that luxury, so it was forced to detect the first push and
# create it then

# but it turns out not everyone has "modern" gits :)
my $git_version = `git --version`;
my ($gv_maj, $gv_min, $gv_patchrel) = ($git_version =~ m/git version (\d+)\.(\d+)\.(\d+)/);
die "$ATTN I can't understand $git_version\n" unless ($gv_maj >= 1);
$git_version = $gv_maj*10000 + $gv_min*100 + $gv_patchrel;  # now it's "normalised"
my $git_too_old = 0;

# repo-base needs to be an absolute path for this loop to work right
# so if it was not already absolute, prefix $HOME.
my $repo_base_abs = ( $REPO_BASE =~ m(^/) ? $REPO_BASE : "$ENV{HOME}/$REPO_BASE" );
wrap_chdir("$repo_base_abs");
for my $repo (keys %repos)
{
    unless (-d "$repo.git")
    {
        mkdir("$repo.git") or die "$ATTN mkdir $repo.git failed: $!\n";
        wrap_chdir("$repo.git");
        system("git --bare init");
        system("cp $GL_ADMINDIR/src/update-hook.pl hooks/update");
        chmod 0755, "hooks/update";
        wrap_chdir("$repo_base_abs");
        $git_too_old++ if $git_version < 10602;     # that's 1.6.2 to you
    }
}
warn "\n\t\t***** WARNING *****\n" .
    "\tyour git version is older than 1.6.2\n" .
    "\tgitolite will work but you MUST read the section on\n" .
    "\t\"git version dependency\" in doc/3-faq-tips-etc.mkd\n"
    if $git_too_old;

# ----------------------------------------------------------------------------
#       "compile" ssh authorized_keys
# ----------------------------------------------------------------------------

my $authkeys_fh = wrap_open( "<", $ENV{HOME} . "/.ssh/authorized_keys",
    "\tFor security reasons, gitolite will not *create* this file if it does\n" .
    "\tnot already exist.  Please see the \"admin\" document for details\n");
my $newkeys_fh = wrap_open( ">", $ENV{HOME} . "/.ssh/new_authkeys" );
# save existing authkeys minus the GL-added stuff
while (<$authkeys_fh>)
{
    print $newkeys_fh $_ unless (/^# gito(sis-)?lite start/../^# gito(sis-)?lite end/);
}

# add our "start" line, each key on its own line (prefixed by command and
# options, in the standard ssh authorized_keys format), then the "end" line.
print $newkeys_fh "# gitolite start\n";
wrap_chdir($GL_KEYDIR);
for my $pubkey (glob("*.pub"))
{
    my $user = $pubkey; $user =~ s/(\@.+)?\.pub$//;
    print $newkeys_fh "command=\"$AUTH_COMMAND $user\",$AUTH_OPTIONS ";
    print $newkeys_fh `cat $pubkey`;
}
print $newkeys_fh "# gitolite end\n";
close $newkeys_fh or die "$ATTN close newkeys failed: $!\n";

# all done; overwrite the file (use cat to avoid perm changes)
system("cat $ENV{HOME}/.ssh/authorized_keys > $ENV{HOME}/.ssh/old_authkeys");
system("cat $ENV{HOME}/.ssh/new_authkeys > $ENV{HOME}/.ssh/authorized_keys");
system("rm  $ENV{HOME}/.ssh/new_authkeys");

# if the gl admin directory (~/.gitolite) is itself a git repo, do an
# autocheckin.  nothing fancy; this is a "just in case" type of thing.
wrap_chdir($GL_ADMINDIR);
if (-d ".git")
{
    system("git add -A conf keydir");       # stage all operational data
    # and if there are any
    if (system("git diff --cached --quiet") )
    {
        open my $commit_ph, "|-", "git commit -F -"
            or die "$ATTN open commit failed: $!\n";
        print $commit_ph "keydir changed\n\n";
        print $commit_ph `git diff --cached --name-status`;
        close $commit_ph or die "$ATTN close commit failed: $!\n";
    }
}