4441ed82e4
we had usurped the email style syntax to separate multiple keys belonging to the same person, like sitaram@desktop.pub and sitaram@laptop.pub. If you have so many users that you need the full email address to disambiguate some of them (or you want to do it for just plain convenience), you couldn't. This patch fixes that in a backward compatible way. See doc/3-faq-tips-etc.mkd for details.
128 lines
4.6 KiB
Perl
128 lines
4.6 KiB
Perl
# this file is commonly used using "require". It is not required to use "use"
|
|
# (because it doesn't live in a different package)
|
|
|
|
# warning: preceding para requires 4th attribute of a programmer after
|
|
# laziness, impatience, and hubris: sense of humour :-)
|
|
|
|
# WARNING
|
|
# -------
|
|
# the name of this file will change as soon as its function/feature set
|
|
# stabilises enough ;-)
|
|
|
|
# right now all it does is
|
|
# - define a function that tells you where to find the rc file
|
|
# - define a function that creates a new repo and give it our update hook
|
|
|
|
# ----------------------------------------------------------------------------
|
|
# common definitions
|
|
# ----------------------------------------------------------------------------
|
|
|
|
$ABRT = "\n\t\t***** ABORTING *****\n ";
|
|
$WARN = "\n\t\t***** WARNING *****\n ";
|
|
|
|
# commands we're expecting
|
|
$R_COMMANDS=qr/^(git[ -]upload-pack|git[ -]upload-archive)$/;
|
|
$W_COMMANDS=qr/^git[ -]receive-pack$/;
|
|
|
|
# note that REPONAME_PATT allows "/", while USERNAME_PATT allows "@"
|
|
$REPONAME_PATT=qr(^\@?[0-9a-zA-Z][0-9a-zA-Z._/-]*$); # very simple pattern
|
|
$USERNAME_PATT=qr(^\@?[0-9a-zA-Z][0-9a-zA-Z._\@-]*$); # very simple pattern
|
|
|
|
# ----------------------------------------------------------------------------
|
|
# convenience subs
|
|
# ----------------------------------------------------------------------------
|
|
|
|
sub wrap_chdir {
|
|
chdir($_[0]) or die "$ABRT chdir $_[0] failed: $! at ", (caller)[1], " line ", (caller)[2], "\n";
|
|
}
|
|
|
|
sub wrap_open {
|
|
open (my $fh, $_[0], $_[1]) or die "$ABRT open $_[1] failed: $! at ", (caller)[1], " line ", (caller)[2], "\n" .
|
|
( $_[2] || '' ); # suffix custom error message if given
|
|
return $fh;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------------
|
|
# where is the rc file hiding?
|
|
# ----------------------------------------------------------------------------
|
|
|
|
sub where_is_rc
|
|
{
|
|
# till now, the rc file was in one fixed place: .gitolite.rc in $HOME of
|
|
# the user hosting the gitolite repos. This was fine, because gitolite is
|
|
# all about empowering non-root users :-)
|
|
|
|
# then we wanted to make a debian package out of it (thank you, Rhonda!)
|
|
# which means (a) it's going to be installed by root anyway and (b) any
|
|
# config files have to be in /etc/<something>
|
|
|
|
# the only way to resolve this in a backward compat way is to look for the
|
|
# $HOME one, and if you don't find it look for the /etc one
|
|
|
|
# this common routine does that, setting an env var for the first one it
|
|
# finds
|
|
|
|
return if $ENV{GL_RC};
|
|
|
|
for my $glrc ( $ENV{HOME} . "/.gitolite.rc", "/etc/gitolite/gitolite.rc" ) {
|
|
if (-f $glrc) {
|
|
$ENV{GL_RC} = $glrc;
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------------
|
|
# create a new repository
|
|
# ----------------------------------------------------------------------------
|
|
|
|
# NOTE: this sub will change your cwd; caller beware!
|
|
sub new_repo
|
|
{
|
|
my ($repo, $hooks_dir) = @_;
|
|
|
|
umask($REPO_UMASK);
|
|
|
|
system("mkdir", "-p", "$repo.git") and die "$ABRT mkdir $repo.git failed: $!\n";
|
|
# erm, note that's "and die" not "or die" as is normal in perl
|
|
wrap_chdir("$repo.git");
|
|
system("git --bare init >&2");
|
|
# propagate our own, plus any local admin-defined, hooks
|
|
system("cp $hooks_dir/* hooks/");
|
|
chmod 0755, "hooks/update";
|
|
}
|
|
|
|
# ----------------------------------------------------------------------------
|
|
# parse the compiled acl
|
|
# ----------------------------------------------------------------------------
|
|
|
|
sub parse_acl
|
|
{
|
|
my $GL_CONF_COMPILED = shift;
|
|
die "parse $GL_CONF_COMPILED failed: " . ($! or $@) unless do $GL_CONF_COMPILED;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------------
|
|
# print a report of $user's basic permissions
|
|
# ----------------------------------------------------------------------------
|
|
|
|
# basic means wildcards will be shown as wildcards; this is pretty much what
|
|
# got parsed by the compile script
|
|
sub report_basic
|
|
{
|
|
my($GL_ADMINDIR, $GL_CONF_COMPILED, $user) = @_;
|
|
|
|
&parse_acl($GL_CONF_COMPILED);
|
|
|
|
# send back some useful info if no command was given
|
|
print "hello $user, the gitolite version here is ";
|
|
system("cat", "$GL_ADMINDIR/src/VERSION");
|
|
print "\ryou have the following permissions:\n\r";
|
|
for my $r (sort keys %repos) {
|
|
my $perm .= ( $repos{$r}{R}{'@all'} ? ' @' : ( $repos{$r}{R}{$user} ? ' R' : '' ) );
|
|
$perm .= ( $repos{$r}{W}{'@all'} ? ' @' : ( $repos{$r}{W}{$user} ? ' W' : '' ) );
|
|
print "$perm\t$r\n\r" if $perm;
|
|
}
|
|
}
|
|
1;
|