summaryrefslogtreecommitdiffstats
path: root/src/commands
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 14:17:27 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 14:17:27 +0000
commitaae1a14ea756102251351d96e2567b4986d30e2b (patch)
treea1af617672e26aee4c1031a3aa83e8ff08f6a0a5 /src/commands
parentInitial commit. (diff)
downloadgitolite3-aae1a14ea756102251351d96e2567b4986d30e2b.tar.xz
gitolite3-aae1a14ea756102251351d96e2567b4986d30e2b.zip
Adding upstream version 3.6.12.upstream/3.6.12upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to '')
-rwxr-xr-xsrc/commands/1plus141
-rwxr-xr-xsrc/commands/D131
-rwxr-xr-xsrc/commands/access173
-rwxr-xr-xsrc/commands/compile-template-data101
-rwxr-xr-xsrc/commands/config110
-rwxr-xr-xsrc/commands/create29
-rwxr-xr-xsrc/commands/creator40
-rwxr-xr-xsrc/commands/desc49
-rwxr-xr-xsrc/commands/fork57
-rwxr-xr-xsrc/commands/git-annex-shell71
-rwxr-xr-xsrc/commands/git-config97
-rwxr-xr-xsrc/commands/help43
-rwxr-xr-xsrc/commands/htpasswd44
-rwxr-xr-xsrc/commands/info144
-rwxr-xr-xsrc/commands/list-dangling-repos55
-rwxr-xr-xsrc/commands/lock143
-rwxr-xr-xsrc/commands/mirror186
-rwxr-xr-xsrc/commands/motd53
-rwxr-xr-xsrc/commands/newbranch41
-rwxr-xr-xsrc/commands/option127
-rwxr-xr-xsrc/commands/owns22
-rwxr-xr-xsrc/commands/perms193
-rwxr-xr-xsrc/commands/print-default-rc8
-rwxr-xr-xsrc/commands/push5
-rwxr-xr-xsrc/commands/readme54
-rwxr-xr-xsrc/commands/rsync143
-rwxr-xr-xsrc/commands/sshkeys-lint176
-rwxr-xr-xsrc/commands/sskm281
-rwxr-xr-xsrc/commands/sudo24
-rwxr-xr-xsrc/commands/svnserve17
-rwxr-xr-xsrc/commands/symbolic-ref31
-rwxr-xr-xsrc/commands/who-pushed172
-rwxr-xr-xsrc/commands/writable63
33 files changed, 2924 insertions, 0 deletions
diff --git a/src/commands/1plus1 b/src/commands/1plus1
new file mode 100755
index 0000000..1d94006
--- /dev/null
+++ b/src/commands/1plus1
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+# import LOCK_*
+use Fcntl qw(:flock);
+
+my $lockbase = shift; # suggested: $GL_REPO_BASE/$GL_REPO.git/.gl-mirror-push-lock.$COPY_NAME
+my @cmd_plus_args = @ARGV; # the actual 'gitolite mirror ...' command
+@ARGV = ();
+
+# ----------------------------------------------------------------------
+
+open( my $fhrun, ">", "$lockbase.run" ) or die "open '$lockbase.run' failed: $!";
+if ( flock( $fhrun, LOCK_EX | LOCK_NB ) ) {
+ # got run lock; you're good to go
+
+ system(@cmd_plus_args);
+
+ flock( $fhrun, LOCK_UN );
+ exit 0;
+}
+
+# "run" lock failed; someone is already running the command
+
+open( my $fhqueue, ">", "$lockbase.queue" ) or die "open '$lockbase.queue' failed: $!";
+if ( flock( $fhqueue, LOCK_EX | LOCK_NB ) ) {
+ # got queue lock, now block waiting for "run" lock
+ flock( $fhrun, LOCK_EX );
+ # got run lock, so take yourself out of "queue" state, then run
+ flock( $fhqueue, LOCK_UN );
+
+ system(@cmd_plus_args);
+
+ flock( $fhrun, LOCK_UN );
+ exit 0;
+}
+
+# "queue" lock also failed; someone is running AND someone is queued; we can go home
+say STDERR "INFO: nothing to do/queue; '$lockbase' already running and 1 in queue";
+exit 0;
diff --git a/src/commands/D b/src/commands/D
new file mode 100755
index 0000000..016a365
--- /dev/null
+++ b/src/commands/D
@@ -0,0 +1,131 @@
+#!/bin/sh
+
+# ----------------------------------------------------------------------
+# ADMINISTRATOR NOTES:
+# ----------------------------------------------------------------------
+
+# - set TRASH_CAN in the rc if you don't like the default. It should be
+# relative to GL_REPO_BASE or an absolute value. It should also be on the
+# same filesystem as GL_REPO_BASE, otherwise the 'mv' will take too long.
+
+# - you could set TRASH_SUFFIX also but I recomend you leave it as it is
+
+# - run a cron job to delete old repos based on age (the TRASH_SUFFIX has a
+# timestamp); your choice how/how often you do that
+
+# - you can completely disable the 'rm' command by setting an rc variable
+# called D_DISABLE_RM to "1".
+# ----------------------------------------------------------------------
+
+# ----------------------------------------------------------------------
+# Usage: ssh git@host D <subcommand> <argument>
+#
+# The whimsically named "D" command deletes repos ("D" is a counterpart to the
+# "C" permission which lets you create repos. Which also means that, just
+# like "C", it only works for wild repos).
+#
+# There are two kinds of deletions: 'rm' removes a repo completely, while
+# 'trash' moves it to a trashcan which can be recovered later (upto a time
+# limit that your admin will tell you).
+#
+# The 'rm', 'lock', and 'unlock' subcommands:
+# Initially, all repos are "locked" against 'rm'. The correct sequence is
+# ssh git@host D unlock repo
+# ssh git@host D rm repo
+# Since the initial condition is always locked, the "lock" command is
+# rarely used but it is there if you want it.
+#
+# The 'trash', 'list-trash', and 'restore' subcommands:
+# You can 'trash' a repo, which moves it to a special place:
+# ssh git@host D trash repo
+# You can then 'list-trash'
+# ssh git@host D list-trash
+# which prints something like
+# repo/2012-04-11_05:58:51
+# allowing you to restore by saying
+# ssh git@host D restore repo/2012-04-11_05:58:51
+
+die() { echo "$@" >&2; exit 1; }
+usage() { perl -lne 'print substr($_, 2) if /^# Usage/../^$/' < $0; exit 1; }
+[ -z "$1" ] && usage
+[ "$1" = "-h" ] && usage
+[ "$1" != "list-trash" ] && [ -z "$2" ] && usage
+[ -z "$GL_USER" ] && die GL_USER not set
+
+# ----------------------------------------------------------------------
+cmd=$1
+repo=$2
+# ----------------------------------------------------------------------
+RB=`gitolite query-rc GL_REPO_BASE`; cd $RB
+TRASH_CAN=`gitolite query-rc TRASH_CAN`; tcan=Trash; TRASH_CAN=${TRASH_CAN:-$tcan}
+TRASH_SUFFIX=`gitolite query-rc TRASH_SUFFIX`; tsuf=`date +%Y-%m-%d_%H:%M:%S`; TRASH_SUFFIX=${TRASH_SUFFIX:-$tsuf}
+# ----------------------------------------------------------------------
+
+owner_or_die() {
+ gitolite owns "$repo" || die You are not authorised
+}
+
+# ----------------------------------------------------------------------
+
+if [ "$cmd" = "rm" ]
+then
+
+ gitolite query-rc -q D_DISABLE_RM && die "sorry, 'unlock' and 'rm' are disabled"
+
+ owner_or_die
+ [ -f $repo.git/gl-rm-ok ] || die "'$repo' is locked!"
+ rm -rf $repo.git
+ echo "'$repo' is now gone!"
+
+elif [ "$cmd" = "lock" ]
+then
+
+ owner_or_die
+ rm -f $repo.git/gl-rm-ok
+ echo "'$repo' is now locked"
+
+elif [ "$cmd" = "unlock" ]
+then
+
+ gitolite query-rc -q D_DISABLE_RM && die "sorry, 'unlock' and 'rm' are disabled"
+
+ owner_or_die
+ touch $repo.git/gl-rm-ok
+ echo "'$repo' is now unlocked"
+
+elif [ "$cmd" = "trash" ]
+then
+
+ owner_or_die
+ mkdir -p $TRASH_CAN/$repo 2>/dev/null || die "failed creating directory in trashcan"
+ [ -d $TRASH_CAN/$repo/$TRASH_SUFFIX ] && die "try again in a few seconds..."
+ mv $repo.git $TRASH_CAN/$repo/$TRASH_SUFFIX
+ echo "'$repo' moved to trashcan"
+
+elif [ "$cmd" = "list-trash" ]
+then
+
+ cd $TRASH_CAN 2>/dev/null || exit 0
+ find . -name gl-creator | sort | while read t
+ do
+ owner=
+ owner=`cat "$t"`
+ [ "$owner" = "$GL_USER" ] && dirname $t
+ done | cut -c3-
+
+elif [ "$cmd" = "restore" ]
+then
+
+ owner=
+ owner=`cat $TRASH_CAN/$repo/gl-creator 2>/dev/null`
+ [ "$owner" = "$GL_USER" ] || die "'$repo' is not yours!"
+
+ cd $TRASH_CAN
+ realrepo=`dirname $repo`
+ [ -d $RB/$realrepo.git ] && die "'$realrepo' already exists"
+ mv $repo $RB/$realrepo.git
+ echo "'$repo' restored to '$realrepo'"
+
+else
+ die "unknown subcommand '$cmd'"
+fi
diff --git a/src/commands/access b/src/commands/access
new file mode 100755
index 0000000..7d4a5b9
--- /dev/null
+++ b/src/commands/access
@@ -0,0 +1,173 @@
+#!/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];
+ }
+}
diff --git a/src/commands/compile-template-data b/src/commands/compile-template-data
new file mode 100755
index 0000000..e4ef86e
--- /dev/null
+++ b/src/commands/compile-template-data
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+# read template data to produce gl-perms and gl-repo-groups files in each
+# $repo dir. Create the repo if needed, using the wild repos create logic
+# (with a "creator" of "gitolite-admin"!), though they're not really wild
+# repos.
+
+# see rule-templates.html in the gitolite documentation site.
+
+# pure text manipulation (and very little of that!), no git or gitolite
+# functions, no access checks, no possibility of a performance drama (or at
+# least not a *complex* performance drama)
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+use Gitolite::Conf::Store;
+
+my $rb = $rc{GL_REPO_BASE};
+
+@ARGV = `find $rc{GL_ADMIN_BASE}/conf -type f -name "*.conf" | sort`; chomp(@ARGV);
+# we don't see the files in the exact same order that gitolite compile sees
+# them, but we don't need to, for the data we are interested in (as long as
+# you don't break up one repo's data across multiple files!)
+
+# XXX We also potentially see more; a conf file may be in the directory, but
+# not pulled in via an 'include' or 'subconf', so it doesn't exist as far as
+# 'gitolite compile' is concerned, but here we *do* pull it in.
+
+my $repos = '';
+my $perms = '';
+my $list = ''; # list of templates to apply
+my $lip = ''; # line in progress
+while (<>) {
+ chomp;
+ next unless /^=begin template-data$/ .. /^=end$/ and not /^=(begin|end)/;
+
+ next unless /\S/;
+ next if /^\s*#/;
+
+ s/\t/ /g; # all the same to us
+
+ # handle continuation lines (backslash as last character)
+ if (/\\$/) {
+ s/\\$//;
+ $lip .= $_;
+ next;
+ }
+ $_ = $lip . $_;
+ $lip = '';
+
+ _warn("bad line: $_"), next if m([^ \w.\@/=-]); # silently ignore lines that have characters we don't need
+ if (/^\s*repo\s+(\S.*)=\s*(\S.*)$/) {
+ flush($repos, $list, $perms);
+ $repos = $1;
+ $perms = '';
+ $list = $2;
+
+ } elsif (/^\s*(\S+)\s*=\s*(\S.*)$/) {
+ $perms .= "$1 = $2\n";
+ } else {
+ # probably a blank line or a comment line. If not, well *shrug*
+ }
+}
+flush($repos, $list, $perms);
+
+sub flush {
+ my ($r, $l, $p) = @_;
+ return unless $r and $l and $p;
+ $l =~ s/\s+/ /g;
+
+ my @r = split ' ', $r;
+ while (@r) {
+ my $r1 = shift @r;
+ if ($r1 =~ m(^@)) {
+ my @g = @{ Gitolite::Conf::Load::list_members($r1) };
+ _warn "undefined group '$r1'" unless @g;
+ unshift @r, @g;
+ next;
+ }
+
+ flush_1($r1, $l, $p);
+ }
+}
+sub flush_1 {
+ my ($repo, $list, $perms) = @_;
+
+ # beware of wild characters!
+ return unless $repo =~ $REPONAME_PATT;
+
+ if (not -d "$rb/$repo.git") {
+ new_wild_repo( $repo, 'gitolite-admin', 'template-data' );
+ }
+
+ _print("$rb/$repo.git/gl-repo-groups", $list);
+
+ _print("$rb/$repo.git/gl-perms", $perms);
+}
diff --git a/src/commands/config b/src/commands/config
new file mode 100755
index 0000000..214158b
--- /dev/null
+++ b/src/commands/config
@@ -0,0 +1,110 @@
+#!/usr/bin/perl
+use 5.10.0;
+
+# ---- WARNING ----
+
+# If your site makes a distinction between "right to push the admin repo" and
+# "right to run arbitrary commands on the server" (i.e., if not all of your
+# "admins" have shell access to the server), this is a security risk. If that
+# is the case, DO NOT ENABLE THIS COMMAND.
+
+# ----------------------------------------------------------------------
+# gitolite command to allow "git config" on repos (with some restrictions)
+
+# (Not to be confused with the 'git-config' command, which is used only in
+# server-side scripts, not remotely.)
+
+# setup:
+# 1. Enable the command by adding it to the COMMANDS section in the ENABLE
+# list in the rc file. (Have you read the warning above?)
+#
+# 2. Specify configs allowed to be changed by the user. This is a space
+# separated regex list. For example:
+
+# repo ...
+# ... (various rules) ...
+# option user-configs = hook\..* foo.bar[0-9].*
+
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+use Gitolite::Common;
+
+# ----------------------------------------------------------------------
+# usage
+
+=for usage
+Usage: ssh git@host config <repo> [git config options]
+
+Runs "git config" in the repo. Only the following 3 syntaxes are supported
+(see 'man git-config'):
+
+ --add name value
+ --get-all name
+ --unset-all name
+ --list
+
+Your administrator should tell you what keys are allowed for the "name".
+=cut
+
+# ----------------------------------------------------------------------
+# arg checks
+
+my %nargs = qw(
+ --add 3
+ --get-all 2
+ --unset-all 2
+ --list 1
+ );
+
+usage() if not @ARGV or $ARGV[0] eq '-h';
+
+my $repo = shift;
+
+my $op = shift;
+usage() unless $op and exists $nargs{$op};
+
+# ----------------------------------------------------------------------
+# authorisation checks
+
+die "sorry, you are not authorised\n" unless
+ owns($repo)
+ or
+ ( ( $op eq '--get-all' or $op eq '--list' )
+ ? can_read($repo)
+ : ( can_write($repo) and option( $repo, 'writer-is-owner' ) )
+ );
+
+# ----------------------------------------------------------------------
+# key validity checks
+
+unless ($op eq '--list') {
+ my $key = shift;
+
+ my $val = '';
+ $val = join(" ", @ARGV) if @ARGV;
+ # values with spaces embedded get flattened by sshd when it passes
+ # SSH_ORIGINAL_COMMAND to gitolite. In this specific instance, we will
+ # pretend we know what the user meant, and join up the last 1+ args into
+ # one space-separated arg.
+
+ my $user_configs = option( $repo, 'user-configs' );
+ # this is a space separated list of allowed config keys
+ my @validkeys = split( ' ', ( $user_configs || '' ) );
+ my @matched = grep { $key =~ /^$_$/i } @validkeys;
+ _die "config '$key' not allowed\n" if ( @matched < 1 );
+
+ @ARGV = ($key);
+ push @ARGV, $val if $val;
+}
+
+# ----------------------------------------------------------------------
+# go!
+
+unshift @ARGV, $op;
+usage() unless @ARGV == $nargs{$op};
+
+_chdir("$rc{GL_REPO_BASE}/$repo.git");
+_system( "git", "config", @ARGV );
diff --git a/src/commands/create b/src/commands/create
new file mode 100755
index 0000000..8565e68
--- /dev/null
+++ b/src/commands/create
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+use Gitolite::Conf::Store;
+
+=for usage
+create -- create a wild repo.
+
+Usage:
+ ssh git@host create <repo>
+=cut
+
+usage() if @ARGV != 1 or $ARGV[0] eq '-h';
+
+$ENV{GL_USER} or _die "GL_USER not set";
+
+my $repo = shift;
+_die "invalid repo '$repo'" unless $repo =~ $REPONAME_PATT;
+
+my $ret = access( $repo, $ENV{GL_USER}, '^C', 'any' );
+_die "repo already exists or you are not authorised to create it" if $ret =~ /DENIED/;
+
+new_wild_repo( $repo, $ENV{GL_USER}, 'create' );
+gl_log( 'create', $repo, $ENV{GL_USER}, 'create' );
diff --git a/src/commands/creator b/src/commands/creator
new file mode 100755
index 0000000..702df73
--- /dev/null
+++ b/src/commands/creator
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+
+=for usage
+Usage: gitolite creator [-n] <reponame> [<username>]
+
+Print the creator name for the repo. A '-n' suppresses the newline.
+
+When an optional username is supplied, it checks if the user is the creator of
+the repo and returns an exit code (shell truth, 0 for success) instead of
+printing anything, which makes it possible to do this in shell:
+
+ if gitolite creator someRepo someUser
+ then
+ ...
+=cut
+
+usage() if not @ARGV or $ARGV[0] eq '-h';
+my $nl = "\n";
+if ( $ARGV[0] eq '-n' ) {
+ $nl = '';
+ shift;
+}
+my $repo = shift;
+my $user = shift || '';
+
+my $creator = '';
+$creator = creator($repo) if not repo_missing($repo);
+if ($user) {
+ exit 0 if $creator eq $user;
+ exit 1;
+}
+return ( $creator eq $user ) if $user;
+print "$creator$nl";
diff --git a/src/commands/desc b/src/commands/desc
new file mode 100755
index 0000000..4a4bf20
--- /dev/null
+++ b/src/commands/desc
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+=for usage
+Usage: ssh git@host desc <repo>
+ ssh git@host desc <repo> <description string>
+
+Show or set description for repo. You need to have write access to the repo
+and the 'writer-is-owner' option must be set for the repo, or it must be a
+user-created ('wild') repo and you must be the owner.
+=cut
+
+usage() if not @ARGV or @ARGV < 1 or $ARGV[0] eq '-h';
+
+my $repo = shift;
+my $text = join( " ", @ARGV );
+my $file = 'description';
+
+#<<<
+_die "you are not authorized" unless
+ ( not $text and can_read($repo) ) or
+ ( $text and owns($repo) ) or
+ ( $text and can_write($repo) and ( $rc{WRITER_CAN_UPDATE_DESC} or option( $repo, 'writer-is-owner' ) ) );
+#>>>
+
+$text
+ ? textfile( file => $file, repo => $repo, text => $text )
+ : print textfile( file => $file, repo => $repo );
+
+__END__
+
+kernel.org needs 'desc' to be available to people who have "RW" or above, not
+just the "creator". In fact they need it for non-wild repos so there *is* no
+creator. To accommodate this, we created the WRITER_CAN_UPDATE_DESC rc
+variable.
+
+However, that has turned out to be a bit of a blunt instrument for people with
+different types of wild repos -- they don't want to apply this to all of them.
+It seems easier to do this as an option, so you may have it for one set of
+"repo ..." and not have it for others. And if you want it for the whole
+system you'd just put it under "repo @all".
+
+The new 'writer-is-owner' option is meant to cover desc, readme, and any other
+repo-specific text file, so it's also a blunt instrument, though in a
+different dimension :-)
diff --git a/src/commands/fork b/src/commands/fork
new file mode 100755
index 0000000..49994fc
--- /dev/null
+++ b/src/commands/fork
@@ -0,0 +1,57 @@
+#!/bin/sh
+
+# Usage: ssh git@host fork <repo1> <repo2>
+#
+# Forks repo1 to repo2. You must have read permissions on repo1, and create
+# ("C") permissions for repo2, which of course must not exist.
+#
+# A fork is functionally the same as cloning repo1 to a client and pushing it
+# to a new repo2. It's just a little more efficient, not just in network
+# traffic but because it uses git clone's "-l" option to share the object
+# store also, so it is likely to be almost instantaneous, regardless of how
+# big the repo actually is.
+
+die() { echo "$@" >&2; exit 1; }
+usage() { perl -lne 'print substr($_, 2) if /^# Usage/../^$/' < $0; exit 1; }
+[ -z "$1" ] && usage
+[ "$1" = "-h" ] && usage
+[ -z "$GL_USER" ] && die GL_USER not set
+
+# ----------------------------------------------------------------------
+from=$1; shift
+to=$1; shift
+[ -z "$to" ] && usage
+
+gitolite access -q "$from" $GL_USER R any || die "'$from' does not exist or you are not allowed to read it"
+gitolite access -q "$to" $GL_USER ^C any || die "'$to' already exists or you are not allowed to create it"
+
+# ----------------------------------------------------------------------
+# IMPORTANT NOTE: checking whether someone can create a repo is done as above.
+# However, make sure that the env var GL_USER is set, and that too to the same
+# value as arg-2 of the access command), otherwise it won't work.
+
+# Ideally, you'll leave such code to me. There's a reason ^C is not listed in
+# the help message for 'gitolite access'.
+# ----------------------------------------------------------------------
+
+# clone $from to $to
+git clone --bare -l $GL_REPO_BASE/$from.git $GL_REPO_BASE/$to.git
+[ $? -ne 0 ] && exit 1
+
+echo "$from forked to $to" >&2
+
+# fix up creator, default role permissions (gl-perms), and hooks
+cd $GL_REPO_BASE/$to.git
+echo $GL_USER > gl-creator
+
+gitolite query-rc -q LOCAL_CODE && ln -sf `gitolite query-rc LOCAL_CODE`/hooks/common/* hooks
+ln -sf `gitolite query-rc GL_ADMIN_BASE`/hooks/common/* hooks
+
+# record where you came from
+echo "$from" > gl-forked-from
+
+# cache control, if rc says caching is on
+gitolite query-rc -q CACHE && perl -I$GL_LIBDIR -MGitolite::Cache -e "cache_control('flush', '$to')";
+
+# trigger post_create
+gitolite trigger POST_CREATE $to $GL_USER fork
diff --git a/src/commands/git-annex-shell b/src/commands/git-annex-shell
new file mode 100755
index 0000000..572aba6
--- /dev/null
+++ b/src/commands/git-annex-shell
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+# This command requires unrestricted arguments, so add it to the ENABLE list
+# like this:
+# 'git-annex-shell ua',
+
+# This requires git-annex version 20111016 or newer. Older versions won't
+# be secure.
+
+use strict;
+use warnings;
+
+# ignore @ARGV and look at the original unmodified command
+my $cmd = $ENV{SSH_ORIGINAL_COMMAND};
+
+# Expect commands like:
+# git-annex-shell 'configlist' '/~/repo'
+# git-annex-shell 'configlist' '/repo'
+# git-annex-shell 'sendkey' '/~/repo' 'key'
+# The parameters are always single quoted, and the repo path is always
+# the second parameter.
+# Further parameters are not validated here (see below).
+die "bad git-annex-shell command: $cmd"
+ unless $cmd =~ m#^(git-annex-shell '\w+' ')/(?:\~/)?([0-9a-zA-Z][0-9a-zA-Z._\@/+-]*)('( .*|))$#;
+my $start = $1;
+my $repo = $2;
+my $end = $3;
+$repo =~ s/\.git$//;
+die "I dont like some of the characters in $repo\n" unless $repo =~ $Gitolite::Rc::REPONAME_PATT;
+die "I dont like absolute paths in $cmd\n" if $repo =~ /^\//;
+die "I dont like '..' paths in $cmd\n" if $repo =~ /\.\./;
+
+# Modify $cmd, fixing up the path to the repo to include GL_REPO_BASE.
+my $newcmd = "$start$rc{GL_REPO_BASE}/$repo$end";
+
+# Rather than keeping track of which git-annex-shell commands
+# require write access and which are readonly, we tell it
+# when readonly access is needed.
+if ( can_write($repo) ) {
+} elsif ( can_read($repo) ) {
+ $ENV{GIT_ANNEX_SHELL_READONLY} = 1;
+} else {
+ die "$repo $ENV{GL_USER} DENIED\n";
+}
+# Further limit git-annex-shell to safe commands (avoid it passing
+# unknown commands on to git-shell)
+$ENV{GIT_ANNEX_SHELL_LIMITED} = 1;
+
+# Note that $newcmd does *not* get evaluated by the unix shell.
+# Instead it is passed as a single parameter to git-annex-shell for
+# it to parse and handle the command. This is why we do not need to
+# fully validate $cmd above.
+Gitolite::Common::gl_log( $ENV{SSH_ORIGINAL_COMMAND} );
+exec "git-annex-shell", "-c", $newcmd;
+
+__END__
+
+INSTRUCTIONS... (NEED TO BE VALIDATED BY SOMEONE WHO KNOWS GIT-ANNEX WELL).
+
+based on http://git-annex.branchable.com/tips/using_gitolite_with_git-annex/
+ONLY VARIATIONS FROM THAT PAGE ARE WRITTEN HERE.
+
+setup
+
+ * in the ENABLE list in the rc file, add an entry like this:
+ 'git-annex-shell ua',
+
+That should be it; everything else should be as in that page.
diff --git a/src/commands/git-config b/src/commands/git-config
new file mode 100755
index 0000000..94211de
--- /dev/null
+++ b/src/commands/git-config
@@ -0,0 +1,97 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Getopt::Long;
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+
+=for usage
+Usage: gitolite git-config [-n] [-q] [-r] <repo> <key|pattern>
+
+Print git config keys and values for the given repo. The key is either a full
+key, or, if '-r' is supplied, a regex that is applied to all available keys.
+
+ -q exit code only (shell truth; 0 is success)
+ -n suppress trailing newline when used as key (not pattern)
+ -r treat key as regex pattern (unanchored)
+ -ev print keys with empty values also (see below)
+
+Examples:
+ gitolite git-config repo gitweb.owner
+ gitolite git-config -q repo gitweb.owner
+ gitolite git-config -r repo gitweb
+
+Notes:
+
+1. When the key is treated as a pattern, prints:
+
+ reponame<tab>key<tab>value<newline>
+
+ Otherwise the output is just the value.
+
+2. By default, keys with empty values (specified as "" in the conf file) are
+ treated as non-existant. Using '-ev' will print those keys also. Note
+ that this only makes sense when the key is treated as a pattern, where
+ such keys are printed as:
+
+ reponame<tab>key<tab><newline>
+
+3. Finally, see the advanced use section of 'gitolite access -h' -- you can
+ do something similar here also:
+
+ gitolite list-phy-repos | gitolite git-config -r % gitweb\\. | cut -f1 > ~/projects.list
+=cut
+
+usage() if not @ARGV;
+
+my ( $help, $nonl, $quiet, $regex, $ev ) = (0) x 5;
+GetOptions(
+ 'n' => \$nonl,
+ 'q' => \$quiet,
+ 'r' => \$regex,
+ 'h' => \$help,
+ 'ev' => \$ev,
+) or usage();
+
+my ( $repo, $key ) = @ARGV;
+usage() unless $key;
+
+my $ret = '';
+
+if ( $repo ne '%' and $key ne '%' ) {
+ # single repo, single key; no STDIN
+ $key = "^\Q$key\E\$" unless $regex;
+
+ $ret = git_config( $repo, $key, $ev );
+
+ # if the key is not a regex, it should match at most one item
+ _die "found more than one entry for '$key'" if not $regex and scalar( keys %$ret ) > 1;
+
+ # unlike access, there's nothing to print if we don't find any matching keys
+ exit 1 unless %$ret;
+
+ if ($regex) {
+ map { print "$repo\t$_\t" . $ret->{$_} . "\n" } sort keys %$ret unless $quiet;
+ } else {
+ map { print $ret->{$_} . ( $nonl ? "" : "\n" ) } sort keys %$ret unless $quiet;
+ }
+ exit 0;
+}
+
+$repo = '' if $repo eq '%';
+$key = '' if $key eq '%';
+
+_die "'-q' doesn't go with using a pipe" if $quiet;
+@ARGV = ();
+while (<>) {
+ my @in = split;
+ my $r = $repo || shift @in;
+ my $k = $key || shift @in;
+ $k = "^\Q$k\E\$" unless $regex;
+ $ret = git_config( $r, $k, $ev );
+ next unless %$ret;
+ map { print "$r\t$_\t" . $ret->{$_} . "\n" } sort keys %$ret;
+}
diff --git a/src/commands/help b/src/commands/help
new file mode 100755
index 0000000..cf54084
--- /dev/null
+++ b/src/commands/help
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+
+=for usage
+Usage: ssh git@host help # via ssh
+ gitolite help # directly on server command line
+
+Prints a list of custom commands available at this gitolite installation.
+
+Each command has its own help, accessed by passing it '-h' again.
+=cut
+
+usage() if @ARGV;
+
+print greeting();
+
+my $user = $ENV{GL_USER} || '';
+print "list of " . ( $user ? "remote" : "gitolite" ) . " commands available:\n\n";
+
+my %list = ( list_x( $ENV{GL_BINDIR} ), list_x( $rc{LOCAL_CODE} || '' ) );
+for ( sort keys %list ) {
+ print "\t$list{$_}" if $ENV{D};
+ print "\t$_\n" if not $user or $rc{COMMANDS}{$_};
+}
+
+print "\n";
+print "$rc{SITE_INFO}\n" if $rc{SITE_INFO};
+
+exit 0;
+
+# ------------------------------------------------------------------------------
+sub list_x {
+ my $d = shift;
+ return unless $d;
+ return unless -d "$d/commands";
+ _chdir "$d/commands";
+ return map { $_ => $d } grep { -x $_ } map { chomp; s(^./)(); $_ } `find . -type f -o -type l|sort`;
+}
diff --git a/src/commands/htpasswd b/src/commands/htpasswd
new file mode 100755
index 0000000..bbfacc7
--- /dev/null
+++ b/src/commands/htpasswd
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+
+=for usage
+Usage: ssh git@host htpasswd
+
+Sets your htpasswd, assuming your admin has enabled it.
+
+(Admins: You need to add HTPASSWD_FILE to the rc file, pointing to an
+existing, writable, but possibly an initially empty, file, as well as adding
+'htpasswd' to the ENABLE list).
+=cut
+
+# usage and sanity checks
+usage() if @ARGV and $ARGV[0] eq '-h';
+$ENV{GL_USER} or _die "GL_USER not set";
+my $htpasswd_file = $rc{HTPASSWD_FILE} || '';
+die "htpasswd not enabled\n" unless $htpasswd_file;
+die "$htpasswd_file doesn't exist or is not writable\n" unless -w $htpasswd_file;
+
+# prompt
+$|++;
+print <<EOFhtp;
+Please type in your new htpasswd at the prompt. You only have to type it once.
+
+NOTE THAT THE PASSWORD WILL BE ECHOED, so please make sure no one is
+shoulder-surfing, and make sure you clear your screen as well as scrollback
+history after you're done (or close your terminal instance).
+
+EOFhtp
+print "new htpasswd: ";
+
+# get the password and run htpasswd
+my $password = <>;
+$password =~ s/[\n\r]*$//;
+die "empty passwords are not allowed\n" unless $password;
+my $res = system( "htpasswd", "-mb", $htpasswd_file, $ENV{GL_USER}, $password );
+die "htpasswd command seems to have failed with return code: $res.\n" if $res;
diff --git a/src/commands/info b/src/commands/info
new file mode 100755
index 0000000..b88e288
--- /dev/null
+++ b/src/commands/info
@@ -0,0 +1,144 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Getopt::Long;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+
+=for args
+Usage: gitolite info [-lc] [-ld] [-json] [<repo name pattern>]
+
+List all existing repos you can access, as well as repo name patterns (see
+"wild repos") you have any kind of access to.
+
+ '-lc' lists creators as an additional field at the end.
+ '-ld' lists description as an additional field at the end.
+ '-json' produce JSON output instead of normal output
+ '-p' limits output to physical repos only (no wild repo regexes!)
+
+The optional pattern is an unanchored regex that will limit the repos
+searched, in both cases. It might speed up things a little if you have more
+than a few thousand repos.
+=cut
+
+# these are globals
+my ( $lc, $ld, $json, $p, $patt ) = args();
+my %out; # holds info to be json'd
+
+$ENV{GL_USER} or _die "GL_USER not set";
+if ($json) {
+ greeting(\%out);
+} else {
+ print greeting();
+}
+
+print_patterns() unless $p; # repos he can create for himself
+print_phy_repos(); # repos already created
+
+if ( $rc{SITE_INFO} ) {
+ $json
+ ? $out{SITE_INFO} = $rc{SITE_INFO}
+ : print "\n$rc{SITE_INFO}\n";
+}
+
+print JSON::to_json( \%out, { utf8 => 1, pretty => 1 } ) if $json;
+
+# ----------------------------------------------------------------------
+
+sub args {
+ my ( $lc, $ld, $json, $p, $patt ) = ( '', '', '', '' );
+ my $help = '';
+
+ GetOptions(
+ 'lc' => \$lc,
+ 'ld' => \$ld,
+ 'json' => \$json,
+ 'p' => \$p,
+ 'h' => \$help,
+ ) or usage();
+
+ usage() if @ARGV > 1 or $help;
+ $patt = shift @ARGV || '.';
+
+ require JSON if $json;
+
+ return ( $lc, $ld, $json, $p, $patt );
+}
+
+sub print_patterns {
+ my ( $repos, @aa );
+
+ my $lm = \&Gitolite::Conf::Load::list_members;
+
+ # find repo patterns only, call them with ^C flag included
+ @$repos = grep { !/$REPONAME_PATT/ } map { /^@/ ? @{ $lm->($_) } : $_ } @{ lister_dispatch('list-repos')->() };
+ @aa = qw(R W ^C);
+ listem( $repos, '', '', @aa );
+ # but squelch the 'lc' and 'ld' flags for these
+}
+
+sub print_phy_repos {
+ my ( $repos, @aa );
+
+ # now get the actual repos and get R or W only
+ _chdir( $rc{GL_REPO_BASE} );
+ $repos = list_phy_repos(1);
+ @aa = qw(R W);
+ listem( $repos, $lc, $ld, @aa );
+}
+
+sub listem {
+ my ( $repos, $lc, $ld, @aa ) = @_;
+ my @list;
+ my $mlr = 0; # max length of reponame
+ my $mlc = 0; # ...and creator
+ for my $repo (@$repos) {
+ next unless $repo =~ /$patt/;
+ my $creator = '';
+ my $desc = '';
+ my $perm = '';
+ $creator = creator($repo) if $lc;
+
+ if ($ld) {
+ # use config value first, else 'description' file as second choice
+ my $k = 'gitweb.description';
+ my $d = "$ENV{GL_REPO_BASE}/$repo.git/description";
+ $desc = git_config( $repo, $k )->{$k} || '';
+ if ( !$desc and -r $d ) {
+ $desc = slurp($d);
+ chomp($desc);
+ }
+ }
+
+ for my $aa (@aa) {
+ my $ret = access( $repo, $ENV{GL_USER}, $aa, 'any' );
+ $perm .= ( $ret =~ /DENIED/ ? " " : " $aa" );
+ }
+ $perm =~ s/\^//;
+ next unless $perm =~ /\S/;
+
+ if ($json) {
+ $out{repos}{$repo}{creator} = $creator if $lc;
+ $out{repos}{$repo}{description} = $desc if $ld;
+ $out{repos}{$repo}{perms} = _hash($perm);
+ } else {
+ $mlr = length($repo) if ( $lc or $ld ) and $mlr < length($repo);
+ $mlc = length($creator) if $lc and $ld and $mlc < length($creator);
+ push @list, [ $perm, $repo, $creator, $desc ];
+ }
+ }
+ return if $json;
+
+ my $fmt = "%s\t%-${mlr}s\t%-${mlc}s\t%s\n";
+ map { s/\t\t/\t/; s/\s*$/\n/; print } map { sprintf $fmt, @$_ } @list;
+}
+
+sub _hash {
+ my $in = shift;
+ my %out = map { $_ => 1 } ( $in =~ /(\S)/g );
+ return \%out;
+}
diff --git a/src/commands/list-dangling-repos b/src/commands/list-dangling-repos
new file mode 100755
index 0000000..60a3592
--- /dev/null
+++ b/src/commands/list-dangling-repos
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+
+=for usage
+Usage: gitolite list-dangling-repos
+
+List all existing repos that no one can access remotely any more. They could
+be normal repos that were taken out of "repo" statements in the conf file, or
+wildcard repos whose matching "wild" pattern was taken out or changed so it no
+longer matches.
+
+I would advise caution if you use this as a basis for deleting repos from the
+file system. A bug in this program could cause you to lose important data!
+=cut
+
+usage() if @ARGV and $ARGV[0] eq '-h';
+
+# get the two lists we need. %repos is the list of repos in "repo" statements
+# in the conf file. %phy_repos is the list of actual repos on disk. Our job
+# is to cull %phy_repos of all keys that have a matching key in %repos, where
+# "matching" means "string equal" or "regex match".
+my %repos = map { chomp; $_ => 1 } `gitolite list-repos`;
+for my $r ( grep /^@/, keys %repos ) {
+ map { chomp; $repos{$_} = 1; } `gitolite list-members $r`;
+}
+my %phy_repos = map { chomp; $_ => 1 } `gitolite list-phy-repos`;
+
+# Remove exact matches. But for repo names like "gtk+", you could have
+# collapsed this into the next step (the regex match).
+for my $pr ( keys %phy_repos ) {
+ next unless exists $repos{$pr};
+ delete $repos{$pr};
+ delete $phy_repos{$pr};
+}
+
+# Remove regex matches.
+for my $pr ( keys %phy_repos ) {
+ my $matched = 0;
+ my $pr2 = Gitolite::Conf::Load::generic_name($pr);
+ for my $r ( keys %repos ) {
+ if ( $pr =~ /^$r$/ or $pr2 =~ /^$r$/ ) {
+ $matched = 1;
+ next;
+ }
+ }
+ delete $phy_repos{$pr} if $matched;
+}
+
+# what's left in %phy_repos are dangling repos.
+print join( "\n", sort keys %phy_repos ), "\n";
diff --git a/src/commands/lock b/src/commands/lock
new file mode 100755
index 0000000..70c2190
--- /dev/null
+++ b/src/commands/lock
@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Getopt::Long;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+
+# gitolite command to lock and unlock (binary) files and deal with locks.
+
+=for usage
+Usage: ssh git@host lock -l <repo> <file> # lock a file
+ ssh git@host lock -u <repo> <file> # unlock a file
+ ssh git@host lock --break <repo> <file> # break someone else's lock
+ ssh git@host lock -ls <repo> # list locked files for repo
+
+See doc/locking.mkd for other details.
+=cut
+
+usage() if not @ARGV or $ARGV[0] eq '-h';
+$ENV{GL_USER} or _die "GL_USER not set";
+
+my $op = '';
+$op = 'lock' if $ARGV[0] eq '-l';
+$op = 'unlock' if $ARGV[0] eq '-u';
+$op = 'break' if $ARGV[0] eq '--break';
+$op = 'list' if $ARGV[0] eq '-ls';
+usage() if not $op;
+shift;
+
+my $repo = shift;
+_die "You are not authorised" if access( $repo, $ENV{GL_USER}, 'W', 'any' ) =~ /DENIED/;
+_die "You are not authorised" if $op eq 'break' and access( $repo, $ENV{GL_USER}, '+', 'any' ) =~ /DENIED/;
+
+my $file = shift || '';
+usage() if $op ne 'list' and not $file;
+
+_chdir( $ENV{GL_REPO_BASE} );
+_chdir("$repo.git");
+
+_die "aborting, file '$file' not found in any branch" if $file and not object_exists($file);
+
+my $ff = "gl-locks";
+
+if ( $op eq 'lock' ) {
+ f_lock( $repo, $file );
+} elsif ( $op eq 'unlock' ) {
+ f_unlock( $repo, $file );
+} elsif ( $op eq 'break' ) {
+ f_break( $repo, $file );
+} elsif ( $op eq 'list' ) {
+ f_list($repo);
+}
+
+# ----------------------------------------------------------------------
+# For a given path, return 1 if object exists in any branch, 0 if not.
+# This is to prevent locking invalid objects.
+
+sub object_exists {
+ my $file = shift;
+
+ my @branches = `git for-each-ref refs/heads '--format=%(refname)'`;
+ foreach my $b (@branches) {
+ chomp($b);
+ system("git cat-file -e $b:$file 2>/dev/null") or return 1;
+ # note that with system(), the return value is "shell truth", so
+ # you check for success with "or", not "and"
+ }
+ return 0; # report object not found
+}
+
+# ----------------------------------------------------------------------
+# everything below assumes we have already chdir'd to "$repo.git". Also, $ff
+# is used as a global.
+
+sub f_lock {
+ my ( $repo, $file ) = @_;
+
+ my %locks = get_locks();
+ _die "'$file' locked by '$locks{$file}{USER}' since " . localtime( $locks{$file}{TIME} ) if $locks{$file}{USER};
+ $locks{$file}{USER} = $ENV{GL_USER};
+ $locks{$file}{TIME} = time;
+ put_locks(%locks);
+}
+
+sub f_unlock {
+ my ( $repo, $file ) = @_;
+
+ my %locks = get_locks();
+ _die "'$file' not locked by '$ENV{GL_USER}'" if ( $locks{$file}{USER} || '' ) ne $ENV{GL_USER};
+ delete $locks{$file};
+ put_locks(%locks);
+}
+
+sub f_break {
+ my ( $repo, $file ) = @_;
+
+ my %locks = get_locks();
+ _die "'$file' was not locked" unless $locks{$file};
+ push @{ $locks{BREAKS} }, time . " $ENV{GL_USER} $locks{$file}{USER} $locks{$file}{TIME} $file";
+ delete $locks{$file};
+ put_locks(%locks);
+}
+
+sub f_list {
+ my $repo = shift;
+
+ my %locks = get_locks();
+ print "\n# locks held:\n\n";
+ map { print "$locks{$_}{USER}\t$_\t(" . scalar( localtime( $locks{$_}{TIME} ) ) . ")\n" } grep { $_ ne 'BREAKS' } sort keys %locks;
+ print "\n# locks broken:\n\n";
+ for my $b ( @{ $locks{BREAKS} } ) {
+ my ( $when, $who, $whose, $how_old, $what ) = split ' ', $b;
+ print "$who\t$what\t(" . scalar( localtime($when) ) . ")\t(locked by $whose at " . scalar( localtime($how_old) ) . ")\n";
+ }
+}
+
+sub get_locks {
+ if ( -f $ff ) {
+ our %locks;
+
+ my $t = slurp($ff);
+ eval $t;
+ _die "do '$ff' failed with '$@', contact your administrator" if $@;
+
+ return %locks;
+ }
+ return ();
+}
+
+sub put_locks {
+ my %locks = @_;
+
+ use Data::Dumper;
+ $Data::Dumper::Indent = 1;
+ $Data::Dumper::Sortkeys = 1;
+
+ my $dumped_data = Data::Dumper->Dump( [ \%locks ], [qw(*locks)] );
+ _print( $ff, $dumped_data );
+}
diff --git a/src/commands/mirror b/src/commands/mirror
new file mode 100755
index 0000000..b22ec2a
--- /dev/null
+++ b/src/commands/mirror
@@ -0,0 +1,186 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+my $tid;
+
+BEGIN {
+ $tid = $ENV{GL_TID} || 0;
+ delete $ENV{GL_TID};
+}
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+
+=for usage
+Usage 1: gitolite mirror push <copy> <repo>
+ gitolite mirror status <copy> <repo>
+ gitolite mirror status all <repo>
+ gitolite mirror status all all
+Usage 2: ssh git@master-server mirror push <copy> <repo>
+ ssh git@master-server mirror status <copy> <repo>
+
+Forces a push of one repo to one copy.
+
+Usage 1 is directly on the master server. Nothing is checked; if the copy
+accepts it, the push happens, even if the copy is not in any copies
+option. This is how you do delayed or lagged pushes to servers that do not
+need real-time updates or have bandwidth/connectivity issues.
+
+Usage 2 can be initiated by *any* user who has *any* gitolite access to the
+master server, but it checks that the copy is in one of the copies options
+before doing the push.
+
+MIRROR STATUS: The usage examples above show what can be done. The 'status
+all <repo>' usage checks the status of all the copies defined for the given
+repo. The 'status all all' usage is special, in that it only prints a list of
+repos that have *some* error, instead of dumping all the error info itself.
+
+SERVER LIST: 'gitolite mirror list master <reponame>' and 'gitolite mirror
+list copies <reponame>' will show you the name of the master server, and list
+the copy servers, for the repo. They only work on the server command line
+(any server), but not remotely (from a normal user).
+=cut
+
+usage() if not @ARGV or $ARGV[0] eq '-h';
+
+_die "HOSTNAME not set" if not $rc{HOSTNAME};
+
+my ( $cmd, $host, $repo ) = @ARGV;
+$host = 'copies' if $host eq 'slaves';
+$repo =~ s/\.git$//;
+usage() if not $repo;
+
+if ( $cmd eq 'push' ) {
+ valid_copy( $host, $repo ) if exists $ENV{GL_USER};
+ # will die if host not in copies for repo
+
+ trace( 1, "TID=$tid host=$host repo=$repo", "gitolite mirror push started" );
+ _chdir( $rc{GL_REPO_BASE} );
+ _chdir("$repo.git");
+
+ if ( -f "gl-creator" ) {
+ # try to propagate the wild repo, including creator name and gl-perms
+ my $creator = `cat gl-creator`; chomp($creator);
+ trace( 1, `cat gl-perms 2>/dev/null | ssh $host CREATOR=$creator perms -c \\'$repo\\' 2>/dev/null` );
+ }
+
+ my $errors = 0;
+ my $glss = '';
+ for (`git push --mirror $host:$repo 2>&1`) {
+ $errors = 1 if $?;
+ print STDERR "$_" if -t STDERR or exists $ENV{GL_USER};
+ $glss .= $_;
+ chomp;
+ if (/FATAL/) {
+ $errors = 1;
+ gl_log( 'mirror', $_ );
+ } else {
+ trace( 1, "mirror: $_" );
+ }
+ }
+ # save the mirror push status for this copy if the word 'fatal' is found,
+ # else remove the status file. We don't store "success" output messages;
+ # you can always get those from the log files if you really need them.
+ if ( $glss =~ /fatal/i ) {
+ my $glss_prefix = Gitolite::Common::gen_ts() . "\t$ENV{GL_TID}\t";
+ $glss =~ s/^/$glss_prefix/gm;
+ _print("gl-copy-$host.status", $glss);
+ } else {
+ unlink "gl-copy-$host.status";
+ }
+
+ exit $errors;
+} elsif ($cmd eq 'status') {
+ if (not exists $ENV{GL_USER} and $repo eq 'all') {
+ # this means 'gitolite mirror status all all'; in this case we only
+ # return a list of repos that *have* status files (indicating some
+ # problem). It's upto you what you do with that list. This is not
+ # allowed to be run remotely; far too wide ranging, sorry.
+ _chdir( $rc{GL_REPO_BASE} );
+ my $phy_repos = list_phy_repos(1);
+ for my $repo ( @{$phy_repos} ) {
+ my @x = glob("$rc{GL_REPO_BASE}/$repo.git/gl-copy-*.status");
+ print "$repo\n" if @x;
+ }
+ exit 0;
+ }
+
+ valid_copy( $host, $repo ) if exists $ENV{GL_USER};
+ # will die if host not in copies for repo
+
+ _chdir( $rc{GL_REPO_BASE} );
+ _chdir("$repo.git");
+
+ $host = '*' if $host eq 'all';
+ map { print_status($repo, $_) } sort glob("gl-copy-$host.status");
+} else {
+ # strictly speaking, we could allow some of the possible commands remotely
+ # also, at least for admins. However, these commands are mainly intended
+ # for server-side scripting so I don't care.
+ usage() if $ENV{GL_USER};
+
+ server_side_commands(@ARGV);
+}
+
+# ----------------------------------------------------------------------
+
+sub valid_copy {
+ my ( $host, $repo ) = @_;
+ _die "invalid repo '$repo'" unless $repo =~ $REPONAME_PATT;
+
+ my %list = repo_copies($repo);
+ _die "'$host' not a valid copy for '$repo'" unless $list{$host};
+}
+
+sub repo_copies {
+ my $repo = shift;
+
+ my $ref = git_config( $repo, "^gitolite-options\\.mirror\\.copies.*" );
+ my %list = map { $_ => 1 } map { split } values %$ref;
+
+ return %list;
+}
+
+sub repo_master {
+ my $repo = shift;
+
+ my $ref = git_config( $repo, "^gitolite-options\\.mirror\\.master\$" );
+ my @list = map { split } values %$ref;
+ _die "'$repo' seems to have more than one master" if @list > 1;
+
+ return $list[0] || '';
+}
+
+sub print_status {
+ my $repo = shift;
+ my $file = shift;
+ return unless -f $file;
+ my $copy = $1 if $file =~ /^gl-copy-(.+)\.status$/;
+ print "----------\n";
+ print "WARNING: previous mirror push of repo '$repo' to host '$copy' failed, status is:\n";
+ print slurp($file);
+ print "----------\n";
+}
+
+# ----------------------------------------------------------------------
+# server side commands. Very little error checking.
+# gitolite mirror list master <repo>
+# gitolite mirror list copies <repo>
+
+sub server_side_commands {
+ if ( $cmd eq 'list' ) {
+ if ( $host eq 'master' ) {
+ say repo_master($repo);
+ } elsif ( $host eq 'copies' ) {
+ my %list = repo_copies($repo);
+ say join( " ", sort keys %list );
+ } else {
+ _die "gitolite mirror list master|copies <reponame>";
+ }
+ } else {
+ _die "invalid command";
+ }
+}
diff --git a/src/commands/motd b/src/commands/motd
new file mode 100755
index 0000000..b56e99e
--- /dev/null
+++ b/src/commands/motd
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+=for usage
+Usage: ssh git@host motd <repo> rm
+ cat <filename> | ssh git@host motd <repo> set
+
+Remove or set the motd file for repo or the whole system.
+
+For a repo: you need to have write access to the repo and the
+'writer-is-owner' option must be set for the repo, or it must be a
+user-created ('wild') repo and you must be the owner.
+
+For the whole system: you need to be an admin (have write access to the
+gitolite-admin repo). Use @all in place of the repo name.
+
+PLEASE NOTE that if you're using http mode, the motd will only appear for
+gitolite commands, not for normal git operations. This in turn means that
+only the system wide motd can be seen; repo level motd's never show up.
+=cut
+
+usage() if not @ARGV or @ARGV < 1 or $ARGV[0] eq '-h';
+
+my $repo = shift;
+my $op = shift || '';
+usage() if $op ne 'rm' and $op ne 'set';
+my $file = "gl-motd";
+
+#<<<
+_die "you are not authorized" unless
+ ( $repo eq '@all' and is_admin() ) or
+ ( $repo ne '@all' and owns($repo) ) or
+ ( $repo ne '@all' and can_write($repo) and option( $repo, 'writer-is-owner' ) );
+#>>>
+
+my @out =
+ $repo eq '@all'
+ ? ( dir => $rc{GL_ADMIN_BASE} )
+ : ( repo => $repo );
+
+if ( $op eq 'rm' ) {
+ $repo eq '@all'
+ ? unlink "$rc{GL_ADMIN_BASE}/$file"
+ : unlink "$rc{GL_REPO_BASE}/$repo.git/$file";
+} elsif ( $op eq 'set' ) {
+ textfile( file => $file, @out, prompt => '' );
+} else {
+ print textfile( file => $file, @out, );
+}
diff --git a/src/commands/newbranch b/src/commands/newbranch
new file mode 100755
index 0000000..6dff545
--- /dev/null
+++ b/src/commands/newbranch
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+=for usage
+Usage: ssh git@host newbranch <repo name> <new branch name> <based-on ref name>
+
+Create a new branch and set it to existing branch or tag. You should have
+write access to that branch.
+
+NOTE: runs "git branch arg-2 arg-3" in repo given by arg-1, which means you
+should NOT prefix arguments with "refs/heads/" or "refs/tags/".
+
+----
+
+This is for people who have restrictions on what files they can "touch". When
+you fork a branch and change a file, even if you changed only the files you're
+allowed to, gitolite thinks you changed *all* the files in the repo because
+the "old SHA" is basically empty.
+
+This helps get around that by first creating the new branch, so that you can
+then push to it.
+
+To enable this command, add it to the rc file as a 'command'.
+
+TODO: handle deletes also (less commonly encountered and left as an "exercise
+for the reader" for now!)
+=cut
+
+usage() if not @ARGV or @ARGV < 3 or $ARGV[0] eq '-h';
+
+my $repo = shift;
+my $newbr = shift;
+my $oldref = shift;
+
+_die "you are not authorized" unless can_write($repo, "W", "refs/heads/$newbr");
+
+Gitolite::Common::_system("git", "branch", $newbr, $oldref);
diff --git a/src/commands/option b/src/commands/option
new file mode 100755
index 0000000..de49aab
--- /dev/null
+++ b/src/commands/option
@@ -0,0 +1,127 @@
+#!/usr/bin/perl
+
+# ----------------------------------------------------------------------
+# gitolite command to allow repo "owners" to set "options" on repos
+
+# This command can be run by a user to set "options" for any repo that she
+# owns.
+#
+# However, gitolite does *not* have the concept of an incremental "compile",
+# and options are only designed to be specified in the gitolite.conf file
+# (which a user should not be able to even see!). Therefore, we allow one
+# specific file (conf/options.conf) to be manipulated by a remote user in a
+# *controlled* fashion, and this file is "include"d in the main gitolite.conf
+# file.
+
+# WARNINGS:
+# 1. Runs "gitolite compile" at the end. On really huge systems (where the
+# sum total of the conf files is in the order of tens of thousands of
+# lines) this may take a second or two :)
+# 2. Since "options.conf" is not part of the admin repo, you may need to
+# back it up separately, just like you currently back up gl-creator and
+# gl-perms files from individual repos.
+# 3. "options.conf" is formatted very strictly because it's not meant to be
+# human edited. If you edit it directly on the server, be careful.
+
+# Relevant gitolite doc links:
+# "wild" repos and "owners"
+# http://gitolite.com/gitolite/wild.html
+# http://gitolite.com/gitolite/wild.html#specifying-owners
+# http://gitolite.com/gitolite/wild.html#appendix-1-owner-and-creator
+# gitolite "options"
+# http://gitolite.com/gitolite/options.html
+# the "include" statement
+# http://gitolite.com/gitolite/conf.html#include
+
+# setup:
+# 1. Enable the command by adding it to the ENABLE list in the rc file.
+#
+# 2. Make sure your gitolite.conf has this line at the end:
+#
+# include "options.conf"
+#
+# then add/commit/push.
+#
+# Do NOT add a file called "options.conf" to your gitolite-admin repo!
+# This means every time you compile (push the admin repo) you will get a
+# warning about the missing file.
+#
+# You can either "touch ~/.gitolite/conf/options.conf" on the server, or
+# take *any* wild repo and add *any* option to create it.
+#
+# 3. Specify options allowed to be changed by the user. For example:
+#
+# repo foo/..*
+# C = blah blah
+# ...other rules...
+# option user-options = hook\..* foo bar[0-9].*
+#
+# Users can then set any of these options, but no others.
+
+# ----------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+use Gitolite::Common;
+
+# ----------------------------------------------------------------------
+# usage and arg checks
+
+=for usage
+Usage: ssh git@host option <repo> add <key> <val>
+ ssh git@host option <repo> del <key>
+ ssh git@host option <repo> list
+
+Add, delete, or list options for wild repos. Keys must match one of the
+allowed patterns; your system administrator will tell you what they are.
+
+Doesn't check things like adding a key that already exists (simply overwrites
+without warning), deleting a key that doesn't, etc.
+=cut
+
+usage() if not @ARGV or $ARGV[0] eq '-h';
+
+my $OPTIONS = "$ENV{HOME}/.gitolite/conf/options.conf";
+
+my $repo = shift;
+die "sorry, you are not authorised\n" unless owns($repo);
+
+my $op = shift; usage() unless $op =~ /^(add|del|list)$/;
+my $key = shift; usage() if not $key and $op ne 'list';
+my $val = shift; usage() if not $val and $op eq 'add';
+
+_print( $OPTIONS, "" ) unless -f $OPTIONS; # avoid error on first run
+my $options = slurp($OPTIONS);
+
+# ----------------------------------------------------------------------
+# get 'list' out of the way first
+if ( $op eq 'list' ) {
+ print "$1\t$2\n" while $options =~ /^repo $repo\n option (\S+) = (.*)/mg;
+ exit 0;
+}
+
+# ----------------------------------------------------------------------
+# that leaves 'add' or 'del'
+
+# NOTE: sanity check on characters in key and val not needed;
+# REMOTE_COMMAND_PATT is more restrictive than UNSAFE_PATT anyway!
+
+# check if the key is allowed
+my $user_options = option( $repo, 'user-options' );
+# this is a space separated list of allowed option keys
+my @validkeys = split( ' ', ( $user_options || '' ) );
+my @matched = grep { $key =~ /^$_$/i } @validkeys;
+_die "option '$key' not allowed\n" if ( @matched < 1 );
+
+# delete anyway
+$options =~ s/^repo $repo\n option $key = .*\n//m;
+# then re-add if needed
+$options .= "repo $repo\n option $key = $val\n" if $op eq 'add';
+
+# ----------------------------------------------------------------------
+# save and compile
+_print( $OPTIONS, $options );
+system("gitolite compile");
diff --git a/src/commands/owns b/src/commands/owns
new file mode 100755
index 0000000..d1d8757
--- /dev/null
+++ b/src/commands/owns
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+=for usage
+Usage: gitolite owns <reponame>
+
+Checks if $GL_USER is an owner of the repo and returns an exit code (shell
+truth, 0 for success), which makes it possible to do this in shell:
+
+ if gitolite owns someRepo
+ then
+ ...
+=cut
+
+usage() if not @ARGV or $ARGV[0] eq '-h';
+my $repo = shift;
+
+exit not owns($repo);
diff --git a/src/commands/perms b/src/commands/perms
new file mode 100755
index 0000000..be7be69
--- /dev/null
+++ b/src/commands/perms
@@ -0,0 +1,193 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Easy;
+
+=for usage
+perms -- list or set permissions for user-created ("wild") repo.
+
+Usage summary:
+ ssh git@host perms <repo> -l
+ # list current permissions on repo
+ ssh git@host perms <repo> -lr
+ # list available roles and their access rights
+
+ ssh git@host perms <repo> + <rolename> <username>
+ # change permissions: add a user to a role
+ ssh git@host perms <repo> - <rolename> <username>
+ # change permissions: remove a user from a role
+
+Examples:
+ ssh git@host perms my/repo + READERS alice
+ ssh git@host perms my/repo + WRITERS bob
+
+----
+There is also a batch mode useful for scripting and bulk loading; see the
+source code of the perms command for details.
+=cut
+
+# BATCH MODE: DO NOT combine this with the +/- mode above. This mode also
+# creates the repo if it does not already exist (assuming $GL_USER has
+# permissions to create it).
+#
+# Example:
+# cat copy-of-backed-up-gl-perms | ssh git@host perms -c <repo>
+
+usage() if not @ARGV or $ARGV[0] eq '-h' or @ARGV < 2;
+
+$ENV{GL_USER} or _die "GL_USER not set";
+
+my $generic_error = "repo does not exist, or you are not authorised";
+
+if ( $ARGV[1] eq '-l' ) {
+ getperms($ARGV[0]); # doesn't return
+}
+
+# auto-create the repo if -c passed and repo doesn't exist
+if ( $ARGV[0] eq '-c' ) {
+ shift;
+ my $repo = $ARGV[0] or usage();
+ _die "invalid repo '$repo'" unless $repo =~ $REPONAME_PATT;
+
+ if ( not -d "$rc{GL_REPO_BASE}/$repo.git" ) {
+ unless ($ENV{GL_BYPASS_CREATOR_CHECK}) {
+ my $ret = Gitolite::Conf::Load::access( $repo, $ENV{GL_USER}, '^C', 'any' );
+ _die $generic_error if $ret =~ /DENIED/;
+ }
+
+ require Gitolite::Conf::Store;
+ Gitolite::Conf::Store->import;
+ new_wild_repo( $repo, $ENV{GL_USER}, 'perms-c' );
+ gl_log( 'create', $repo, $ENV{GL_USER}, 'perms-c' );
+ }
+}
+
+my $repo = shift;
+
+if ( @ARGV and $ARGV[0] eq '-lr' ) {
+ list_roles();
+ exit 0;
+} else {
+ setperms(@ARGV);
+}
+
+# cache control
+if ($rc{CACHE}) {
+ require Gitolite::Cache;
+ Gitolite::Cache::cache_control('flush', $repo);
+}
+
+_system( "gitolite", "trigger", "POST_CREATE", $repo, $ENV{GL_USER}, 'perms' );
+
+# ----------------------------------------------------------------------
+
+sub getperms {
+ my $repo = shift;
+ _die $generic_error if not owns($repo);
+ my $pf = "$rc{GL_REPO_BASE}/$repo.git/gl-perms";
+
+ print slurp($pf) if -f $pf;
+
+ exit 0;
+}
+
+sub setperms {
+ _die $generic_error if not owns($repo);
+ my $pf = "$rc{GL_REPO_BASE}/$repo.git/gl-perms";
+
+ if ( not @_ ) {
+ # legacy mode; pipe data in
+ print STDERR "'batch' mode started, waiting for input (run with '-h' for details).\n";
+ print STDERR "Please enter 'cancel' to abort if you did not intend to do this.\n";
+ @ARGV = ();
+ my @a;
+ while (<>) {
+ _die "CANCELLED" if /^\s*cancel\s*$/i;
+ invalid_role($1) if /(\S+)/ and not $rc{ROLES}{$1};
+ push @a, $_;
+ }
+
+ _print( $pf, @a );
+ return;
+ }
+
+ _die "Invalid syntax. Please re-run with '-h' for detailed usage" if @_ != 3;
+ my ( $op, $role, $user ) = @_;
+ _die "Invalid syntax. Please re-run with '-h' for detailed usage" if $op ne '+' and $op ne '-';
+ _die "Invalid user '$user'" if not $user =~ $USERNAME_PATT;
+
+ my $text = '';
+ my @text = slurp($pf) if -f $pf;
+
+ my $present = grep { $_ eq "$role $user\n" } @text;
+
+ if ( $op eq '-' ) {
+ if ( not $present ) {
+ _warn "'$role $user' was not present in file";
+ } else {
+ @text = grep { $_ ne "$role $user\n" } @text;
+ _print( $pf, @text );
+ }
+ } else {
+ invalid_role($role) unless grep { $_->[3] eq $role } load_roles();
+ if ($present) {
+ _warn "'$role $user' already present in file";
+ } else {
+ push @text, "$role $user\n";
+ @text = sort @text;
+ _print( $pf, @text );
+ }
+ }
+}
+
+my @rules;
+
+sub load_roles {
+ return @rules if @rules;
+
+ require Gitolite::Conf::Load;
+ Gitolite::Conf::Load::load($repo);
+
+ my %repos = %Gitolite::Conf::Load::repos;
+ my @repo_memberships = Gitolite::Conf::Load::memberships('repo', $repo);
+
+ for my $rp (@repo_memberships) {
+ my $hr = $repos{$rp};
+ for my $r ( keys %$hr ) {
+ next unless $r =~ s/^@//;
+ next unless $rc{ROLES}{$r};
+ map { $_->[3] = $r } @{ $hr->{"\@$r"} };
+ push @rules, @{ $hr->{"\@$r"} };
+ }
+ }
+ return @rules;
+}
+
+sub invalid_role {
+ my $role = shift;
+
+ print STDERR "Invalid role '$role'; valid roles for this repo:\n";
+ open(STDOUT, '>&', \*STDERR); # make list_roles print to STDERR
+ list_roles();
+ exit 1;
+}
+
+sub list_roles {
+
+ my @rules = sort { $a->[0] <=> $b->[0] } load_roles();
+
+ for (@rules) {
+ $_->[2] =~ s(^refs/heads/)();
+ $_->[2] = '--any--' if $_->[2] eq 'refs/.*';
+ }
+
+ my $max = 0;
+ map { $max = $_ if $_ > $max } map { length($_->[2]) } @rules;
+ printf("\t%s\t%*s\t \t%s\n", "perm", -$max, "ref", "role");
+ printf("\t%s\t%*s\t \t%s\n", "----", -$max, "---", "----");
+ printf("\t%s\t%*s\t=\t%s\n", $_->[1], -$max, $_->[2], $_->[3]) for @rules;
+}
diff --git a/src/commands/print-default-rc b/src/commands/print-default-rc
new file mode 100755
index 0000000..79b88c1
--- /dev/null
+++ b/src/commands/print-default-rc
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+
+print glrc('default-text');
diff --git a/src/commands/push b/src/commands/push
new file mode 100755
index 0000000..f97f730
--- /dev/null
+++ b/src/commands/push
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+export GL_BYPASS_ACCESS_CHECKS=1
+
+git push "$@"
diff --git a/src/commands/readme b/src/commands/readme
new file mode 100755
index 0000000..cd9632f
--- /dev/null
+++ b/src/commands/readme
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+# README.html files work similar to "description" files. For further
+# information see
+# https://www.kernel.org/pub/software/scm/git/docs/gitweb.html
+# under "Per-repository gitweb configuration".
+
+=for usage
+Usage: ssh git@host readme <repo>
+ ssh git@host readme <repo> rm
+ cat <filename> | ssh git@host readme <repo> set
+
+Show, remove or set the README.html file for repo.
+
+You need to have write access to the repo and the 'writer-is-owner' option
+must be set for the repo, or it must be a user-created ('wild') repo and you
+must be the owner.
+=cut
+
+usage() if not @ARGV or @ARGV < 1 or $ARGV[0] eq '-h';
+
+my $repo = shift;
+my $op = shift || '';
+usage() if $op and $op ne 'rm' and $op ne 'set';
+my $file = 'README.html';
+
+#<<<
+_die "you are not authorized" unless
+ ( not $op and can_read($repo) ) or
+ ( $op and owns($repo) ) or
+ ( $op and can_write($repo) and option( $repo, 'writer-is-owner' ) );
+#>>>
+
+if ( $op eq 'rm' ) {
+ unlink "$rc{GL_REPO_BASE}/$repo.git/$file";
+} elsif ( $op eq 'set' ) {
+ textfile( file => $file, repo => $repo, prompt => '' );
+} else {
+ print textfile( file => $file, repo => $repo );
+}
+
+__END__
+
+The WRITER_CAN_UPDATE_README option is gone now; it applies to all the repos
+in the system. Much better to add 'option writer-is-owner = 1' to repos or
+repo groups that you want this to apply to.
+
+This option is meant to cover desc, readme, and any other repo-specific text
+file, so it's also a blunt instrument, though in a different dimension :-)
diff --git a/src/commands/rsync b/src/commands/rsync
new file mode 100755
index 0000000..c7b25d1
--- /dev/null
+++ b/src/commands/rsync
@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+=for admins
+
+BUNDLE SUPPORT
+
+ (1) For each repo in gitolite.conf for which you want bundle support (or
+ '@all', if you wish), add the following line:
+
+ option bundle = 1
+
+ Or you can say:
+
+ option bundle.ttl = <number>
+
+ A bundle file that is more than <number> seconds old (default value
+ 86400, i.e., 1 day) is recreated on the next bundle request. Increase
+ this if your repo is not terribly active.
+
+ Note: a bundle file is also deleted and recreated if it contains a ref
+ that was then either deleted or rewound in the repo. This is checked
+ on every invocation.
+
+ (2) Add 'rsync' to the ENABLE list in the rc file
+
+=cut
+
+=for usage
+rsync helper for gitolite
+
+BUNDLE SUPPORT
+
+ Admins: see src/commands/rsync for setup instructions
+
+ Users:
+ rsync git@host:repo.bundle .
+ # downloads a file called "<basename of repo>.bundle"; repeat as
+ # needed till the whole thing is downloaded
+ git clone repo.bundle repo
+ cd repo
+ git remote set-url origin git@host:repo
+ git fetch origin # and maybe git pull, etc. to freshen the clone
+
+ NOTE on options to the rsync command: you are only allowed to use the
+ "-v", "-n", "-q", and "-P" options.
+
+=cut
+
+usage() if not @ARGV or $ARGV[0] eq '-h';
+
+# rsync driver program. Several things can be done later, but for now it
+# drives just the 'bundle' transfer.
+
+if ( $ENV{SSH_ORIGINAL_COMMAND} =~ /^rsync --server --sender (?:-[vn]*(?:e\d*\.\w*)? )?\. (\S+)\.bundle$/ ) {
+
+ my $repo = $1;
+ $repo =~ s/\.git$//;
+
+ # all errors have the same message to avoid leaking info
+ can_read($repo) or _die "you are not authorised";
+ my %config = config( $repo, "gitolite-options.bundle" ) or _die "you are not authorised";
+
+ my $ttl = $config{'gitolite-options.bundle.ttl'} || 86400; # in seconds (default 1 day)
+
+ my $bundle = bundle_create( $repo, $ttl );
+
+ $ENV{SSH_ORIGINAL_COMMAND} =~ s( \S+\.bundle)( $bundle);
+ trace( 1, "rsync bundle", $ENV{SSH_ORIGINAL_COMMAND} );
+ Gitolite::Common::_system( split ' ', $ENV{SSH_ORIGINAL_COMMAND} );
+ exit 0;
+}
+
+_warn "Sorry, you are only allowed to use the '-v', '-n', '-q', and '-P' options.";
+usage();
+
+# ----------------------------------------------------------------------
+# helpers
+# ----------------------------------------------------------------------
+
+sub bundle_create {
+ my ( $repo, $ttl ) = @_;
+ my $bundle = "$repo.bundle";
+ $bundle =~ s(.*/)();
+ my $recreate = 0;
+
+ my ( %b, %r );
+ if ( -f $bundle ) {
+ %b = map { chomp; reverse split; } `git ls-remote --heads --tags $bundle`;
+ %r = map { chomp; reverse split; } `git ls-remote --heads --tags .`;
+
+ for my $ref ( sort keys %b ) {
+
+ my $mtime = ( stat $bundle )[9];
+ if ( time() - $mtime > $ttl ) {
+ trace( 1, "bundle too old" );
+ $recreate++;
+ last;
+ }
+
+ if ( not $r{$ref} ) {
+ trace( 1, "ref '$ref' deleted in repo" );
+ $recreate++;
+ last;
+ }
+
+ if ( $r{$ref} eq $b{$ref} ) {
+ # same on both sides; ignore
+ delete $r{$ref};
+ delete $b{$ref};
+ next;
+ }
+
+ `git rev-list --count --left-right $b{$ref}...$r{$ref}` =~ /^(\d+)\s+(\d+)$/ or _die "git too old";
+ if ($1) {
+ trace( 1, "ref '$ref' rewound in repo" );
+ $recreate++;
+ last;
+ }
+
+ }
+
+ } else {
+ trace( 1, "no bundle found" );
+ $recreate++;
+ }
+
+ return $bundle if not $recreate;
+
+ trace( 1, "creating bundle for '$repo'" );
+ -f $bundle and ( unlink $bundle or die "a horrible death" );
+ system("git bundle create $bundle --branches --tags >&2");
+
+ return $bundle;
+}
+
+sub trace {
+ Gitolite::Common::trace(@_);
+}
diff --git a/src/commands/sshkeys-lint b/src/commands/sshkeys-lint
new file mode 100755
index 0000000..3f07b13
--- /dev/null
+++ b/src/commands/sshkeys-lint
@@ -0,0 +1,176 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+# complete rewrite of the sshkeys-lint program. Usage has changed, see
+# usage() function or run without arguments.
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Common;
+
+use Getopt::Long;
+my $admin = 0;
+my $quiet = 0;
+my $help = 0;
+GetOptions( 'admin|a=s' => \$admin, 'quiet|q' => \$quiet, 'help|h' => \$help );
+
+use Data::Dumper;
+$Data::Dumper::Deepcopy = 1;
+$|++;
+
+my $in_gl_section = 0;
+my $warnings = 0;
+my $KEYTYPE_REGEX = qr/\b(?:ssh-(?:rsa|dss|ed25519)|ecdsa-sha2-nistp(?:256|384|521))\b/;
+
+sub msg {
+ my $warning = shift;
+ return if $quiet and not $warning;
+ $warnings++ if $warning;
+ print "sshkeys-lint: " . ( $warning ? "WARNING: " : "" ) . $_ for @_;
+}
+
+usage() if $help;
+
+our @pubkeyfiles = @ARGV; @ARGV = ();
+my $kd = "$ENV{HOME}/.gitolite/keydir";
+if ( not @pubkeyfiles ) {
+ chomp( @pubkeyfiles = `find $kd -type f -name "*.pub" | sort` );
+}
+
+if ( -t STDIN ) {
+ @ARGV = ("$ENV{HOME}/.ssh/authorized_keys");
+}
+
+# ------------------------------------------------------------------------
+
+my @authkeys;
+my %seen_fprints;
+my %pkf_by_fp;
+msg 0, "==== checking authkeys file:\n";
+fill_authkeys(); # uses up STDIN
+
+if ($admin) {
+ my $fp = fprint("$admin.pub");
+ my $fpu = ( $fp && $seen_fprints{$fp}{user} || 'no access' );
+ # dbg("fpu = $fpu, admin=$admin");
+ #<<<
+ die "\t\t*** FATAL ***\n" .
+ "$admin.pub maps to $fpu, not $admin.\n" .
+ "You will not be able to access gitolite with this key.\n" .
+ "Look for the 'ssh troubleshooting' link in http://gitolite.com/gitolite/ssh.html.\n"
+ if $fpu ne "user $admin";
+ #>>>
+}
+
+msg 0, "==== checking pubkeys:\n" if @pubkeyfiles;
+for my $pkf (@pubkeyfiles) {
+ # get the short name for the pubkey file
+ ( my $pkfsn = $pkf ) =~ s(^$kd/)();
+
+ my $fp = fprint($pkf);
+ next unless $fp;
+ msg 1, "$pkfsn appears to be a COPY of $pkf_by_fp{$fp}\n" if $pkf_by_fp{$fp};
+ $pkf_by_fp{$fp} ||= $pkfsn;
+ my $fpu = ( $seen_fprints{$fp}{user} || 'no access' );
+ msg 0, "$pkfsn maps to $fpu\n";
+}
+
+if ($warnings) {
+ print "\n$warnings warnings found\n";
+}
+
+exit $warnings;
+
+# ------------------------------------------------------------------------
+sub fill_authkeys {
+ while (<>) {
+ my $seq = $.;
+ next if ak_comment($_); # also sets/clears $in_gl_section global
+ my $fp = fprint($_);
+ my $user = user($_);
+
+ check( $seq, $fp, $user );
+
+ $authkeys[$seq]{fprint} = $fp;
+ $authkeys[$seq]{ustatus} = $user;
+ }
+}
+
+sub check {
+ my ( $seq, $fp, $user ) = @_;
+
+ msg 1, "line $seq, $user key found *outside* gitolite section!\n"
+ if $user =~ /^user / and not $in_gl_section;
+
+ msg 1, "line $seq, $user key found *inside* gitolite section!\n"
+ if $user !~ /^user / and $in_gl_section;
+
+ if ( $seen_fprints{$fp} ) {
+ #<<<
+ msg 1, "authkeys line $seq ($user) will be ignored by sshd; " .
+ "same key found on line " .
+ $seen_fprints{$fp}{seq} . " (" .
+ $seen_fprints{$fp}{user} . ")\n";
+ return;
+ #>>>
+ }
+
+ $seen_fprints{$fp}{seq} = $seq;
+ $seen_fprints{$fp}{user} = $user;
+}
+
+sub user {
+ my $user = '';
+ $user ||= "user $1" if /^command=.*gitolite-shell (.*?)"/;
+ $user ||= "unknown command" if /^command/;
+ $user ||= "shell access" if /$KEYTYPE_REGEX/;
+
+ return $user;
+}
+
+sub ak_comment {
+ local $_ = shift;
+ $in_gl_section = 1 if /^# gitolite start/;
+ $in_gl_section = 0 if /^# gitolite end/;
+ die "gitosis? what's that?\n" if /^#.*gitosis/;
+ return /^\s*(#|$)/;
+}
+
+sub fprint {
+ local $_ = shift;
+ my ($fp, $output);
+ if ( /$KEYTYPE_REGEX/ ) {
+ # an actual key was passed. ssh-keygen CAN correctly handle options on
+ # the front of the key, so don't bother to strip them at all.
+ ($fp, $output) = ssh_fingerprint_line($_);
+ } else {
+ # a filename was passed
+ ($fp, $output) = ssh_fingerprint_file($_);
+ # include the line of input as well, as it won't always be included by the ssh-keygen command
+ warn "Bad line: $_\n" unless $fp;
+ }
+ # sshkeys-lint should only be run by a trusted admin, so we can give the output here.
+ warn "$output\n" unless $fp;
+ return $fp;
+}
+
+# ------------------------------------------------------------------------
+=for usage
+
+Usage: gitolite sshkeys-lint [-q] [optional list of pubkey filenames]
+ (optionally, STDIN can be a pipe or redirected from a file; see below)
+
+Look for potential problems in ssh keys.
+
+sshkeys-lint expects:
+ - the contents of an authorized_keys file via STDIN, otherwise it uses
+ \$HOME/.ssh/authorized_keys
+ - one or more pubkey filenames as arguments, otherwise it uses all the keys
+ found (recursively) in \$HOME/.gitolite/keydir
+
+The '-q' option will print only warnings instead of all mappings.
+
+Note that this runs ssh-keygen -l for each line in the authkeys file and each
+pubkey in the argument list, so be wary of running it on something huge. This
+is meant for troubleshooting.
+
+=cut
diff --git a/src/commands/sskm b/src/commands/sskm
new file mode 100755
index 0000000..eb51f69
--- /dev/null
+++ b/src/commands/sskm
@@ -0,0 +1,281 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+use Gitolite::Common;
+
+=for usage
+Usage for this command is not that simple. Please read the full documentation
+in doc/sskm.mkd or online at http://gitolite.com/gitolite/sskm.html.
+=cut
+
+usage() if @ARGV and $ARGV[0] eq '-h';
+
+my $rb = $rc{GL_REPO_BASE};
+my $ab = $rc{GL_ADMIN_BASE};
+# get to the keydir
+_chdir("$ab/keydir");
+
+# save arguments for later
+my $operation = shift || 'list';
+my $keyid = shift || '';
+# keyid must fit a very specific pattern
+$keyid and $keyid !~ /^@[-0-9a-z_]+$/i and die "invalid keyid $keyid\n";
+
+# get the actual userid and keytype
+my $gl_user = $ENV{GL_USER};
+my $keytype = '';
+$keytype = $1 if $gl_user =~ s/^zzz-marked-for-(...)-//;
+print STDERR "hello $gl_user, you are currently using "
+ . (
+ $keytype
+ ? "a key in the 'marked for $keytype' state\n"
+ : "a normal (\"active\") key\n"
+ );
+
+# ----
+# first collect the keys
+
+my ( @pubkeys, @marked_for_add, @marked_for_del );
+# get the list of pubkey files for this user, including pubkeys marked for
+# add/delete
+
+for my $pubkey (`find . -type f -name "*.pub" | sort`) {
+ chomp($pubkey);
+ $pubkey =~ s(^./)(); # artifact of the find command
+
+ my $user = $pubkey;
+ $user =~ s(.*/)(); # foo/bar/baz.pub -> baz.pub
+ $user =~ s/(\@[^.]+)?\.pub$//; # baz.pub, baz@home.pub -> baz
+
+ next unless $user eq $gl_user or $user =~ /^zzz-marked-for-...-$gl_user/;
+
+ if ( $user =~ m(^zzz-marked-for-add-) ) {
+ push @marked_for_add, $pubkey;
+ } elsif ( $user =~ m(^zzz-marked-for-del-) ) {
+ push @marked_for_del, $pubkey;
+ } else {
+ push @pubkeys, $pubkey;
+ }
+}
+
+# ----
+# list mode; just do it and exit
+sub print_keylist {
+ my ( $message, @list ) = @_;
+ return unless @list;
+ print "== $message ==\n";
+ my $count = 1;
+ for (@list) {
+ my $fp = fingerprint($_);
+ s/zzz-marked(\/|-for-...-)//g;
+ print $count++ . ": $fp : $_\n";
+ }
+}
+if ( $operation eq 'list' ) {
+ print "you have the following keys:\n";
+ print_keylist( "active keys", @pubkeys );
+ print_keylist( "keys marked for addition/replacement", @marked_for_add );
+ print_keylist( "keys marked for deletion", @marked_for_del );
+ print "\n\n";
+ exit;
+}
+
+# ----
+# please see docs for details on how a user interacts with this
+
+if ( $keytype eq '' ) {
+ # user logging in with a normal key
+ die "valid operations: add, del, undo-add, confirm-del\n" unless $operation =~ /^(add|del|confirm-del|undo-add)$/;
+ if ( $operation eq 'add' ) {
+ print STDERR "please supply the new key on STDIN. (I recommend you
+ don't try to do this interactively, but use a pipe)\n";
+ kf_add( $gl_user, $keyid, safe_stdin() );
+ } elsif ( $operation eq 'del' ) {
+ kf_del( $gl_user, $keyid );
+ } elsif ( $operation eq 'confirm-del' ) {
+ die "you dont have any keys marked for deletion\n" unless @marked_for_del;
+ kf_confirm_del( $gl_user, $keyid );
+ } elsif ( $operation eq 'undo-add' ) {
+ die "you dont have any keys marked for addition\n" unless @marked_for_add;
+ kf_undo_add( $gl_user, $keyid );
+ }
+} elsif ( $keytype eq 'del' ) {
+ # user is using a key that was marked for deletion. The only possible use
+ # for this is that she changed her mind for some reason (maybe she marked
+ # the wrong key for deletion) or is not able to get her client-side sshd
+ # to stop using this key
+ die "valid operations: undo-del\n" unless $operation eq 'undo-del';
+
+ # reinstate the key
+ kf_undo_del( $gl_user, $keyid );
+} elsif ( $keytype eq 'add' ) {
+ die "valid operations: confirm-add\n" unless $operation eq 'confirm-add';
+ # user is trying to validate a key that has been previously marked for
+ # addition. This isn't interactive, but it *could* be... if someone asked
+ kf_confirm_add( $gl_user, $keyid );
+}
+
+exit;
+
+# ----
+
+# make a temp clone and switch to it
+our $TEMPDIR;
+BEGIN { $TEMPDIR = `mktemp -d -t tmp.XXXXXXXXXX`; }
+END { `/bin/rm -rf $TEMPDIR`; }
+
+sub cd_temp_clone {
+ chomp($TEMPDIR);
+ hushed_git( "clone", "$rb/gitolite-admin.git", "$TEMPDIR" );
+ chdir($TEMPDIR);
+ my $hostname = `hostname`; chomp($hostname);
+ hushed_git( "config", "--get", "user.email" ) and hushed_git( "config", "user.email", $ENV{USER} . "@" . $hostname );
+ hushed_git( "config", "--get", "user.name" ) and hushed_git( "config", "user.name", "$ENV{USER} on $hostname" );
+}
+
+sub fingerprint {
+ my ($fp, $output) = ssh_fingerprint_file(shift);
+ # Do not print the output of $output to an untrusted destination.
+ die "does not seem to be a valid pubkey\n" unless $fp;
+ return $fp;
+}
+
+sub safe_stdin {
+ # read one line from STDIN
+ my $data;
+ my $ret = read STDIN, $data, 4096;
+ # current pubkeys are approx 400 bytes so we go a little overboard
+ die "could not read pubkey data" . ( defined($ret) ? "" : ": $!" ) . "\n" unless $ret;
+ die "pubkey data seems to have more than one line\n" if $data =~ /\n./;
+ return $data;
+}
+
+sub hushed_git {
+ local (*STDOUT) = \*STDOUT;
+ local (*STDERR) = \*STDERR;
+ open( STDOUT, ">", "/dev/null" );
+ open( STDERR, ">", "/dev/null" );
+ system( "git", @_ );
+}
+
+sub highlander {
+ # there can be only one
+ my ( $keyid, $die_if_empty, @a ) = @_;
+ # too many?
+ if ( @a > 1 ) {
+ print STDERR "
+more than one key satisfies this condition, and I can't deal with that!
+The keys are:
+
+";
+ print STDERR "\t" . join( "\n\t", @a ), "\n\n";
+ exit 1;
+ }
+ # too few?
+ die "no keys with " . ( $keyid || "empty" ) . " keyid found\n" if $die_if_empty and not @a;
+
+ return @a;
+}
+
+sub kf_add {
+ my ( $gl_user, $keyid, $keymaterial ) = @_;
+
+ # add a new "marked for addition" key for $gl_user.
+ cd_temp_clone();
+ chdir("keydir");
+
+ mkdir("zzz-marked");
+ _print( "zzz-marked/zzz-marked-for-add-$gl_user$keyid.pub", $keymaterial );
+ hushed_git( "add", "." ) and die "git add failed\n";
+ my $fp = fingerprint("zzz-marked/zzz-marked-for-add-$gl_user$keyid.pub");
+ hushed_git( "commit", "-m", "sskm: add $gl_user$keyid ($fp)" ) and die "git commit failed\n";
+ system("gitolite push >/dev/null 2>/dev/null") and die "git push failed\n";
+}
+
+sub kf_confirm_add {
+ my ( $gl_user, $keyid ) = @_;
+ # find entries in both @pubkeys and @marked_for_add whose basename matches $gl_user$keyid
+ my @pk = highlander( $keyid, 0, grep { m(^(.*/)?$gl_user$keyid.pub$) } @pubkeys );
+ my @mfa = highlander( $keyid, 1, grep { m(^zzz-marked/zzz-marked-for-add-$gl_user$keyid.pub$) } @marked_for_add );
+
+ cd_temp_clone();
+ chdir("keydir");
+
+ my $fp = fingerprint( $mfa[0] );
+ if ( $pk[0] ) {
+ hushed_git( "mv", "-f", $mfa[0], $pk[0] );
+ hushed_git( "commit", "-m", "sskm: confirm-add (replace) $pk[0] ($fp)" ) and die "git commit failed\n";
+ } else {
+ hushed_git( "mv", "-f", $mfa[0], "$gl_user$keyid.pub" );
+ hushed_git( "commit", "-m", "sskm: confirm-add $gl_user$keyid ($fp)" ) and die "git commit failed\n";
+ }
+ system("gitolite push >/dev/null 2>/dev/null") and die "git push failed\n";
+}
+
+sub kf_undo_add {
+ # XXX some code at start is shared with kf_confirm_add
+ my ( $gl_user, $keyid ) = @_;
+ my @mfa = highlander( $keyid, 1, grep { m(^zzz-marked/zzz-marked-for-add-$gl_user$keyid.pub$) } @marked_for_add );
+
+ cd_temp_clone();
+ chdir("keydir");
+
+ my $fp = fingerprint( $mfa[0] );
+ hushed_git( "rm", $mfa[0] );
+ hushed_git( "commit", "-m", "sskm: undo-add $gl_user$keyid ($fp)" ) and die "git commit failed\n";
+ system("gitolite push >/dev/null 2>/dev/null") and die "git push failed\n";
+}
+
+sub kf_del {
+ my ( $gl_user, $keyid ) = @_;
+
+ cd_temp_clone();
+ chdir("keydir");
+
+ mkdir("zzz-marked");
+ my @pk = highlander( $keyid, 1, grep { m(^(.*/)?$gl_user$keyid.pub$) } @pubkeys );
+
+ my $fp = fingerprint( $pk[0] );
+ hushed_git( "mv", $pk[0], "zzz-marked/zzz-marked-for-del-$gl_user$keyid.pub" ) and die "git mv failed\n";
+ hushed_git( "commit", "-m", "sskm: del $pk[0] ($fp)" ) and die "git commit failed\n";
+ system("gitolite push >/dev/null 2>/dev/null") and die "git push failed\n";
+}
+
+sub kf_confirm_del {
+ my ( $gl_user, $keyid ) = @_;
+ my @mfd = highlander( $keyid, 1, grep { m(^zzz-marked/zzz-marked-for-del-$gl_user$keyid.pub$) } @marked_for_del );
+
+ cd_temp_clone();
+ chdir("keydir");
+
+ my $fp = fingerprint( $mfd[0] );
+ hushed_git( "rm", $mfd[0] );
+ hushed_git( "commit", "-m", "sskm: confirm-del $gl_user$keyid ($fp)" ) and die "git commit failed\n";
+ system("gitolite push >/dev/null 2>/dev/null") and die "git push failed\n";
+}
+
+sub kf_undo_del {
+ my ( $gl_user, $keyid ) = @_;
+
+ my @mfd = highlander( $keyid, 1, grep { m(^zzz-marked/zzz-marked-for-del-$gl_user$keyid.pub$) } @marked_for_del );
+
+ print STDERR "
+You're undeleting a key that is currently marked for deletion.
+ Hit ENTER to undelete this key
+ Hit Ctrl-C to cancel the undelete
+Please see documentation for caveats on the undelete process as well as how to
+actually delete it.
+";
+ <>; # yeay... always wanted to do that -- throw away user input!
+
+ cd_temp_clone();
+ chdir("keydir");
+
+ my $fp = fingerprint( $mfd[0] );
+ hushed_git( "mv", "-f", $mfd[0], "$gl_user$keyid.pub" );
+ hushed_git( "commit", "-m", "sskm: undo-del $gl_user$keyid ($fp)" ) and die "git commit failed\n";
+ system("gitolite push >/dev/null 2>/dev/null") and die "git push failed\n";
+}
diff --git a/src/commands/sudo b/src/commands/sudo
new file mode 100755
index 0000000..eeb0083
--- /dev/null
+++ b/src/commands/sudo
@@ -0,0 +1,24 @@
+#!/bin/sh
+
+# Usage: ssh git@host sudo <user> <command> <arguments>
+#
+# Let super-user run commands as any other user. "Super-user" is defined as
+# "have write access to the gitolite-admin repo".
+
+die() { echo "$@" >&2; exit 1; }
+usage() { perl -lne 'print substr($_, 2) if /^# Usage/../^$/' < $0; exit 1; }
+[ -z "$2" ] && usage
+[ "$1" = "-h" ] && usage
+[ -z "$GL_USER" ] && die GL_USER not set
+
+gitolite access -q gitolite-admin $GL_USER W any || die "You are not authorised"
+
+user="$1"; shift
+cmd="$1"; shift
+
+# switch user
+GL_USER="$user"
+
+# figure out if the command is allowed from a remote user
+gitolite query-rc -q COMMANDS $cmd || die "Command '$cmd' not allowed"
+gitolite $cmd "$@"
diff --git a/src/commands/svnserve b/src/commands/svnserve
new file mode 100755
index 0000000..6e68acf
--- /dev/null
+++ b/src/commands/svnserve
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Rc;
+my $svnserve = $rc{SVNSERVE} || '';
+$svnserve ||= "/usr/bin/svnserve -r /var/svn/ -t --tunnel-user=%u";
+
+my $cmd = $ENV{SSH_ORIGINAL_COMMAND};
+
+die "expecting 'svnserve -t', got '$cmd'\n" unless $cmd eq 'svnserve -t';
+
+$svnserve =~ s/%u/$ENV{GL_USER}/g;
+exec $svnserve;
+die "svnserve exec failed\n";
diff --git a/src/commands/symbolic-ref b/src/commands/symbolic-ref
new file mode 100755
index 0000000..b65c792
--- /dev/null
+++ b/src/commands/symbolic-ref
@@ -0,0 +1,31 @@
+#!/bin/sh
+
+# Usage: ssh git@host symbolic-ref <repo> <arguments to git-symbolic-ref>
+#
+# allow 'git symbolic-ref' over a gitolite connection
+
+# Security: remember all arguments to commands must match a very conservative
+# pattern. Once that is assured, the symbolic-ref command has no security
+# related side-effects, so we don't check arguments at all.
+
+# Note: because of the restriction on allowed characters in arguments, you
+# can't supply an arbitrary string to the '-m' option. The simplest
+# work-around is-to-just-use-join-up-words-like-this if you feel the need to
+# supply a "reason" string. In any case this is useless by default; you'd
+# have to have core.logAllRefUpdates set for it to have any meaning.
+
+die() { echo "$@" >&2; exit 1; }
+usage() { perl -lne 'print substr($_, 2) if /^# Usage/../^$/' < $0; exit 1; }
+[ -z "$1" ] && usage
+[ "$1" = "-h" ] && usage
+[ -z "$GL_USER" ] && die GL_USER not set
+
+# ----------------------------------------------------------------------
+repo=$1; shift
+repo=${repo%.git}
+gitolite access -q "$repo" $GL_USER W any || die You are not authorised
+
+# change head
+cd $GL_REPO_BASE/$repo.git
+
+git symbolic-ref "$@"
diff --git a/src/commands/who-pushed b/src/commands/who-pushed
new file mode 100755
index 0000000..e59a750
--- /dev/null
+++ b/src/commands/who-pushed
@@ -0,0 +1,172 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+usage() if not @ARGV;
+usage($ARGV[1]) if $ARGV[1] and $ARGV[1] =~ /^[\w-]+$/ and $ARGV[0] eq '-h';
+
+( my $logdir = $ENV{GL_LOGFILE} ) =~ s(/[^/]+$)();
+
+# deal with migrate
+my %gl_log_lines_buffer;
+my $countr = 0;
+my $countl = 0;
+migrate(@ARGV) if $ARGV[0] eq '--migrate'; # won't return; exits right there
+
+# tip search?
+my $tip_search = 0;
+if ($ARGV[0] eq '--tip') {
+ shift;
+ $tip_search = 1;
+}
+
+# the normal who-pushed
+usage() if @ARGV < 2 or $ARGV[0] eq '-h';
+usage() if $ARGV[1] !~ /^[0-9a-f]+$/i;
+
+my $repo = shift;
+my $sha = shift; $sha =~ tr/A-F/a-f/;
+
+$ENV{GL_USER} and ( can_read($repo) or die "no read permissions on '$repo'" );
+
+# ----------------------------------------------------------------------
+
+my $repodir = "$ENV{GL_REPO_BASE}/$repo.git";
+chdir $repodir or die "repo '$repo' missing";
+
+my @logfiles = reverse glob("$logdir/*");
+@logfiles = ( "$repodir/gl-log" ) if -f "$repodir/gl-log";
+
+for my $logfile ( @logfiles ) {
+ @ARGV = ($logfile);
+ for my $line ( reverse grep { m(\tupdate\t($repo|$repodir)\t) } <> ) {
+ chomp($line);
+ my @fields = split /\t/, $line;
+ my ( $ts, $pid, $who, $ref, $d_old, $new ) = @fields[ 0, 1, 4, 6, 7, 8 ];
+
+ # d_old is what you display
+ my $old = $d_old;
+ $old = "" if $d_old eq ( "0" x 40 );
+ $old = "$old.." if $old;
+
+ if ($tip_search) {
+ print "$ts $pid $who $ref $d_old $new\n" if $new =~ /^$sha/;
+ } else {
+ system("git rev-list $old$new 2>/dev/null | grep ^$sha >/dev/null && echo '$ts $pid $who $ref $d_old $new'");
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# migration
+
+sub migrate {
+ chdir $ENV{GL_REPO_BASE};
+ my @repos = `gitolite list-phy-repos`; chomp @repos;
+
+ my $count = scalar( grep { -f "$_.git/gl-log" } @repos );
+ if ( $count and ( $_[1] || '' ) ne '--force' ) {
+ say2 "$count repo(s) already have gl-log files. To confirm overwriting, please re-run as:";
+ say2 "\tgitolite who-pushed --migrate --force";
+ say2 "see help ('-h', '-h logfiles', or '-h migrate') for details.";
+ exit 1;
+ }
+
+ foreach my $r (@repos) {
+ _print("$r.git/gl-log", '');
+ }
+
+ my %repo_exists = map { $_ => 1 } @repos;
+ @ARGV = sort ( glob("$logdir/*") );
+ while (<>) {
+ say2 "processed '$ARGV'" if eof(ARGV);
+ next unless /\tupdate\t/;
+ my @f = split /\t/;
+ my $repo = $f[3];
+ if ($repo =~ m(^/)) {
+ $repo =~ s/^$ENV{GL_REPO_BASE}\///;
+ $repo =~ s/\.git$//;
+ }
+
+ gen_gl_log($repo, $_) if $repo_exists{$repo};
+ }
+ flush_gl_log();
+
+ exit 0;
+}
+sub gen_gl_log {
+ my ($repo, $l) = @_;
+
+ $countr++ unless $gl_log_lines_buffer{$repo}; # new repo, not yet seen
+ $countl++;
+ $gl_log_lines_buffer{$repo} .= $l;
+
+ # once we have buffered log lines for about 100 repos, or about 10,000 log
+ # lines, we flush them
+ flush_gl_log() if $countr >= 100 or $countl >= 10_000;
+}
+sub flush_gl_log {
+ while (my ($r, $l) = each %gl_log_lines_buffer) {
+ open my $fh, ">>", "$r.git/gl-log" or _die "open flush_gl_log failed: $!";
+ print $fh $l;
+ close $fh;
+ }
+ %gl_log_lines_buffer = ();
+ say2 "flushed $countl lines to $countr repos...";
+ $countr = $countl = 0;
+}
+
+__END__
+
+=for usage
+usage: ssh git@host who-pushed [--tip] <repo> <SHA>
+
+Determine who pushed the given commit. The first few hex digits of the SHA
+should suffice. If the '--tip' option is supplied, it'll only look for the
+SHA among "tip" commits (i.e., search the "new SHA"s, without running the
+expensive 'git rev-parse' for each push).
+
+Each line of the output contains the following fields: timestamp, a
+transaction ID, username, refname, and the old and new SHAs for the ref.
+
+Note on the "transaction ID" field: if looking at the log file doesn't help
+you figure out what its purpose is, please just ignore it.
+
+TO SEE ADDITIONAL HELP, run with options "-h logfiles" or "-h migrate".
+=cut
+
+=for logfiles
+There are 2 places that gitolite logs to, based on the value give to the
+LOG_DEST rc variable. By default, log files go to ~/.gitolite/logs, but you
+can choose to send them to syslog instead (in which case 'who-pushed' will not
+work), or to both syslog and the normal log files.
+
+In addition, gitolite can also be told to log just the "update" records to a
+special "gl-log" file in the bare repo directory. This makes 'who-pushed'
+**much** faster (thanks to milki for the problem *and* the simple solution).
+
+'who-pushed' will look for that special file first and use only that if it is
+found. Otherwise it will look in the normal gitolite log files, which will of
+course be much slower.
+=cut
+
+=for migrate
+If you installed gitolite before v3.6.4, and you wish to use the new, more
+efficient logging that helps who-pushed run faster, you should first update
+the rc file (see http://gitolite.com/gitolite/rc.html for notes on that) to
+specify a suitable value for LOG_DEST.
+
+After that you should probably do a one-time generation of the repo-specific
+'gl-log' files from the normal log files. This can only be done from the
+server command line, even if the 'who-pushed' command has been enabled for
+remote access.
+
+To do this, just run 'gitolite who-pushed --migrate'. If some of your repos
+already had gl-log files, it will warn you, and tell you how to override.
+You're only supposed to to use this *once* after upgrading to v3.6.4 and
+setting LOG_DEST in the rc file anyway.
+=cut
+
diff --git a/src/commands/writable b/src/commands/writable
new file mode 100755
index 0000000..3e97f0b
--- /dev/null
+++ b/src/commands/writable
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_LIBDIR};
+use Gitolite::Easy;
+
+=for usage
+Usage: gitolite writable <reponame>|@all on|off|status
+
+Disable/re-enable pushes to all repos or named repo. Useful to run
+non-git-aware backups and so on.
+
+'on' enables, 'off' disables, writes (pushes) to the named repo or all repos.
+'status' returns the current status as shell truth (i.e., exit code 0 for
+writable, 1 for not writable).
+
+With 'off', any subsequent text is taken to be the message to be shown to
+users when their pushes get rejected. If it is not supplied, it will take it
+from STDIN; this allows longer messages.
+=cut
+
+usage() if not @ARGV or @ARGV < 2 or $ARGV[0] eq '-h';
+usage() if $ARGV[1] ne 'on' and $ARGV[1] ne 'off' and $ARGV[1] ne 'status';
+
+my $repo = shift;
+my $op = shift; # on|off|status
+
+if ( $repo eq '@all' ) {
+ _die "you are not authorized" if $ENV{GL_USER} and not is_admin();
+} else {
+ _die "you are not authorized" if $ENV{GL_USER} and not( owns($repo) or is_admin() or ( can_write($repo) and $op eq 'status' ) );
+}
+
+my $msg = join( " ", @ARGV );
+# try STDIN only if no msg found in args *and* it's an 'off' command
+if ( not $msg and $op eq 'off' ) {
+ say2 "...please type the message to be shown to users:";
+ $msg = join( "", <> );
+}
+
+my $sf = ".gitolite.down";
+my $rb = $ENV{GL_REPO_BASE};
+
+if ( $repo eq '@all' ) {
+ target( $ENV{HOME} );
+} else {
+ target("$rb/$repo.git");
+ target( $ENV{HOME} ) if $op eq 'status';
+}
+
+exit 0;
+
+sub target {
+ my $repodir = shift;
+ if ( $op eq 'status' ) {
+ exit 1 if -e "$repodir/$sf";
+ } elsif ( $op eq 'on' ) {
+ unlink "$repodir/$sf";
+ } elsif ( $op eq 'off' ) {
+ _print( "$repodir/$sf", $msg );
+ }
+}