ssh-authkeys done!

src/Gitolite/Hooks/PostUpdate.pm

@@ -19,7 +19,7 @@ use warnings;
 # ----------------------------------------------------------------------
 
 sub post_update {
-    trace(3);
+    trace(3, @ARGV);
     # this is the *real* post_update hook for gitolite
 
     tsh_try("git ls-tree --name-only master");
@@ -31,6 +31,24 @@ sub post_update {
     }
     _system("$ENV{GL_BINDIR}/gitolite compile");
 
+    # now run optional post-compile features
+    if (exists $rc{POST_COMPILE}) {
+        if (ref($rc{POST_COMPILE}) ne 'ARRAY') {
+            _warn "bad syntax for specifying post compile scripts; see docs";
+        } else {
+            for my $s (@{ $rc{POST_COMPILE} }) {
+
+                # perl-ism; apart from keeping the full path separate from the
+                # simple name, this also protects %rc from change by implicit
+                # aliasing, which would happen if you touched $s itself
+                my $sfp = "$ENV{GL_BINDIR}/post-compile/$s";
+
+                _warn("skipped post-compile script '$s'"), next if not -x $sfp;
+                _system($sfp, @ARGV);   # they better all return with 0 exit codes!
+            }
+        }
+    }
+
     exit 0;
 }
 
@@ -64,5 +82,5 @@ use Gitolite::Hooks::PostUpdate;
 # gitolite post-update hook (only for the admin repo)
 # ----------------------------------------------------------------------
 
-post_update(@ARGV);     # is not expected to return
+post_update();          # is not expected to return
 exit 1;                 # so if it does, something is wrong

src/Gitolite/Hooks/Update.pm

@@ -19,7 +19,7 @@ use warnings;
 # ----------------------------------------------------------------------
 
 sub update {
-    trace( 3, @_ );
+    trace( 3, @ARGV );
     # this is the *real* update hook for gitolite
 
     my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = args(@ARGV);
@@ -150,5 +150,5 @@ use Gitolite::Hooks::Update;
 # gitolite update hook
 # ----------------------------------------------------------------------
 
-update(@ARGV);          # is not expected to return
+update();               # is not expected to return
 exit 1;                 # so if it does, something is wrong

src/Gitolite/Rc.pm

@@ -165,19 +165,28 @@ __DATA__
 
 # PLEASE READ THE DOCUMENTATION BEFORE EDITING OR ASKING QUESTIONS
 
-# this file is in perl syntax.  However, you do NOT need to know perl to edit
-# it; it should be fairly self-explanatory and easy to maintain.  Just mind
-# the commas, make sure the brackets and braces stay matched up!
+# This file is in perl syntax.
+
+# However, you do NOT need to know perl to edit it; it should be fairly
+# self-explanatory and easy to maintain.  Just mind the commas (perl is quite
+# happy to have an extra one at the end of the last item in any list, by the
+# way!).  And make sure the brackets and braces stay matched up!
 
 %RC = (
     UMASK                       =>  0077,
     GL_GITCONFIG_KEYS           =>  "",
 
-    # uncomment as needed
+    # comment out or uncomment as needed
     SYNTACTIC_SUGAR             =>
         [
             # 'continuation-lines',
-        ]
+        ],
+
+    # comment out or uncomment as needed
+    POST_COMPILE                =>
+        [
+            'ssh-authkeys',
+        ],
 );
 
 # ------------------------------------------------------------------------------

src/Gitolite/Setup.pm

@@ -47,6 +47,7 @@ sub setup {
     }
 
     _system("$ENV{GL_BINDIR}/gitolite compile");
+    _system("$ENV{GL_BINDIR}/gitolite post-compile ssh-authkeys") if $pubkey;
 
     hook_repos();    # all of them, just to be sure
 }

src/gitolite

@@ -6,7 +6,8 @@
 =for usage
 Usage:  gitolite [sub-command] [options]
 
-The following subcommands are available; they should all respond to '-h':
+The following subcommands are available; they should all respond to '-h' if
+you want further details on each:
 
     setup                       1st run: initial setup; all runs: hook fixups
     compile                     compile gitolite.conf
@@ -17,6 +18,7 @@ The following subcommands are available; they should all respond to '-h':
     list-phy-repos              list all repos actually on disk
     list-memberships            list all groups a name is a member of
     list-members                list all members of a group
+    post-compile                run a post-compile command
 
 Warnings:
   - list-users is disk bound and could take a while on sites with 1000s of repos
