diff options
Diffstat (limited to 'src')
91 files changed, 10228 insertions, 0 deletions
diff --git a/src/VREF/COUNT b/src/VREF/COUNT new file mode 100755 index 0000000..f4c3eae --- /dev/null +++ b/src/VREF/COUNT @@ -0,0 +1,51 @@ +#!/bin/sh + +# gitolite VREF to count number of changed/new files in a push + +# see gitolite docs for what the first 7 arguments mean + +# inputs: +# arg-8 is a number +# arg-9 is optional, and can be "NEWFILES" +# outputs (STDOUT) +# arg-7 if the number of changed (or new, if arg-9 supplied) files is > arg-8 +# otherwise nothing +# exit status: +# always 0 + +die() { echo "$@" >&2; exit 1; } +[ -z "$8" ] && die "not meant to be run manually" + +newsha=$3 +oldtree=$4 +newtree=$5 +refex=$7 + +max=$8 + +nf= +[ "$9" = "NEWFILES" ] && nf='--diff-filter=A' +# NO_SIGNOFF implies NEWFILES +[ "$9" = "NO_SIGNOFF" ] && nf='--diff-filter=A' + +# count files against all the other commits in the system not just $oldsha +# (why? consider what is $oldtree when you create a new branch, or what is +# $oldsha when you update an old feature branch from master and then push it +count=`git log --name-only $nf --format=%n $newtree --not --all | grep . | sort -u | perl -ne '}{print "$."'` + +[ $count -gt $max ] && { + # count has been exceeded. If $9 was NO_SIGNOFF there's still a chance + # for redemption -- if the top commit has a proper signed-off by line + [ "$9" = "NO_SIGNOFF" ] && { + author_email=$(git log --format=%ae -1 $newsha) + git cat-file -p $newsha | + egrep -i >/dev/null "^ *$count +new +files +signed-off by: *$author_email *$" && exit 0 + echo $refex top commit message should include the text \'$count new files signed-off by: $author_email\' + exit 0 + } + echo -n $refex "(too many " + [ -n "$nf" ] && echo -n "new " || echo -n "changed " + echo "files in this push)" +} + +exit 0 diff --git a/src/VREF/EMAIL-CHECK b/src/VREF/EMAIL-CHECK new file mode 100755 index 0000000..34c66f5 --- /dev/null +++ b/src/VREF/EMAIL-CHECK @@ -0,0 +1,66 @@ +#!/usr/bin/perl + +# gitolite VREF to check if all *new* commits have author == pusher + +# THIS IS NOT READY TO USE AS IS +# ------------------------------ +# you MUST change the 'email_ok()' sub to suit *YOUR* site's +# gitolite username -> author email mapping! + +# See bottom of the program for important philosophical notes. + +use strict; +use warnings; + +# mapping between gitolite userid and correct email address is encapsulated in +# this subroutine; change as you like +sub email_ok { + my ($author_email) = shift; + my $expected_email = "$ENV{GL_USER}\@atc.tcs.com"; + return $author_email eq $expected_email; +} + +my ( $ref, $old, $new ) = @ARGV; +for my $rev (`git log --format="%ae\t%h\t%s" $new --not --all`) { + chomp($rev); + my ( $author_email, $hash, $subject ) = split /\t/, $rev; + + # again, we use the trick that a vref can just choose to die instead of + # passing back a vref, having it checked, etc., if it's more convenient + die "$ENV{GL_USER}, you can't push $hash authored by $author_email\n" . "\t(subject of commit was $subject)\n" + unless email_ok($author_email); +} + +exit 0; + +__END__ + +The following discussion is for people who want to enforce this check on ALL +their developers (i.e., not just the newbies). + +Doing this breaks the "D" in "DVCS", forcing all your developers to work to a +centralised model as far as pushes are concerned. It prevents amending +someone else's commit and pushing (this includes rebasing, cherry-picking, and +so on, which are all impossible now). It also makes *any* off-line +collabaration between two developers useless, because neither of them can push +the result to the server. + +PHBs should note that validating the committer ID is NOT the same as reviewing +the code and running QA/tests on it. If you're not reviewing/QA-ing the code, +it's probably worthless anyway. Conversely, if you *are* going to review the +code and run QA/tests anyway, then you don't really need to validate the +author email! + +In a DVCS, if you *pushed* a series of commits, you have -- in some sense -- +signed off on them. The most formal way to "sign" a series is to tack on and +push a gpg-signed tag, although most people don't go that far. Gitolite's log +files are designed to preserve that accountability to *some* extent, though; +see contrib/adc/who-pushed for an admin defined command that quickly and +easily tells you who *pushed* a particular commit. + +Anyway, the point is that the only purpose of this script is to + + * pander to someone who still has not grokked *D*VCS + OR + * tick off an item in some stupid PHB's checklist + diff --git a/src/VREF/FILETYPE b/src/VREF/FILETYPE new file mode 100755 index 0000000..3f1d5f9 --- /dev/null +++ b/src/VREF/FILETYPE @@ -0,0 +1,45 @@ +#!/bin/sh + +# gitolite VREF to find autogenerated files + +# *completely* site specific; use it as an illustration of what can be done +# with gitolite VREFs if you wish + +# see gitolite docs for what the first 7 arguments mean + +# inputs: +# arg-8 is currently only one possible value: AUTOGENERATED +# outputs (STDOUT) +# arg-7 if any files changed in the push look like they were autogenerated +# otherwise nothing +# exit status: +# always 0 + +die() { echo "$@" >&2; exit 1; } +[ -z "$8" ] && die "not meant to be run manually" + +newsha=$3 +oldtree=$4 +newtree=$5 +refex=$7 + +option=$8 + +[ "$option" = "AUTOGENERATED" ] && { + # currently we only look for ".java" programs with the string "Generated + # by the protocol buffer compiler. DO NOT EDIT" in them. + + git log --name-only $nf --format=%n $newtree --not --all | + grep . | + sort -u | + grep '\.java$' | + while read fn + do + git show "$newtree:$fn" | egrep >/dev/null \ + 'Generated by the protocol buffer compiler. +DO NOT EDIT' || + continue + + echo $refex + exit 0 + done +} diff --git a/src/VREF/MAX_NEWBIN_SIZE b/src/VREF/MAX_NEWBIN_SIZE new file mode 100755 index 0000000..99d51d3 --- /dev/null +++ b/src/VREF/MAX_NEWBIN_SIZE @@ -0,0 +1,42 @@ +#!/usr/bin/perl +use strict; +use warnings; + +# gitolite VREF to check max size of new binary files + +# see gitolite docs for what the first 7 arguments mean + +# inputs: +# arg-8 is a number +# outputs (STDOUT) +# arg-7 if any new binary files exist that are greater in size than arg-8 +# *and* there is no "signed-off by" line for such a file in the top commit +# message. +# +# Otherwise nothing +# exit status: +# always 0 + +die "not meant to be run manually" unless $ARGV[7]; + +my ( $newsha, $oldtree, $newtree, $refex, $max ) = @ARGV[ 2, 3, 4, 6, 7 ]; + +exit 0 if $newsha eq '0000000000000000000000000000000000000000'; + +# / (.*) +\| Bin 0 -> (\d+) bytes/ + +chomp( my $author_email = `git log --format=%ae -1 $newsha` ); +my $msg = `git cat-file -p $newsha`; +$msg =~ s/\t/ /g; # makes our regexes simpler + +for my $newbin (`git diff --stat=999,999 $oldtree $newtree | grep Bin.0.-`) { + next unless $newbin =~ /^ (.*) +\| +Bin 0 -> (\d+) bytes/; + my ( $f, $s ) = ( $1, $2 ); + next if $s <= $max; + + next if $msg =~ /^ *$f +signed-off by: *$author_email *$/mi; + + print "$refex $f is larger than $max"; +} + +exit 0 diff --git a/src/VREF/MERGE-CHECK b/src/VREF/MERGE-CHECK new file mode 100644 index 0000000..a70fe23 --- /dev/null +++ b/src/VREF/MERGE-CHECK @@ -0,0 +1,49 @@ +#!/usr/bin/perl +use strict; +use warnings; + +# gitolite VREF to check if there are any merge commits in the current push. + +# THIS IS DEMO CODE; please read all comments below as well as +# doc/vref.mkd before trying to use this. + +# usage in conf/gitolite.conf goes like this: + +# - VREF/MERGE-CHECK/master = @all +# # reject only if the merge commit is being pushed to the master branch +# - VREF/MERGE-CHECK = @all +# # reject merge commits to any branch + +my $ref = $ARGV[0]; +my $oldsha = $ARGV[1]; +my $newsha = $ARGV[2]; +my $refex = $ARGV[6]; + +# The following code duplicates some code from parse_conf_line() and some from +# check_ref(). This duplication is the only thing that is preventing me from +# removing the "M" permission code from 'core' gitolite and using this +# instead. However, it does demonstrate how you would do this if you had to +# create any other similar features, for example someone wanted "no non-merge +# first-parent", which is far too specific for me to add to 'core'. + +# -- begin duplication -- +my $branch_refex = $ARGV[7] || ''; +if ($branch_refex) { + $branch_refex =~ m(^refs/) or $branch_refex =~ s(^)(refs/heads/); +} else { + $branch_refex = 'refs/.*'; +} +exit 0 unless $ref =~ /^$branch_refex/; +# -- end duplication -- + +# we can't run this check for tag creation or new branch creation, because +# 'git log' does not deal well with $oldsha = '0' x 40. +if ( $oldsha eq "0" x 40 or $newsha eq "0" x 40 ) { + print STDERR "ref create/delete ignored for purposes of merge-check\n"; + exit 0; +} + +my $ret = `git rev-list -n 1 --merges $oldsha..$newsha`; +print "$refex FATAL: merge commits not allowed\n" if $ret =~ /./; + +exit 0; diff --git a/src/VREF/NAME_NC b/src/VREF/NAME_NC new file mode 100755 index 0000000..1a81714 --- /dev/null +++ b/src/VREF/NAME_NC @@ -0,0 +1,33 @@ +#!/bin/sh + +# ---------------------------------------------------------------------- +# VREF/NAME_NC +# Like VREF/NAME, but only considers "new commits" -- i.e., commits that +# don't already exist in the repo as part of some other ref. + +# ---------------------------------------------------------------------- +# WHY +# VREF/NAME doesn't deal well with tag creation (or new branch creation), +# since then all files in the project look like they are being created (due +# to comparison with an empty tree). + +# Use this instead of VREF/NAME when you need to make that distinction. + +newsha=$3 + +[ $newsha = "0000000000000000000000000000000000000000" ] && { + echo "we don't currently handle deletions" >&2 + exit 1 +} + +git log --name-only --format=%n $newsha --not --all | + sort -u | grep . | sed -e 's.^.VREF/NAME_NC/.' + +# ---------------------------------------------------------------------- +# OTHER NOTES +# The built-in NAME does have a wee bit of a performance advantage. I plan +# to ignore this until someone notices this enough to be a problem :) +# +# I could explain it here at least, but I fear that any explanation will +# only add to the already rampant confusion about how VREFs work. I'm not +# rocking THAT boat again, sorry! diff --git a/src/VREF/VOTES b/src/VREF/VOTES new file mode 100755 index 0000000..8dc3563 --- /dev/null +++ b/src/VREF/VOTES @@ -0,0 +1,80 @@ +#!/bin/sh + +# gitolite VREF to count votes before allowing pushes to certain branches. + +# This approximates gerrit's voting (but it is SHA based; I believe Gerrit is +# more "changeset" based). Here's how it works: + +# - A normal developer "bob" proposes changes to master by pushing a commit to +# "pers/bob/master", then informs the voting members by email. + +# - Some or all of the voting members fetch and examine the commit. If they +# approve, they "vote" for the commit like so. For example, say voting +# member "alice" fetched bob's proposed commit into "bob-master" on her +# clone, then tested or reviewed it. She would approve it by running: +# git push origin bob-master:votes/alice/master + +# - Once enough votes have been tallied (hopefully there is normal team +# communication that says "hey I approved your commit", or it can be checked +# by 'git ls-remote origin' anyway), Bob, or any developer, can push the +# same commit (same SHA) to master and the push will succeed. + +# - Finally, a "trusted" developer can push a commit to master without +# worrying about the voting restriction at all. + +# The config for this example would look like this: + +# repo foo +# # allow personal branches (to submit proposed changes) +# RW+ pers/USER/ = @devs +# - pers/ = @all +# +# # allow only voters to vote +# RW+ votes/USER/ = @voters +# - votes/ = @all +# +# # normal access rules go here; should allow *someone* to push master +# RW+ = @devs +# +# # 2 votes required to push master, but trusted devs don't have this restriction +# RW+ VREF/VOTES/2/master = @trusted-devs +# - VREF/VOTES/2/master = @devs + +# Note: "2 votes required to push master" means at least 2 refs matching +# "votes/*/master" have the same SHA as the one currently being pushed. + +# ---------------------------------------------------------------------- + +# see gitolite docs for what the first 7 arguments mean + +# inputs: +# arg-8 is a number; see below +# arg-9 is a simple branch name (i.e., "master", etc). Currently this code +# does NOT do vote counting for branch names with more than one component +# (like foo/bar). +# outputs (STDOUT) +# nothing +# exit status: +# always 0 + +die() { echo "$@" >&2; exit 1; } +[ -z "$8" ] && die "not meant to be run manually" + +ref=$1 +newsha=$3 +refex=$7 +votes_needed=$8 +branch=$9 + +# nothing to do if the branch being pushed is not "master" (using our example) +[ "$ref" = "refs/heads/$branch" ] || exit 0 + +# find how many votes have come in +votes=`git for-each-ref refs/heads/votes/*/$branch | grep -c $newsha` + +# send back a vref if we don't have the minimum votes needed. For trusted +# developers this will invoke the RW+ rule and pass anyway, but for others it +# will invoke the "-" rule and fail. +[ $votes -ge $votes_needed ] || echo $refex "require at least $votes_needed votes to push $branch" + +exit 0 diff --git a/src/VREF/lock b/src/VREF/lock new file mode 100755 index 0000000..0fc7681 --- /dev/null +++ b/src/VREF/lock @@ -0,0 +1,36 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Common; + +# gitolite VREF to lock and unlock (binary) files. Requires companion command +# 'lock' to be enabled; see doc/locking.mkd for details. + +# ---------------------------------------------------------------------- + +# see gitolite docs for what the first 7 arguments mean + +die "not meant to be run manually" unless $ARGV[6]; + +my $ff = "$ENV{GL_REPO_BASE}/$ENV{GL_REPO}.git/gl-locks"; +exit 0 unless -f $ff; + +our %locks; +my $t = slurp($ff); +eval $t; +_die "do '$ff' failed with '$@', contact your administrator" if $@; + +my ( $oldtree, $newtree, $refex ) = @ARGV[ 3, 4, 6 ]; + +for my $file (`git diff --name-only $oldtree $newtree`) { + chomp($file); + + if ( $locks{$file} and $locks{$file}{USER} ne $ENV{GL_USER} ) { + print "$refex '$file' locked by '$locks{$file}{USER}'"; + last; + } +} + +exit 0 diff --git a/src/VREF/partial-copy b/src/VREF/partial-copy new file mode 100755 index 0000000..55a7dcf --- /dev/null +++ b/src/VREF/partial-copy @@ -0,0 +1,41 @@ +#!/bin/sh + +# push updated branches back to the "main" repo. + +# This must be run as the *last* VREF, though it doesn't matter what +# permission you give to it + +die() { echo "$@" >&2; exit 1; } + +repo=$GL_REPO +user=$GL_USER +ref=$1 # we're running like an update hook +old=$2 +new=$3 + +# never send any STDOUT back, to avoid looking like a ref. If we fail, git +# will catch it by our exit code +exec >&2 + +main=`git config --file $GL_REPO_BASE/$repo.git/config --get gitolite.partialCopyOf`; +[ -z "$main" ] && exit 0 + +rand=$$ +export GL_BYPASS_ACCESS_CHECKS=1 + +if [ "$new" = "0000000000000000000000000000000000000000" ] +then + # special case for deleting a ref (this is why it is important to put this + # VREF as the last one; if we got this far he is allowed to delete it) + git push -f $GL_REPO_BASE/$main.git :$ref || die "FATAL: failed to delete $ref" + + exit 0 +fi + +git push -f $GL_REPO_BASE/$main.git $new:refs/partial/br-$rand || die "FATAL: failed to send $new" + +cd $GL_REPO_BASE/$main.git +git update-ref -d refs/partial/br-$rand +git update-ref $ref $new $old || die "FATAL: update-ref for $ref failed" + +exit 0 diff --git a/src/VREF/refex-expr b/src/VREF/refex-expr new file mode 100755 index 0000000..b788dd9 --- /dev/null +++ b/src/VREF/refex-expr @@ -0,0 +1,99 @@ +#!/usr/bin/perl +use strict; +use warnings; + +# see bottom of this file for instructons and IMPORTANT WARNINGS! +# ---------------------------------------------------------------------- + +my $rule = $ARGV[7]; +die "\n\nFATAL: GL_REFEX_EXPR_ doesn't exist\n(your admin probably forgot the rc file change needed for this to work)\n\n" + unless exists $ENV{ "GL_REFEX_EXPR_" . $rule }; +my $res = $ENV{ "GL_REFEX_EXPR_" . $rule } || 0; +print "$ARGV[6] ($res)\n" if $res; + +exit 0; + +__END__ + +------------------------------------------------------------------------ +IMPORTANT WARNINGS: + * has not been tested heavily + * SO PLEASE TEST YOUR SPECIFIC USE CASE THOROUGHLY! + * read the NOTES section below + * syntax and semantics are to be considered beta and may change as I find + better use cases +------------------------------------------------------------------------ + +Refex expressions, like VREFs, are best used as additional "deny" rules, to +deny combinations that the normal ruleset cannot detect. + +To enable this, uncomment 'refex-expr' in the ENABLE list in the rc file. + +It allows you to say things like "don't allow users u3 and u4 to change the +Makefile in the master branch" (i.e., they can change any other file in +master, or the Makefile in any other branch, but not that specific combo). + + repo foo + RW+ = u1 u2 # line 1 + + RW+ master = u3 u4 # line 2 + RW+ = u3 u4 # line 3 + RW+ VREF/NAME/Makefile = u3 u4 # line 4 + - master and VREF/NAME/Makefile = u3 u4 # line 5 + +Line 5 is a "refex expression". Here are the rules: + + * for each refex in the expression ("master" and "VREF/NAME/Makefile" in + this example), a count is kept of the number of times the EXACT refex was + matched and allowed in the *normal* rules (here, lines 2 and 4) during + this push. + + * the expression is evaluated based on these counts. 0 is false, and + any non-zero is true (see more examples later). The truth value of the + expression determines whether the refex expression matched. + + You can use any logical or arithmetic expression using refexes as operands + and using these operators: + + not and or xor + - == -lt -gt -eq -le -ge -ne + + Parens are not allowed. Precedence is as you might expect for those + operators. It's actually perl that is evaluating it (you can guess what + the '-lt' etc., get translated to) so if in doubt, check 'man perlop'. + + * the refexes that form the terms of the expression (in this case, lines 2 + and 4) MUST come before the expression itself (i.e., line 5). + + * note the words "EXACT refex was matched" above. + + Let's say you add "u3" to line 1. Then the refex expression in line 5 + would never match for u3. This is because line 1 prevents line 2 from + matching (being more general *and* appearing earlier), so the count for + the "master" refex would be 0. If "master" is 0 (false), then "master and + <anything>" is also false. + + (Same thing is you swap lines 2 and 3; i.e., put the "RW+ = ..." before + the "RW+ master = ..."). + + Put another way, the terms in the refex expression are refexes, not refs. + Merely pushing the master branch does not mean the count for "master" + increases; it has to *match* on a line that has "master" as the refex. + +Here are some more examples: + + * user u2 is allowed to push either 'doc/' or 'src/' but not both + + repo foo + RW+ = u1 u2 u3 + + RW+ VREF/NAME/doc/ = u2 + RW+ VREF/NAME/src/ = u2 + - VREF/NAME/doc/ and VREF/NAME/src/ = u2 + + * user u3 is allowed to push at most 2 files to conf/ + + repo foo + RW+ = u1 u2 u3 + + RW+ VREF/NAME/conf/ = u3 + - VREF/NAME/conf/ -gt 2 = u3 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 ); + } +} diff --git a/src/gitolite b/src/gitolite new file mode 100755 index 0000000..c11e047 --- /dev/null +++ b/src/gitolite @@ -0,0 +1,108 @@ +#!/usr/bin/perl + +# all gitolite CLI tools run as sub-commands of this command +# ---------------------------------------------------------------------- + +=for args +Usage: gitolite [sub-command] [options] + +The following built-in subcommands are available; they should all respond to +'-h' if you want further details on each: + + setup 1st run: initial setup; all runs: hook fixups + compile compile gitolite.conf + + query-rc get values of rc variables + + list-groups list all group names in conf + list-users list all users/user groups in conf + list-repos list all repos/repo groups in conf + list-phy-repos list all repos actually on disk + list-memberships list all groups a name is a member of + list-members list all members of a group + +Warnings: + - list-users is disk bound and could take a while on sites with 1000s of repos + - list-memberships does not check if the name is known; unknown names come + back with 2 answers: the name itself and '@all' + +In addition, running 'gitolite help' should give you a list of custom commands +available. They may or may not respond to '-h', depending on how they were +written. +=cut + +# ---------------------------------------------------------------------- + +use FindBin; + +BEGIN { $ENV{GL_BINDIR} = $FindBin::RealBin; } +BEGIN { $ENV{GL_LIBDIR} = "$ENV{GL_BINDIR}/lib"; } +use lib $ENV{GL_LIBDIR}; +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +my ( $command, @args ) = @ARGV; +gl_log( 'cli', 'gitolite', @ARGV ) if -d $rc{GL_ADMIN_BASE} and $$ == ( $ENV{GL_TID} || 0 ); +args(); + +# the first two commands need options via @ARGV, as they have their own +# GetOptions calls and older perls don't have 'GetOptionsFromArray' + +if ( $command eq 'setup' ) { + shift @ARGV; + require Gitolite::Setup; + Gitolite::Setup->import; + setup(); + +} elsif ( $command eq 'query-rc' ) { + shift @ARGV; + query_rc(); # doesn't return + +# the rest don't need @ARGV per se + +} elsif ( $command eq 'compile' ) { + require Gitolite::Conf; + Gitolite::Conf->import; + compile(@args); + +} elsif ( $command eq 'trigger' ) { + my $s = $args[0]; + _die "trigger section '$s' not found in rc" + unless $s eq 'POST_COMPILE' + or $s eq 'POST_CREATE' + or ( exists $rc{$s} and ref( $rc{$s} ) eq 'ARRAY' ); + trigger(@args); + +} elsif ( my $c = _which( "commands/$command", 'x' ) ) { + trace( 2, "attempting gitolite command $c" ); + _system( $c, @args ); + +} elsif ( $command eq 'list-phy-repos' ) { + _chdir( $rc{GL_REPO_BASE} ); + print "$_\n" for ( @{ list_phy_repos(@args) } ); + +} elsif ( $command =~ /^list-/ ) { + trace( 2, "attempting lister command $command" ); + require Gitolite::Conf::Load; + Gitolite::Conf::Load->import; + my $fn = lister_dispatch($command); + print "$_\n" for ( @{ $fn->(@args) } ); + +} else { + _die "unknown gitolite sub-command"; +} + +gl_log('END') if $$ == $ENV{GL_TID}; + +exit 0; + +sub args { + usage() if not $command or $command eq '-h'; +} + +# ---------------------------------------------------------------------- diff --git a/src/gitolite-shell b/src/gitolite-shell new file mode 100755 index 0000000..072e0ff --- /dev/null +++ b/src/gitolite-shell @@ -0,0 +1,262 @@ +#!/usr/bin/perl + +# gitolite shell, invoked from ~/.ssh/authorized_keys +# ---------------------------------------------------------------------- + +use FindBin; + +BEGIN { $ENV{GL_BINDIR} = $FindBin::RealBin; } +BEGIN { $ENV{GL_LIBDIR} = "$ENV{GL_BINDIR}/lib"; } +use lib $ENV{GL_LIBDIR}; + +# set HOME +BEGIN { $ENV{HOME} = $ENV{GITOLITE_HTTP_HOME} if $ENV{GITOLITE_HTTP_HOME}; } + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +# the main() sub expects ssh-ish things; set them up... +my $id = ''; +if ( exists $ENV{G3T_USER} ) { + $id = in_file(); # file:// masquerading as ssh:// for easy testing +} elsif ( exists $ENV{SSH_CONNECTION} ) { + $id = in_ssh(); +} elsif ( exists $ENV{REQUEST_URI} ) { + $id = in_http(); +} else { + _die "who the *heck* are you?"; +} + +# sanity... +my $soc = $ENV{SSH_ORIGINAL_COMMAND}; +$soc =~ s/[\n\r]+/<<newline>>/g; +_die "I don't like newlines in the command: '$soc'\n" if $ENV{SSH_ORIGINAL_COMMAND} ne $soc; + +# allow gitolite-shell to be used as "$SHELL". Experts only; no support, no docs +if (@ARGV and $ARGV[0] eq '-c') { + shift; + $ARGV[0] =~ s/^$0 // or _die "unknown git/gitolite command: '$ARGV[0]'"; +} + +# the INPUT trigger massages @ARGV and $ENV{SSH_ORIGINAL_COMMAND} as needed +trigger('INPUT'); + +main($id); + +gl_log('END') if $$ == $ENV{GL_TID}; + +exit 0; + +# ---------------------------------------------------------------------- + +sub in_file { + gl_log( 'file', "ARGV=" . join( ",", @ARGV ), "SOC=$ENV{SSH_ORIGINAL_COMMAND}" ); + + if ( $ENV{SSH_ORIGINAL_COMMAND} =~ /git-\w+-pack/ ) { + print STDERR "TRACE: gsh(", join( ")(", @ARGV ), ")\n"; + print STDERR "TRACE: gsh(SOC=$ENV{SSH_ORIGINAL_COMMAND})\n"; + } + return 'file'; +} + +sub in_http { + http_setup_die_handler(); + + _die "GITOLITE_HTTP_HOME not set" unless $ENV{GITOLITE_HTTP_HOME}; + + _die "fallback to DAV not supported" if $ENV{REQUEST_METHOD} eq 'PROPFIND'; + + # fake out SSH_ORIGINAL_COMMAND and SSH_CONNECTION when called via http, + # so the rest of the code stays the same (except the exec at the end). + http_simulate_ssh_connection(); + $ENV{SSH_ORIGINAL_COMMAND} ||= ''; + + $ENV{REMOTE_USER} ||= $rc{HTTP_ANON_USER}; + @ARGV = ( $ENV{REMOTE_USER} ); + + my $ip; + ( $ip = $ENV{SSH_CONNECTION} || '(no-IP)' ) =~ s/ .*//; + + gl_log( 'http', "ARGV=" . join( ",", @ARGV ), "SOC=" . ( $ENV{SSH_ORIGINAL_COMMAND} || '' ), "FROM=$ip" ); + + return 'http'; +} + +sub in_ssh { + my $ip; + ( $ip = $ENV{SSH_CONNECTION} || '(no-IP)' ) =~ s/ .*//; + + gl_log( 'ssh', "ARGV=" . join( ",", @ARGV ), "SOC=" . ( $ENV{SSH_ORIGINAL_COMMAND} || '' ), "FROM=$ip" ); + + $ENV{SSH_ORIGINAL_COMMAND} ||= ''; + + return $ip; +} + +# ---------------------------------------------------------------------- + +# call this once you are sure arg-1 is the username and SSH_ORIGINAL_COMMAND +# has been setup (even if it's not actually coming via ssh). +sub main { + my $id = shift; + + # set up the user + my $user = $ENV{GL_USER} = shift @ARGV; + + # set up the repo and the attempted access + my ( $verb, $repo ) = parse_soc(); # returns only for git commands + Gitolite::Conf::Load::sanity($repo, $REPONAME_PATT); + $ENV{GL_REPO} = $repo; + my $aa = ( $verb =~ 'upload' ? 'R' : 'W' ); + + # set up env vars from options set for this repo + env_options($repo); + + # auto-create? + if ( repo_missing($repo) and access( $repo, $user, '^C', 'any' ) !~ /DENIED/ ) { + require Gitolite::Conf::Store; + Gitolite::Conf::Store->import; + new_wild_repo( $repo, $user, $aa ); + gl_log( 'create', $repo, $user, $aa ); + } + + # a ref of 'any' signifies that this is a pre-git check, where we don't + # yet know the ref that will be eventually pushed (and even that won't + # apply if it's a read operation). See the matching code in access() for + # more information. + unless ( $ENV{GL_BYPASS_ACCESS_CHECKS} ) { + my $ret = access( $repo, $user, $aa, 'any' ); + trigger( 'ACCESS_1', $repo, $user, $aa, 'any', $ret ); + _die $ret . "\n(or you mis-spelled the reponame)" if $ret =~ /DENIED/; + + gl_log( "pre_git", $repo, $user, $aa, 'any', $ret ); + } + + trigger( 'PRE_GIT', $repo, $user, $aa, 'any', $verb ); + if ( $ENV{REQUEST_URI} ) { + _system( "git", "http-backend" ); + } else { + my $repodir = "'$rc{GL_REPO_BASE}/$repo.git'"; + _system( "git", "shell", "-c", "$verb $repodir" ); + } + trigger( 'POST_GIT', $repo, $user, $aa, 'any', $verb ); +} + +# ---------------------------------------------------------------------- + +sub parse_soc { + my $soc = $ENV{SSH_ORIGINAL_COMMAND}; + $soc ||= 'info'; + + my $git_commands = "git-upload-pack|git-receive-pack|git-upload-archive"; + # simplify the regex; we'll handle all the reponame nuances later + if ( $soc =~ m(^($git_commands) '?/?(.*?)'?$) ) { + my ( $verb, $repo ) = ( $1, $2 ); + trace( 2, "git command", $soc ); + + # clean up the repo name; first extract the trace level if supplied + # (and no, you can't have a trace level *and* a trailing slash). + $ENV{D} = $1 if $repo =~ s/\.git(\d)$//; + # and then the git-daemon-compatibility trailers + $repo =~ s(/$)(); + $repo =~ s(\.git$)(); + + _die "invalid repo name: '$repo'" if $repo !~ $REPONAME_PATT; + return ( $verb, $repo ); + } + + # after this we should not return; caller expects us to handle it all here + # and exit out + + my @words = split ' ', $soc; + if ( $rc{COMMANDS}{ $words[0] } ) { + if ( $rc{COMMANDS}{ $words[0] } ne 'ua' ) { + _die "suspicious characters loitering about '$soc'" if $soc !~ $REMOTE_COMMAND_PATT; + _die "no relative paths allowed anywhere!" if $soc =~ m(\.\./); + } + trace( 2, "gitolite command", $soc ); + _system( "gitolite", @words ); + exit 0; + } + + _die "unknown git/gitolite command: '$soc'"; +} + +# ---------------------------------------------------------------------- +# helper functions for "in_http" + +sub http_setup_die_handler { + + $SIG{__DIE__} = sub { + my $service = ( $ENV{SSH_ORIGINAL_COMMAND} =~ /git-receive-pack/ ? 'git-receive-pack' : 'git-upload-pack' ); + my $message = shift; chomp($message); + print STDERR "$message\n"; + + http_print_headers($service); + + # format the service response, then the message. With initial + # help from Ilari and then a more detailed email from Shawn... + $service = "# service=$service\n"; $message = "ERR $message\n"; + $service = sprintf( "%04X", length($service) + 4 ) . "$service"; # no CRLF on this one + $message = sprintf( "%04X", length($message) + 4 ) . "$message"; + + print $service; + print "0000"; # flush-pkt, apparently + print $message; + print STDERR $service; + print STDERR $message; + exit 0; # if it's ok for die_webcgi in git.git/http-backend.c, it's ok for me ;-) + } +} + +sub http_simulate_ssh_connection { + # these patterns indicate normal git usage; see "services[]" in + # http-backend.c for how I got that. Also note that "info" is overloaded; + # git uses "info/refs...", while gitolite uses "info" or "info?...". So + # there's a "/" after info in the list below + if ( $ENV{PATH_INFO} =~ m(^/(.*)/(HEAD$|info/refs$|objects/|git-(?:upload|receive)-pack$)) ) { + my $repo = $1; + my $verb = ( $ENV{REQUEST_URI} =~ /git-receive-pack/ ) ? 'git-receive-pack' : 'git-upload-pack'; + $ENV{SSH_ORIGINAL_COMMAND} = "$verb '$repo'"; + } else { + # this is one of our custom commands; could be anything really, + # because of the adc feature + my ($verb) = ( $ENV{PATH_INFO} =~ m(^/(\S+)) ); + my $args = $ENV{QUERY_STRING}; + $args =~ s/\+/ /g; + $args =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + $ENV{SSH_ORIGINAL_COMMAND} = $verb; + $ENV{SSH_ORIGINAL_COMMAND} .= " $args" if $args; + http_print_headers(); # in preparation for the eventual output! + + # we also need to pipe STDERR out via STDOUT, else the user doesn't see those messages! + open(STDERR, ">&STDOUT") or _die "Can't dup STDOUT: $!"; + } + $ENV{SSH_CONNECTION} = "$ENV{REMOTE_ADDR} $ENV{REMOTE_PORT} $ENV{SERVER_ADDR} $ENV{SERVER_PORT}"; +} + +my $http_headers_printed = 0; + +sub http_print_headers { + my ( $service, $code, $text ) = @_; + + return if $http_headers_printed++; + $code ||= 200; + $text ||= "OK - gitolite"; + + $|++; + print "Status: $code $text\r\n"; + print "Expires: Fri, 01 Jan 1980 00:00:00 GMT\r\n"; + print "Pragma: no-cache\r\n"; + print "Cache-Control: no-cache, max-age=0, must-revalidate\r\n"; + if ($service) { + print "Content-Type: application/x-$service-advertisement\r\n"; + } else { + print "Content-Type: text/plain\r\n"; + } + print "\r\n"; +} diff --git a/src/lib/Gitolite/Cache.pm b/src/lib/Gitolite/Cache.pm new file mode 100644 index 0000000..351a13e --- /dev/null +++ b/src/lib/Gitolite/Cache.pm @@ -0,0 +1,161 @@ +package Gitolite::Cache; + +# cache stuff using an external database (redis) +# ---------------------------------------------------------------------- + +@EXPORT = qw( + cache_control + cache_wrap +); + +use Exporter 'import'; + +use Gitolite::Common; +use Gitolite::Rc; +use Storable qw(freeze thaw); +use Redis; + +my $redis; + +my $redis_sock = "$ENV{HOME}/.redis-gitolite.sock"; +if ( -S $redis_sock ) { + _connect_redis(); +} else { + _start_redis(); + _connect_redis(); + + # this redis db is a transient, caching only, db, so let's not + # accidentally use any stale data when if we're just starting up + cache_control('stop'); + cache_control('start'); +} + +# ---------------------------------------------------------------------- + +my %wrapped; +my $ttl = ( $rc{CACHE_TTL} || ( $rc{GROUPLIST_PGM} ? 900 : 90000 ) ); + +sub cache_control { + my $op = shift; + if ( $op eq 'stop' ) { + $redis->flushall(); + } elsif ( $op eq 'start' ) { + $redis->set( 'cache-up', 1 ); + } elsif ( $op eq 'flush' ) { + flush_repo(@_); + } +} + +sub cache_wrap { + my $sub = shift; + my $tname = $sub; # this is what will show up in the trace output + trace( 3, "wrapping '$sub'" ); + $sub = ( caller 1 )[0] . "::" . $sub if $sub !~ /::/; + return if $wrapped{$sub}++; # in case somehow it gets called twice for the same sub! + + # collect names of wrapped subs into a redis 'set' + $redis->sadd( "SUBWAY", $sub ); # subway? yeah well they wrap subs don't they? + + my $cref = eval '\&' . $sub; + my %opt = @_; + # rest of the options come in as a hash. 'list' says this functions + # returns a list. 'ttl' is a number to override the default ttl for + # the cached value. + + no strict 'refs'; + no warnings 'redefine'; + *{$sub} = sub { # the wrapper function + my $key = join( ", ", @_ ); + trace( 2, "$tname.args", @_ ); + + if ( cache_up() and defined( my $val = $redis->get("$sub: $key") ) ) { + # cache is up and we got a hit, return value from cache + if ( $opt{list} ) { + trace( 2, "$tname.getl", @{ thaw($val) } ); + return @{ thaw($val) }; + } else { + trace( 2, "$tname.get", $val ); + return $val; + } + } else { + # cache is down or we got a miss, compute + my ( $r, @r ); + if ( $opt{list} ) { + @r = $cref->(@_); # provide list context + trace( 2, "$tname.setl", @r ); + } else { + $r = $cref->(@_); # provide scalar context + trace( 2, "$tname.set", $r ); + } + + # store computed value in cache if cache is up + if ( cache_up() ) { + $redis->set( "$sub: $key", ( $opt{list} ? freeze( \@r ) : $r ) ); + $redis->expire( "$sub: $key", $opt{ttl} || $ttl ); + trace( 2, "$tname.ttl", ( $opt{ttl} || $ttl ) ); + } + + return @r if $opt{list}; + return $r; + } + }; + trace( 3, "wrapped '$sub'" ); +} + +sub cache_up { + return $redis->exists('cache-up'); +} + +sub flush_repo { + my $repo = shift; + + my @wrapped = $redis->smembers("SUBWAY"); + for my $func (@wrapped) { + # if we wrap any more functions, make sure they're functions where the + # first argument is 'repo' + my @keys = $redis->keys("$func: $repo, *"); + $redis->del( @keys ) if @keys; + } +} + +# ---------------------------------------------------------------------- + +sub _start_redis { + my $conf = join( "", <DATA> ); + $conf =~ s/%HOME/$ENV{HOME}/g; + + open( REDIS, "|-", "/usr/sbin/redis-server", "-" ) or die "start redis server failed: $!"; + print REDIS $conf; + close REDIS; + + # give it a little time to come up + select( undef, undef, undef, 0.2 ); +} + +sub _connect_redis { + $redis = Redis->new( sock => $redis_sock, encoding => undef ) or die "redis new failed: $!"; + $redis->ping or die "redis ping failed: $!"; +} + +1; + +__DATA__ +# resources +maxmemory 50MB +port 0 +unixsocket %HOME/.redis-gitolite.sock +unixsocketperm 700 +timeout 0 +databases 1 + +# daemon +daemonize yes +pidfile %HOME/.redis-gitolite.pid +dbfilename %HOME/.redis-gitolite.rdb +dir %HOME + +# feedback +loglevel notice +logfile %HOME/.redis-gitolite.log + +# we don't save diff --git a/src/lib/Gitolite/Common.pm b/src/lib/Gitolite/Common.pm new file mode 100644 index 0000000..b06f967 --- /dev/null +++ b/src/lib/Gitolite/Common.pm @@ -0,0 +1,422 @@ +package Gitolite::Common; + +# common (non-gitolite-specific) functions +# ---------------------------------------------------------------------- + +#<<< +@EXPORT = qw( + print2 dbg _mkdir _open ln_sf tsh_rc sort_u + say _warn _chdir _print tsh_text list_phy_repos + say2 _die _system slurp tsh_lines + trace cleanup_conf_line tsh_try + usage tsh_run + gen_lfn + gl_log + + dd + t_start + t_lap + + ssh_fingerprint_file + ssh_fingerprint_line + + update_hook_present +); +#>>> +use Exporter 'import'; +use File::Path qw(mkpath); +use File::Temp qw(tempfile); +use Carp qw(carp cluck croak confess); + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +sub print2 { + local $/ = "\n"; + print STDERR @_; +} + +sub say { + local $/ = "\n"; + print @_, "\n"; +} + +sub say2 { + local $/ = "\n"; + print STDERR @_, "\n"; +} + +sub trace { + gl_log( "\t" . join( ",", @_[ 1 .. $#_ ] ) ) if $_[0] <= 1 and defined $Gitolite::Rc::rc{LOG_EXTRA}; + + return unless defined( $ENV{D} ); + + my $level = shift; return if $ENV{D} < $level; + my $sub = ( caller 1 )[3] || ''; $sub =~ s/.*://; + if ( not $sub ) { + $sub = (caller)[1]; + $sub =~ s(.*/(.*))(($1)); + } + $sub .= ' ' x ( 31 - length($sub) ); + say2 "$level\t$sub\t", join( "\t", @_ ); +} + +sub dbg { + use Data::Dumper; + return unless defined( $ENV{D} ); + for my $i (@_) { + print STDERR "DBG: " . Dumper($i); + } +} + +sub dd { + local $ENV{D} = 1; + dbg(@_); +} + +{ + my %start_times; + + eval "require Time::HiRes"; + # we just ignore any errors from this; nothing needs to be done as long as + # no code *calls* either of the next two functions. + + sub t_start { + my $name = shift || 'default'; + $start_times{$name} = [ Time::HiRes::gettimeofday() ]; + } + + sub t_lap { + my $name = shift || 'default'; + return Time::HiRes::tv_interval( $start_times{$name} ); + } +} + +sub _warn { + gl_log( 'warn', @_ ); + if ( $ENV{D} and $ENV{D} >= 3 ) { + cluck "WARNING: ", @_, "\n"; + } elsif ( defined( $ENV{D} ) ) { + carp "WARNING: ", @_, "\n"; + } else { + warn "WARNING: ", @_, "\n"; + } +} +$SIG{__WARN__} = \&_warn; + +sub _die { + gl_log( 'die', @_ ); + if ( $ENV{D} and $ENV{D} >= 3 ) { + confess "FATAL: " . join( ",", @_ ) . "\n" if defined( $ENV{D} ); + } elsif ( defined( $ENV{D} ) ) { + croak "FATAL: " . join( ",", @_ ) . "\n"; + } else { + die "FATAL: " . join( ",", @_ ) . "\n"; + } +} +$SIG{__DIE__} = \&_die; + +sub usage { + my $script = (caller)[1]; + my $function = shift if @_ and $_[0] =~ /^[\w-]+$/; + $function ||= ( ( ( caller(1) )[3] ) || ( ( caller(0) )[3] ) ); + $function =~ s/.*:://; + my $code = slurp($script); + $code =~ /^=for $function\b(.*?)^=cut/sm; + say( $1 ? $1 : "...no usage message for '$function' in $script" ); + exit 1; +} + +sub _mkdir { + # It's not an error if the directory exists, but it is an error if it + # doesn't exist and we can't create it. This includes not guaranteeing + # dead symlinks or if mkpath traversal is blocked by a file. + my $dir = shift; + my $perm = shift; # optional + return if -d $dir; + mkpath($dir); + chmod $perm, $dir if $perm; + return 1; +} + +sub _chdir { + chdir( $_[0] || $ENV{HOME} ) or _die "chdir $_[0] failed: $!\n"; +} + +sub _system { + # run system(), catch errors. Be verbose only if $ENV{D} exists. If not, + # exit with <rc of system()> if it applies, else just "exit 1". + trace( 1, 'system', @_ ); + if ( system(@_) != 0 ) { + trace( 1, "system() failed", @_, "-> $?" ); + if ( $? == -1 ) { + die "failed to execute: $!\n" if $ENV{D}; + } elsif ( $? & 127 ) { + die "child died with signal " . ( $? & 127 ) . "\n" if $ENV{D}; + } else { + die "child exited with value " . ( $? >> 8 ) . "\n" if $ENV{D}; + exit( $? >> 8 ); + } + exit 1; + } +} + +sub _open { + open( my $fh, $_[0], $_[1] ) or _die "open $_[1] failed: $!\n"; + return $fh; +} + +sub _print { + my ( $file, @text ) = @_; + my $fh = _open( ">", "$file.$$" ); + print $fh @text; + close($fh) or _die "close $file failed: $! at ", (caller)[1], " line ", (caller)[2], "\n"; + my $oldmode = ( ( stat $file )[2] ); + rename "$file.$$", $file; + chmod $oldmode, $file if $oldmode; +} + +sub slurp { + return unless defined wantarray; + local $/ = undef unless wantarray; + my $fh = _open( "<", $_[0] ); + return <$fh>; +} + +sub dos2unix { + # WARNING: when calling this, make sure you supply a list context + s/\r\n/\n/g for @_; + return @_; +} + +sub ln_sf { + trace( 3, @_ ); + my ( $srcdir, $glob, $dstdir ) = @_; + for my $hook ( glob("$srcdir/$glob") ) { + $hook =~ s/$srcdir\///; + unlink "$dstdir/$hook"; + symlink "$srcdir/$hook", "$dstdir/$hook" or croak "could not symlink $srcdir/$hook to $dstdir\n"; + } +} + +sub sort_u { + my %uniq; + my $listref = shift; + return [] unless @{$listref}; + undef @uniq{ @{$listref} }; # expect a listref + my @sort_u = sort keys %uniq; + return \@sort_u; +} + +sub cleanup_conf_line { + my $line = shift; + return $line if $line =~ /^# \S+ \d+$/; + + # kill comments, but take care of "#" inside *simple* strings + $line =~ s/^((".*?"|[^#"])*)#.*/$1/; + # normalise whitespace; keeps later regexes very simple + $line =~ s/=/ = /; + $line =~ s/\s+/ /g; + $line =~ s/^ //; + $line =~ s/ $//; + return $line; +} + +{ + my @phy_repos = (); + + sub list_phy_repos { + # use cached value only if it exists *and* no arg was received (i.e., + # receiving *any* arg invalidates cache) + return \@phy_repos if ( @phy_repos and not @_ ); + + my $cmd = 'find . ' . ($Gitolite::Rc::rc{REPO_SYMLINKS} || '') . ' -name "*.git" -prune'; + for my $repo (`$cmd`) { + chomp($repo); + $repo =~ s/\.git$//; + $repo =~ s(^\./)(); + next if $repo =~ m(/$); + # tolerate non-bare repos within ~/repositories but silently ignore them + push @phy_repos, $repo; + } + trace( 3, scalar(@phy_repos) . " physical repos found" ); + return sort_u( \@phy_repos ); + } +} + +sub update_hook_present { + my $repo = shift; + + return 1 unless -d "$ENV{GL_REPO_BASE}/$repo.git"; # non-existent repo is fine + + my $x = readlink("$ENV{GL_REPO_BASE}/$repo.git/hooks/update"); + return 1 if $x and $x eq "$ENV{GL_ADMIN_BASE}/hooks/common/update"; + + return 0; +} + +# generate a timestamp +sub gen_ts { + my ( $s, $min, $h, $d, $m, $y ) = (localtime)[ 0 .. 5 ]; + $y += 1900; $m++; # usual adjustments + for ( $s, $min, $h, $d, $m ) { + $_ = "0$_" if $_ < 10; + } + my $ts = "$y-$m-$d.$h:$min:$s"; + + return $ts; +} + +# generate a log file name +sub gen_lfn { + my ( $s, $min, $h, $d, $m, $y ) = (localtime)[ 0 .. 5 ]; + $y += 1900; $m++; # usual adjustments + for ( $s, $min, $h, $d, $m ) { + $_ = "0$_" if $_ < 10; + } + + my ($template) = shift; + # substitute template parameters and set the logfile name + $template =~ s/%y/$y/g; + $template =~ s/%m/$m/g; + $template =~ s/%d/$d/g; + + return $template; +} + +my $log_dest; +my $syslog_opened = 0; +END { closelog() if $syslog_opened; } +sub gl_log { + # the log filename and the timestamp come from the environment. If we get + # called even before they are set, we have no choice but to dump to STDERR + # (and probably call "logger"). + + # tab sep if there's more than one field + my $msg = join( "\t", @_ ); + $msg =~ s/[\n\r]+/<<newline>>/g; + + my $ts = gen_ts(); + my $tid = $ENV{GL_TID} ||= $$; + + $log_dest = $Gitolite::Rc::rc{LOG_DEST} || '' if not defined $log_dest; + + # log (update records only) to "gl-log" in the bare repo dir; this is to + # make 'who-pushed' more efficient. Since this is only for the update + # records, it is not a replacement for the other two types of logging. + if ($log_dest =~ /repo-log/ and $_[0] eq 'update') { + # if the log line is 'update', we're already in the bare repo dir + open my $lfh, ">>", "gl-log" or _die "open gl-log failed: $!"; + print $lfh "$ts\t$tid\t$msg\n"; + close $lfh; + } + + # syslog + if ($log_dest =~ /syslog/) { # log_dest *includes* syslog + if ($syslog_opened == 0) { + require Sys::Syslog; + Sys::Syslog->import(qw(:standard)); + + openlog("gitolite" . ( $ENV{GL_TID} ? "[$ENV{GL_TID}]" : "" ), "pid", $Gitolite::Rc::rc{LOG_FACILITY} || 'local0'); + $syslog_opened = 1; + } + + # gl_log is called either directly, or, if the rc variable LOG_EXTRA + # is set, from trace(1, ...). The latter use is considered additional + # info for troubleshooting. Trace prefixes a tab to the arguments + # before calling gl_log, to visually set off such lines in the log + # file. Although syslog eats up that leading tab, we use it to decide + # the priority/level of the syslog message. + syslog( ( $msg =~ /^\t/ ? 'debug' : 'info' ), "%s", $msg); + + return if $log_dest !~ /normal/; + } + + my $fh; + logger_plus_stderr( "errors found before logging could be setup", "$msg" ) if not $ENV{GL_LOGFILE}; + open my $lfh, ">>", $ENV{GL_LOGFILE} + or logger_plus_stderr( "errors found but logfile could not be created", "$ENV{GL_LOGFILE}: $!", "$msg" ); + print $lfh "$ts\t$tid\t$msg\n"; + close $lfh; +} + +sub logger_plus_stderr { + open my $fh, "|-", "logger" or confess "it's really not my day is it...?\n"; + for (@_) { + print STDERR "FATAL: $_\n"; + print $fh "FATAL: $_\n"; + } + exit 1; +} + +# ---------------------------------------------------------------------- +# Get the SSH fingerprint of a file +# If the fingerprint cannot be parsed, it will be undef +# In a scalar context, returns the fingerprint +# In a list context, returns (fingerprint, output) where output +# is the raw output of the ssh-keygen command +sub ssh_fingerprint_file { + my $in = shift; + -f $in or die "file not found: $in\n"; + my $fh; + open( $fh, "ssh-keygen -l -f $in 2>&1 |" ) or die "could not fork: $!\n"; + my $output = <$fh>; + chomp $output; + # dbg("fp = $fp"); + close $fh; + # Return a valid fingerprint or undef + my $fp = undef; + if($output =~ /((?:MD5:)?(?:[0-9a-f]{2}:){15}[0-9a-f]{2})/i or + $output =~ m{((?:RIPEMD|SHA)\d+:[A-Za-z0-9+/=]+)}i) { + $fp = $1; + } + return wantarray ? ($fp, $output) : $fp; +} + +# Get the SSH fingerprint of a line of text +# If the fingerprint cannot be parsed, it will be undef +# In a scalar context, returns the fingerprint +# In a list context, returns (fingerprint, output) where output +# is the raw output of the ssh-keygen command +sub ssh_fingerprint_line { + my ( $fh, $fn ) = tempfile(); + print $fh shift() . "\n"; + close $fh; + my ($fp,$output) = ssh_fingerprint_file($fn); + unlink $fn; + return wantarray ? ($fp,$output) : $fp; +} + +# ---------------------------------------------------------------------- + +# bare-minimum subset of 'Tsh' (see github.com/sitaramc/tsh) +{ + my ( $rc, $text ); + sub tsh_rc { return $rc || 0; } + sub tsh_text { return $text || ''; } + sub tsh_lines { return split /\n/, $text; } + + sub tsh_try { + my $cmd = shift; die "try: expects only one argument" if @_; + $text = `( $cmd ) 2>&1; printf RC=\$?`; + if ( $text =~ s/RC=(\d+)$// ) { + $rc = $1; + trace( 3, $text ); + return ( not $rc ); + } + die "couldnt find RC= in result; this should not happen:\n$text\n\n...\n"; + } + + sub tsh_run { + open( my $fh, "-|", @_ ) or die "popen failed: $!"; + local $/ = undef; $text = <$fh>; + close $fh; warn "pclose failed: $!" if $!; + $rc = ( $? >> 8 ); + trace( 3, $text ); + return $text; + } +} + +1; diff --git a/src/lib/Gitolite/Conf.pm b/src/lib/Gitolite/Conf.pm new file mode 100644 index 0000000..97b6c32 --- /dev/null +++ b/src/lib/Gitolite/Conf.pm @@ -0,0 +1,109 @@ +package Gitolite::Conf; + +# explode/parse a conf file +# ---------------------------------------------------------------------- + +@EXPORT = qw( + compile + explode + parse +); + +use Exporter 'import'; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Sugar; +use Gitolite::Conf::Store; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +sub compile { + _die "'gitolite compile' does not take any arguments" if @_; + + _chdir( $rc{GL_ADMIN_BASE} ); + _chdir("conf"); + + parse( sugar('gitolite.conf') ); + + # the order matters; new repos should be created first, to give store a + # place to put the individual gl-conf files + new_repos(); + + # cache control + if ($rc{CACHE}) { + require Gitolite::Cache; + Gitolite::Cache->import(qw(cache_control)); + + cache_control('stop'); + } + + store(); + + if ($rc{CACHE}) { + cache_control('start'); + } + + # remove entries from POST_CREATE which also exist in POST_COMPILE. This + # not only saves us having to implement an optimisation in *those* + # scripts, but more importantly, moves the optimisation one step up -- we + # don't even *call* those scripts now. + my %pco = map { $_ => 1 } @{ $rc{POST_COMPILE} }; + @{ $rc{POST_CREATE} } = grep { ! exists $pco{$_} } @{ $rc{POST_CREATE} }; + + for my $repo ( @{ $rc{NEW_REPOS_CREATED} } ) { + trigger( 'POST_CREATE', $repo ); + } + + # process rule template data + _system("gitolite compile-template-data"); +} + +sub parse { + my $lines = shift; + trace( 3, scalar(@$lines) . " lines incoming" ); + + my ( $fname, $lnum ); + for my $line (@$lines) { + ( $fname, $lnum ) = ( $1, $2 ), next if $line =~ /^# (\S+) (\d+)$/; + # user or repo groups + if ( $line =~ /^(@\S+) = (.*)/ ) { + add_to_group( $1, split( ' ', $2 ) ); + } elsif ( $line =~ /^repo (.*)/ ) { + set_repolist( split( ' ', $1 ) ); + } elsif ( $line =~ /^(-|C|R|RW\+?(?:C?D?|D?C?)M?) (.* )?= (.+)/ ) { + my $perm = $1; + my @refs = parse_refs( $2 || '' ); + my @users = parse_users($3); + + for my $ref (@refs) { + for my $user (@users) { + add_rule( $perm, $ref, $user, $fname, $lnum ); + } + } + } elsif ( $line =~ /^config (.+) = ?(.*)/ ) { + my ( $key, $value ) = ( $1, $2 ); + $value =~ s/^['"](.*)["']$/$1/; + my @validkeys = split( ' ', ( $rc{GIT_CONFIG_KEYS} || '' ) ); + push @validkeys, "gitolite-options\\..*"; + my @matched = grep { $key =~ /^$_$/i } @validkeys; + _die "git config '$key' not allowed\ncheck GIT_CONFIG_KEYS in the rc file" if ( @matched < 1 ); + _die "bad config value '$value'" if $value =~ $UNSAFE_PATT; + while ( my ( $mk, $mv ) = each %{ $rc{SAFE_CONFIG} } ) { + $value =~ s/%$mk/$mv/g; + } + add_config( 1, $key, $value ); + } elsif ( $line =~ /^subconf (\S+)$/ ) { + trace( 3, $line ); + set_subconf($1); + } else { + _warn "syntax error, ignoring: '$line'"; + } + } + parse_done(); +} + +1; diff --git a/src/lib/Gitolite/Conf/Explode.pm b/src/lib/Gitolite/Conf/Explode.pm new file mode 100644 index 0000000..cf89620 --- /dev/null +++ b/src/lib/Gitolite/Conf/Explode.pm @@ -0,0 +1,118 @@ +package Gitolite::Conf::Explode; + +# include/subconf processor +# ---------------------------------------------------------------------- + +@EXPORT = qw( + explode +); + +use Exporter 'import'; + +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +# 'seen' for include/subconf files +my %included = (); +# 'seen' for group names on LHS +my %prefixed_groupname = (); + +sub explode { + trace( 3, @_ ); + my ( $file, $subconf, $out ) = @_; + + # seed the 'seen' list if it's empty + $included{ device_inode("gitolite.conf") }++ unless %included; + + my $fh = _open( "<", $file ); + while (<$fh>) { + my $line = cleanup_conf_line($_); + next unless $line =~ /\S/; + + # subst %HOSTNAME word if rc defines a hostname, else leave as is + $line =~ s/%HOSTNAME\b/$rc{HOSTNAME}/g if $rc{HOSTNAME}; + + $line = prefix_groupnames( $line, $subconf ) if $subconf ne 'master'; + + if ( $line =~ /^(include|subconf) (?:(\S+) )?(\S.+)$/ ) { + incsub( $1, $2, $3, $subconf, $out ); + } else { + # normal line, send it to the callback function + push @{$out}, "# $file $."; + push @{$out}, $line; + } + } +} + +sub incsub { + my $is_subconf = ( +shift eq 'subconf' ); + my ( $new_subconf, $include_glob, $current_subconf, $out ) = @_; + + _die "subconf '$current_subconf' attempting to run 'subconf'\n" if $is_subconf and $current_subconf ne 'master'; + + _die "invalid include/subconf file/glob '$include_glob'" + unless $include_glob =~ /^"(.+)"$/ + or $include_glob =~ /^'(.+)'$/; + $include_glob = $1; + + trace( 3, $is_subconf, $include_glob ); + + for my $file ( glob($include_glob) ) { + _warn("included file not found: '$file'"), next unless -f $file; + _die "invalid include/subconf filename '$file'" unless $file =~ m(([^/]+).conf$); + my $basename = $1; + + next if already_included($file); + + if ($is_subconf) { + push @{$out}, "subconf " . ( $new_subconf || $basename ); + explode( $file, ( $new_subconf || $basename ), $out ); + push @{$out}, "subconf $current_subconf"; + } else { + explode( $file, $current_subconf, $out ); + } + } +} + +sub prefix_groupnames { + my ( $line, $subconf ) = @_; + + my $lhs = ''; + # save 'foo' if it's an '@foo = list' line + $lhs = $1 if $line =~ /^@(\S+) = /; + # prefix all @groups in the line + $line =~ s/(^| )(@\S+)(?= |$)/ $1 . ($prefixed_groupname{$subconf}{$2} || $2) /ge; + # now prefix the LHS and store it if needed + if ($lhs) { + $line =~ s/^@\S+ = /"\@$subconf.$lhs = "/e; + $prefixed_groupname{$subconf}{"\@$lhs"} = "\@$subconf.$lhs"; + trace( 3, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" ); + } + + return $line; +} + +sub already_included { + my $file = shift; + + my $file_id = device_inode($file); + return 0 unless $included{$file_id}++; + + _warn("$file already included"); + trace( 3, "$file already included" ); + return 1; +} + +sub device_inode { + my $file = shift; + trace( 3, $file, ( stat $file )[ 0, 1 ] ); + return join( "/", ( stat $file )[ 0, 1 ] ); +} + +1; + diff --git a/src/lib/Gitolite/Conf/Load.pm b/src/lib/Gitolite/Conf/Load.pm new file mode 100644 index 0000000..7dea259 --- /dev/null +++ b/src/lib/Gitolite/Conf/Load.pm @@ -0,0 +1,704 @@ +package Gitolite::Conf::Load; + +# load conf data from stored files +# ---------------------------------------------------------------------- + +@EXPORT = qw( + load + + access + git_config + env_options + + option + repo_missing + creator + + vrefs + lister_dispatch +); + +use Exporter 'import'; +use Cwd; + +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +# our variables, because they get loaded by a 'do' +our $data_version = ''; +our %repos; +our %one_repo; +our %groups; +our %patterns; +our %configs; +our %one_config; +our %split_conf; + +my $subconf = 'master'; + +my %listers = ( + 'list-groups' => \&list_groups, + 'list-users' => \&list_users, + 'list-repos' => \&list_repos, + 'list-memberships' => \&list_memberships, + 'list-members' => \&list_members, +); + +# helps maintain the "cache" in both "load_common" and "load_1" +my $last_repo = ''; + +# ---------------------------------------------------------------------- + +{ + my $loaded_repo = ''; + + sub load { + my $repo = shift or _die "load() needs a reponame"; + trace( 3, "$repo" ); + if ( $repo ne $loaded_repo ) { + load_common(); + load_1($repo); + $loaded_repo = $repo; + } + } +} + +sub access { + my ( $repo, $user, $aa, $ref ) = @_; + trace( 2, $repo, $user, $aa, $ref ); + _die "invalid user '$user'" if not( $user and $user =~ $USERNAME_PATT ); + sanity($repo); + return "$aa any $repo $user DENIED by fallthru" unless update_hook_present($repo); + + my @rules; + my $deny_rules; + + load($repo); + @rules = rules( $repo, $user ); + $deny_rules = option( $repo, 'deny-rules' ); + + # sanity check the only piece the user can control + _die "invalid characters in ref or filename: '$ref'\n" unless $ref =~ m(^VREF/NAME/) or $ref =~ $REF_OR_FILENAME_PATT; + # apparently we can't always force sanity; at least what we *return* + # should be sane/safe. This pattern is based on REF_OR_FILENAME_PATT. + ( my $safe_ref = $ref ) =~ s([^-0-9a-zA-Z._\@/+ :,])(.)g; + trace( 3, "safe_ref", $safe_ref ) if $ref ne $safe_ref; + + # when a real repo doesn't exist, ^C is a pre-requisite for any other + # check to give valid results. + if ( $aa ne '^C' and $repo !~ /^\@/ and $repo =~ $REPONAME_PATT and repo_missing($repo) ) { + my $iret = access( $repo, $user, '^C', $ref ); + $iret =~ s/\^C/$aa/; + return $iret if $iret =~ /DENIED/; + } + # similarly, ^C must be denied if the repo exists + if ( $aa eq '^C' and not repo_missing($repo) ) { + trace( 2, "DENIED by existence" ); + return "$aa $safe_ref $repo $user DENIED by existence"; + } + + trace( 3, scalar(@rules) . " rules found" ); + + $rc{RULE_TRACE} = ''; + for my $r (@rules) { + $rc{RULE_TRACE} .= " " . $r->[0] . " "; + + my $perm = $r->[1]; + my $refex = $r->[2]; $refex =~ s(/USER/)(/$user/); + trace( 3, "perm=$perm, refex=$refex" ); + + $rc{RULE_TRACE} .= "d"; + # skip 'deny' rules if the ref is not (yet) known + next if $perm eq '-' and $ref eq 'any' and not $deny_rules; + + $rc{RULE_TRACE} .= "r"; + # rule matches if ref matches or ref is any (see gitolite-shell) + next unless $ref =~ /^$refex/ or $ref eq 'any'; + + $rc{RULE_TRACE} .= "D"; + trace( 2, "DENIED by $refex" ) if $perm eq '-'; + return "$aa $safe_ref $repo $user DENIED by $refex" if $perm eq '-'; + + # For repo creation, perm will be C and aa will be "^C". For branch + # access, $perm can be RW\+?(C|D|CD|DC)?M?, and $aa can be W, +, C or + # D, or any of these followed by "M". + + # We need to turn $aa into a regex that can match a suitable $perm. + # This is trivially true for "^C", "W" and "D", but the others (+, C, + # M) need some tweaking. + + # first, quote the '+': + ( my $aaq = $aa ) =~ s/\+/\\+/; + # if aa is just "C", the user is trying to create a *branch* (not a + # *repo*), so let's make the pattern clearer to reflect that. + $aaq = "RW.*C" if $aaq eq "C"; + # if the aa is, say "WM", make this "W.*M" because the perm could be + # 'RW+M', 'RW+CDM' etc, and they are all valid: + $aaq =~ s/M/.*M/; + + $rc{RULE_TRACE} .= "A"; + + # as far as *this* ref is concerned we're ok + return $refex if ( $perm =~ /$aaq/ ); + + $rc{RULE_TRACE} .= "p"; + } + $rc{RULE_TRACE} .= " F"; + + trace( 2, "DENIED by fallthru" ); + return "$aa $safe_ref $repo $user DENIED by fallthru"; +} + +# cache control +if ($rc{CACHE}) { + require Gitolite::Cache; + Gitolite::Cache::cache_wrap('Gitolite::Conf::Load::access'); +} + +sub git_config { + my ( $repo, $key, $empty_values_OK ) = @_; + $key ||= '.'; + + if ( repo_missing($repo) ) { + load_common(); + } else { + load($repo); + } + + # read comments bottom up + my %ret = + # and take the second and third elements to make up your new hash + map { $_->[1] => $_->[2] } + # keep only the ones where the second element matches your key + grep { $_->[1] =~ qr($key) } + # sort this list of listrefs by the first element in each list ref'd to + sort { $a->[0] <=> $b->[0] } + # dereference it (into a list of listrefs) + map { @$_ } + # take the value of that entry + map { $configs{$_} } + # if it has an entry in %configs + grep { $configs{$_} } + # for each "repo" that represents us + memberships( 'repo', $repo ); + + # %configs looks like this (for each 'foo' that is in memberships()) + # 'foo' => [ [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ] ], + # the first map gets you the value + # [ [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ] ], + # the deref gets you + # [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ] + # the sort rearranges it (in this case it's already sorted but anyway...) + # the grep gets you this, assuming the key is foo.bar (and "." is regex ".') + # [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ] + # and the final map does this: + # 'foo.bar'=>'repo' , 'foodbar'=>'repoD' + + # now some of these will have an empty key; we need to delete them unless + # we're told empty values are OK + unless ($empty_values_OK) { + my ( $k, $v ); + while ( ( $k, $v ) = each %ret ) { + delete $ret{$k} if not $v; + } + } + + my ( $k, $v ); + my $creator = creator($repo); + while ( ( $k, $v ) = each %ret ) { + $v =~ s/%GL_REPO/$repo/g; + $v =~ s/%GL_CREATOR/$creator/g if $creator; + $ret{$k} = $v; + } + + map { trace( 3, "$_", "$ret{$_}" ) } ( sort keys %ret ) if $ENV{D}; + return \%ret; +} + +sub env_options { + return unless -f "$rc{GL_ADMIN_BASE}/conf/gitolite.conf-compiled.pm"; + # prevent catch-22 during initial install + + my $cwd = getcwd(); + + my $repo = shift; + map { delete $ENV{$_} } grep { /^GL_OPTION_/ } keys %ENV; + my $h = git_config( $repo, '^gitolite-options.ENV\.' ); + while ( my ( $k, $v ) = each %$h ) { + next unless $k =~ /^gitolite-options.ENV\.(\w+)$/; + $ENV{ "GL_OPTION_" . $1 } = $v; + } + + chdir($cwd); +} + +sub option { + my ( $repo, $option ) = @_; + $option = "gitolite-options.$option"; + my $ret = git_config( $repo, "^\Q$option\E\$" ); + return '' unless %$ret; + return $ret->{$option}; +} + +sub sanity { + my ($repo, $patt) = @_; + $patt ||= $REPOPATT_PATT; + + _die "invalid repo '$repo'" if not( $repo and $repo =~ $patt ); + _die "'$repo' ends with a '/'" if $repo =~ m(/$); + _die "'$repo' contains '..'" if $repo =~ $REPONAME_PATT and $repo =~ m(\.\.); + _die "'$repo' contains '.git/'" if $repo =~ $REPONAME_PATT and $repo =~ m(\.git/); + _die "'$repo' ends with '.git'" if $repo =~ m(\.git$); +} + +sub repo_missing { + my $repo = shift; + sanity($repo); + + return not -d "$rc{GL_REPO_BASE}/$repo.git"; +} + +# ---------------------------------------------------------------------- + +sub load_common { + + _chdir( $rc{GL_ADMIN_BASE} ); + + # we take an unusual approach to caching this function! + # (requires that first call to load_common is before first call to load_1) + if ( $last_repo and $split_conf{$last_repo} ) { + delete $repos{$last_repo}; + delete $configs{$last_repo}; + return; + } + + my $cc = "./conf/gitolite.conf-compiled.pm"; + + _die "parse '$cc' failed: " . ( $! or $@ ) unless do $cc; + + if ( data_version_mismatch() ) { + _system("gitolite setup"); + _die "parse '$cc' failed: " . ( $! or $@ ) unless do $cc; + _die "data version update failed; this is serious" if data_version_mismatch(); + } +} + +sub load_1 { + my $repo = shift; + return if $repo =~ /^\@/; + trace( 3, $repo ); + + if ( repo_missing($repo) ) { + trace( 1, "repo '$repo' missing" ) if $repo =~ $REPONAME_PATT; + return; + } + _chdir("$rc{GL_REPO_BASE}/$repo.git"); + + if ( $repo eq $last_repo ) { + $repos{$repo} = $one_repo{$repo}; + $configs{$repo} = $one_config{$repo} if $one_config{$repo}; + return; + } + + if ( -f "gl-conf" ) { + return if not $split_conf{$repo} and not $rc{ALLOW_ORPHAN_GL_CONF}; + + my $cc = "./gl-conf"; + _die "parse '$cc' failed: " . ( $@ or $! ) unless do $cc; + + $last_repo = $repo; + $repos{$repo} = $one_repo{$repo}; + $configs{$repo} = $one_config{$repo} if $one_config{$repo}; + } else { + _die "split conf set, gl-conf not present for '$repo'" if $split_conf{$repo}; + } +} + +{ + my $lastrepo = ''; + my $lastuser = ''; + my @cached = (); + + sub rules { + my ( $repo, $user ) = @_; + trace( 3, $repo, $user ); + + return @cached if ( $lastrepo eq $repo and $lastuser eq $user and @cached ); + + my @rules = (); + + my @repos = memberships( 'repo', $repo ); + my @users = memberships( 'user', $user, $repo ); + trace( 3, "memberships: " . scalar(@repos) . " repos and " . scalar(@users) . " users found" ); + + for my $r (@repos) { + for my $u (@users) { + push @rules, @{ $repos{$r}{$u} } if exists $repos{$r} and exists $repos{$r}{$u}; + } + } + + @rules = sort { $a->[0] <=> $b->[0] } @rules; + + $lastrepo = $repo; + $lastuser = $user; + @cached = @rules; + + # however if the repo was missing, invalidate the cache + $lastrepo = '' if repo_missing($repo); + + return @rules; + } + + sub vrefs { + my ( $repo, $user ) = @_; + # fill the cache if needed + rules( $repo, $user ) unless ( $lastrepo eq $repo and $lastuser eq $user and @cached ); + + my %seen; + my @vrefs = grep { /^VREF\// and not $seen{$_}++ } map { $_->[2] } @cached; + return @vrefs; + } +} + +sub memberships { + trace( 3, @_ ); + my ( $type, $base, $repo ) = @_; + $repo ||= ''; + my @ret; + my $base2 = ''; + + @ret = ( $base, '@all' ); + + if ( $type eq 'repo' ) { + # first, if a repo, say, pub/sitaram/project, has a gl-creator file + # that says "sitaram", find memberships for pub/CREATOR/project also + $base2 = generic_name($base); + + # second, you need to check in %repos also + for my $i ( keys %repos, keys %configs ) { + if ( $base eq $i or $base =~ /^$i$/ or $base2 and ( $base2 eq $i or $base2 =~ /^$i$/ ) ) { + push @ret, $i; + } + } + + # add in any group names explicitly given in (GIT_DIR)/gl-repo-groups + push @ret, + map { s/^\@?/\@/; $_ } + grep { ! /[^\w@-]/ } + split (' ', slurp("$ENV{GL_REPO_BASE}/$base.git/gl-repo-groups")) + if -f "$ENV{GL_REPO_BASE}/$base.git/gl-repo-groups"; + } + + push @ret, @{ $groups{$base} } if exists $groups{$base}; + push @ret, @{ $groups{$base2} } if $base2 and exists $groups{$base2}; + if ($type eq 'repo') { + # regexes can only be used for repos, not for users + for my $i ( keys %{ $patterns{groups} } ) { + if ( $base =~ /^$i$/ or $base2 and ( $base2 =~ /^$i$/ ) ) { + push @ret, @{ $groups{$i} }; + } + } + } + + push @ret, @{ ext_grouplist($base) } if $type eq 'user' and $rc{GROUPLIST_PGM}; + + if ( $type eq 'user' and $repo and not repo_missing($repo) ) { + # find the roles this user has when accessing this repo and add those + # in as groupnames he is a member of. You need the already existing + # memberships for this; see below this function for an example + push @ret, user_roles( $base, $repo, @ret ); + } + + @ret = @{ sort_u( \@ret ) }; + trace( 3, sort @ret ); + return @ret; +} + +=for example + +conf/gitolite.conf: + @g1 = u1 + @g2 = u1 + # now user is a member of both g1 and g2 + +gl-perms for repo being accessed: + READERS @g1 + +This should result in @READERS being added to the memberships that u1 has +(when accessing this repo). So we send the current list (@g1, @g2) to +user_roles(), otherwise it has to redo that logic. + +=cut + +sub data_version_mismatch { + return $data_version ne glrc('current-data-version'); +} + +sub user_roles { + my ( $user, $repo, @eg ) = @_; + + # eg == existing groups (that user is already known to be a member of) + my %eg = map { $_ => 1 } @eg; + + my %ret = (); + my $f = "$rc{GL_REPO_BASE}/$repo.git/gl-perms"; + my @roles = (); + if ( -f $f ) { + my $fh = _open( "<", $f ); + chomp( @roles = <$fh> ); + } + push @roles, "CREATOR = " . creator($repo); + for (@roles) { + # READERS u3 u4 @g1 + s/^\s+//; s/ +$//; s/=/ /; s/\s+/ /g; s/^\@//; + next if /^#/; + next unless /\S/; + my ( $role, @members ) = split; + # role = READERS, members = u3, u4, @g1 + if ( $role ne 'CREATOR' and not $rc{ROLES}{$role} ) { + _warn "role '$role' not allowed, ignoring"; + next; + } + for my $m (@members) { + if ( $m !~ $USERNAME_PATT ) { + _warn "ignoring '$m' in perms line"; + next; + } + # if user eq u3/u4, or is a member of @g1, he has role READERS + $ret{ '@' . $role } = 1 if $m eq $user or $eg{$m}; + } + } + + return keys %ret; +} + +sub generic_name { + my $base = shift; + my $base2 = ''; + my $creator; + + # get the creator name. For not-yet-born repos this is $ENV{GL_USER}, + # which should be set in all cases that we care about, viz., where we are + # checking ^C permissions before new_wild_repo(), and the info command. + # In particular, 'gitolite access' can't be used to check ^C perms on wild + # repos that contain "CREATOR" if GL_USER is not set. + $creator = creator($base); + + $base2 = $base; + $base2 =~ s(\b$creator\b)(CREATOR) if $creator; + $base2 = '' if $base2 eq $base; # if there was no change + + return $base2; +} + +sub creator { + my $repo = shift; + sanity($repo); + + return ( $ENV{GL_USER} || '' ) if repo_missing($repo); + my $f = "$rc{GL_REPO_BASE}/$repo.git/gl-creator"; + my $creator = ''; + chomp( $creator = slurp($f) ) if -f $f; + return $creator; +} + +{ + my %cache = (); + + sub ext_grouplist { + my $user = shift; + my $pgm = $rc{GROUPLIST_PGM}; + return [] if not $pgm; + + return $cache{$user} if $cache{$user}; + my @extgroups = map { s/^@?/@/; $_; } split ' ', `$rc{GROUPLIST_PGM} $user`; + return ( $cache{$user} = \@extgroups ); + } +} + +# ---------------------------------------------------------------------- +# api functions +# ---------------------------------------------------------------------- + +sub lister_dispatch { + my $command = shift; + + my $fn = $listers{$command} or _die "unknown gitolite sub-command"; + return $fn; +} + +=for list_groups +Usage: gitolite list-groups + + - lists all group names in conf + - no options, no flags +=cut + +sub list_groups { + usage() if @_; + + load_common(); + + my @g = (); + while ( my ( $k, $v ) = each(%groups) ) { + push @g, @{$v}; + } + return ( sort_u( \@g ) ); +} + +=for list_users +Usage: gitolite list-users [<repo name pattern>] + +List all users and groups explicitly named in a rule. + +- you will have to run 'list-members' on each group name to expand it -- for + details and caveats on that please see its help message. +- User names not mentioned in an access rule will not show up at all (for + example, if you have users who only have access via an '@all' rule). + +WARNING: may be slow if you have thousands of repos. The optional repo name +pattern is an unanchored regex; it can speed things up if you're interested +only in users of a matching set of repos. This is only an optimisation, not +an actual access list; you will still have to pipe it to 'gitolite access' +with appropriate arguments to get an actual access list. + +NOTE: If you're running in ssh mode, it may be simpler to parse the authorized +keys file in ~/.ssh, like so: + perl -lne '/ ([a-z0-9]+)"/; print $1 if $1' < ~/.ssh/authorized_keys | sort -u +If you're running in http mode, only your web server knows all the potential +user names. +=cut + +sub list_users { + my $patt = shift || '.'; + usage() if $patt eq '-h' or @_; + my $count = 0; + my $total = 0; + + load_common(); + + my @u = map { keys %{$_} } values %repos; + $total = scalar( grep { /$patt/ } keys %split_conf ); + warn "WARNING: you have $total repos to check; this could take some time!\n" if $total > 100; + for my $one ( grep { /$patt/ } keys %split_conf ) { + load_1($one); + $count++; print STDERR "$count / $total\r" if not( $count % 100 ) and timer(5); + push @u, map { keys %{$_} } values %one_repo; + } + print STDERR "\n" if $count >= 100; + return ( sort_u( \@u ) ); +} + +=for list_repos +Usage: gitolite list-repos + + - lists all repos/repo groups in conf + - no options, no flags +=cut + +sub list_repos { + usage() if @_; + + load_common(); + + my @r = keys %repos; + push @r, keys %split_conf; + + return ( sort_u( \@r ) ); +} + +=for list_memberships +Usage: gitolite list-memberships -u|-r <name> + +List all groups a name is a member of. One of the flags '-u' or '-r' is +mandatory, to specify if the name is a user or a repo. + +For users, the output includes the result from GROUPLIST_PGM, if it is +defined. For repos, the output includes any repo patterns that the repo name +matches, as well as any groups that contain those patterns. +=cut + +sub list_memberships { + require Getopt::Long; + + my ( $user, $repo, $help ); + + Getopt::Long::GetOptionsFromArray( + \@_, + 'user|u=s' => \$user, + 'repo|r=s' => \$repo, + 'help|h' => \$help, + ); + usage() if $help or ( not $user and not $repo ); + + load_common(); + my @m; + + if ( $user and $repo ) { + # unsupported/undocumented except via "in_role()" in Easy.pm + @m = memberships( 'user', $user, $repo ); + } elsif ($user) { + @m = memberships( 'user', $user ); + } elsif ($repo) { + @m = memberships( 'repo', $repo ); + } + + @m = grep { $_ ne '@all' and $_ ne ( $user || $repo ) } @m; + return ( sort_u( \@m ) ); +} + +=for list_members +Usage: gitolite list-members <group name> + + - list all members of a group + - takes one group name + +'@all' is not expandable in this context. Also, if you have GROUPLIST_PGM set +in your rc file[1], gitolite cannot expand group names completely; only your +external database can. + +[1]: http://gitolite.com/gitolite/conf.html#ldap + +=cut + +sub list_members { + usage() if @_ and $_[0] eq '-h' or not @_; + + my $name = shift; + + load_common(); + + my @m = (); + while ( my ( $k, $v ) = each(%groups) ) { + for my $g ( @{$v} ) { + push @m, $k if $g eq $name; + } + } + + return ( sort_u( \@m ) ); +} + +# ---------------------------------------------------------------------- + +{ + my $start_time = 0; + + sub timer { + unless ($start_time) { + $start_time = time(); + return 0; + } + my $elapsed = shift; + return 0 if time() - $start_time < $elapsed; + $start_time = time(); + return 1; + } +} + +1; + diff --git a/src/lib/Gitolite/Conf/Store.pm b/src/lib/Gitolite/Conf/Store.pm new file mode 100644 index 0000000..8757c89 --- /dev/null +++ b/src/lib/Gitolite/Conf/Store.pm @@ -0,0 +1,411 @@ +package Gitolite::Conf::Store; + +# receive parsed conf data and store it +# ---------------------------------------------------------------------- + +@EXPORT = qw( + add_to_group + set_repolist + parse_refs + parse_users + add_rule + add_config + set_subconf + + expand_list + new_repos + new_repo + new_wild_repo + hook_repos + store + parse_done +); + +use Exporter 'import'; +use Data::Dumper; +$Data::Dumper::Indent = 1; +$Data::Dumper::Sortkeys = 1; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Hooks::Update; +use Gitolite::Hooks::PostUpdate; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +my %repos; +my %groups; +my %configs; +my %split_conf; + +my @repolist; # current repo list; reset on each 'repo ...' line +my $subconf = 'master'; +my $nextseq = 0; +my %ignored; + +# ---------------------------------------------------------------------- + +sub add_to_group { + my ( $lhs, @rhs ) = @_; + _die "bad group '$lhs'" unless $lhs =~ $REPONAME_PATT; + map { _die "bad expansion '$_'" unless $_ =~ $REPOPATT_PATT } @rhs; + + # store the group association, but overload it to keep track of when + # the group was *first* created by using $subconf as the *value* + do { $groups{$lhs}{$_} ||= $subconf } + for ( expand_list(@rhs) ); + + # create the group hash even if empty + $groups{$lhs} = {} unless $groups{$lhs}; +} + +sub set_repolist { + my @in = @_; + @repolist = (); + # ...sanity checks + while (@in) { + $_ = shift @in; + if ( check_subconf_repo_disallowed( $subconf, $_ ) ) { + if ( exists $groups{$_} ) { + # groupname disallowed; try individual members now + ( my $g = $_ ) =~ s/^\@$subconf\./\@/; + _warn "expanding '$g'; this *may* slow down compilation"; + unshift @in, keys %{ $groups{$_} }; + next; + } + $ignored{$subconf}{$_} = 1; + next; + } + + _warn "explicit '.git' extension ignored for $_.git" if s/\.git$//; + _die "bad reponame '$_'" if $_ !~ $REPOPATT_PATT; + + push @repolist, $_; + } +} + +sub parse_refs { + my $refs = shift; + my @refs; @refs = split( ' ', $refs ) if $refs; + @refs = expand_list(@refs); + + # if no ref is given, this PERM applies to all refs + @refs = qw(refs/.*) unless @refs; + + # fully qualify refs that dont start with "refs/" or "VREF/"; + # prefix them with "refs/heads/" + @refs = map { m(^(refs|VREF)/) or s(^)(refs/heads/); $_ } @refs; + + return @refs; +} + +sub parse_users { + my $users = shift; + my @users = split ' ', $users; + do { _die "bad username '$_'" unless $_ =~ $USERNAME_PATT } + for @users; + + return @users; +} + +sub add_rule { + my ( $perm, $ref, $user, $fname, $lnum ) = @_; + _warn "doesn't make sense to supply a ref ('$ref') for 'R' rule" + if $perm eq 'R' and $ref ne 'refs/.*'; + _warn "possible undeclared group '$user'" + if $user =~ /^@/ + and not $groups{$user} + and not $rc{GROUPLIST_PGM} + and not special_group($user); + _die "bad ref '$ref'" unless $ref =~ $REPOPATT_PATT; + _die "bad user '$user'" unless $user =~ $USERNAME_PATT; + + $nextseq++; + store_rule_info( $nextseq, $fname, $lnum ); + for my $repo (@repolist) { + push @{ $repos{$repo}{$user} }, [ $nextseq, $perm, $ref ]; + } + + sub special_group { + # ok perl doesn't really have lexical subs (at least not the older + # perls I want to support) but let's pretend... + my $g = shift; + $g =~ s/^\@//; + return 1 if $g eq 'all' or $g eq 'CREATOR'; + return 1 if $rc{ROLES}{$g}; + return 0; + } + +} + +sub add_config { + my ( $n, $key, $value ) = @_; + + $nextseq++; + for my $repo (@repolist) { + push @{ $configs{$repo} }, [ $nextseq, $key, $value ]; + } +} + +sub set_subconf { + $subconf = shift; + _die "bad subconf '$subconf'" unless $subconf =~ /^[-\w.]+$/; +} + +# ---------------------------------------------------------------------- + +sub expand_list { + my @list = @_; + my @new_list = (); + + for my $item (@list) { + if ( $item =~ /^@/ and $item ne '@all' ) # nested group + { + _die "undefined group '$item'" unless $groups{$item}; + # add those names to the list + push @new_list, sort keys %{ $groups{$item} }; + } else { + push @new_list, $item; + } + } + + return @new_list; +} + +sub new_repos { + trace(3); + _chdir( $rc{GL_REPO_BASE} ); + + # normal repos + my @repos = grep { $_ =~ $REPONAME_PATT and not /^@/ } ( sort keys %repos, sort keys %configs ); + # add in members of repo groups + map { push @repos, keys %{ $groups{$_} } } grep { /^@/ and $_ ne '@all' } keys %repos; + + for my $repo ( @{ sort_u( \@repos ) } ) { + next unless $repo =~ $REPONAME_PATT; # skip repo patterns + next if $repo =~ m(^\@|EXTCMD/); # skip groups and fake repos + + # use gl-conf as a sentinel; if it exists, all is well + next if -f "$repo.git/gl-conf"; + + if (-d "$repo.git") { + # directory exists but sentinel missing? Maybe a freshly imported repo? + hook_1($repo); + } else { + push @{ $rc{NEW_REPOS_CREATED} }, $repo; + trigger( 'PRE_CREATE', $repo ); + new_repo($repo); + } + } +} + +sub new_repo { + my $repo = shift; + trace( 3, $repo ); + + _mkdir("$repo.git"); + _chdir("$repo.git"); + _system("git init --bare >&2"); + _chdir( $rc{GL_REPO_BASE} ); + hook_1($repo); +} + +sub new_wild_repo { + my ( $repo, $user, $aa ) = @_; + _chdir( $rc{GL_REPO_BASE} ); + + trigger( 'PRE_CREATE', $repo, $user, $aa ); + new_repo($repo); + _print( "$repo.git/gl-creator", $user ); + trigger( 'POST_CREATE', $repo, $user, $aa ); + + _chdir( $rc{GL_ADMIN_BASE} ); +} + +sub hook_repos { + trace(3); + + # all repos, all hooks + _chdir( $rc{GL_REPO_BASE} ); + my $phy_repos = list_phy_repos(1); + + for my $repo ( @{$phy_repos} ) { + hook_1($repo); + } +} + +sub store { + trace(3); + + # first write out the ones for the physical repos + _chdir( $rc{GL_REPO_BASE} ); + + # list of repos (union of keys of %repos plus %configs) + my %kr_kc; + @kr_kc{ keys %repos } = (); + @kr_kc{ keys %configs } = (); + for my $repo ( keys %kr_kc ) { + store_1($repo); + } + + _chdir( $rc{GL_ADMIN_BASE} ); + store_common(); +} + +sub parse_done { + for my $ig ( sort keys %ignored ) { + _warn "subconf '$ig' attempting to set access for " . join( ", ", sort keys %{ $ignored{$ig} } ); + } + + close_rule_info(); +} + +# ---------------------------------------------------------------------- + +sub check_subconf_repo_disallowed { + # trying to set access for $repo (='foo')... + my ( $subconf, $repo ) = @_; + trace( 2, $subconf, $repo ); + + # processing the master config, not a subconf + return 0 if $subconf eq 'master'; + # subconf is also called 'foo' (you're allowed to have a + # subconf that is only concerned with one repo) + return 0 if $subconf eq $repo; + # same thing in big-config-land; foo is just @foo now + return 0 if ( "\@$subconf" eq $repo ); + my @matched = grep { $repo =~ /^$_$/ } + grep { $groups{"\@$subconf"}{$_} eq 'master' } + sort keys %{ $groups{"\@$subconf"} }; + return 0 if @matched > 0; + + trace( 2, "-> disallowed" ); + return 1; +} + +sub store_1 { + # warning: writes and *deletes* it from %repos and %configs + my ($repo) = shift; + trace( 3, $repo ); + return unless -d "$repo.git"; + + my ( %one_repo, %one_config ); + + my $dumped_data = ''; + if ( $repos{$repo} ) { + $one_repo{$repo} = $repos{$repo}; + delete $repos{$repo}; + $dumped_data = Data::Dumper->Dump( [ \%one_repo ], [qw(*one_repo)] ); + } + + if ( $configs{$repo} ) { + $one_config{$repo} = $configs{$repo}; + delete $configs{$repo}; + $dumped_data .= Data::Dumper->Dump( [ \%one_config ], [qw(*one_config)] ); + } + + _print( "$repo.git/gl-conf", $dumped_data ); + + $split_conf{$repo} = 1; +} + +sub store_common { + trace(3); + my $cc = "conf/gitolite.conf-compiled.pm"; + my $compiled_fh = _open( ">", "$cc.new" ); + + my %patterns = (); + + my $data_version = glrc('current-data-version'); + trace( 3, "data_version = $data_version" ); + print $compiled_fh Data::Dumper->Dump( [$data_version], [qw(*data_version)] ); + + my $dumped_data = Data::Dumper->Dump( [ \%repos ], [qw(*repos)] ); + $dumped_data .= Data::Dumper->Dump( [ \%configs ], [qw(*configs)] ) if %configs; + + print $compiled_fh $dumped_data; + + if (%groups) { + my %groups = %{ inside_out( \%groups ) }; + $dumped_data = Data::Dumper->Dump( [ \%groups ], [qw(*groups)] ); + print $compiled_fh $dumped_data; + + # save patterns in %groups for faster handling of multiple repos, such + # as happens in the various POST_COMPILE scripts + for my $k ( keys %groups ) { + $patterns{groups}{$k} = 1 unless $k =~ $REPONAME_PATT; + } + } + + print $compiled_fh Data::Dumper->Dump( [ \%patterns ], [qw(*patterns)] ) if %patterns; + + print $compiled_fh Data::Dumper->Dump( [ \%split_conf ], [qw(*split_conf)] ) if %split_conf; + + close $compiled_fh or _die "close compiled-conf failed: $!\n"; + rename "$cc.new", $cc; +} + +{ + my $hook_reset = 0; + + sub hook_1 { + my $repo = shift; + trace( 3, $repo ); + + # reset the gitolite supplied hooks, in case someone fiddled with + # them, but only once per run + if ( not $hook_reset ) { + _mkdir("$rc{GL_ADMIN_BASE}/hooks/common"); + _mkdir("$rc{GL_ADMIN_BASE}/hooks/gitolite-admin"); + _print( "$rc{GL_ADMIN_BASE}/hooks/common/update", update_hook() ); + _print( "$rc{GL_ADMIN_BASE}/hooks/gitolite-admin/post-update", post_update_hook() ); + chmod 0755, "$rc{GL_ADMIN_BASE}/hooks/common/update"; + chmod 0755, "$rc{GL_ADMIN_BASE}/hooks/gitolite-admin/post-update"; + $hook_reset++; + } + + # propagate user-defined (custom) hooks to all repos + ln_sf( "$rc{LOCAL_CODE}/hooks/common", "*", "$repo.git/hooks" ) if $rc{LOCAL_CODE}; + + # override/propagate gitolite defined hooks for all repos + ln_sf( "$rc{GL_ADMIN_BASE}/hooks/common", "*", "$repo.git/hooks" ); + # override/propagate gitolite defined hooks for the admin repo + ln_sf( "$rc{GL_ADMIN_BASE}/hooks/gitolite-admin", "*", "$repo.git/hooks" ) if $repo eq 'gitolite-admin'; + } +} + +sub inside_out { + my $href = shift; + # input conf: @aa = bb cc <newline> @bb = @aa dd + + my %ret = (); + while ( my ( $k, $v ) = each( %{$href} ) ) { + # $k is '@aa', $v is a href + for my $k2 ( keys %{$v} ) { + # $k2 is bb, then cc + push @{ $ret{$k2} }, $k; + } + } + return \%ret; + # %groups = ( 'bb' => [ '@bb', '@aa' ], 'cc' => [ '@bb', '@aa' ], 'dd' => [ '@bb' ]); +} + +{ + my $ri_fh = ''; + + sub store_rule_info { + $ri_fh = _open( ">", $rc{GL_ADMIN_BASE} . "/conf/rule_info" ) unless $ri_fh; + # $nextseq, $fname, $lnum + print $ri_fh join( "\t", @_ ) . "\n"; + } + + sub close_rule_info { + close $ri_fh or die "close rule_info file failed: $!"; + } +} + +1; + diff --git a/src/lib/Gitolite/Conf/Sugar.pm b/src/lib/Gitolite/Conf/Sugar.pm new file mode 100644 index 0000000..5c743d3 --- /dev/null +++ b/src/lib/Gitolite/Conf/Sugar.pm @@ -0,0 +1,202 @@ +# and now for something completely different... + +package SugarBox; + +sub run_sugar_script { + my ( $ss, $lref ) = @_; + do $ss if -r $ss; + $lref = sugar_script($lref); + return $lref; +} + +# ---------------------------------------------------------------------- + +package Gitolite::Conf::Sugar; + +# syntactic sugar for the conf file, including site-local macros +# ---------------------------------------------------------------------- + +@EXPORT = qw( + sugar +); + +use Exporter 'import'; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Explode; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +sub sugar { + # gets a filename, returns a listref + + my @lines = (); + explode( shift, 'master', \@lines ); + + my $lines; + $lines = \@lines; + + # run through the sugar stack one by one + + # first, user supplied sugar: + if ( exists $rc{SYNTACTIC_SUGAR} ) { + if ( ref( $rc{SYNTACTIC_SUGAR} ) ne 'ARRAY' ) { + _warn "bad syntax for specifying sugar scripts; see docs"; + } else { + for my $s ( @{ $rc{SYNTACTIC_SUGAR} } ) { + + # perl-ism; apart from keeping the full path separate from the + # simple name, this also protects %rc from change by implicit + # aliasing, which would happen if you touched $s itself + my $sfp = _which( "syntactic-sugar/$s", 'r' ); + + _warn("skipped sugar script '$s'"), next if not -r $sfp; + $lines = SugarBox::run_sugar_script( $sfp, $lines ); + $lines = [ grep /\S/, map { cleanup_conf_line($_) } @$lines ]; + } + } + } + + # then our stuff: + + $lines = rw_cdm($lines); + $lines = option($lines); # must come after rw_cdm + $lines = owner_desc($lines); + $lines = name_vref($lines); + $lines = role_names($lines); + $lines = skip_block($lines); + + return $lines; +} + +sub rw_cdm { + my $lines = shift; + my @ret; + + # repo foo <...> RWC = ... + # -> option CREATE_IS_C = 1 + # (and similarly DELETE_IS_D and MERGE_CHECK) + # but only once per repo of course + + my %seen = (); + for my $line (@$lines) { + push @ret, $line; + if ( $line =~ /^repo / ) { + %seen = (); + } elsif ( $line =~ /^(-|C|R|RW\+?(?:C?D?|D?C?)M?) (.* )?= (.+)/ ) { + my $perms = $1; + push @ret, "option DELETE_IS_D = 1" if $perms =~ /D/ and not $seen{D}++; + push @ret, "option CREATE_IS_C = 1" if $perms =~ /RW.*C/ and not $seen{C}++; + push @ret, "option MERGE_CHECK = 1" if $perms =~ /M/ and not $seen{M}++; + } + } + return \@ret; +} + +sub option { + my $lines = shift; + my @ret; + + # option foo = bar + # -> config gitolite-options.foo = bar + + for my $line (@$lines) { + $line =~ s/option mirror\.slaves/option mirror.copies/; + if ( $line =~ /^option (\S+) = (\S.*)/ ) { + push @ret, "config gitolite-options.$1 = $2"; + } else { + push @ret, $line; + } + } + return \@ret; +} + +sub owner_desc { + my $lines = shift; + my @ret; + + # owner = "owner name" + # -> config gitweb.owner = owner name + # desc = "some long description" + # -> config gitweb.description = some long description + # category = "whatever..." + # -> config gitweb.category = whatever... + + for my $line (@$lines) { + if ( $line =~ /^desc = (\S.*)/ ) { + push @ret, "config gitweb.description = $1"; + } elsif ( $line =~ /^owner = (\S.*)/ ) { + push @ret, "config gitweb.owner = $1"; + } elsif ( $line =~ /^category = (\S.*)/ ) { + push @ret, "config gitweb.category = $1"; + } else { + push @ret, $line; + } + } + return \@ret; +} + +sub name_vref { + my $lines = shift; + my @ret; + + # <perm> NAME/foo = <user> + # -> <perm> VREF/NAME/foo = <user> + + for my $line (@$lines) { + if ( $line =~ /^(-|R\S+) \S.* = \S.*/ ) { + $line =~ s( NAME/)( VREF/NAME/)g; + } + push @ret, $line; + } + return \@ret; +} + +sub role_names { + my $lines = shift; + my @ret; + + # <perm> [<ref>] = <user list containing CREATOR|READERS|WRITERS> + # -> same but with "@" prepended to rolenames + + for my $line (@$lines) { + if ( $line =~ /^(-|C|R|RW\+?(?:C?D?|D?C?)M?) (.* )?= (.+)/ ) { + my ( $p, $r ) = ( $1, $2 ); + my $u = ''; + for ( split ' ', $3 ) { + $_ = "\@$_" if $_ eq 'CREATOR' or $rc{ROLES}{$_}; + $u .= " $_"; + } + $r ||= ''; + # mind the spaces (or play safe and run cleanup_conf_line again) + push @ret, cleanup_conf_line("$p $r = $u"); + } else { + push @ret, $line; + } + } + return \@ret; +} + +sub skip_block { + my $lines = shift; + + my @out = (); + for (@$lines) { + my $skip = 0; + $skip = 1 if /^= *begin testconf$/; + $skip = 1 if /^= *begin template-data$/; + # add code for other types of blocks here as needed + + next if $skip .. /^= *end$/; + push @out, $_; + } + + return \@out; +} + +1; + diff --git a/src/lib/Gitolite/Easy.pm b/src/lib/Gitolite/Easy.pm new file mode 100644 index 0000000..8f530f2 --- /dev/null +++ b/src/lib/Gitolite/Easy.pm @@ -0,0 +1,240 @@ +package Gitolite::Easy; + +# easy access to gitolite from external perl programs +# ---------------------------------------------------------------------- +# most/all functions in this module test $ENV{GL_USER}'s rights and +# permissions so it needs to be set. + +# "use"-ing this module +# ---------------------------------------------------------------------- +# Using this module from within a gitolite trigger or command is easy; you +# just need 'use lib $ENV{GL_LIBDIR};' before the 'use Gitolite::Easy;'. +# +# Using it from something completely outside gitolite requires a bit more +# work. First, run 'gitolite query-rc -a' to find the correct values for +# GL_BINDIR and GL_LIBDIR in your installation. Then use this code in your +# external program, using the paths you just found: +# +# BEGIN { +# $ENV{HOME} = "/home/git"; # or whatever is the hosting user's $HOME +# $ENV{GL_BINDIR} = "/full/path/to/gitolite/src"; +# $ENV{GL_LIBDIR} = "/full/path/to/gitolite/src/lib"; +# } +# use lib $ENV{GL_LIBDIR}; +# use Gitolite::Easy; + +# API documentation +# ---------------------------------------------------------------------- +# documentation for each function is at the top of the function. +# Documentation is NOT in pod format; just read the source with a nice syntax +# coloring text editor and you'll be happy enough. (I do not like POD; please +# don't send me patches for this aspect of the module). + +#<<< +@EXPORT = qw( + is_admin + is_super_admin + in_group + in_role + + owns + can_read + can_write + + config + + textfile + + %rc + say + say2 + _die + _warn + _print + usage + + option +); +#>>> +use Exporter 'import'; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +my $user; + +# ---------------------------------------------------------------------- + +# is_admin() + +# return true if $ENV{GL_USER} is set and has W perms to the admin repo + +# shell equivalent +# if gitolite access -q gitolite-admin $GL_USER W; then ... + +sub is_admin { + valid_user(); + return not( access( 'gitolite-admin', $user, 'W', 'any' ) =~ /DENIED/ ); +} + +# is_super_admin() + +# (useful only if you are using delegation) + +# return true if $ENV{GL_USER} is set and has W perms to any file in the admin +# repo + +# shell equivalent +# if gitolite access -q gitolite-admin $GL_USER W VREF/NAME/; then ... +sub is_super_admin { + valid_user(); + return not( access( 'gitolite-admin', $user, 'W', 'VREF/NAME/' ) =~ /DENIED/ ); +} + +# in_group() + +# return true if $ENV{GL_USER} is set and is in the given group + +# shell equivalent +# if gitolite list-memberships $GL_USER | grep -x $GROUPNAME >/dev/null; then ... +sub in_group { + valid_user(); + my $g = shift; + $g =~ s/^\@?/@/; + + return grep { $_ eq $g } @{ Gitolite::Conf::Load::list_memberships( '-u', $user ) }; +} + +# in_role() + +# return true if $ENV{GL_USER} is set and has the given role for the given repo + +# shell equivalent +# if gitolite list-memberships -u $GL_USER -r $GL_REPO | grep -x $ROLENAME >/dev/null; then ... +sub in_role { + valid_user(); + my $r = shift; + $r =~ s/^\@?/@/; + my $repo = shift; + + return grep { $_ eq $r } @{ Gitolite::Conf::Load::list_memberships( "-u", $user, "-r", $repo ) }; +} + +# owns() + +# return true if $ENV{GL_USER} is set and is an OWNER of the given repo. + +# shell equivalent (assuming GL_USER is set) +# if gitolite owns $REPONAME; then ... +sub owns { + valid_user(); + my $r = shift; + + # prevent unnecessary disclosure of repo existence info + return 0 if repo_missing($r); + + return ( creator($r) eq $user or $rc{OWNER_ROLENAME} and in_role( $rc{OWNER_ROLENAME}, $r ) ); +} + +# can_read() +# return true if $ENV{GL_USER} is set and can read the given repo + +# shell equivalent +# if gitolite access -q $REPONAME $GL_USER R; then ... +sub can_read { + valid_user(); + my $r = shift; + return not( access( $r, $user, 'R', 'any' ) =~ /DENIED/ ); +} + +# can_write() +# return true if $ENV{GL_USER} is set and can write to the given repo. +# Optional second argument can be '+' to check that instead of 'W'. Optional +# third argument can be a full ref name instead of 'any'. + +# shell equivalent +# if gitolite access -q $REPONAME $GL_USER W; then ... +sub can_write { + valid_user(); + my ( $r, $aa, $ref ) = @_; + $aa ||= 'W'; + $ref ||= 'any'; + return not( access( $r, $user, $aa, $ref ) =~ /DENIED/ ); +} + +# config() +# given a repo and a key, return a hash containing all the git config +# variables for that repo where the section+key match the regex. If none are +# found, return an empty hash. If you don't want it as a regex, use \Q +# appropriately + +# shell equivalent +# foo=$(gitolite git-config -r $REPONAME foo\\.bar) +sub config { + my $repo = shift; + my $key = shift; + + return () if repo_missing($repo); + + my $ret = git_config( $repo, $key ); + return %$ret; +} + +# ---------------------------------------------------------------------- + +# maintain a textfile; see comments in code for details, and calls in various +# other programs (like 'motd', 'desc', and 'readme') for how to call +sub textfile { + my %h = @_; + my $repodir; + + # target file + _die "need file" unless $h{file}; + _die "'$h{file}' contains a '/'" if $h{file} =~ m(/); + Gitolite::Conf::Load::sanity($h{file}, $REPONAME_PATT); + + # target file's location. This can come from one of two places: dir + # (which comes from our code, so does not need to be sanitised), or repo, + # which may come from the user + _die "need exactly one of repo or dir" unless $h{repo} xor $h{dir}; + _die "'$h{dir}' does not exist" if $h{dir} and not -d $h{dir}; + if ($h{repo}) { + Gitolite::Conf::Load::sanity($h{repo}, $REPONAME_PATT); + $h{dir} = "$rc{GL_REPO_BASE}/$h{repo}.git"; + _die "repo '$h{repo}' does not exist" if not -d $h{dir}; + + my $umask = option( $h{repo}, 'umask' ); + # note: using option() moves us to ADMIN_BASE, but we don't care here + umask oct($umask) if $umask; + } + + # final full file name + my $f = "$h{dir}/$h{file}"; + + # operation + _die "can't have both prompt and text" if defined $h{prompt} and defined $h{text}; + if (defined $h{prompt}) { + print STDERR $h{prompt}; + my $t = join( "", <> ); + _print($f, $t); + } elsif (defined $h{text}) { + _print($f, $h{text}); + } else { + return slurp($f) if -f $f; + } + + return ''; +} + +# ---------------------------------------------------------------------- + +sub valid_user { + _die "GL_USER not set" unless exists $ENV{GL_USER}; + $user = $ENV{GL_USER}; +} + +1; diff --git a/src/lib/Gitolite/Hooks/PostUpdate.pm b/src/lib/Gitolite/Hooks/PostUpdate.pm new file mode 100644 index 0000000..a76d1d9 --- /dev/null +++ b/src/lib/Gitolite/Hooks/PostUpdate.pm @@ -0,0 +1,75 @@ +package Gitolite::Hooks::PostUpdate; + +# everything to do with the post-update hook +# ---------------------------------------------------------------------- + +@EXPORT = qw( + post_update + post_update_hook +); + +use Exporter 'import'; + +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +sub post_update { + trace( 3, 'post-up', @ARGV ); + exit 0 unless grep( m(^refs/heads/master$), @ARGV ); + # this is the *real* post_update hook for gitolite + + tsh_try("git ls-tree --name-only master"); + _die "no files/dirs called 'hooks' or 'logs' are allowed" if tsh_text() =~ /^(hooks|logs)$/m; + + my $hooks_changed = 0; + { + local $ENV{GIT_WORK_TREE} = $rc{GL_ADMIN_BASE}; + + tsh_try("git diff --name-only master"); + $hooks_changed++ if tsh_text() =~ m(/hooks/common/); + # the leading slash ensure that this hooks/common directory is below + # some top level directory, not *at* the top. That's LOCAL_CODE, and + # it's actual name could be anything but it doesn't matter to us. + + tsh_try("git checkout -f --quiet master"); + } + _system("gitolite compile"); + _system("gitolite setup --hooks-only") if $hooks_changed; + _system("gitolite trigger POST_COMPILE"); + + exit 0; +} + +{ + my $text = ''; + + sub post_update_hook { + if ( not $text ) { + local $/ = undef; + $text = <DATA>; + } + return $text; + } +} + +1; + +__DATA__ +#!/usr/bin/perl + +use strict; +use warnings; + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Hooks::PostUpdate; + +# gitolite post-update hook (only for the admin repo) +# ---------------------------------------------------------------------- + +post_update(); # is not expected to return +exit 1; # so if it does, something is wrong diff --git a/src/lib/Gitolite/Hooks/Update.pm b/src/lib/Gitolite/Hooks/Update.pm new file mode 100644 index 0000000..2bc43a8 --- /dev/null +++ b/src/lib/Gitolite/Hooks/Update.pm @@ -0,0 +1,172 @@ +package Gitolite::Hooks::Update; + +# everything to do with the update hook +# ---------------------------------------------------------------------- + +@EXPORT = qw( + update + update_hook +); + +use Exporter 'import'; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +$|++; + +# ---------------------------------------------------------------------- + +sub update { + # this is the *real* update hook for gitolite + + bypass() if $ENV{GL_BYPASS_ACCESS_CHECKS}; + + my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = args(@ARGV); + + trace( 2, $ENV{GL_REPO}, $ENV{GL_USER}, $aa, @ARGV ); + + my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref ); + trigger( 'ACCESS_2', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref, $ret, $oldsha, $newsha ); + _die $ret if $ret =~ /DENIED/; + + check_vrefs( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ); + + gl_log( 'update', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, @ARGV, $ret ); + exit 0; +} + +sub bypass { + require Cwd; + Cwd->import; + gl_log( 'update', getcwd(), '(' . ( $ENV{USER} || '?' ) . ')', 'bypass', @ARGV ); + exit 0; +} + +sub check_vrefs { + my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = @_; + my $name_seen = 0; + my $n_vrefs = 0; + for my $vref ( vrefs( $ENV{GL_REPO}, $ENV{GL_USER} ) ) { + $n_vrefs++; + if ( $vref =~ m(^VREF/NAME/) ) { + # this one is special; we process it right here, and only once + next if $name_seen++; + + for my $ref ( map { chomp; s(^)(VREF/NAME/); $_; } `git diff --name-only $oldtree $newtree` ) { + check_vref( $aa, $ref ); + } + } else { + my ( $dummy, $pgm, @args ) = split '/', $vref; + $pgm = _which( "VREF/$pgm", 'x' ); + $pgm or _die "'$vref': helper program missing or unexecutable"; + + open( my $fh, "-|", $pgm, @_, $vref, @args ) or _die "'$vref': can't spawn helper program: $!"; + while (<$fh>) { + # print non-vref lines and skip processing (for example, + # normal STDOUT by a normal update hook) + unless (m(^VREF/)) { + print; + next; + } + my ( $ref, $deny_message ) = split( ' ', $_, 2 ); + check_vref( $aa, $ref, $deny_message ); + } + close($fh) or _die $! + ? "Error closing sort pipe: $!" + : "$vref: helper program exit status $?"; + } + } + return $n_vrefs; +} + +sub check_vref { + my ( $aa, $ref, $deny_message ) = @_; + + my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref ); + trace( 2, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref)", "-> $ret" ); + if ( $ret =~ /by fallthru/ ) { + trace( 3, "remember, fallthru is success here!" ); + return; + } + trigger( 'ACCESS_2', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref, $ret ); + _die "$ret" . ( $deny_message ? "\n$deny_message" : '' ) if $ret =~ /DENIED/; +} + +{ + my $text = ''; + + sub update_hook { + if ( not $text ) { + local $/ = undef; + $text = <DATA>; + } + return $text; + } +} + +# ---------------------------------------------------------------------- + +sub args { + my ( $ref, $oldsha, $newsha ) = @_; + my ( $oldtree, $newtree, $aa ); + + # this is special to git -- the hash of an empty tree + my $empty = '4b825dc642cb6eb9a060e54bf8d69288fbee4904'; + $oldtree = $oldsha eq '0' x 40 ? $empty : $oldsha; + $newtree = $newsha eq '0' x 40 ? $empty : $newsha; + + my $merge_base = '0' x 40; + # for branch create or delete, merge_base stays at '0'x40 + chomp( $merge_base = `git merge-base $oldsha $newsha` ) + unless $oldsha eq '0' x 40 + or $newsha eq '0' x 40; + + $aa = 'W'; + # tag rewrite + $aa = '+' if $ref =~ m(refs/tags/) and $oldsha ne ( '0' x 40 ); + # non-ff push to ref (including ref delete) + $aa = '+' if $oldsha ne $merge_base; + + $aa = 'D' if ( option( $ENV{GL_REPO}, 'DELETE_IS_D' ) ) and $newsha eq '0' x 40; + $aa = 'C' if ( option( $ENV{GL_REPO}, 'CREATE_IS_C' ) ) and $oldsha eq '0' x 40; + + # and now "M" commits. All the other accesses (W, +, C, D) were mutually + # exclusive in some sense. Sure a W could be a C or a + could be a D but + # that's by design. A merge commit, however, could still be any of the + # others (except a "D"). + + # so we have to *append* 'M' to $aa (if the repo has MERGE_CHECK in + # effect and this push contains a merge inside) + + if ( option( $ENV{GL_REPO}, 'MERGE_CHECK' ) ) { + if ( $oldsha eq '0' x 40 or $newsha eq '0' x 40 ) { + _warn "ref create/delete ignored for purposes of merge-check\n"; + } else { + $aa .= 'M' if `git rev-list -n 1 --merges $oldsha..$newsha` =~ /./; + } + } + + return ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ); +} + +1; + +__DATA__ +#!/usr/bin/perl + +use strict; +use warnings; + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Hooks::Update; + +# gitolite update hook +# ---------------------------------------------------------------------- + +update(); # is not expected to return +exit 1; # so if it does, something is wrong diff --git a/src/lib/Gitolite/Rc.pm b/src/lib/Gitolite/Rc.pm new file mode 100644 index 0000000..41996fb --- /dev/null +++ b/src/lib/Gitolite/Rc.pm @@ -0,0 +1,688 @@ +package Gitolite::Rc; + +# everything to do with 'rc'. Also defines some 'constants' +# ---------------------------------------------------------------------- + +@EXPORT = qw( + %rc + glrc + query_rc + version + greeting + trigger + _which + + $REMOTE_COMMAND_PATT + $REF_OR_FILENAME_PATT + $REPONAME_PATT + $REPOPATT_PATT + $USERNAME_PATT + $UNSAFE_PATT +); + +use Exporter 'import'; + +use Gitolite::Common; + +# ---------------------------------------------------------------------- + +our %rc; +our $non_core; + +# ---------------------------------------------------------------------- + +# pre-populate some important rc keys +# ---------------------------------------------------------------------- + +$rc{GL_BINDIR} = $ENV{GL_BINDIR}; +$rc{GL_LIBDIR} = $ENV{GL_LIBDIR}; + +# these keys could be overridden by the rc file later +$rc{GL_REPO_BASE} = "$ENV{HOME}/repositories"; +$rc{GL_ADMIN_BASE} = "$ENV{HOME}/.gitolite"; +$rc{LOG_TEMPLATE} = "$ENV{HOME}/.gitolite/logs/gitolite-%y-%m.log"; + +# variables that should probably never be changed but someone will want to, I'll bet... +# ---------------------------------------------------------------------- + +#<<< +$REMOTE_COMMAND_PATT = qr(^[-0-9a-zA-Z._\@/+ :,\%=]*$); +$REF_OR_FILENAME_PATT = qr(^[0-9a-zA-Z][-0-9a-zA-Z._\@/+ :,]*$); +$REPONAME_PATT = qr(^\@?[0-9a-zA-Z][-0-9a-zA-Z._\@/+]*$); +$REPOPATT_PATT = qr(^\@?[[0-9a-zA-Z][-0-9a-zA-Z._\@/+\\^$|()[\]*?{},]*$); +$USERNAME_PATT = qr(^\@?[0-9a-zA-Z][-0-9a-zA-Z._\@+]*$); + +$UNSAFE_PATT = qr([`~#\$\&()|;<>]); +#>>> + +# ---------------------------------------------------------------------- + +# find the rc file and 'do' it +# ---------------------------------------------------------------------- +my $current_data_version = "3.2"; + +my $rc = glrc('filename'); +if ( -r $rc and -s $rc ) { + do $rc or die $@; +} +if ( defined($GL_ADMINDIR) ) { + say2 ""; + say2 "FATAL: '$rc' seems to be for older gitolite; please see\nhttp://gitolite.com/gitolite/migr.html"; + + exit 1; +} + +# let values specified in rc file override our internal ones +# ---------------------------------------------------------------------- +@rc{ keys %RC } = values %RC; + +# expand the non_core list into INPUT, PRE_GIT, etc using 'ENABLE' settings +non_core_expand() if $rc{ENABLE}; + +# add internal triggers +# ---------------------------------------------------------------------- + +# is the server/repo in a writable state (i.e., not down for maintenance etc) +unshift @{ $rc{ACCESS_1} }, 'Writable::access_1'; + +# (testing only) override the rc file silently +# ---------------------------------------------------------------------- +# use an env var that is highly unlikely to appear in real life :) +do $ENV{G3T_RC} if exists $ENV{G3T_RC} and -r $ENV{G3T_RC}; + +# setup some perl/rc/env vars, plus umask +# ---------------------------------------------------------------------- + +umask ( $rc{UMASK} || 0077 ); + +unshift @INC, "$rc{LOCAL_CODE}/lib" if $rc{LOCAL_CODE}; + +$ENV{PATH} = "$ENV{GL_BINDIR}:$ENV{PATH}" unless $ENV{PATH} =~ /^$ENV{GL_BINDIR}:/; + +{ + $rc{GL_TID} = $ENV{GL_TID} ||= $$; + # TID: loosely, transaction ID. The first PID at the entry point passes + # it down to all its children so you can track each access, across all the + # various commands it spawns and actions it generates. + + $rc{GL_LOGFILE} = $ENV{GL_LOGFILE} ||= gen_lfn( $rc{LOG_TEMPLATE} ); +} + +# these two are meant to help externally written commands (see +# src/commands/writable for an example) +$ENV{GL_REPO_BASE} = $rc{GL_REPO_BASE}; +$ENV{GL_ADMIN_BASE} = $rc{GL_ADMIN_BASE}; + +# ---------------------------------------------------------------------- + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +my $glrc_default_text = ''; +{ + local $/ = undef; + $glrc_default_text = <DATA>; +} + +# ---------------------------------------------------------------------- + +sub non_core_expand { + my %enable; + + for my $e ( @{ $rc{ENABLE} } ) { + my ( $name, $arg ) = split ' ', $e, 2; + # store args as the hash value for the name + $enable{$name} = $arg || ''; + + # for now, we pretend everything is a command, because commands + # are the only thing that the non_core list does not contain + $rc{COMMANDS}{$name} = $arg || 1; + } + + # bring in additional non-core specs from the rc file, if given + if ( my $nc2 = $rc{NON_CORE} ) { + for ( $non_core, $nc2 ) { + # beat 'em into shape :) + s/#.*//g; + s/[ \t]+/ /g; s/^ //mg; s/ $//mg; + s/\n+/\n/g; + } + + for ( split "\n", $nc2 ) { + next unless /\S/; + my ( $name, $where, $module, $before, $name2 ) = split ' ', $_; + if ( not $before ) { + $non_core .= "$name $where $module\n"; + next; + } + die if $before ne 'before'; + $non_core =~ s(^(?=$name2 $where( |$)))($name $where $module\n)m; + } + } + + my @data = split "\n", $non_core || ''; + for (@data) { + next if /^\s*(#|$)/; + my ( $name, $where, $module ) = split ' ', $_; + + # if it appears here, it's not a command, so delete it. At the end of + # this loop, what's left in $rc{COMMANDS} will be those names in the + # enable list that do not appear in the non_core list. + delete $rc{COMMANDS}{$name}; + + next unless exists $enable{$name}; + + # module to call is name if specified as "." + $module = $name if $module eq "."; + + # module to call is "name::pre_git" or such if specified as "::" + ( $module = $name ) .= "::" . lc($where) if $module eq '::'; + + # append arguments, if supplied + $module .= " $enable{$name}" if $enable{$name}; + + push @{ $rc{$where} }, $module; + } + + # finally, add in commands that were declared in the non-core list + map { /^(\S+)/; $rc{COMMANDS}{$1} = 1 } @{ $rc{COMMAND} }; +} + +# exported functions +# ---------------------------------------------------------------------- + +sub glrc { + my $cmd = shift; + if ( $cmd eq 'default-filename' ) { + return "$ENV{HOME}/.gitolite.rc"; + } elsif ( $cmd eq 'default-text' ) { + return $glrc_default_text if $glrc_default_text; + _die "rc file default text not set; this should not happen!"; + } elsif ( $cmd eq 'filename' ) { + # where is the rc file? + + # search $HOME first + return "$ENV{HOME}/.gitolite.rc" if -f "$ENV{HOME}/.gitolite.rc"; + + return ''; + } elsif ( $cmd eq 'current-data-version' ) { + return $current_data_version; + } else { + _die "unknown argument to glrc: '$cmd'"; + } +} + +my $all = 0; +my $dump = 0; +my $nonl = 0; +my $quiet = 0; + +sub query_rc { + + my @vars = args(); + + no strict 'refs'; + + if ($all) { + for my $e ( sort keys %rc ) { + print "$e=" . ( defined( $rc{$e} ) ? $rc{$e} : 'undef' ) . "\n"; + } + exit 0; + } + + if ($dump) { + require Data::Dumper; + $Data::Dumper::Sortkeys = 1; + print Data::Dumper::Dumper \%rc; + exit 0; + } + + my $cv = \%rc; # current "value" + while (@vars) { + my $v = shift @vars; + + # dig into the rc hash, using each var as a component + if ( not ref($cv) ) { + _warn "unused arguments..."; + last; + } elsif ( ref($cv) eq 'HASH' ) { + $cv = $cv->{$v} || ''; + } elsif ( ref($cv) eq 'ARRAY' ) { + $cv = $cv->[$v] || ''; + } else { + _die "dont know what to do with " . ref($cv) . " item in the rc file"; + } + } + + # we've run out of arguments so $cv is what we have. If we're supposed to + # be quiet, we don't have to print anything so let's get that done first: + exit( $cv ? 0 : 1 ) if $quiet; # shell truth + + # print values (notice we ignore the '-n' option if it's a ref) + if ( ref($cv) eq 'HASH' ) { + print join( "\n", sort keys %$cv ), "\n" if %$cv; + } elsif ( ref($cv) eq 'ARRAY' ) { + print join( "\n", @$cv ), "\n" if @$cv; + } else { + print $cv . ( $nonl ? '' : "\n" ) if $cv; + } + exit( $cv ? 0 : 1 ); # shell truth +} + +sub version { + my $version = ''; + $version = '(unknown)'; + for ("$ENV{GL_BINDIR}/VERSION") { + $version = slurp($_) if -r $_; + } + chomp($version); + return $version; +} + +sub greeting { + my $json = shift; + + chomp( my $hn = `hostname -s 2>/dev/null || hostname` ); + my $gv = substr( `git --version`, 12 ); + my $gl_user = $ENV{GL_USER} || ''; + $gl_user = " $gl_user" if $gl_user; + + if ($json) { + $json->{GL_USER} = $ENV{GL_USER}; + $json->{USER} = ( $ENV{USER} || "httpd" ) . "\@$hn"; + $json->{gitolite_version} = version(); + chomp( $json->{git_version} = $gv ); # this thing has a newline at the end + return; + } + + # normal output + return "hello$gl_user, this is " . ( $ENV{USER} || "httpd" ) . "\@$hn running gitolite3 " . version() . " on git $gv\n"; +} + +sub trigger { + my $rc_section = shift; + + # if arg-2 (now arg-1, due to the 'shift' above) exists, it is a repo + # name, so setup env from options + require Gitolite::Conf::Load; + Gitolite::Conf::Load->import('env_options'); + env_options( $_[0] ) if $_[0]; + + if ( exists $rc{$rc_section} ) { + if ( ref( $rc{$rc_section} ) ne 'ARRAY' ) { + _die "'$rc_section' section in rc file is not a perl list"; + } else { + for my $s ( @{ $rc{$rc_section} } ) { + my ( $pgm, @args ) = split ' ', $s; + + if ( my ( $module, $sub ) = ( $pgm =~ /^(.*)::(\w+)$/ ) ) { + + require Gitolite::Triggers; + trace( 2, 'trigger module', $module, $sub, @args, $rc_section, @_ ); + Gitolite::Triggers::run( $module, $sub, @args, $rc_section, @_ ); + + } else { + $pgm = _which( "triggers/$pgm", 'x' ); + + _warn("skipped trigger '$s' (not found or not executable)"), next if not $pgm; + trace( 2, 'trigger command', $s ); + _system( $pgm, @args, $rc_section, @_ ); # they better all return with 0 exit codes! + } + } + } + return; + } + trace( 3, "'$rc_section' not found in rc" ); +} + +sub _which { + # looks for a file in LOCAL_CODE or GL_BINDIR. Returns whichever exists + # (LOCAL_CODE preferred if defined) or 0 if not found. + my $file = shift; + my $mode = shift; # could be 'x' or 'r' + + my @files = ("$rc{GL_BINDIR}/$file"); + unshift @files, ("$rc{LOCAL_CODE}/$file") if $rc{LOCAL_CODE}; + + for my $f (@files) { + return $f if -x $f; + return $f if -r $f and $mode eq 'r'; + } + + return 0; +} + +# ---------------------------------------------------------------------- + +=for args +Usage: gitolite query-rc -a + gitolite query-rc -d + gitolite query-rc [-n] [-q] rc-variable + + -a print all variables and values (first level only) + -d dump the entire rc structure + -n do not append a newline if variable is scalar + -q exit code only (shell truth; 0 is success) + +Query the rc hash. Second and subsequent arguments dig deeper into the hash. +The examples are for the default configuration; yours may be different. + +Single values: + gitolite query-rc GL_ADMIN_BASE # prints "/home/git/.gitolite" or similar + gitolite query-rc UMASK # prints "63" (that's 0077 in decimal!) + +Hashes: + gitolite query-rc COMMANDS + # prints "desc", "help", "info", "perms", "writable", one per line + gitolite query-rc COMMANDS help # prints 1 + gitolite query-rc -q COMMANDS help # prints nothing; exit code is 0 + gitolite query-rc COMMANDS fork # prints nothing; exit code is 1 + +Arrays (somewhat less useful): + gitolite query-rc POST_GIT # prints nothing; exit code is 0 + gitolite query-rc POST_COMPILE # prints 4 lines + gitolite query-rc POST_COMPILE 0 # prints the first of those 4 lines + +Explore: + gitolite query-rc -a + # prints all first level variables and values, one per line. Any that are + # listed as HASH or ARRAY can be explored further in subsequent commands. + gitolite query-rc -d # dump the entire rc structure +=cut + +sub args { + my $help = 0; + + require Getopt::Long; + Getopt::Long::GetOptions( + 'all|a' => \$all, + 'dump|d' => \$dump, + 'nonl|n' => \$nonl, + 'quiet|q' => \$quiet, + 'help|h' => \$help, + ) or usage(); + + _die("'-a' cannot be combined with other arguments or options; run with '-h' for usage") if $all and ( @ARGV or $dump or $nonl or $quiet ); + usage() if not $all and not $dump and not @ARGV or $help; + return @ARGV; +} + +# ---------------------------------------------------------------------- + +BEGIN { + $non_core = " + # No user-servicable parts inside. Warranty void if seal broken. Refer + # servicing to authorised service center only. + + continuation-lines SYNTACTIC_SUGAR . + keysubdirs-as-groups SYNTACTIC_SUGAR . + macros SYNTACTIC_SUGAR . + refex-expr SYNTACTIC_SUGAR . + + renice PRE_GIT . + + Kindergarten INPUT :: + + CpuTime INPUT :: + CpuTime POST_GIT :: + + Shell INPUT :: + + Alias INPUT :: + + Motd INPUT :: + Motd PRE_GIT :: + Motd COMMAND motd + + Mirroring INPUT :: + Mirroring PRE_GIT :: + Mirroring POST_GIT :: + + refex-expr ACCESS_2 RefexExpr::access_2 + + expand-deny-messages ACCESS_1 . + expand-deny-messages ACCESS_2 . + + RepoUmask PRE_GIT :: + RepoUmask POST_CREATE :: + + partial-copy PRE_GIT . + + upstream PRE_GIT . + + no-create-on-read PRE_CREATE AutoCreate::deny_R + no-auto-create PRE_CREATE AutoCreate::deny_RW + + ssh-authkeys-split POST_COMPILE post-compile/ssh-authkeys-split + ssh-authkeys POST_COMPILE post-compile/ssh-authkeys + Shell POST_COMPILE post-compile/ssh-authkeys-shell-users + + set-default-roles POST_CREATE . + + git-config POST_COMPILE post-compile/update-git-configs + git-config POST_CREATE post-compile/update-git-configs + + create-with-reference POST_CREATE post-compile/create-with-reference + + gitweb POST_CREATE post-compile/update-gitweb-access-list + gitweb POST_COMPILE post-compile/update-gitweb-access-list + + cgit POST_COMPILE post-compile/update-description-file + + daemon POST_CREATE post-compile/update-git-daemon-access-list + daemon POST_COMPILE post-compile/update-git-daemon-access-list + + repo-specific-hooks POST_COMPILE . + repo-specific-hooks POST_CREATE . +"; +} + +1; + +# ---------------------------------------------------------------------- + +__DATA__ +# configuration variables for gitolite + +# This file is in perl syntax. But you do NOT need to know perl to edit it -- +# just mind the commas, use single quotes unless you know what you're doing, +# and make sure the brackets and braces stay matched up! + +# (Tip: perl allows a comma after the last item in a list also!) + +# HELP for commands can be had by running the command with "-h". + +# HELP for all the other FEATURES can be found in the documentation (look for +# "list of non-core programs shipped with gitolite" in the master index) or +# directly in the corresponding source file. + +%RC = ( + + # ------------------------------------------------------------------ + + # default umask gives you perms of '0700'; see the rc file docs for + # how/why you might change this + UMASK => 0077, + + # look for "git-config" in the documentation + GIT_CONFIG_KEYS => '', + + # comment out if you don't need all the extra detail in the logfile + LOG_EXTRA => 1, + # logging options + # 1. leave this section as is for 'normal' gitolite logging (default) + # 2. uncomment this line to log ONLY to syslog: + # LOG_DEST => 'syslog', + # 3. uncomment this line to log to syslog and the normal gitolite log: + # LOG_DEST => 'syslog,normal', + # 4. prefixing "repo-log," to any of the above will **also** log just the + # update records to "gl-log" in the bare repo directory: + # LOG_DEST => 'repo-log,normal', + # LOG_DEST => 'repo-log,syslog', + # LOG_DEST => 'repo-log,syslog,normal', + # syslog 'facility': defaults to 'local0', uncomment if needed. For example: + # LOG_FACILITY => 'local4', + + # roles. add more roles (like MANAGER, TESTER, ...) here. + # WARNING: if you make changes to this hash, you MUST run 'gitolite + # compile' afterward, and possibly also 'gitolite trigger POST_COMPILE' + ROLES => { + READERS => 1, + WRITERS => 1, + }, + + # enable caching (currently only Redis). PLEASE RTFM BEFORE USING!!! + # CACHE => 'Redis', + + # ------------------------------------------------------------------ + + # rc variables used by various features + + # the 'info' command prints this as additional info, if it is set + # SITE_INFO => 'Please see http://blahblah/gitolite for more help', + + # the CpuTime feature uses these + # display user, system, and elapsed times to user after each git operation + # DISPLAY_CPU_TIME => 1, + # display a warning if total CPU times (u, s, cu, cs) crosses this limit + # CPU_TIME_WARN_LIMIT => 0.1, + + # the Mirroring feature needs this + # HOSTNAME => "foo", + + # TTL for redis cache; PLEASE SEE DOCUMENTATION BEFORE UNCOMMENTING! + # CACHE_TTL => 600, + + # ------------------------------------------------------------------ + + # suggested locations for site-local gitolite code (see cust.html) + + # this one is managed directly on the server + # LOCAL_CODE => "$ENV{HOME}/local", + + # or you can use this, which lets you put everything in a subdirectory + # called "local" in your gitolite-admin repo. For a SECURITY WARNING + # on this, see http://gitolite.com/gitolite/non-core.html#pushcode + # LOCAL_CODE => "$rc{GL_ADMIN_BASE}/local", + + # ------------------------------------------------------------------ + + # List of commands and features to enable + + ENABLE => [ + + # COMMANDS + + # These are the commands enabled by default + 'help', + 'desc', + 'info', + 'perms', + 'writable', + + # Uncomment or add new commands here. + # 'create', + # 'fork', + # 'mirror', + # 'readme', + # 'sskm', + # 'D', + + # These FEATURES are enabled by default. + + # essential (unless you're using smart-http mode) + 'ssh-authkeys', + + # creates git-config entries from gitolite.conf file entries like 'config foo.bar = baz' + 'git-config', + + # creates git-daemon-export-ok files; if you don't use git-daemon, comment this out + 'daemon', + + # creates projects.list file; if you don't use gitweb, comment this out + 'gitweb', + + # These FEATURES are disabled by default; uncomment to enable. If you + # need to add new ones, ask on the mailing list :-) + + # user-visible behaviour + + # prevent wild repos auto-create on fetch/clone + # 'no-create-on-read', + # no auto-create at all (don't forget to enable the 'create' command!) + # 'no-auto-create', + + # access a repo by another (possibly legacy) name + # 'Alias', + + # give some users direct shell access. See documentation in + # sts.html for details on the following two choices. + # "Shell $ENV{HOME}/.gitolite.shell-users", + # 'Shell alice bob', + + # set default roles from lines like 'option default.roles-1 = ...', etc. + # 'set-default-roles', + + # show more detailed messages on deny + # 'expand-deny-messages', + + # show a message of the day + # 'Motd', + + # system admin stuff + + # enable mirroring (don't forget to set the HOSTNAME too!) + # 'Mirroring', + + # allow people to submit pub files with more than one key in them + # 'ssh-authkeys-split', + + # selective read control hack + # 'partial-copy', + + # manage local, gitolite-controlled, copies of read-only upstream repos + # 'upstream', + + # updates 'description' file instead of 'gitweb.description' config item + # 'cgit', + + # allow repo-specific hooks to be added + # 'repo-specific-hooks', + + # performance, logging, monitoring... + + # be nice + # 'renice 10', + + # log CPU times (user, system, cumulative user, cumulative system) + # 'CpuTime', + + # syntactic_sugar for gitolite.conf and included files + + # allow backslash-escaped continuation lines in gitolite.conf + # 'continuation-lines', + + # create implicit user groups from directory names in keydir/ + # 'keysubdirs-as-groups', + + # allow simple line-oriented macros + # 'macros', + + # Kindergarten mode + + # disallow various things that sensible people shouldn't be doing anyway + # 'Kindergarten', + ], + +); + +# ------------------------------------------------------------------------------ +# per perl rules, this should be the last line in such a file: +1; + +# Local variables: +# mode: perl +# End: +# vim: set syn=perl: diff --git a/src/lib/Gitolite/Setup.pm b/src/lib/Gitolite/Setup.pm new file mode 100644 index 0000000..8ad5d34 --- /dev/null +++ b/src/lib/Gitolite/Setup.pm @@ -0,0 +1,175 @@ +package Gitolite::Setup; + +# implements 'gitolite setup' +# ---------------------------------------------------------------------- + +=for args +Usage: gitolite setup [<option>] + +Setup gitolite, compile conf, run the POST_COMPILE trigger (see rc file) and +propagate hooks. + + -a, --admin <name> admin name + -pk, --pubkey <file> pubkey file name + -ho, --hooks-only skip other steps and just propagate hooks + -m, --message set setup commit message + +First run: either the pubkey or the admin name is *required*, depending on +whether you're using ssh mode or http mode. + +Subsequent runs: + + - Without options, 'gitolite setup' is a general "fix up everything" command + (for example, if you brought in repos from outside, or someone messed + around with the hooks, or you made an rc file change that affects access + rules, etc.) + + - '-pk' can be used to replace the admin key; useful if you lost the admin's + private key but do have shell access to the server. + + - '-ho' is mainly for scripting use. Do not combine with other options. + + - '-a' is ignored + + - '-m' can be used to replace default commit message "gitolite setup $argv" + with a custom message (e.g. "Setting up your repository mgmt"). + +=cut + +# ---------------------------------------------------------------------- + +@EXPORT = qw( + setup +); + +use Exporter 'import'; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Store; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +sub setup { + my ( $admin, $pubkey, $h_only, $message ) = args(); + + unless ($h_only) { + setup_glrc(); + setup_gladmin( $admin, $pubkey, $message ); + + _system("gitolite compile"); + _system("gitolite trigger POST_COMPILE"); + } + + hook_repos(); # all of them, just to be sure +} + +# ---------------------------------------------------------------------- + +sub args { + my $admin = ''; + my $pubkey = ''; + my $message = ''; + my $h_only = 0; + my $help = 0; + my $argv = join( " ", @ARGV ); + + require Getopt::Long; + Getopt::Long::GetOptions( + 'admin|a=s' => \$admin, + 'pubkey|pk=s' => \$pubkey, + 'message|m=s' => \$message, + 'hooks-only|ho' => \$h_only, + 'help|h' => \$help, + ) or usage(); + + usage() if $help or ( $pubkey and $admin ); + usage() if $h_only and ( $admin or $pubkey ); + + if ($pubkey) { + $pubkey =~ /\.pub$/ or _die "'$pubkey' name does not end in .pub"; + tsh_try("cat $pubkey") or _die "'$pubkey' not a readable file"; + tsh_lines() == 1 or _die "'$pubkey' must have exactly one line"; + tsh_try("ssh-keygen -l -f $pubkey") or _die "'$pubkey' does not seem to be a valid ssh pubkey file"; + + $admin = $pubkey; + # next 2 lines duplicated from args() in ssh-authkeys + $admin =~ s(.*/)(); # foo/bar/baz.pub -> baz.pub + $admin =~ s/(\@[^.]+)?\.pub$//; # baz.pub, baz@home.pub -> baz + $pubkey =~ /\@/ and print STDERR "NOTE: the admin username is '$admin'\n"; + + } + + return ( $admin || '', $pubkey || '', $h_only || 0, $message || "gitolite setup $argv"); +} + +sub setup_glrc { + _print( glrc('default-filename'), glrc('default-text') ) if not glrc('filename'); +} + +sub setup_gladmin { + my ( $admin, $pubkey, $message ) = @_; + _die "'-pk' or '-a' required; see 'gitolite setup -h' for more" + if not $admin and not -f "$rc{GL_ADMIN_BASE}/conf/gitolite.conf"; + + # reminder: 'admin files' are in ~/.gitolite, 'admin repo' is + # $rc{GL_REPO_BASE}/gitolite-admin.git + + # grab the pubkey content before we chdir() away + my $pubkey_content = ''; + $pubkey_content = slurp($pubkey) if $pubkey; + + # set up the admin files in admin-base + + _mkdir( $rc{GL_ADMIN_BASE} ); + _chdir( $rc{GL_ADMIN_BASE} ); + + _mkdir("conf"); + _mkdir("logs"); + my $conf; + { + local $/ = undef; + $conf = <DATA>; + } + $conf =~ s/%ADMIN/$admin/g; + + _print( "conf/gitolite.conf", $conf ) if not -f "conf/gitolite.conf"; + + if ($pubkey) { + _mkdir("keydir"); + _print( "keydir/$admin.pub", $pubkey_content ); + } + + # set up the admin repo in repo-base + + _chdir(); + _mkdir( $rc{GL_REPO_BASE} ); + _chdir( $rc{GL_REPO_BASE} ); + + new_repo("gitolite-admin") if not -d "gitolite-admin.git"; + + # commit the admin files to the admin repo + + $ENV{GIT_WORK_TREE} = $rc{GL_ADMIN_BASE}; + _chdir("$rc{GL_REPO_BASE}/gitolite-admin.git"); + _system("git add conf/gitolite.conf"); + _system("git add keydir") if $pubkey; + tsh_try("git config --get user.email") or tsh_run( "git config user.email $ENV{USER}\@" . `hostname` ); + tsh_try("git config --get user.name") or tsh_run( "git config user.name '$ENV{USER} on '" . `hostname` ); + tsh_try("git diff --cached --quiet") + or tsh_try("git commit -am '$message'") + or _die "setup failed to commit to the admin repo"; + delete $ENV{GIT_WORK_TREE}; +} + +1; + +__DATA__ +repo gitolite-admin + RW+ = %ADMIN + +repo testing + RW+ = @all diff --git a/src/lib/Gitolite/Test.pm b/src/lib/Gitolite/Test.pm new file mode 100644 index 0000000..904abbf --- /dev/null +++ b/src/lib/Gitolite/Test.pm @@ -0,0 +1,122 @@ +package Gitolite::Test; + +# functions for the test code to use +# ---------------------------------------------------------------------- + +#<<< +@EXPORT = qw( + try + put + text + lines + dump + confreset + confadd + cmp + md5sum +); +#>>> +use Exporter 'import'; +use File::Path qw(mkpath); +use Carp qw(carp cluck croak confess); +use Digest::MD5 qw(md5_hex); + +use Gitolite::Common; + +BEGIN { + require Gitolite::Test::Tsh; + *{'try'} = \&Tsh::try; + *{'put'} = \&Tsh::put; + *{'text'} = \&Tsh::text; + *{'lines'} = \&Tsh::lines; + *{'cmp'} = \&Tsh::cmp; +} + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +# make sure the user is ready for it +if ( not $ENV{GITOLITE_TEST} or $ENV{GITOLITE_TEST} ne 'y' ) { + print "Bail out! See t/README for information on how to run the tests.\n"; + exit 255; +} + +# required preamble for all tests +try " + DEF gsh = /TRACE: gsh.SOC=/ + DEF reject = /hook declined to update/; /remote rejected.*hook declined/; /error: failed to push some refs to/ + + DEF AP_1 = cd ../gitolite-admin; ok or die cant find admin repo clone; + DEF AP_2 = AP_1; git add conf ; ok; git commit -m %1; ok; /master.* %1/ + DEF ADMIN_PUSH = AP_2 %1; glt push admin origin; ok; gsh; /master -> master/ + + DEF CS_1 = pwd; //tmp/tsh_tempdir.*gitolite-admin/; git remote -v; ok; /file:///gitolite-admin/ + DEF CHECK_SETUP = CS_1; git log; ok; /fa7564c1b903ea3dce49314753f25b34b9e0cea0/ + + DEF CLONE = glt clone %1 file:///%2 + DEF PUSH = glt push %1 origin + + # clean install + mkdir -p $ENV{HOME}/bin + ln -sf $ENV{PWD}/t/glt ~/bin + ./install -ln + cd; rm -vrf .gito* repositories + git config --file $ENV{HOME}/.gitconfig.local user.name \"gitolite tester\" + git config --file $ENV{HOME}/.gitconfig.local user.email \"tester\@example.com\" + git config --global include.path \"~/.gitconfig.local\" + + # setup + gitolite setup -a admin + + # clone admin repo + cd tsh_tempdir + glt clone admin --progress file:///gitolite-admin + cd gitolite-admin +" or die "could not setup the test environment; errors:\n\n" . text() . "\n\n"; + +sub dump { + use Data::Dumper; + for my $i (@_) { + print STDERR "DBG: " . Dumper($i); + } +} + +sub _confargs { + return @_ if ( $_[1] ); + return 'gitolite.conf', $_[0]; +} + +sub confreset { + chdir("../gitolite-admin") or die "in `pwd`, could not cd ../g-a"; + system( "rm", "-rf", "conf" ); + mkdir("conf"); + system("mv ~/repositories/gitolite-admin.git ~/repositories/.ga"); + system("mv ~/repositories/testing.git ~/repositories/.te"); + system("find ~/repositories -name '*.git' |xargs rm -rf"); + system("mv ~/repositories/.ga ~/repositories/gitolite-admin.git"); + system("mv ~/repositories/.te ~/repositories/testing.git "); + put "|cut -c9- > conf/gitolite.conf", ' + repo gitolite-admin + RW+ = admin + repo testing + RW+ = @all +'; +} + +sub confadd { + chdir("../gitolite-admin") or die "in `pwd`, could not cd ../g-a"; + my ( $file, $string ) = _confargs(@_); + put "|cat >> conf/$file", $string; +} + +sub md5sum { + my $out = ''; + for my $file (@_) { + $out .= md5_hex( slurp($file) ) . " $file\n"; + } + return $out; +} + +1; diff --git a/src/lib/Gitolite/Test/Tsh.pm b/src/lib/Gitolite/Test/Tsh.pm new file mode 100644 index 0000000..6861960 --- /dev/null +++ b/src/lib/Gitolite/Test/Tsh.pm @@ -0,0 +1,645 @@ +#!/usr/bin/perl +use 5.10.0; + +# Tsh -- non interactive Testing SHell in perl + +# TODO items: +# - allow an RC file to be used to add basic and extended commands +# - convert internal defaults to additions to the RC file +# - implement shell commands as you go +# - solve the "pass/fail" inconsistency between shell and perl +# - solve the pipes problem (use 'overload'?) + +# ---------------------------------------------------------------------- +# modules + +package Tsh; + +use Exporter 'import'; +@EXPORT = qw( + try run cmp AUTOLOAD + rc error_count text lines error_list put + cd tsh_tempdir + + $HOME $PWD $USER +); +@EXPORT_OK = qw(); + +use Env qw(@PATH HOME PWD USER TSH_VERBOSE); +# other candidates: +# GL_ADMINDIR GL_BINDIR GL_RC GL_REPO_BASE_ABS GL_REPO GL_USER + +use strict; +use warnings; + +use Text::Tabs; # only used for formatting the usage() message +use Text::ParseWords; + +use File::Temp qw(tempdir); +END { chdir( $ENV{HOME} ); } +# we need this END handler *after* the 'use File::Temp' above. Without +# this, if $PWD at exit was $tempdir, you get errors like "cannot remove +# path when cwd is [...] at /usr/share/perl5/File/Temp.pm line 902". + +use Data::Dumper; + +# ---------------------------------------------------------------------- +# globals + +my $rc; # return code from backticked (external) programs +my $text; # STDOUT+STDERR of backticked (external) programs +my $lec; # the last external command (the rc and text are from this) +my $cmd; # the current command + +my $testnum; # current test number, for info in TAP output +my $testname; # current test name, for error info to user +my $line; # current line number and text + +my $err_count; # count of test failures +my @errors_in; # list of testnames that errored + +my $tick; # timestamp for git commits + +my %autoloaded; +my $tempdir = ''; + +# ---------------------------------------------------------------------- +# setup + +# unbuffer STDOUT and STDERR +select(STDERR); $|++; +select(STDOUT); $|++; + +# set the timestamp (needed only under harness) +test_tick() if $ENV{HARNESS_ACTIVE}; + +# ---------------------------------------------------------------------- +# this is for one-liner access from outside, using @ARGV, as in: +# perl -MTsh -e 'tsh()' 'tsh command list' +# or via STDIN +# perl -MTsh -e 'tsh()' < file-containing-tsh-commands +# NOTE: it **exits**! + +sub tsh { + my @lines; + + if (@ARGV) { + # simple, single argument which is a readable filename + if ( @ARGV == 1 and $ARGV[0] !~ /\s/ and -r $ARGV[0] ) { + # take the contents of the file + @lines = <>; + } else { + # more than one argument *or* not readable filename + # just take the arguments themselves as the command list + @lines = @ARGV; + @ARGV = (); + } + } else { + # no arguments given, take STDIN + usage() if -t; + @lines = <>; + } + + # and process them + try(@lines); + + # print error summary by default + if ( not defined $TSH_VERBOSE ) { + say STDERR "$err_count error(s)" if $err_count; + } + + exit $err_count; +} + +# these two get called with series of tsh commands, while the autoload, +# (later) handles single commands + +sub try { + $line = $rc = $err_count = 0; + @errors_in = (); + + # break up multiline arguments into separate lines + my @lines = map { split /\n/ } @_; + + # and process them + rc_lines(@lines); + + # bump err_count if the last command had a non-0 rc (that was apparently not checked). + $err_count++ if $rc; + + # finish up... + dbg( 1, "$err_count error(s)" ) if $err_count; + return ( not $err_count ); +} + +# run() differs from try() in that +# - uses open(), not backticks +# - takes only one command, not tsh-things like ok, /patt/ etc +# - - if you pass it an array it uses the list form! + +sub run { + open( my $fh, "-|", @_ ) or die "tell sitaram $!"; + local $/ = undef; $text = <$fh>; + close $fh; warn "tell sitaram $!" if $!; + $rc = ( $? >> 8 ); + return $text; +} + +sub put { + my ( $file, $data ) = @_; + die "probable quoting error in arguments to put: $file\n" if $file =~ /^\s*['"]/; + my $mode = ">"; + $mode = "|-" if $file =~ s/^\s*\|\s*//; + + $rc = 0; + my $fh; + open( $fh, $mode, $file ) + and print $fh $data + and close $fh + and return 1; + + $rc = 1; + dbg( 1, "put $file: $!" ); + return ''; +} + +# ---------------------------------------------------------------------- +# TODO: AUTOLOAD and exportable convenience subs for common shell commands + +sub cd { + my $dir = shift || ''; + _cd($dir); + dbg( 1, "cd $dir: $!" ) if $rc; + return ( not $rc ); +} + +# this is classic AUTOLOAD, almost from the perlsub manpage. Although, if +# instead of `ls('bin');` you want to be able to say `ls 'bin';` you will need +# to predeclare ls, with `sub ls;`. +sub AUTOLOAD { + my $program = $Tsh::AUTOLOAD; + dbg( 4, "program = $program, arg=$_[0]" ); + $program =~ s/.*:://; + $autoloaded{$program}++; + + die "tsh's autoload support expects only one arg\n" if @_ > 1; + _sh("$program $_[0]"); + return ( not $rc ); # perl truth +} + +# ---------------------------------------------------------------------- +# exportable service subs + +sub rc { + return $rc || 0; +} + +sub text { + return $text || ''; +} + +sub lines { + return split /\n/, $text; +} + +sub error_count { + return $err_count; +} + +sub error_list { + return ( + wantarray + ? @errors_in + : join( "\n", @errors_in ) + ); +} + +sub tsh_tempdir { + # create tempdir if not already done + $tempdir = tempdir( "tsh_tempdir.XXXXXXXXXX", TMPDIR => 1, CLEANUP => 1 ) unless $tempdir; + # XXX TODO that 'UNLINK' doesn't work for Ctrl_C + + return $tempdir; +} + +# ---------------------------------------------------------------------- +# internal (non-exportable) service subs + +sub print_plan { + return unless $ENV{HARNESS_ACTIVE}; + local $_ = shift; + say "1..$_"; +} + +sub rc_lines { + my @lines = @_; + + while (@lines) { + local $_ = shift @lines; + chomp; $_ = trim_ws($_); + + no warnings; + $line++; + use warnings; + + # this also sets $testname + next if is_comment_or_empty($_); + + dbg( 2, "L: $_" ); + $line .= ": $_"; # save line for printing with 'FAIL:' + + # a DEF has to be on a line by itself + if (/^DEF\s+([-.\w]+)\s*=\s*(\S.*)$/) { + def( $1, $2 ); + next; + } + + my @cmds = cmds($_); + + # process each command + # (note: some of the commands may put stuff back into @lines) + while (@cmds) { + # this needs to be the 'global' one, since fail() prints it + $cmd = shift @cmds; + + # is the current command a "testing" command? + my $testing_cmd = ( + $cmd =~ m(^ok(?:\s+or\s+(.*))?$) + or $cmd =~ m(^!ok(?:\s+or\s+(.*))?$) + or $cmd =~ m(^/(.*?)/(?:\s+or\s+(.*))?$) + or $cmd =~ m(^!/(.*?)/(?:\s+or\s+(.*))?$) + ); + + # warn if the previous command failed but rc is not being checked + if ( $rc and not $testing_cmd ) { + dbg( 1, "rc: $rc from cmd prior to '$cmd'\n" ); + # count this as a failure, for exit status purposes + $err_count++; + # and reset the rc, otherwise for example 'ls foo; tt; tt; tt' + # will tell you there are 3 errors! + $rc = 0; + push @errors_in, $testname if $testname; + } + + # prepare to run the command + dbg( 3, "C: $cmd" ); + if ( def($cmd) ) { + # expand macro and replace head of @cmds (unshift) + dbg( 2, "DEF: $cmd" ); + unshift @cmds, cmds( def($cmd) ); + } else { + parse($cmd); + } + # reset rc if checking is done + $rc = 0 if $testing_cmd; + # assumes you will (a) never have *both* 'ok' and '!ok' after + # an action command, and (b) one of them will come immediately + # after the action command, with /patt/ only after it. + } + } +} + +sub def { + my ( $cmd, $list ) = @_; + state %def; + %def = read_rc_file() unless %def; + + if ($list) { + # set mode + die "attempt to redefine macro $cmd\n" if $def{$cmd}; + $def{$cmd} = $list; + return; + } + + # get mode: split the $cmd at spaces, see if there is a definition + # available, substitute any %1, %2, etc., in it and send it back + my ( $c, @d ) = shellwords($cmd); + my $e; # the expanded value + if ( $e = $def{$c} ) { # starting value + for my $i ( 1 .. 9 ) { + last unless $e =~ /%$i/; # no more %N's (we assume sanity) + die "$def{$c} requires more arguments\n" unless @d; + my $f = shift @d; # get the next datum + $e =~ s/%$i/$f/g; # and substitute %N all over + } + return join( " ", $e, @d ); # join up any remaining data + } + return ''; +} + +sub _cd { + my $dir = shift || $HOME; + # a directory name of 'tsh_tempdir' is special + $dir = tsh_tempdir() if $dir eq 'tsh_tempdir'; + $rc = 0; + chdir($dir) or $rc = 1; +} + +sub _sh { + my $cmd = shift; + # TODO: switch to IPC::Open3 or something...? + + dbg( 4, " running: ( $cmd ) 2>&1" ); + $text = `( $cmd ) 2>&1; /bin/echo -n RC=\$?`; + $lec = $cmd; + dbg( 4, " results:\n$text" ); + + if ( $text =~ /RC=(\d+)$/ ) { + $rc = $1; + $text =~ s/RC=\d+$//; + } else { + die "couldnt find RC= in result; this should not happen:\n$text\n\n...\n"; + } +} + +sub _perl { + my $perl = shift; + local $_; + $_ = $text; + + dbg( 4, " eval: $perl" ); + my $evrc = eval $perl; + + if ($@) { + $rc = 1; # shell truth + dbg( 1, $@ ); + # leave $text unchanged + } else { + $rc = not $evrc; + # $rc is always shell truth, so we need to cover the case where + # there was no error but it still returned a perl false + $text = $_; + } + dbg( 4, " eval-rc=$evrc, results:\n$text" ); +} + +sub parse { + my $cmd = shift; + + if ( $cmd =~ /^sh (.*)/ ) { + + _sh($1); + + } elsif ( $cmd =~ /^perl (.*)/ ) { + + _perl($1); + + } elsif ( $cmd eq 'tt' or $cmd eq 'test-tick' ) { + + test_tick(); + + } elsif ( $cmd =~ /^plan ?(\d+)$/ ) { + + print_plan($1); + + } elsif ( $cmd =~ /^cd ?(\S*)$/ ) { + + _cd($1); + + } elsif ( $cmd =~ /^ENV (\w+)=['"]?(.+?)['"]?$/ ) { + + $ENV{$1} = $2; + + } elsif ( $cmd =~ /^(?:tc|test-commit)\s+(\S.*)$/ ) { + + # this is the only "git special" really; the default expansions are + # just that -- defaults. But this one is hardwired! + dummy_commits($1); + + } elsif ( $cmd =~ '^put(?:\s+(\S.*))?$' ) { + + if ($1) { + put( $1, $text ); + } else { + print $text if defined $text; + } + + } elsif ( $cmd =~ m(^ok(?:\s+or\s+(.*))?$) ) { + + $rc ? fail( "ok, rc=$rc from $lec", $1 || '' ) : ok(); + + } elsif ( $cmd =~ m(^!ok(?:\s+or\s+(.*))?$) ) { + + $rc ? ok() : fail( "!ok, rc=0 from $lec", $1 || '' ); + + } elsif ( $cmd =~ m(^/(.*?)/(?:\s+or\s+(.*))?$) ) { + + expect( $1, $2 ); + + } elsif ( $cmd =~ m(^!/(.*?)/(?:\s+or\s+(.*))?$) ) { + + not_expect( $1, $2 ); + + } else { + + _sh($cmd); + + } +} + +# currently unused +sub executable { + my $cmd = shift; + # path supplied + $cmd =~ m(/) and -x $cmd and return 1; + # barename; look up in $PATH + for my $p (@PATH) { + -x "$p/$cmd" and return 1; + } + return 0; +} + +sub ok { + $testnum++; + say "ok ($testnum)" if $ENV{HARNESS_ACTIVE}; +} + +sub fail { + $testnum++; + say "not ok ($testnum)" if $ENV{HARNESS_ACTIVE}; + + my $die = 0; + my ( $msg1, $msg2 ) = @_; + if ($msg2) { + # if arg2 is non-empty, print it regardless of debug level + $die = 1 if $msg2 =~ s/^die //; + say STDERR "# $msg2"; + } + + local $TSH_VERBOSE = 1 if $ENV{TSH_ERREXIT}; + dbg( 1, "FAIL: $msg1", $testname || '', "test number $testnum", "L: $line", "results:\n$text" ); + + # count the error and add the testname to the list if it is set + $err_count++; + push @errors_in, $testname if $testname; + + return unless $die or $ENV{TSH_ERREXIT}; + dbg( 1, "exiting at cmd $cmd\n" ); + + exit( $rc || 74 ); +} + +sub cmp { + # compare input string with second input string or text() + my $in = shift; + my $text = ( @_ ? +shift : text() ); + + if ( $text eq $in ) { + ok(); + } else { + fail( 'cmp failed', '' ); + dbg( 4, "\n\ntext = <<<$text>>>, in = <<<$in>>>\n\n" ); + } +} + +sub expect { + my ( $patt, $msg ) = @_; + $msg =~ s/^\s+// if $msg; + my $sm; + if ( $sm = sm($patt) ) { + dbg( 4, " M: $sm" ); + ok(); + } else { + fail( "/$patt/", $msg || '' ); + } +} + +sub not_expect { + my ( $patt, $msg ) = @_; + $msg =~ s/^\s+// if $msg; + my $sm; + if ( $sm = sm($patt) ) { + dbg( 4, " M: $sm" ); + fail( "!/$patt/", $msg || '' ); + } else { + ok(); + } +} + +sub sm { + # smart match? for now we just do regex match + my $patt = shift; + + return ( $text =~ qr($patt) ? $& : "" ); +} + +sub trim_ws { + local $_ = shift; + s/^\s+//; s/\s+$//; + return $_; +} + +sub is_comment_or_empty { + local $_ = shift; + chomp; $_ = trim_ws($_); + if (/^##\s(.*)/) { + $testname = $1; + say "# $1"; + } + return ( /^#/ or /^$/ ); +} + +sub cmds { + local $_ = shift; + chomp; $_ = trim_ws($_); + + # split on unescaped ';'s, then unescape the ';' in the results + my @cmds = map { s/\\;/;/g; $_ } split /(?<!\\);/; + @cmds = grep { $_ = trim_ws($_); /\S/; } @cmds; + return @cmds; +} + +sub dbg { + return unless $TSH_VERBOSE; + my $level = shift; + return unless $TSH_VERBOSE >= $level; + my $all = join( "\n", grep( /./, @_ ) ); + chomp($all); + $all =~ s/\n/\n\t/g; + say STDERR "# $all"; +} + +sub ddump { + for my $i (@_) { + print STDERR "DBG: " . Dumper($i); + } +} + +sub usage { + # TODO + print "Please see documentation at: + + https://github.com/sitaramc/tsh/blob/master/README.mkd + +Meanwhile, here are your local 'macro' definitions: + +"; + my %m = read_rc_file(); + my @m = map { "$_\t$m{$_}\n" } sort keys %m; + $tabstop = 16; + print join( "", expand(@m) ); + exit 1; +} + +# ---------------------------------------------------------------------- +# git-specific internal service subs + +sub dummy_commits { + for my $f ( split ' ', shift ) { + if ( $f eq 'tt' or $f eq 'test-tick' ) { + test_tick(); + next; + } + my $ts = ( $tick ? gmtime( $tick + 19800 ) : gmtime() ); + _sh("echo $f at $ts >> $f && git add $f && git commit -m '$f at $ts'"); + } +} + +sub test_tick { + unless ( $ENV{HARNESS_ACTIVE} ) { + sleep 1; + return; + } + $tick += 60 if $tick; + $tick ||= 1310000000; + $ENV{GIT_COMMITTER_DATE} = "$tick +0530"; + $ENV{GIT_AUTHOR_DATE} = "$tick +0530"; +} + +# ---------------------------------------------------------------------- +# the internal macros, for easy reference and reading + +sub read_rc_file { + my $rcfile = "$HOME/.tshrc"; + my $rctext; + if ( -r $rcfile ) { + local $/ = undef; + open( my $rcfh, "<", $rcfile ) or die "this should not happen: $!\n"; + $rctext = <$rcfh>; + } else { + # this is the default "rc" content + $rctext = " + add = git add + branch = git branch + clone = git clone + checkout = git checkout + commit = git commit + fetch = git fetch + init = git init + push = git push + reset = git reset + tag = git tag + + empty = git commit --allow-empty -m empty + push-om = git push origin master + reset-h = git reset --hard + reset-hu = git reset --hard \@{u} + " + } + + # ignore everything except lines of the form "aa = bb cc dd" + my %commands = ( $rctext =~ /^\s*([-.\w]+)\s*=\s*(\S.*)$/gm ); + return %commands; +} + +1; diff --git a/src/lib/Gitolite/Triggers.pm b/src/lib/Gitolite/Triggers.pm new file mode 100644 index 0000000..16e8aa6 --- /dev/null +++ b/src/lib/Gitolite/Triggers.pm @@ -0,0 +1,33 @@ +package Gitolite::Triggers; + +# load and run triggered modules +# ---------------------------------------------------------------------- + +#<<< +@EXPORT = qw( +); +#>>> +use Exporter 'import'; + +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +# ---------------------------------------------------------------------- + +sub run { + my ( $module, $sub, @args ) = @_; + $module = "Gitolite::Triggers::$module" if $module !~ /^Gitolite::/; + + eval "require $module"; + _die "$@" if $@; + my $subref; + eval "\$subref = \\\&$module" . "::" . "$sub"; + _die "module '$module' does not exist or does not have sub '$sub'" unless ref($subref) eq 'CODE'; + + $subref->(@args); +} + +1; diff --git a/src/lib/Gitolite/Triggers/Alias.pm b/src/lib/Gitolite/Triggers/Alias.pm new file mode 100644 index 0000000..adaceb5 --- /dev/null +++ b/src/lib/Gitolite/Triggers/Alias.pm @@ -0,0 +1,128 @@ +package Gitolite::Triggers::Alias; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +# aliasing a repo to another +# ---------------------------------------------------------------------- + +=for usage + +Why: + + We had an existing repo "foo" that lots of people use. We wanted to + rename it to "foo/code", so that related repos "foo/upstream" and + "foo/docs" (both containing stuff we did not want to put in "foo") could + also be made and then the whole thing would be structured nicely. + + At the same time we did not want to *force* all the users to change the + name. At least git operations should still work with the old name, + although it is OK for "info" and other "commands" to display/require the + proper name (i.e., the new name). + +How: + + * uncomment the line "Alias" in the "user-visible behaviour" section in the + rc file + + * add a new variable REPO_ALIASES to the rc file, with entries like: + + REPO_ALIASES => + { + # if you need a more aggressive warning message than the default + WARNING => "Please change your URLs to use '%new'; '%old' will not work after XXXX-XX-XX", + + # prefix mapping section + PREFIX_MAPS => { + # note: NO leading slash in keys or values below + 'var/lib/git/' => '', + 'var/opt/git/' => 'opt/', + }, + + # individual repo mapping section + 'foo' => 'foo/code', + + # force users to change their URLs + 'bar' => '301/bar/code', + # a target repo starting with "301/" won't actually work; + # it will just produce an error message pointing the user + # to the new name. This allows admins to force users to + # fix their URLs. + }, + + If a prefix map is supplied, each key is checked (in *undefined* order), + and the *first* key which matches the prefix of the repo will be applied. + If more than one key matches (for example if you specify '/abc/def' as one + key, and '/abc' as another), it is undefined which will get picked up. + + The result of this, (or the original repo name if no map was found), will + then be subject to the individual repo mappings. Since these are full + repo names, there is no possibility of multiple matches. + +Notes: + + * only git operations (clone/fetch/push) are alias aware. Nothing else in + gitolite, such as all the gitolite commands etc., are alias-aware and will + always use/require the proper repo name. + + * http mode has not been tested and will not be. If someone has the time to + test it and make it work please let me know. + + * funnily enough, this even works with mirroring! That is, a master can + push a repo "foo" to a copy per its configuration, while the copy thinks + it is getting repo "bar" from the master per its configuration. + + Just make sure to put the Alias::input line *before* the Mirroring::input + line in the rc file on the copy. + + However, it will probably not work with redirected pushes unless you setup + the opposite alias ("bar" -> "foo") on master. +=cut + +sub input { + my $git_commands = "git-upload-pack|git-receive-pack|git-upload-archive"; + my $user = $ARGV[0] || '@all'; # user name is undocumented for now + + if ( $ENV{SSH_ORIGINAL_COMMAND} =~ /(?:$git_commands) '\/?(\S+)'$/ ) { + my $repo = $1; + ( my $norm = $repo ) =~ s/\.git$//; # normalised repo name + + my $target = $norm; + + # prefix maps first + my $pm = $rc{REPO_ALIASES}{PREFIX_MAPS} || {}; + while (my($k, $v) = each %$pm) { + last if $target =~ s/^$k/$v/; + # no /i, /g, etc. by design + } + + # individual repo map next + $target = $rc{REPO_ALIASES}{$target} || $target; + + # undocumented; don't use without discussing on mailing list + $target = $target->{$user} if ref($target) eq 'HASH'; + + # if the repo name finally maps to empty, we bail, with no changes + return unless $target; + + # we're done. Did we actually change anything? + return if $norm eq $target; + + # if the new name starts with "301/", inform and abort + _die "please use '$target' instead of '$norm'" if $target =~ s(^301/)(); + # otherwise print a warning and continue with the new name + my $wm = $rc{REPO_ALIASES}{WARNING} || "'%old' is an alias for '%new'"; + $wm =~ s/%new/$target/g; + $wm =~ s/%old/$norm/g; + _warn $wm; + + $ENV{SSH_ORIGINAL_COMMAND} =~ s/'\/?$repo'/'$target'/; + } + +} + +1; diff --git a/src/lib/Gitolite/Triggers/AutoCreate.pm b/src/lib/Gitolite/Triggers/AutoCreate.pm new file mode 100644 index 0000000..e1d977a --- /dev/null +++ b/src/lib/Gitolite/Triggers/AutoCreate.pm @@ -0,0 +1,24 @@ +package Gitolite::Triggers::AutoCreate; + +use strict; +use warnings; + +# perl trigger set for stuff to do with auto-creating repos +# ---------------------------------------------------------------------- + +# to deny auto-create on read access, uncomment 'no-create-on-read' in the +# ENABLE list in the rc file +sub deny_R { + die "autocreate denied\n" if $_[3] and $_[3] eq 'R'; + return; +} + +# to deny auto-create on read *and* write, uncomment 'no-auto-create' in the +# ENABLE list in the rc file. This means you can only create wild repos using +# the 'create' command, (which needs to be enabled in the ENABLE list). +sub deny_RW { + die "autocreate denied\n" if $_[3] and ( $_[3] eq 'R' or $_[3] eq 'W' ); + return; +} + +1; diff --git a/src/lib/Gitolite/Triggers/CpuTime.pm b/src/lib/Gitolite/Triggers/CpuTime.pm new file mode 100644 index 0000000..74b4217 --- /dev/null +++ b/src/lib/Gitolite/Triggers/CpuTime.pm @@ -0,0 +1,52 @@ +package Gitolite::Triggers::CpuTime; + +use Time::HiRes; + +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +# cpu and elapsed times for gitolite+git operations +# ---------------------------------------------------------------------- +# uncomment the appropriate lines in the rc file to enable this + +# Ideally, you will (a) write your own code with a different filename so later +# gitolite upgrades won't overwrite your copy, (b) add appropriate variables +# to the rc file, and (c) change your rc file to call your program instead. + +# ---------------------------------------------------------------------- +my $start_time; + +sub input { + _warn "something wrong with the invocation of CpuTime::input" if $ENV{GL_TID} ne $$; + $start_time = [ Time::HiRes::gettimeofday() ]; +} + +sub post_git { + _warn "something wrong with the invocation of CpuTime::post_git" if $ENV{GL_TID} ne $$; + + my ( $trigger, $repo, $user, $aa, $ref, $verb ) = @_; + my ( $utime, $stime, $cutime, $cstime ) = times(); + my $elapsed = Time::HiRes::tv_interval($start_time); + + gl_log( 'times', $utime, $stime, $cutime, $cstime, $elapsed ); + + # now do whatever you want with the data; the following is just an example. + + if ( my $limit = $rc{CPU_TIME_WARN_LIMIT} ) { + my $total = $utime + $cutime + $stime + $cstime; + # some code to send an email or whatever... + say2 "limit = $limit, actual = $total" if $total > $limit; + } + + if ( $rc{DISPLAY_CPU_TIME} ) { + say2 "perf stats for $verb on repo '$repo':"; + say2 " user CPU time: " . ( $utime + $cutime ); + say2 " sys CPU time: " . ( $stime + $cstime ); + say2 " elapsed time: " . $elapsed; + } +} + +1; diff --git a/src/lib/Gitolite/Triggers/Kindergarten.pm b/src/lib/Gitolite/Triggers/Kindergarten.pm new file mode 100755 index 0000000..6274c3d --- /dev/null +++ b/src/lib/Gitolite/Triggers/Kindergarten.pm @@ -0,0 +1,99 @@ +package Gitolite::Triggers::Kindergarten; + +# http://www.great-quotes.com/quote/424177 +# "Doctor, it hurts when I do this." +# "Then don't do that!" + +# Prevent various things that sensible people shouldn't be doing anyway. List +# of things it prevents is at the end of the program. + +# If you were forced to enable this module because someone is *constantly* +# doing things that need to be caught, consider getting rid of that person. +# Because, really, who knows what *else* he/she is doing that can't be caught +# with some clever bit of code? + +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +my %active; +sub active { + # in rc, you either see just 'Kindergarten' to activate all features, or + # 'Kindergarten U0 CREATOR' (i.e., a space sep list of features after the + # word Kindergarten) to activate only those named features. + + # no features specifically activated; implies all of them are active + return 1 if not %active; + # else check if this specific feature is active + return 1 if $active{ +shift }; + + return 0; +} + +my ( $verb, $repo, $cmd, $args ); +sub input { + # get the features to be activated, if supplied + while ( $_[0] ne 'INPUT' ) { + $active{ +shift } = 1; + } + + # generally fill up variables you might use later + my $git_commands = "git-upload-pack|git-receive-pack|git-upload-archive"; + if ( $ENV{SSH_ORIGINAL_COMMAND} =~ /($git_commands) '\/?(\S+)'$/ ) { + $verb = $1; + $repo = $2; + } elsif ( $ENV{SSH_ORIGINAL_COMMAND} =~ /^(\S+) (.*)$/ ) { + $cmd = $1; + $args = $2; + } + + prevent_CREATOR($repo) if active('CREATOR') and $verb; + prevent_0(@ARGV) if active('U0') and @ARGV; +} + +sub prevent_CREATOR { + my $repo = shift; + _die "'CREATOR' not allowed as part of reponame" if $repo =~ /\bCREATOR\b/; +} + +sub prevent_0 { + my $user = shift; + _die "'0' is not a valid username" if $user eq '0'; +} + +1; + +__END__ + +CREATOR + + prevent literal 'CREATOR' from being part of a repo name + + a quirk deep inside gitolite would let this config + + repo foo/CREATOR/..* + C = ... + + allow the creation of repos like "foo/CREATOR/bar", i.e., the word CREATOR is + literally used. + + I consider this a totally pathological situation to check for. The worst that + can happen is someone ends up cluttering the server with useless repos. + + One solution could be to prevent this only for wild repos, but I can't be + bothered to fine tune this, so this module prevents even normal repos from + having the literal CREATOR in them. + + See https://groups.google.com/forum/#!topic/gitolite/cS34Vxix0Us for more. + +U0 + + prevent a user from being called literal '0' + + Ideally we should prevent keydir/0.pub (or variants) from being created, + but for "Then don't do that" purposes it's enough to prevent the user from + logging in. + + See https://groups.google.com/forum/#!topic/gitolite/F1IBenuSTZo for more. diff --git a/src/lib/Gitolite/Triggers/Mirroring.pm b/src/lib/Gitolite/Triggers/Mirroring.pm new file mode 100644 index 0000000..07b7f96 --- /dev/null +++ b/src/lib/Gitolite/Triggers/Mirroring.pm @@ -0,0 +1,256 @@ +package Gitolite::Triggers::Mirroring; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +my $hn = $rc{HOSTNAME}; + +my ( $mode, $master, %copies, %trusted_copies ); + +# ---------------------------------------------------------------------- + +sub input { + unless ( $ARGV[0] =~ /^server-(\S+)$/ ) { + _die "'$ARGV[0]' is not a valid server name" if $ENV{SSH_ORIGINAL_COMMAND} =~ /^USER=(\S+) SOC=(git-receive-pack '(\S+)')$/; + return; + } + + # note: we treat %rc as our own internal "poor man's %ENV" + $rc{FROM_SERVER} = $1; + trace( 3, "from_server: $1" ); + my $sender = $rc{FROM_SERVER} || ''; + + # custom peer-to-peer commands. At present the only one is 'perms -c', + # sent from a mirror command + if ( $ENV{SSH_ORIGINAL_COMMAND} =~ /^CREATOR=(\S+) perms -c '(\S+)'$/ ) { + $ENV{GL_USER} = $1; + + my $repo = $2; + details($repo); + _die "$hn: '$repo' is local" if $mode eq 'local'; + _die "$hn: '$repo' is native" if $mode eq 'master'; + _die "$hn: '$sender' is not the master for '$repo'" if $master ne $sender; + + $ENV{GL_BYPASS_CREATOR_CHECK} = option($repo, "bypass-creator-check"); + # this expects valid perms content on STDIN + _system("gitolite perms -c $repo"); + delete $ENV{GL_BYPASS_CREATOR_CHECK}; + + # we're done. Yes, really... + exit 0; + } + + if ( $ENV{SSH_ORIGINAL_COMMAND} =~ /^USER=(\S+) SOC=(git-receive-pack '(\S+)')$/ ) { + # my ($user, $newsoc, $repo) = ($1, $2, $3); + $ENV{SSH_ORIGINAL_COMMAND} = $2; + @ARGV = ($1); + $rc{REDIRECTED_PUSH} = 1; + trace( 3, "redirected_push for user $1" ); + } else { + # master -> copy push, no access checks needed + $ENV{GL_BYPASS_ACCESS_CHECKS} = 1; + } +} + +# ---------------------------------------------------------------------- + +sub pre_git { + return unless $hn; + # nothing, and I mean NOTHING, happens if HOSTNAME is not set + trace( 3, "pre_git() on $hn" ); + + my ( $repo, $user, $aa ) = @_[ 1, 2, 3 ]; + + my $sender = $rc{FROM_SERVER} || ''; + $user = '' if $sender and not exists $rc{REDIRECTED_PUSH}; + + # ------------------------------------------------------------------ + # now you know the repo, get its mirroring details + details($repo); + + # print mirror status if at least one copy status file is present + print_status( $repo ) if not $rc{HUSH_MIRROR_STATUS} and $mode ne 'local' and glob("$rc{GL_REPO_BASE}/$repo.git/gl-copy-*.status"); + + # we don't deal with any reads. Note that for pre-git this check must + # happen *after* getting details, to give mode() a chance to die on "known + # unknown" repos (repos that are in the config, but mirror settings + # exclude this host from both the master and copy lists) + return if $aa eq 'R'; + + trace( 1, "mirror", "pre_git", $repo, "user=$user", "sender=$sender", "mode=$mode", ( $rc{REDIRECTED_PUSH} ? ("redirected") : () ) ); + + # ------------------------------------------------------------------ + # case 1: we're master or copy, normal user pushing to us + if ( $user and not $rc{REDIRECTED_PUSH} ) { + trace( 3, "case 1, user push" ); + return if $mode eq 'local' or $mode eq 'master'; + if ( $trusted_copies{$hn} ) { + trace( 1, "redirect to $master" ); + exec( "ssh", $master, "USER=$user", "SOC=$ENV{SSH_ORIGINAL_COMMAND}" ); + } else { + _die "$hn: pushing '$repo' to copy '$hn' not allowed"; + } + } + + # ------------------------------------------------------------------ + # case 2: we're copy, master pushing to us + if ( $sender and not $rc{REDIRECTED_PUSH} ) { + trace( 3, "case 2, master push" ); + _die "$hn: '$repo' is local" if $mode eq 'local'; + _die "$hn: '$repo' is native" if $mode eq 'master'; + _die "$hn: '$sender' is not the master for '$repo'" if $master ne $sender; + return; + } + + # ------------------------------------------------------------------ + # case 3: we're master, copy sending a redirected push to us + if ( $sender and $rc{REDIRECTED_PUSH} ) { + trace( 3, "case 2, copy redirect" ); + _die "$hn: '$repo' is local" if $mode eq 'local'; + _die "$hn: '$repo' is not native" if $mode eq 'copy'; + _die "$hn: '$sender' is not a valid copy for '$repo'" if not $copies{$sender}; + _die "$hn: redirection not allowed from '$sender'" if not $trusted_copies{$sender}; + return; + } + + _die "$hn: should not reach this line"; + +} + +# ---------------------------------------------------------------------- + +sub post_git { + return unless $hn; + # nothing, and I mean NOTHING, happens if HOSTNAME is not set + trace( 1, "post_git() on $hn" ); + + my ( $repo, $user, $aa ) = @_[ 1, 2, 3 ]; + # we don't deal with any reads + return if $aa eq 'R'; + + my $sender = $rc{FROM_SERVER} || ''; + $user = '' if $sender; + + # ------------------------------------------------------------------ + # now you know the repo, get its mirroring details + details($repo); + + trace( 1, "mirror", "post_git", $repo, "user=$user", "sender=$sender", "mode=$mode", ( $rc{REDIRECTED_PUSH} ? ("redirected") : () ) ); + + # ------------------------------------------------------------------ + # case 1: we're master or copy, normal user pushing to us + if ( $user and not $rc{REDIRECTED_PUSH} ) { + trace( 3, "case 1, user push" ); + return if $mode eq 'local'; + # copy was eliminated earlier anyway, so that leaves 'master' + + # find all copies and push to each of them + push_to_copies($repo); + + return; + } + + # ------------------------------------------------------------------ + # case 2: we're copy, master pushing to us + if ( $sender and not $rc{REDIRECTED_PUSH} ) { + trace( 3, "case 2, master push" ); + # nothing to do + return; + } + + # ------------------------------------------------------------------ + # case 3: we're master, copy sending a redirected push to us + if ( $sender and $rc{REDIRECTED_PUSH} ) { + trace( 3, "case 2, copy redirect" ); + + # find all copies and push to each of them + push_to_copies($repo); + + return; + } +} + +{ + my $lastrepo = ''; + + sub details { + my $repo = shift; + return if $lastrepo eq $repo; + + $master = master($repo); + %copies = copies($repo); + $mode = mode($repo); + %trusted_copies = trusted_copies($repo); + trace( 3, $master, $mode, join( ",", sort keys %copies ), join( ",", sort keys %trusted_copies ) ); + } + + sub master { + return option( +shift, 'mirror.master' ); + } + + sub copies { + my $repo = shift; + + my $ref = git_config( $repo, "^gitolite-options\\.mirror\\.copies.*" ); + my %out = map { $_ => 'async' } map { split } values %$ref; + + $ref = git_config( $repo, "^gitolite-options\\.mirror\\.copies\\.sync.*" ); + map { $out{$_} = 'sync' } map { split } values %$ref; + + $ref = git_config( $repo, "^gitolite-options\\.mirror\\.copies\\.nosync.*" ); + map { $out{$_} = 'nosync' } map { split } values %$ref; + + return %out; + } + + sub trusted_copies { + my $ref = git_config( +shift, "^gitolite-options\\.mirror\\.redirectOK.*" ); + # the list of trusted copies (where we accept redirected pushes from) + # is either explicitly given... + my @out = map { split } values %$ref; + my %out = map { $_ => 1 } @out; + # ...or it's all the copies mentioned if the list is just a "all" + %out = %copies if ( @out == 1 and $out[0] eq 'all' ); + return %out; + } + + sub mode { + my $repo = shift; + return 'local' if not $hn; + return 'master' if $master eq $hn; + return 'copy' if $copies{$hn}; + return 'local' if not $master and not %copies; + _die "$hn: '$repo' is mirrored but not here"; + } +} + +sub push_to_copies { + my $repo = shift; + + my $u = $ENV{GL_USER}; + delete $ENV{GL_USER}; # why? see src/commands/mirror + + my $lb = "$ENV{GL_REPO_BASE}/$repo.git/.gl-mirror-lock"; + for my $s ( sort keys %copies ) { + trace( 1, "push_to_copies skipping self" ), next if $s eq $hn; + system("gitolite 1plus1 $lb.$s gitolite mirror push $s $repo </dev/null >/dev/null 2>&1 &") if $copies{$s} eq 'async'; + system("gitolite 1plus1 $lb.$s gitolite mirror push $s $repo </dev/null >/dev/null 2>&1") if $copies{$s} eq 'sync'; + _warn "manual mirror push pending for '$s'" if $copies{$s} eq 'nosync'; + } + + $ENV{GL_USER} = $u; +} + +sub print_status { + my $repo = shift; + my $u = $ENV{GL_USER}; + delete $ENV{GL_USER}; + system("gitolite mirror status all $repo >&2"); + $ENV{GL_USER} = $u; +} + +1; diff --git a/src/lib/Gitolite/Triggers/Motd.pm b/src/lib/Gitolite/Triggers/Motd.pm new file mode 100644 index 0000000..6de80a2 --- /dev/null +++ b/src/lib/Gitolite/Triggers/Motd.pm @@ -0,0 +1,29 @@ +package Gitolite::Triggers::Motd; + +use Gitolite::Rc; +use Gitolite::Common; + +use strict; +use warnings; + +# print a message of the day to STDERR +# ---------------------------------------------------------------------- + +my $file = "gl-motd"; + +sub input { + # at present, we print it for every single interaction with gitolite. We + # may want to change that later; if we do, get code from Kindergarten.pm + # to get the gitcmd+repo or cmd+args so you can filter on them + + my $f = "$rc{GL_ADMIN_BASE}/$file"; + print STDERR slurp($f) if -f $f; +} + +sub pre_git { + my $repo = $_[1]; + my $f = "$rc{GL_REPO_BASE}/$repo.git/$file"; + print STDERR slurp($f) if -f $f; +} + +1; diff --git a/src/lib/Gitolite/Triggers/RefexExpr.pm b/src/lib/Gitolite/Triggers/RefexExpr.pm new file mode 100644 index 0000000..e913665 --- /dev/null +++ b/src/lib/Gitolite/Triggers/RefexExpr.pm @@ -0,0 +1,80 @@ +package Gitolite::Triggers::RefexExpr; +use strict; +use warnings; + +# track refexes passed and evaluate expressions on them +# ---------------------------------------------------------------------- +# see src/VREF/refex-expr for instructions and WARNINGS! + +use Gitolite::Easy; + +my %passed; +my %rules; +my $init_done = 0; + +sub access_2 { + # get out quick for repos that don't have any rules + return if $init_done and not %rules; + + # but we don't really know that the first time, heh! + if ( not $init_done ) { + my $repo = $_[1]; + init($repo); + return unless %rules; + } + + my $refex = $_[5]; + return if $refex =~ /DENIED/; + + $passed{$refex}++; + + # evaluate the rules each time; it's not very expensive + for my $k ( sort keys %rules ) { + $ENV{ "GL_REFEX_EXPR_" . $k } = eval_rule( $rules{$k} ); + } +} + +sub eval_rule { + my $rule = shift; + + my $e; + $e = join " ", map { convert($_) } split ' ', $rule; + + my $ret = eval $e; + _die "eval '$e' -> '$@'" if $@; + Gitolite::Common::trace( 1, "RefexExpr", "'$rule' -> '$e' -> '$ret'" ); + + return "'$rule' -> '$e'" if $ret; +} + +my %constant; +%constant = map { $_ => $_ } qw(1 not and or xor + - ==); +$constant{'-lt'} = '<'; +$constant{'-gt'} = '>'; +$constant{'-eq'} = '=='; +$constant{'-le'} = '<='; +$constant{'-ge'} = '>='; +$constant{'-ne'} = '!='; + +sub convert { + my $i = shift; + return $i if $i =~ /^-?\d+$/; + return $constant{$i} || $passed{$i} || $passed{"refs/heads/$i"} || 0; +} + +# called only once +sub init { + $init_done = 1; + my $repo = shift; + + # find all the rule expressions + my %t = config( $repo, "^gitolite-options\\.refex-expr\\." ); + my ( $k, $v ); + # get rid of the cruft and store just the rule name as the key + while ( ( $k, $v ) = each %t ) { + $k =~ s/^gitolite-options\.refex-expr\.//; + $rules{$k} = $v; + } +} + +1; diff --git a/src/lib/Gitolite/Triggers/RepoUmask.pm b/src/lib/Gitolite/Triggers/RepoUmask.pm new file mode 100644 index 0000000..276cd01 --- /dev/null +++ b/src/lib/Gitolite/Triggers/RepoUmask.pm @@ -0,0 +1,62 @@ +package Gitolite::Triggers::RepoUmask; + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +# setting a repo specific umask +# ---------------------------------------------------------------------- +# this is for people who are too paranoid to trust e.g., gitweb's repo +# exclusion logic, but not paranoid enough to put it on a different server + +=for usage + + * In the rc file, add the line + 'RepoUmask', + somewhere in the ENABLE list + + * For each repo that is to get a different umask than the default, add a + line like this: + + option umask = 0027 + + * Anytime you add or change the value, if there are existing repos that + would be affected, you will need to do a manual "chmod" adjustment, + because umask only affects newly created files. + +=cut + +# sadly option/config values are not available at pre_create time for normal +# repos. So we have to do a one-time fixup in a post_create trigger. +sub post_create { + my $repo = $_[1]; + + my $umask = option( $repo, 'umask' ); + _chdir( $rc{GL_REPO_BASE} ); # because using option() moves us to ADMIN_BASE! + + return unless $umask; + + # unlike the one in the rc file, this is a string + $umask = oct($umask); + my $mode = "0" . sprintf( "%o", $umask ^ 0777 ); + + system("chmod -R $mode $repo.git >&2"); + system("find $repo.git -type f -exec chmod a-x '{}' \\;"); +} + +sub pre_git { + my $repo = $_[1]; + + my $umask = option( $repo, 'umask' ); + _chdir( $rc{GL_REPO_BASE} ); # because using option() moves us to ADMIN_BASE! + + return unless $umask; + + # unlike the one in the rc file, this is a string + umask oct($umask); +} + +1; diff --git a/src/lib/Gitolite/Triggers/Shell.pm b/src/lib/Gitolite/Triggers/Shell.pm new file mode 100644 index 0000000..a2c5c0d --- /dev/null +++ b/src/lib/Gitolite/Triggers/Shell.pm @@ -0,0 +1,66 @@ +package Gitolite::Triggers::Shell; + +# usage notes: uncomment 'Shell' in the ENABLE list in the rc file. + +# documentation is in the ssh troubleshooting and tips document, under the +# section "giving shell access to gitolite users" + +use Gitolite::Rc; +use Gitolite::Common; + +# fedora likes to do things that are a little off the beaten track, compared +# to typical gitolite usage: +# - every user has their own login +# - the forced command may not get the username as an argument. If it does +# not, the gitolite user name is $USER (the unix user name) +# - and finally, if the first argument to the forced command is '-s', and +# $SSH_ORIGINAL_COMMAND is empty or runs a non-git/gitolite command, then +# the user gets a shell + +sub input { + my $shell_allowed = 0; + if ( @ARGV and $ARGV[0] eq '-s' ) { + shift @ARGV; + $shell_allowed++; + } + + @ARGV = ( $ENV{USER} ) unless @ARGV; + + return unless $shell_allowed; + + # now determine if this was intended as a shell command or git/gitolite + # command + + my $soc = $ENV{SSH_ORIGINAL_COMMAND}; + + # no command, just 'ssh alice@host'; doesn't return ('exec's out) + shell_out() if $shell_allowed and not $soc; + + return if git_gitolite_command($soc); + + gl_log( 'shell', $ENV{SHELL}, "-c", $soc ); + exec $ENV{SHELL}, "-c", $soc; +} + +sub shell_out { + my $shell = $ENV{SHELL}; + $shell =~ s/.*\//-/; # change "/bin/bash" to "-bash" + gl_log( 'shell', $shell ); + exec { $ENV{SHELL} } $shell; +} + +# some duplication with gitolite-shell, factor it out later, if it works fine +# for fedora and they like it. +sub git_gitolite_command { + my $soc = shift; + + my $git_commands = "git-upload-pack|git-receive-pack|git-upload-archive"; + return 1 if $soc =~ /^($git_commands) /; + + my @words = split ' ', $soc; + return 1 if $rc{COMMANDS}{ $words[0] }; + + return 0; +} + +1; diff --git a/src/lib/Gitolite/Triggers/TProxy.pm b/src/lib/Gitolite/Triggers/TProxy.pm new file mode 100644 index 0000000..9c42918 --- /dev/null +++ b/src/lib/Gitolite/Triggers/TProxy.pm @@ -0,0 +1,98 @@ +package Gitolite::Triggers::TProxy; + +# ---------------------------------------------------------------------- +# transparent proxy for git repos, hosted on a gitolite server + +# ---------------------------------------------------------------------- +# WHAT + +# 1. user runs a git command (clone, fetch, push) against a gitolite +# server. +# 2. if that server has the repo, it will serve it up. Else it will +# *transparently* forward the git operation to a designated upstream +# server. The user does not have to do anything, and in fact may not +# even know this has happened. + +# can be combined with, but does not *require*, gitolite mirroring. + +# ---------------------------------------------------------------------- +# SECURITY +# +# 1. Most of the issues that apply to "redirected push" in mirroring.html +# also apply here. In particular, you had best make sure the two +# servers use the same authentication data (i.e., "alice" here should be +# "alice" there!) +# +# 2. Also, do not add keys for servers you don't trust! + +# ---------------------------------------------------------------------- +# HOW + +# on transparent proxy server (the one that is doing the redirect): +# 1. add +# INPUT => ['TProxy::input'], +# just before the ENABLE list in the rc file +# 2. add an RC variable to tell gitolite where to go; this is also just +# before the ENABLE list: +# TPROXY_FORWARDS_TO => 'git@upstream', + +# on upstream server (the one redirected TO): +# 1. add +# INPUT => ['TProxy::input'], +# just before the ENABLE list in the rc file +# 2. add the pubkey of the proxy server (the one that will be redirecting +# to us) to this server's gitolite-admin "keydir" as +# "server-<something>.pub", and push the change. + +# to use in combination with gitolite mirroring +# 1. just follow the same instructions as above. Server names and +# corresponding pub keys would already be set ok so step 2 in the +# upstream server setup (above) will not be needed. +# 2. needless to say, **don't** declare the repos you want to be +# transparently proxied in the gitolite.conf for the copy. + +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +my $soc = $ENV{SSH_ORIGINAL_COMMAND}; + +# ---------------------------------------------------------------------- + +sub input { + # are we the upstream, getting something from a tproxy server? + my $git_commands = "git-upload-pack|git-receive-pack|git-upload-archive"; + if ( $ARGV[0] =~ /^server-/ and $soc =~ /^TPROXY_FOR=(\S+) SOC=(($git_commands) '\S+')$/ ) { + @ARGV = ($1); + # you better make sure you read the security warnings up there! + + $ENV{SSH_ORIGINAL_COMMAND} = $2; + delete $ENV{GL_BYPASS_ACCESS_CHECKS}; + # just in case we somehow end up running before Mirroring::input! + + return; + } + + # well we're not upstream; are we a tproxy? + return unless $rc{TPROXY_FORWARDS_TO}; + + # is it a normal git command? + return unless $ENV{SSH_ORIGINAL_COMMAND} =~ m(^($git_commands) '/?(.*?)(?:\.git(\d)?)?'$); + + # ...get the repo name from $ENV{SSH_ORIGINAL_COMMAND} + my ( $verb, $repo, $trace_level ) = ( $1, $2, $3 ); + $ENV{D} = $trace_level if $trace_level; + _die "invalid repo name: '$repo'" if $repo !~ $REPONAME_PATT; + + # nothing to do if the repo exists locally + return if -d "$ENV{GL_REPO_BASE}/$repo.git"; + + my $user = shift @ARGV; + # redirect to upstream + exec( "ssh", $rc{TPROXY_FORWARDS_TO}, "TPROXY_FOR=$user", "SOC=$ENV{SSH_ORIGINAL_COMMAND}" ); +} + +1; diff --git a/src/lib/Gitolite/Triggers/Writable.pm b/src/lib/Gitolite/Triggers/Writable.pm new file mode 100644 index 0000000..ed86e12 --- /dev/null +++ b/src/lib/Gitolite/Triggers/Writable.pm @@ -0,0 +1,17 @@ +package Gitolite::Triggers::Writable; + +use Gitolite::Rc; +use Gitolite::Common; + +sub access_1 { + my ( $repo, $aa, $result ) = @_[ 1, 3, 5 ]; + return if $aa eq 'R' or $result =~ /DENIED/; + + for my $f ( "$ENV{HOME}/.gitolite.down", "$rc{GL_REPO_BASE}/$repo.git/.gitolite.down" ) { + next unless -f $f; + _die slurp($f) if -s $f; + _die "sorry, writes are currently disabled (no more info available)\n"; + } +} + +1; diff --git a/src/syntactic-sugar/continuation-lines b/src/syntactic-sugar/continuation-lines new file mode 100644 index 0000000..d63475f --- /dev/null +++ b/src/syntactic-sugar/continuation-lines @@ -0,0 +1,36 @@ +# vim: syn=perl: + +# "sugar script" (syntactic sugar helper) for gitolite3 + +# Enabling this script in the rc file allows you to use back-slash escaped +# continuation lines, like in C or shell etc. + +# This script also serves as an example "sugar script" if you want to write +# your own (and maybe send them to me). A "sugar script" in gitolite will be +# executed via a perl 'do' and is expected to contain one function called +# 'sugar_script'. This function should take a listref and return a listref. +# Each item in the list is one line. There are NO newlines; g3 kills them off +# fairly early in the process. + +# If you're not familiar with perl please do not try this. Ask me to write +# you a sugar script instead. + +sub sugar_script { + my $lines = shift; + + my @out = (); + my $keep = ''; + for my $l (@$lines) { + # skip RULE_INFO lines if in continuation mode + next if $keep and $l =~ /^ *#/; + if ( $l =~ s/\\$// ) { + $keep .= $l; + } else { + $l = $keep . $l if $keep; + $keep = ''; + push @out, $l; + } + } + + return \@out; +} diff --git a/src/syntactic-sugar/keysubdirs-as-groups b/src/syntactic-sugar/keysubdirs-as-groups new file mode 100644 index 0000000..0a3a9ae --- /dev/null +++ b/src/syntactic-sugar/keysubdirs-as-groups @@ -0,0 +1,32 @@ +# vim: syn=perl: + +# "sugar script" (syntactic sugar helper) for gitolite3 + +# Enabling this script in the rc file allows you to use subdirectories in +# keydir as group names. The last component other than keydir itself will be +# taken as the group name. + +sub sugar_script { + Gitolite::Common::trace( 2, "running 'keysubdirs-as-groups' sugar script..." ); + my $lines = shift; + + my @out = @{$lines}; + unshift @out, groupnames(); + + return \@out; +} + +sub groupnames { + my @out = (); + my %members = (); + for my $pk (`find ../keydir/ -name "*.pub"`) { + next unless $pk =~ m(.*/([^/]+)/([^/]+?)(?:@[^./]+)?\.pub$); + next if $1 eq 'keydir'; + $members{$1} .= " $2"; + } + for my $m ( sort keys %members ) { + push @out, "\@$m =" . $members{$m}; + } + + return @out; +} diff --git a/src/syntactic-sugar/macros b/src/syntactic-sugar/macros new file mode 100644 index 0000000..a3493a4 --- /dev/null +++ b/src/syntactic-sugar/macros @@ -0,0 +1,82 @@ +# vim: syn=perl: + +# "sugar script" (syntactic sugar helper) for gitolite3 + +# simple line-wise macro processor +# ---------------------------------------------------------------------- +# see documentation at the end of this script + +my %macro; + +sub sugar_script { + my $lines = shift; + my @out = (); + + my $l = join( "\n", @$lines ); + while ( $l =~ s/^macro (\w+)\b(.*?)\nend//ms ) { + $macro{$1} = $2; + } + + $l =~ s/^((\w+)\b.*)/$macro{$2} ? expand($1) : $1/gem; + + $lines = [ split "\n", $l ]; + return $lines; +} + +sub expand { + my $l = shift; + my ( $word, @arg ); + + eval "require Text::ParseWords"; + if ($@) { + ( $word, @arg ) = split ' ', $l; + } else { + ( $word, @arg ) = Text::ParseWords::shellwords($l); + } + my $v = $macro{$word}; + $v =~ s/%(\d+)/$arg[$1-1] or die "macro '$word' needs $1 arguments at '$l'\n"/gem; + return $v; +} + +__END__ + +Documentation is mostly by example. + +Setup: + + * uncomment the line + 'macros', + in the ENABLE list in ~/.gitolite.rc + +Notes on macro definition: + + * the keywords 'macro' and 'end' should start on a new line + * the first word after 'macro' is the name of the macro, and the rest, until + the 'end', is the body + +Notes on macro use: + + * the macro name should be the first word on a line + * the rest of the line is used as arguments to the macro + +Example: + + if your conf contains: + + macro foo repo aa-%1 + RW = u1 %2 + R = u2 + end + + foo 1 alice + foo 2 bob + + this will effectively turn into + + repo aa-1 + RW = u1 alice + R = u2 + + repo aa-2 + RW = u1 bob + R = u2 diff --git a/src/syntactic-sugar/refex-expr b/src/syntactic-sugar/refex-expr new file mode 100644 index 0000000..f9e7706 --- /dev/null +++ b/src/syntactic-sugar/refex-expr @@ -0,0 +1,35 @@ +# vim: syn=perl: + +# "sugar script" (syntactic sugar helper) for gitolite3 +# ---------------------------------------------------------------------- +# see src/VREF/refex-expr for instructions and WARNINGS! + +my $perm = qr(-|R|RW\+?C?D?M?); + +my $seq = 1; + +sub sugar_script { + my $lines = shift; + + # my @out = (); + for my $l (@$lines) { + push @out, $l; + + # quick check + next unless $l =~ /^($perm) /; + # more detailed check + next unless $l =~ /^($perm) (\S.*) = (\S.*)$/; + my ( $perm, $refexes, $users ) = ( $1, $2, $3 ); + next unless $refexes =~ / (and|not|or|xor|\+|-|==|-lt|-gt|-eq|-le|-ge|-ne) /; + + print STDERR ">>>> $l\n"; + pop @out; # we need to replace that last line + + push @out, "option refex-expr.sugar$seq = $refexes"; + push @out, "$perm VREF/refex-expr/sugar$seq = $users"; + + $seq++; + } + + return \@out; +} diff --git a/src/triggers/bg b/src/triggers/bg new file mode 100755 index 0000000..3c66500 --- /dev/null +++ b/src/triggers/bg @@ -0,0 +1,17 @@ +#!/bin/bash + +# quick and dirty program to background any of the triggers programs that are +# taking too long. To use, just replace a line like +# 'post-compile/update-gitweb-access-list', +# with +# 'bg post-compile/update-gitweb-access-list', + +# We dump output to a file in the log directory but please keep in mind this +# is not a "log" so much as a redirection of the entire output. + +echo `date` $GL_TID "$0: $@" >> $GL_LOGFILE.bg + +path=${0%/*} +script=$path/$1; shift + +( ( $script "$@" < /dev/null >> $GL_LOGFILE.bg 2>&1 & ) ) diff --git a/src/triggers/expand-deny-messages b/src/triggers/expand-deny-messages new file mode 100755 index 0000000..107202c --- /dev/null +++ b/src/triggers/expand-deny-messages @@ -0,0 +1,191 @@ +#!/usr/bin/perl +use strict; +use warnings; + +$|++; + +# program name: expand-deny-messages + +# DOCUMENTATION IS AT THE BOTTOM OF THIS FILE; PLEASE READ + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Rc; +use Gitolite::Common; + +my %attempted_access = ( + # see triggers.html + 'ACCESS_1' => { + 'R' => 'Repo read', + 'W' => 'Repo write', + }, + 'ACCESS_2' => { + 'W' => "Fast forward push", + '+' => "Rewind push branch or overwrite tag", + 'C' => "Create ref", + 'D' => "Delete ref", + } +); + +# env var to disable is set? +exit 0 if $ENV{GL_OPTION_EDM_DISABLE}; + +# argument 1 +my $a12 = shift; # ACCESS_1 or ACCESS_2 +exit 0 if $a12 !~ /^ACCESS_[12]$/; # shouldn't happen; error in rc file? + +# the rest of the arguments +my ( $repo, $user, $aa, $ref, $msg, $oldsha, $newsha ) = @ARGV; + +# we're only interested in deny messages +exit 0 if $msg !~ /DENIED/; + +print STDERR "\nFATAL -- ACCESS DENIED\n"; + +_info( "Repo", $repo ); +_info( "User", $user ); +_info( "Stage", ( $a12 eq 'ACCESS_1' ? "Before git was called" : "From git's update hook" ) ); +_info( "Ref", _ref($ref) ) if $a12 eq 'ACCESS_2'; +_info( "Operation", _op( $a12, $aa, $oldsha, $newsha ) ); + +if ( $ref =~ m((^VREF/[^/]+)) ) { + my $vref = $1; + if ($ref =~ s(^VREF/NAME/)()) { + print STDERR "You're apparently not allowed to push '$ref'"; + } else { + my $vref_text = slurp( _which( $vref, 'x' ) ); + my $etag = '(?:help|explain|explanation)'; + $vref_text =~ m(^\s*# $etag.start\n(.*)^\s*# $etag.end\n)sm + and print STDERR "Explanation for $vref:\n$1"; + } +} + +print STDERR "\n"; +print STDERR "$ENV{GL_OPTION_EDM_EXTRA_INFO}\n\n" if $ENV{GL_OPTION_EDM_EXTRA_INFO}; + +# ------------------------------------------------------------------------ + +sub _ref { + my $r = shift; + return "VREF '$r'" if $r =~ s(^VREF/)(); + return "Branch '$r'" if $r =~ s(^refs/heads/)(); + return "Tag '$r'" if $r =~ s(^refs/tags/)(); + return "Non-standard ref '$r'"; +} + +sub _info { + printf STDERR "%-14s %-60s\n", @_; +} + +sub _op { + my ( $a12, $aa, $oldsha, $newsha ) = @_; + + # first remove the M part and save the text for later addition if needed + my $merge = ( $aa =~ s/M// ? " with merge commit" : "" ); + + # next, the attempted access is modified to reflect the actual operation being + # attempted. NOTE: this no longer necessarily reflects what the gitolite log + # file stores; it's more granular and truly distinguishes a branch create from + # an ff push, etc. Could help when user typos a branch name I suppose + $aa = 'C' if $oldsha and $oldsha eq '0' x 40; + $aa = 'D' if $newsha and $newsha eq '0' x 40; + + # then we map it, add merge text if any + my $op = $attempted_access{$a12}{$aa} || "Unknown operation '$aa'"; + $op .= $merge; + + return $op; +} + +__END__ + +ENABLING THE FEATURE +-------------------- + +To enable this feature, uncomment the line in the rc file if your gitolite was +installed recently enough. Otherwise you will need to add these lines to the +end of your rc file, just before the "%RC" block ends: + + ACCESS_1 => [ + 'expand-deny-messages', + ], + + ACCESS_2 => [ + 'expand-deny-messages', + ], + +Please don't miss the trailing commas! + +DISABLING IT FOR SPECIFIC REPOS +------------------------------- + +Once it is enabled at the rc file level, if you wish to disable it for +specific repositories just add a line like this to those repos: + + option ENV.EDM_DISABLE = 1 + +Or you can also disable it for all repos, then enable it for some: + + repo @all + option ENV.EDM_DISABLE = 1 + + # ... then later ... + + repo foo bar @baz + option ENV.EDM_DISABLE = 0 + +(options.html[1] and pages linked from it will explain how that works). + +[1]: http://gitolite.com/gitolite/options.html + +SUPPLYING EXTRA INFORMATION +--------------------------- + +You can also supply some extra information to be printed, by adding a line +like this to each repository in the gitolite.conf file: + + option ENV.EDM_EXTRA_INFO = "please contact alice@example.com" + +You could of course add it under a "repo @all" section if you like. + +SUPPLYING EXTRA INFORMATION FOR VREFs +------------------------------------- + +If you have VREFs that do funky things and you want to **lecture** your users +when they screw up, add something like the following to your VREF code. + + # help start + + Some help text. + + Some more help text. This can be + multi-line. + + (etc etc etc) + + # help end + +Then everything between the "# help start" line and the "# help end" line will +get printed if a users falls afoul of this VREF. If any of the lines shown +are not valid syntax for your language, figure out some way to put the whole +thing in a comment block. Here a C example: + + /* + # help start + line 1 + line 2 + ... + last line + # help end + */ + +Even if your language does not support multi-line comments like C does, there +may be other ways to specify those lines. Here's an example in shell: + + cat << EOF > /dev/null + # help start + line 1 + line 2 + ... + last line + # help end + EOF diff --git a/src/triggers/partial-copy b/src/triggers/partial-copy new file mode 100755 index 0000000..79b4d48 --- /dev/null +++ b/src/triggers/partial-copy @@ -0,0 +1,69 @@ +#!/bin/sh + +# this is a wee bit expensive in terms of forks etc., compared to doing it in +# perl, but I wanted to show how *easy* it actually is now. And really, +# you'll only notice if you access this repo like a hundred times a minute or +# something so don't sweat it. + +# given a repo and a user, check if option('partialCopyOf') is set, and if so, +# fetch all allowed branches from there. + +die() { echo "$@" >&2; exit 1; } + +# make sure we're being called from the pre_git trigger +[ "$1" = "PRE_GIT" ] || die I must be called from PRE_GIT, not "$1" +shift + +repo=$1 +user=$2 +main=`git config --file $GL_REPO_BASE/$repo.git/config --get gitolite.partialCopyOf`; +[ -z "$main" ] && exit 0 + +# "we", "our repo" => the partial copy +# "main", "pco" => the one which we are a "partial copy of" + +cd $GL_REPO_BASE/$main.git + +for ref in `git for-each-ref refs/heads '--format=%(refname)'` +do + cd $GL_REPO_BASE/$repo.git + + gitolite access -q $repo $user R $ref && + git fetch -f $GL_REPO_BASE/$main.git $ref:$ref +done + +export GL_BYPASS_ACCESS_CHECKS=1 + +# remove all refs not in main or accessible +cd $GL_REPO_BASE/$repo.git + +for ref in `git for-each-ref refs/heads refs/tags '--format=%(refname)'` +do + cd $GL_REPO_BASE/$main.git + + if git show-ref --verify --quiet $ref && + gitolite access -q $repo $user R $ref ; then + # ref is present in main and accessible in repo + continue + fi + + git push -f $GL_REPO_BASE/$repo.git :$ref || die "FATAL: failed to delete $ref" +done + +# remove all tags no longer reachable +cd $GL_REPO_BASE/$repo.git + +for ref in `git for-each-ref refs/tags '--format=%(refname)'` +do + SHA=`git rev-list -1 $ref` + for branch in `git for-each-ref refs/heads '--format=%(refname)'` + do + if [ "`git merge-base $SHA $branch`" = "$SHA" ]; then + # tag is reachable in current branch, continue higher loop + continue 2 + fi + done + git push -f $GL_REPO_BASE/$repo.git :$ref || die "FATAL: failed to delete $ref" +done + +exit 0 diff --git a/src/triggers/post-compile/create-with-reference b/src/triggers/post-compile/create-with-reference new file mode 100755 index 0000000..f525082 --- /dev/null +++ b/src/triggers/post-compile/create-with-reference @@ -0,0 +1,39 @@ +#!/usr/bin/perl + +# Set alternates if option reference.repo is set +# ---------------------------------------------------------------------- + +use FindBin; + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +my $RB = $rc{GL_REPO_BASE}; + +if ( @ARGV and $ARGV[0] eq 'POST_CREATE' ) { + my $repo = $ARGV[1]; + create_alternates($repo); + + exit 0; +} + +# not interested in any other triggers +exit 0; + +sub create_alternates { + my $pr = shift; + + my $refrepos = git_config( $pr, "^gitolite-options\\.reference\\.repo.*" ); + my %list = map { $_ => 1 } map { split } values %$refrepos; + my @alts = keys %list; + if ( @alts ) { + my $altlist = join "\n", map { "$RB/$_.git/objects" } @alts; + _print( "$RB/$pr.git/objects/info/alternates", "$altlist\n" ); + + } +} diff --git a/src/triggers/post-compile/ssh-authkeys b/src/triggers/post-compile/ssh-authkeys new file mode 100755 index 0000000..cd59aec --- /dev/null +++ b/src/triggers/post-compile/ssh-authkeys @@ -0,0 +1,142 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Getopt::Long; + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Rc; +use Gitolite::Common; + +$|++; + +# best called via 'gitolite trigger POST_COMPILE'; other modes at your own +# risk, especially if the rc file specifies arguments for it. (That is also +# why it doesn't respond to "-h" like most gitolite commands do). + +# option procesing +# ---------------------------------------------------------------------- + +# currently has one option: +# -kfn, --key-file-name adds the keyfilename as a second argument + +my $kfn = ''; +GetOptions( 'key-file-name|kfn' => \$kfn, ); + +tsh_try("sestatus"); +my $selinux = ( tsh_text() =~ /enforcing/ ); + +my $ab = $rc{GL_ADMIN_BASE}; +trace( 1, "'keydir' not found in '$ab'; exiting" ), exit if not -d "$ab/keydir"; +my $akdir = "$ENV{HOME}/.ssh"; +my $akfile = "$ENV{HOME}/.ssh/authorized_keys"; +my $glshell = $rc{GL_BINDIR} . "/gitolite-shell"; +my $auth_options = auth_options(); + +sanity(); + +# ---------------------------------------------------------------------- + +_chdir($ab); + +# old data +my $old_ak = slurp($akfile); +my @non_gl = grep { not /^# gito.*start/ .. /^# gito.*end/ } slurp($akfile); +chomp(@non_gl); +my %seen = map { $_ => 'a non-gitolite key' } ( fp(@non_gl) ); + +# pubkey files +chomp( my @pubkeys = `find keydir/ -type f -name "*.pub" | sort` ); +my @gl_keys = (); +for my $f (@pubkeys) { + my $fp = fp($f); + if ( $seen{$fp} ) { + _warn "$f duplicates $seen{$fp}, sshd will ignore it"; + } else { + $seen{$fp} = $f; + } + push @gl_keys, grep { /./ } optionise($f); +} + +# dump it out +my $out = join( "\n", @non_gl, "# gitolite start", @gl_keys, "# gitolite end" ) . "\n"; + +my $ak = slurp($akfile); +_die "'$akfile' changed between start and end of this program!" if $ak ne $old_ak; +_print( $akfile, $out ); + +_warn "you have no keys left; I hope you intended to do that!" unless @gl_keys; + +# ---------------------------------------------------------------------- + +sub sanity { + _die "'$glshell' not found; this should NOT happen..." if not -f $glshell; + _die "'$glshell' found but not readable; this should NOT happen..." if not -r $glshell; + _die "'$glshell' found but not executable; this should NOT happen..." if not -x $glshell; + + my $n = " (this is normal on a brand new install)"; + _warn "$akdir missing; creating a new one\n$n" if not -d $akdir; + _warn "$akfile missing; creating a new one\n$n" if not -f $akfile; + + _mkdir( $akdir, 0700 ) if not -d $akdir; + if ( not -f $akfile ) { + _print( $akfile, "" ); + chmod 0600, $akfile; + } +} + +sub auth_options { + my $auth_options = $rc{AUTH_OPTIONS}; + $auth_options ||= "no-port-forwarding,no-X11-forwarding,no-agent-forwarding,no-pty"; + + return $auth_options; +} + +sub fp { + # input: see below + # output: a (list of) FPs + my $in = shift || ''; + if ( $in =~ /\.pub$/ ) { + # single pubkey file + _die "bad pubkey file '$in'" unless $in =~ $REPONAME_PATT; + return fp_file($in); + } elsif ( -f $in ) { + # an authkeys file + return map { fp_line($_) } grep { !/^#/ and /\S/ } slurp($in); + } else { + # one or more actual keys + return map { fp_line($_) } grep { !/^#/ and /\S/ } ( $in, @_ ); + } +} + +sub fp_file { + return $selinux++ if $selinux; # return a unique "fingerprint" to prevent noise + my $f = shift; + my ($fp, $output) = ssh_fingerprint_file($f); + _die "fingerprinting failed for '$f': $output" unless $fp; + return $fp; +} + +sub fp_line { + my $line = shift; + my ($fp, $output) = ssh_fingerprint_line($line); + _die "fingerprinting failed for '$line': $output" unless $fp; + return $fp; +} + +sub optionise { + my $f = shift; + + my $user = $f; + $user =~ s(.*/)(); # foo/bar/baz.pub -> baz.pub + $user =~ s/(\@[^.]+)?\.pub$//; # baz.pub, baz@home.pub -> baz + + my @line = slurp($f); + if ( @line != 1 ) { + _warn "$f does not contain exactly 1 line; ignoring"; + return ''; + } + chomp(@line); + return "command=\"$glshell $user" . ( $kfn ? " $f" : "" ) . "\",$auth_options $line[0]"; +} + diff --git a/src/triggers/post-compile/ssh-authkeys-shell-users b/src/triggers/post-compile/ssh-authkeys-shell-users new file mode 100755 index 0000000..2dd6643 --- /dev/null +++ b/src/triggers/post-compile/ssh-authkeys-shell-users @@ -0,0 +1,51 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Rc; +use Gitolite::Common; + +$|++; + +my $akfile = "$ENV{HOME}/.ssh/authorized_keys"; + +# ---------------------------------------------------------------------- + +my $aktext = slurp($akfile); + +for my $su ( shell_users() ) { + $aktext =~ s(/gitolite-shell $su([" ].*?),no-pty )(/gitolite-shell -s $su$1 )g; +} + +_print( $akfile, $aktext ); + +# two methods to specify list of shell-capable users. (1) list of usernames +# as arguments to 'Shell' in rc file, (2) list of usernames in a plain text +# file whose name is the first argument to 'Shell' in the rc file. Or both! +sub shell_users { + my ($sufile, @ret); + + # backward compat for 3.6 and below. This code will be removed in 3.7. + # Also, the variable is ignored if you end up using the new variant (i.e., + # put a file name on the 'Shell' line itself). + $sufile = $rc{SHELL_USERS_LIST} if $rc{SHELL_USERS_LIST} and -r $rc{SHELL_USERS_LIST}; + + $sufile = shift @ARGV if @ARGV and -r $ARGV[0]; + + if ($sufile) { + @ret = grep { not /^#/ } slurp($sufile); + chomp(@ret); + } + + for my $u (@ARGV) { + # arguments placed in the rc file appear before the trigger name + last if $u eq 'POST_COMPILE'; + + push @ret, $u; + # no sanity checking, since the rc file can only be created by someone + # who already has shell access + } + _die "'Shell': enabled but no usernames supplied" unless @ret; + return @ret; +} diff --git a/src/triggers/post-compile/ssh-authkeys-split b/src/triggers/post-compile/ssh-authkeys-split new file mode 100755 index 0000000..031bd07 --- /dev/null +++ b/src/triggers/post-compile/ssh-authkeys-split @@ -0,0 +1,87 @@ +#!/bin/bash + +# split multi-key files into separate keys like ssh-authkeys likes + +# WHY +# --- +# +# Yeah I wonder that too, when it's so much more maintainable to keep the damn +# keys as sitaram@home.pub and sitaram@work.pub or such. But there's no +# accounting for tastes, and some old fogies apparently want to put all of a +# user's keys into a single ".pub" file. + +# WARNINGS AND CAVEATS +# -------------------- +# +# - assumes no "@" sign in basenames of any multi-key files (single line file +# may still have them) + +# - assumes you don't have a subdir in keydir called "__split_keys__" + +# SUPPORT +# ------- +# +# NONE. + +# USAGE +# ----- +# +# to enable, uncomment the 'ssh-authkeys-split' line in the ENABLE list in the +# rc file. + +cd $GL_ADMIN_BASE/keydir + +rm -rf __split_keys__ +mkdir __split_keys__ +export SKD=$PWD/__split_keys__ + +# if we're coming from a gitolite-admin push, delete all *.multi, and rename +# all multi-line *.pub to *.multi +if [ "$GL_REPO" = "gitolite-admin" ] || [ "$GL_BYPASS_ACCESS_CHECKS" = "1" ] +then + find . -type f -name "*.multi" | while read k + do + rm -f "$k" + done + find . -type f -name "*.pub" | while read k + do + # is this a multi-key? + lines=`wc -l < $k` + case $lines in + (0|1) continue + esac + + base=`basename $k .pub` + mv $k $base.multi + done +fi + +# now process *.multi +find . -type f -name "*.multi" | while read k +do + # do we need to split? + lines=`wc -l < $k` + case $lines in + (0|1) continue + esac + + base=`basename $k .multi` + # sanity check + echo $base | grep '@' >/dev/null && continue + + # ok do it + seq=0 + while read line + do + (( seq++ )) + [ -z "$line" ] && continue + f=$SKD/$base@$seq.pub + echo "$line" > $f + # similar sanity check as main ssh-authkeys script + if ! ssh-keygen -l -f $f >/dev/null + then + echo 1>&2 "ssh-authkeys-split: bad line $seq in keydir/$k" + rm -f $f + fi + done < $k +done diff --git a/src/triggers/post-compile/update-description-file b/src/triggers/post-compile/update-description-file new file mode 100755 index 0000000..e5b7c6a --- /dev/null +++ b/src/triggers/post-compile/update-description-file @@ -0,0 +1,16 @@ +#!/bin/sh + +# For normal (not "wild") repos, gitolite v3 sets 'gitweb.description' instead +# of putting the text in the "description" file. This is easier because it +# just goes with the flow of setting config variables; nothing special needs +# to be done for the description. + +# But this only works for gitweb, not for cgit. Cgit users must uncomment the +# 'cgit' line in the ENABLE list in the rc file (which has the effect of +# adding this program to the POST_COMPILE trigger list). + +cd $GL_REPO_BASE +gitolite list-phy-repos | gitolite git-config % gitweb.description | perl -I"$GL_LIBDIR" -MGitolite::Easy -lne ' + my @F = split /\t/,$_,3; + textfile( file => "description", repo => $F[0], text => $F[2] ); + ' diff --git a/src/triggers/post-compile/update-git-configs b/src/triggers/post-compile/update-git-configs new file mode 100755 index 0000000..6eb2f46 --- /dev/null +++ b/src/triggers/post-compile/update-git-configs @@ -0,0 +1,61 @@ +#!/usr/bin/perl + +# update git-config entries in each repo +# ---------------------------------------------------------------------- + +use FindBin; + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Rc; +use Gitolite::Common; +use Gitolite::Conf::Load; + +use strict; +use warnings; + +my $RB = $rc{GL_REPO_BASE}; +_chdir($RB); + +# ---------------------------------------------------------------------- +# if called from POST_CREATE, we have only a single repo to worry about +if ( @ARGV and $ARGV[0] eq 'POST_CREATE' ) { + my $repo = $ARGV[1]; + fixup_config($repo); + + exit 0; +} + +# ---------------------------------------------------------------------- +# else it's all repos (i.e., called from POST_COMPILE) + +my $lpr = list_phy_repos(); + +for my $pr (@$lpr) { + fixup_config($pr); +} + +sub fixup_config { + my $pr = shift; + my $creator = creator($pr); + + my $gc = git_config( $pr, '.', 1 ); + my $ac = `git config --file $RB/$pr.git/config -l`; + while ( my ( $key, $value ) = each( %{$gc} ) ) { + next if $key =~ /^gitolite-options\./; + $value =~ s/(@\w+)/expand_group($1)/ge if $rc{EXPAND_GROUPS_IN_CONFIG}; + my $lkey = lc $key; + next if $ac =~ /^\Q$lkey\E=\Q$value\E$/m; + if ( $value ne "" ) { + system( "git", "config", "--file", "$RB/$pr.git/config", $key, $value ); + } elsif ( $ac =~ /^\Q$lkey\E=/m ) { + system( "git", "config", "--file", "$RB/$pr.git/config", "--unset-all", $key ); + } + } +} + +sub expand_group { + my $g = shift; + my @m = @{ Gitolite::Conf::Load::list_members($1) }; + return join(" ", @m) if @m; + return $g; +} diff --git a/src/triggers/post-compile/update-git-daemon-access-list b/src/triggers/post-compile/update-git-daemon-access-list new file mode 100755 index 0000000..ade97a8 --- /dev/null +++ b/src/triggers/post-compile/update-git-daemon-access-list @@ -0,0 +1,40 @@ +#!/usr/bin/perl + +# update git-daemon-export-ok files in each repo +# ---------------------------------------------------------------------- + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Rc; +use Gitolite::Easy; +use Gitolite::Common; + +use strict; +use warnings; + +my $EO = "git-daemon-export-ok"; +my $RB = $rc{GL_REPO_BASE}; + +my $cmd = "gitolite list-phy-repos"; +if ( @ARGV and $ARGV[0] eq 'POST_CREATE' ) { + # only one repo to do + $cmd = "echo $ARGV[1]"; +} + +for my $d (`$cmd | gitolite access % daemon R any`) { + my @F = split "\t", $d; + if ($F[2] =~ /DENIED/) { + unlink "$RB/$F[0].git/$EO"; + } elsif (! -f "$RB/$F[0].git/$EO") { + textfile( file => $EO, repo => $F[0], text => "" ); + } +} + +# As a quick recap, the gitolite output looks somewhat like this: + +# bar^Idaemon^IR any bar daemon DENIED by fallthru$ +# foo^Idaemon^Irefs/.*$ +# fubar^Idaemon^Irefs/.*$ +# gitolite-admin^Idaemon^IR any gitolite-admin daemon DENIED by fallthru$ +# testing^Idaemon^Irefs/.*$ + +# where I've typed "^I" to denote a tab. diff --git a/src/triggers/post-compile/update-gitweb-access-list b/src/triggers/post-compile/update-gitweb-access-list new file mode 100755 index 0000000..4085d59 --- /dev/null +++ b/src/triggers/post-compile/update-gitweb-access-list @@ -0,0 +1,40 @@ +#!/bin/sh + +# this is literally the simplest gitweb update possible. You are free to add +# whatever you want and contribute it back, as long as it is upward +# compatible. + +# ---------------------------------------------------------------------- +# delete the 'description' file that 'git init' created if this is run from +# the post-create trigger. However, note that POST_CREATE is also called from +# perms (since POST_CREATE doubles as eqvt of POST_COMPILE to propagate ad hoc +# permissions changes for wild repos) and then you should not delete it. +[ "$1" = "POST_CREATE" ] && [ "$4" != "perms" ] && rm -f $GL_REPO_BASE/$2.git/description 2>/dev/null + +plf=`gitolite query-rc GITWEB_PROJECTS_LIST` +[ -z "$plf" ] && plf=$HOME/projects.list +# since mktemp does not honor umask, we just use it to generate a temp +# filename (note: 'mktemp -u' on some systems, this gets close enough) +tmpfile=`mktemp $plf.tmp_XXXXXXXX` +rm -f $tmpfile; + +if [ "$1" = "POST_CREATE" ] && [ -n "$2" ] +then + # just one to be done + repo="$2" + grep -v "^$repo.git$" $plf > $tmpfile + if gitolite access -q $repo gitweb R any || gitolite git-config -q -r $repo gitweb\\. + then + echo "$repo.git" >> $tmpfile + fi +else + # all of them + ( + gitolite list-phy-repos | gitolite access % gitweb R any | grep -v DENIED + gitolite list-phy-repos | gitolite git-config -r % gitweb\\. + ) | + cut -f1 | sort -u | sed -e 's/$/.git/' > $tmpfile +fi + +[ -f $plf ] && perl -e "chmod ( ( (stat('$plf'))[2] & 07777 ), '$tmpfile')" +mv $tmpfile $plf diff --git a/src/triggers/post-compile/update-gitweb-daemon-from-options b/src/triggers/post-compile/update-gitweb-daemon-from-options new file mode 100755 index 0000000..1f5fd26 --- /dev/null +++ b/src/triggers/post-compile/update-gitweb-daemon-from-options @@ -0,0 +1,51 @@ +#!/bin/sh + +# TODO: look at the commit in which *this* line was added, and see the changes +# to the other scripts. We need to make those changes here also, but I'm too +# lazy right now. Plus I'm not even sure if anyone is using this! + +# Update git-daemon and gitweb access using 'option' lines instead of special +# usernames. + +# To use: + +# * enable this combined updater in the rc file by removing the other two +# update-*-access-list entries and inserting this one instead. (This would +# be in the POST_CREATE and POST_COMPILE lists). + +# * the add option lines in the conf file, like this: +# +# repo foo @bar +# option daemon = 1 +# option gitweb = 1 + +# Note: don't forget that gitweb can also be enabled by actual config +# variables (gitweb.owner, gitweb.description, gitweb.category) + +# This is useful for people who don't like '@all' to be literally *all* users, +# including gitweb and daemon, and can't/won't use deny-rules properly. + +# first do the gitweb stuff + +plf=`gitolite query-rc GITWEB_PROJECTS_LIST` +[ -z "$plf" ] && plf=$HOME/projects.list + +( + gitolite list-phy-repos | gitolite git-config % gitolite-options.gitweb + gitolite list-phy-repos | gitolite git-config -r % gitweb\\. +) | + cut -f1 | sort -u | sed -e 's/$/.git/' > $plf + +# now deal with git-daemon + +EO=git-daemon-export-ok +RB=`gitolite query-rc GL_REPO_BASE` +export EO RB + +export tmp=$(mktemp -d) +trap "rm -rf $tmp" 0 + +gitolite list-phy-repos | sort | tee $tmp/all | gitolite git-config % gitolite-options.daemon | cut -f1 > $tmp/daemon + +comm -23 $tmp/all $tmp/daemon | perl -lne 'unlink "$ENV{RB}/$_.git/$ENV{EO}"' +cat $tmp/daemon | perl -I"$GL_LIBDIR" -MGitolite::Easy -lne 'textfile( file => $ENV{EO}, repo => $_, text => "");' diff --git a/src/triggers/renice b/src/triggers/renice new file mode 100755 index 0000000..ba0b726 --- /dev/null +++ b/src/triggers/renice @@ -0,0 +1,5 @@ +#!/bin/sh + +n=$1 +[ "$n" = "PRE_GIT" ] && n=10 +renice -n $n $GL_TID >/dev/null diff --git a/src/triggers/repo-specific-hooks b/src/triggers/repo-specific-hooks new file mode 100755 index 0000000..4044cc9 --- /dev/null +++ b/src/triggers/repo-specific-hooks @@ -0,0 +1,118 @@ +#!/usr/bin/perl +use strict; +use warnings; + +# setup repo-specific hooks + +use lib $ENV{GL_LIBDIR}; +use Gitolite::Rc; +use Gitolite::Common; + +_die "repo-specific-hooks: LOCAL_CODE not defined in rc" unless $rc{LOCAL_CODE}; +_die "repo-specific-hooks: '$rc{LOCAL_CODE}/hooks/repo-specific' does not exist or is not a directory" unless -d "$rc{LOCAL_CODE}/hooks/repo-specific"; + +_chdir( $ENV{GL_REPO_BASE} ); + +if ($ARGV[0] eq 'POST_CREATE') { + # just the repo given in arg-2 + @ARGV = ("gitolite git-config -ev -r $ARGV[1] gitolite-options\\.hook\\. |"); +} else { + # POST_COMPILE, all repos + @ARGV = ("gitolite list-phy-repos | gitolite git-config -ev -r % gitolite-options\\.hook\\. |"); +} + +my $driver = $rc{MULTI_HOOK_DRIVER} || "$rc{LOCAL_CODE}/hooks/multi-hook-driver"; +# Hook Driver +{ + local $/ = undef; + my $hook_text = <DATA>; + _print( $driver, $hook_text ); + chmod 0755, $driver; +} + +my %repo_hooks; +while (<>) { + chomp; + my ( $repo, $hook, $codes ) = split /\t/, $_; + $codes ||= ''; + + # get the hook name + $hook =~ s/^gitolite-options\.hook\.//; + $hook =~ s/\..*//; + + my @codes = split /\s+/, $codes; + + # bail on disallowed hook types (but warn only if @codes is non-empty) + if ( $repo eq 'gitolite-admin' and $hook eq 'post-update' ) { + _warn "repo-specific-hooks: ignoring attempts to set post-update hook for the admin repo" if @codes; + next; + } + unless ( $hook =~ /^(pre-receive|post-receive|post-update|pre-auto-gc)$/ ) { + if (@codes) { + _warn "repo-specific-hooks: '$hook' is not allowed, ignoring"; + _warn " (only pre-receive, post-receive, post-update, and pre-auto-gc are allowed)"; + } + next; + } + + push @{ $repo_hooks{$repo}{$hook} }, @codes; +} + +for my $repo (keys %repo_hooks) { + for my $hook (keys %{ $repo_hooks{$repo} }) { + my @codes = @{ $repo_hooks{$repo}{$hook} }; + + my $dst = "$repo.git/hooks/$hook"; + unlink( glob("$dst.*") ); + + my $counter = "h00"; + foreach my $code (@codes) { + if ( $code =~ m(^/|\.\.) ) { + _warn "repo-specific-hooks: double dot or leading slash not allowed in '$code'"; + next; + } + + my $src = $rc{LOCAL_CODE} . "/hooks/repo-specific/$code"; + + # if $code has slashes in it, flatten it for use in $dst, to avoid + # having to re-create those intermediate sub-directories + $code =~ s(/)(_)g; + my $dst = "$repo.git/hooks/$hook.$counter-$code"; + + unless ( -x $src ) { + _warn "repo-specific-hooks: '$src' doesn't exist or is not executable"; + next; + } + unlink $dst; + symlink $src, $dst or _warn "could not symlink '$src' to '$dst'"; + $counter++; + + # no sanity checks for multiple overwrites of the same hook + } + + unlink $dst; + symlink $driver, $dst or die "could not symlink '$driver' to '$dst'"; + } +} + +__DATA__ +#!/bin/sh + +# Determine what input the hook needs +# post-update takes args, pre/post-receive take stdin +type=args +stdin='' +[ $0 != hooks/post-update ] && { + type=stdin + stdin=`cat` +} + +for h in $0.*; do + [ -x $h ] || continue + if [ $type = args ] + then + $h $@ || { [ $0 = hooks/pre-receive ] && exit 1; } + else + echo "$stdin" | $h || { [ $0 = hooks/pre-receive ] && exit 1; } + fi +done diff --git a/src/triggers/set-default-roles b/src/triggers/set-default-roles new file mode 100755 index 0000000..dbbcc92 --- /dev/null +++ b/src/triggers/set-default-roles @@ -0,0 +1,20 @@ +#!/bin/sh + +# POST_CREATE trigger to set up default set of perms for a new wild repo + +# ---------------------------------------------------------------------- +# skip if arg-1 is POST_CREATE and no arg-3 (user name) exists (i.e., it's not +# a wild repo) +[ "$1" = "POST_CREATE" ] && [ -z "$3" ] && exit 0; +[ "$4" = "R" ] || [ "$4" = "W" ] || [ "$4" = "perms-c" ] || [ "$4" = "create" ] || [ "$4" = "fork" ] || exit 0 + +die() { echo "$@" >&2; exit 1; } + +cd $GL_REPO_BASE/$2.git || die "could not cd to $GL_REPO_BASE/$2.git" +gitolite git-config -r $2 gitolite-options.default.roles | sort | cut -f3 | + perl -pe 's/(\s)CREATOR(\s|$)/$1$ENV{GL_USER}$2/' > gl-perms + +# cache control, if rc says caching is on +gitolite query-rc -q CACHE && perl -I$GL_LIBDIR -MGitolite::Cache -e "cache_control('flush', '$2')"; + +exit 0 diff --git a/src/triggers/upstream b/src/triggers/upstream new file mode 100755 index 0000000..611e11e --- /dev/null +++ b/src/triggers/upstream @@ -0,0 +1,72 @@ +#!/bin/sh + +# manage local, gitolite-controlled, copies of read-only upstream repos. + +repo=$2 + +url=$(gitolite git-config $repo gitolite-options.upstream.url) +[ -z "$url" ] && exit 0 # exit if no url was specified + +cd $GL_REPO_BASE/$repo.git || exit 1 + +[ "$1" != "fetch" ] && { + nice=$(gitolite git-config $repo gitolite-options.upstream.nice) + [ -n "$nice" ] && find FETCH_HEAD -mmin -$nice 2>/dev/null | grep . >/dev/null && exit 0 +} + +git fetch -q "$url" '+refs/*:refs/*' + +# ---------------------------------------------------------------------- + +# FEATURES: +# * invokes upstream fetch on each local fetch +# (unless the optional 'nice' setting is enabled) +# * can force a fetch (ignoring 'nice' value) from server CLI + +# INSTRUCTIONS: +# +# * uncomment 'upstream' in the ENABLE list in the rc file. +# * add option lines to conf file. For example: +# +# repo git +# R = @all +# RW+ my-company/ = @developers +# +# option upstream.url = https://git.kernel.org/pub/scm/git/git.git +# option upstream.nice = 120 +# +# * to force a fetch on the server shell (or via cron), run this command: +# gitolite ../triggers/upstream fetch reponame + +# ADDITIONAL NOTES: +# * restrict local pushes to a namespace that the upstream won't use +# (otherwise the next fetch will wipe them out) +# * if the upstream URL changes, just change the conf and push admin repo +# * the 'nice' setting is in minutes and is optional; it is the minimum +# elapsed time between 2 upstream fetches. + +# USAGE EXAMPLE: +# +# Let's say you want to keep a read-only local mirror of all your github repos +# on your local gitolite installation. Assuming your github usernames are the +# same as your local usernames, and you have updated GIT_CONFIG_KEYS in the rc +# file to allow 'config' lines, you can do this: +# +# repo github/CREATOR/..* +# C = @all +# R = @all +# option upstream.url = https://github.com/%GL_REPO.git +# option upstream.nice = 120 +# config url.https://github.com/.insteadOf = https://github.com/github/ +# +# Now you can make local, read-only, clones of all your github repos with +# +# git ls-remote gitolite:github/sitaramc/gitolite +# git ls-remote gitolite:github/sitaramc/hap +# (etc) +# +# and if milki were also a user on this gitolite instance, then +# +# git ls-remote gitolite:github/milki/xclip +# git ls-remote gitolite:github/milki/ircblogger +# (etc) |