@@ -89,7 +91,35 @@ sub args {
         require Gitolite::Conf::Load;
         Gitolite::Conf::Load->import;
         print "$_\n" for ( @{ list_members() } );
+    } elsif ( $command eq 'post-compile' ) {
+        shift @ARGV;
+        post_compile();
     } else {
         _die "unknown gitolite sub-command";
     }
 }
+
+=for post-compile
+Usage:  gitolite post-compile [-l] [post-compile-scriptname] [script args...]
+
+    -l          list currently available post-compile scripts
+
+Run a post-compile script (which normally runs from the post-update hook in
+the gitolite-admin repo).
+=cut
+
+sub post_compile {
+    usage('', 'post-compile') if (@ARGV and $ARGV[0] eq '-h');
+
+    if (@ARGV and $ARGV[0] eq '-l') {
+        _chdir("$ENV{GL_BINDIR}/post-compile");
+        map { say2($_) } grep { -x } glob("*");
+        exit 0;
+    }
+
+    my $pgm = shift @ARGV;
+    my $fullpath = "$ENV{GL_BINDIR}/post-compile/$pgm";
+    _die "$pgm not found or not executable" if not -x $fullpath;
+    _system($fullpath, @ARGV);
+    exit 0;
+}

src/post-compile/ssh-authkeys

@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use File::Temp qw(tempfile);
+
+use lib $ENV{GL_BINDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+
+$|++;
+
+# can be called directly, or as a post-update hook.  Since it ignores
+# arguments anyway, it hardly matters.
+
+my $ab      = `gitolite query-rc -n GL_ADMIN_BASE`;
+_warn("'keydir' not found in '$ab'"), exit if not -d "$ab/keydir";
+my $akfile  = "$ENV{HOME}/.ssh/authorized_keys";
+my $glshell = `gitolite query-rc -n GL_BINDIR` . "/gitolite-shell";
+# XXX gl-time not yet coded (GL_PERFLOGT)
+my $auth_options = auth_options();
+
+sanity();
+
+# ----------------------------------------------------------------------
+
+_chdir($ab);
+
+# old data
+my $old_ak = slurp($akfile);
+my @non_gl = grep { not /^# gito.*start/ .. /^# gito.*end/ } slurp($akfile);
+chomp(@non_gl);
+my %seen = map { $_ => 'a non-gitolite key' } ( fp(@non_gl) );
+# die 1;
+
+# pubkey files
+chomp( my @pubkeys = `find keydir -type f -name "*.pub" | sort` );
+my @gl_keys = ();
+for my $f (@pubkeys) {
+    my $fp = fp($f);
+    if ( $seen{$fp} ) {
+        _warn "$f duplicates $seen{$fp}, sshd will ignore it";
+    } else {
+        $seen{$fp} = $f;
+    }
+    push @gl_keys, grep { /./ } optionise($f);
+}
+
+# dump it out
+if (@gl_keys) {
+    my $out = join( "\n", map { my $_ = $_; chomp($_); $_ } @non_gl, "# gitolite start", @gl_keys, "# gitolite end" ) . "\n";
+
+    my $ak = slurp($akfile);
+    _die "$akfile changed between start and end of this program!" if $ak ne $old_ak;
+    _print( $akfile, $out );
+}
+
+# ----------------------------------------------------------------------
+
+sub sanity {
+    _warn "$akfile missing; creating a new one"                         if not -f $akfile;
+    _die "$glshell not found; this should NOT happen..."                if not -f $glshell;
+    _die "$glshell found but not readable; this should NOT happen..."   if not -r $glshell;
+    _die "$glshell found but not executable; this should NOT happen..." if not -x $glshell;
+
+    if ( not -f $akfile ) {
+        _print( $akfile, "" );
+        chmod 0700, $akfile;
+    }
+}
+
+sub auth_options {
+    my $auth_options = `gitolite query-rc AUTH_OPTIONS`;
+    chomp($auth_options);
+    $auth_options ||= "no-port-forwarding,no-X11-forwarding,no-agent-forwarding,no-pty";
+
+    return $auth_options;
+}
+
+sub fp {
+    # input: see below
+    # output: a (list of) FPs
+    my $in = shift || '';
+    if ( $in =~ /\.pub$/ ) {
+        # single pubkey file
+        return fp_file($in);
+    } elsif ( -f $in ) {
+        # an authkeys file
+        return map { fp_line($_) } grep { !/^#/ and /\S/ } slurp($in);
+    } else {
+        # one or more actual keys
+        return map { fp_line($_) } grep { !/^#/ and /\S/ } ($in, @_);
+    }
+}
+
+sub fp_file {
+    my $f  = shift;
+    my $fp = `ssh-keygen -l -f $f`;
+    chomp($fp);
+    _die "fingerprinting failed for $f" unless $fp =~ /([0-9a-f][0-9a-f](:[0-9a-f][0-9a-f])+)/;
+    $fp = $1;
+    return $fp;
+}
+
+sub fp_line {
+    my ( $fh, $fn ) = tempfile();
+    print $fh shift;
+    close $fh;
+    my $fp = fp_file($fn);
+    unlink $fn;
+    return $fp;
+}
+
+sub optionise {
+    my $f = shift;
+
+    my $user = $f;
+    $user =~ s(.*/)();                # foo/bar/baz.pub -> baz.pub
+    $user =~ s/(\@[^.]+)?\.pub$//;    # baz.pub, baz@home.pub -> baz
+
+    my @line = slurp($f);
+    if ( @line != 1 ) {
+        _warn "$f does not contain exactly 1 line; ignoring";
+        return '';
+    }
+    chomp(@line);
+    return "command=\"$glshell $user\",$auth_options $line[0]";
+}
+

t/reset

@@ -2,6 +2,10 @@
 use strict;
 use warnings;
 
+BEGIN {
+    unlink "$ENV{HOME}/.ssh/authorized_keys";
+}
+
 # this is hardcoded; change it if needed
 use lib "src";
 use Gitolite::Test;

t/ssh-authkeys.t

@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+# this is hardcoded; change it if needed
+use lib "src";
+use Gitolite::Test;
+
+$ENV{GL_BINDIR} = "$ENV{PWD}/src";
+
+my $ak = "$ENV{HOME}/.ssh/authorized_keys";
+my $kd = `gitolite query-rc -n GL_ADMIN_BASE` . "/keydir";
+
+try "plan 50";
+
+my $pgm = "gitolite post-compile ssh-authkeys";
+
+try "
+    # prep
+    rm -rf $ak;                 ok
+
+    $pgm;                       ok;    /'keydir' not found/
+    mkdir $kd;                  ok
+    cd $kd;                     ok
+    $pgm;                       ok;     /authorized_keys missing/
+                                        /creating/
+    wc < $ak;                   ok;     /0 *0 *0/
+    # some gl keys
+    ssh-keygen -N '' -q -f alice -C alice
+    ssh-keygen -N '' -q -f bob   -C bob
+    ssh-keygen -N '' -q -f carol -C carol
+    ssh-keygen -N '' -q -f dave  -C dave
+    ssh-keygen -N '' -q -f eve   -C eve
+    rm alice bob carol dave eve
+    ls -a;                      ok;     /alice.pub/; /bob.pub/; /carol.pub/; /dave.pub/; /eve.pub/
+    $pgm;                       ok;
+    wc    < $ak;                ok;     /^ *7 .*/;
+    grep gitolite $ak;          ok;     /start/
+                                        /end/
+
+    # some normal keys
+    mv alice.pub $ak;           ok
+    cat carol.pub >> $ak;       ok
+    $pgm;                       ok;     /carol.pub duplicates.*non-gitolite key/
+    wc < $ak;                   ok;     /^ *8 .*/;
+
+    # moving normal keys up
+    mv dave.pub dave
+    $pgm;                       ok
+    cat dave >> $ak;            ok
+    grep -n dave $ak;           ok;     /8:ssh-rsa/
+    mv dave dave.pub
+    $pgm;                       ok;     /carol.pub duplicates.*non-gitolite key/
+                                         /dave.pub duplicates.*non-gitolite key/
+    grep -n dave $ak;           ok;     /3:ssh-rsa/
+
+    # a bad key
+    ls -al > bad.pub
+    $pgm;                       !ok;    /fingerprinting failed for keydir/bad.pub/
+    wc < $ak;                   ok;     /^ *9 .*/;
+    # a good key doesn't get added
+    ssh-keygen -N '' -q -f good
+    $pgm;                       !ok;    /fingerprinting failed for keydir/bad.pub/
+    wc < $ak;                   ok;     /^ *9 .*/;
+    # till the bad key is removed
+    rm bad.pub
+    $pgm;                       ok;
+    wc < $ak;                   ok;     /^ *10 .*/;
+
+    # duplicate gl key
+    cp bob.pub robert.pub
+    $pgm;                       ok;     /robert.pub duplicates.*bob.pub/
+";