fork command, and some core changes to make it work...

- access command allows checking ^C
  - ^C check will fail when the repo exists

doc/non-core.mkd

@@ -18,6 +18,7 @@ bug to me if they don't.
 Here's a list of remote commands that are shipped:
 
   * 'desc' -- get/set the 'description' file for a repo
+  * 'fork' -- fork a repo
   * 'info' -- already documented [here][info]
   * 'mirror' -- documented [here][sync]
   * 'perms' -- get/set the gl-perms file; see [perms][] for more

src/commands/access

@@ -42,7 +42,7 @@ if ( $ARGV[0] eq '-q' ) { $quiet = 1; shift @ARGV; }
 my ( $repo, $user, $aa, $ref ) = @ARGV;
 $aa  ||= '+';
 $ref ||= 'any';
-_die "invalid perm" if not( $aa and $aa =~ /^(R|W|\+|C|D|M)$/ );
+_die "invalid perm" if not( $aa and $aa =~ /^(R|W|\+|C|D|M|\^C)$/ );
 _die "invalid ref name" if not( $ref and $ref =~ $REPONAME_PATT );
 
 my $ret = '';

src/commands/fork

@@ -0,0 +1,62 @@
+#!/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.
+#
+# The only caveat is that the repo you cloned *from* must not later become
+# unavailable in any way.  If you cannot be sure of this, take the scenic
+# route (clone repo1, push to repo2).
+
+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
+
+if gitolite query-rc -q DEFAULT_ROLE_PERMS
+then
+    gitolite query-rc DEFAULT_ROLE_PERMS > gl-perms
+fi
+
+ln -sf `gitolite query-rc GL_ADMIN_BASE`/hooks/common/* hooks
+
+# record where you came from
+echo "$from" > gl-forked-from
+
+# trigger post_create
+gitolite trigger POST_CREATE

src/lib/Gitolite/Conf/Load.pm

@@ -80,6 +80,11 @@ sub access {
         $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 $ref $repo $user DENIED by existence";
+    }
 
     my @rules = rules( $repo, $user );
     trace( 2, scalar(@rules) . " rules found" );
@@ -367,7 +372,8 @@ sub generic_name {
     # 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.
+    # 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;

src/lib/Gitolite/Rc.pm

@@ -288,6 +288,7 @@ __DATA__
         {
             'help'              =>  1,
             'desc'              =>  1,
+            # 'fork'            =>  1,
             'info'              =>  1,
             # 'mirror'          =>  1,
             'perms'             =>  1,

t/fork.t

@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+# this is hardcoded; change it if needed
+use lib "src/lib";
+use Gitolite::Test;
+
+# fork command
+# ----------------------------------------------------------------------
+
+try "plan 30";
+
+my $rb = `gitolite query-rc -n GL_REPO_BASE`;
+
+confreset;confadd '
+
+    repo foo/CREATOR/..*
+        C   =   u1 u2
+        RW+ =   CREATOR
+';
+
+try "ADMIN_PUSH set1; !/FATAL/" or die text();
+
+try "
+    cd ..
+
+    # make the initial repo
+    glt ls-remote u1 file:///foo/u1/u1a;ok;     gsh
+                                                /Initialized empty Git repository in .*/foo/u1/u1a.git/
+    # vrc doesn't have the fork command
+    glt fork u1 foo/u1/u1a foo/u1/u1a2; !ok;    /FATAL: unknown git/gitolite command: fork/
+";
+
+# allow fork as a valid command
+$ENV{G3T_RC} = "$ENV{HOME}/g3trc";
+put "$ENV{G3T_RC}", "\$rc{COMMANDS}{fork} = 1;\n\$rc{DEFAULT_ROLE_PERMS} = 'READERS \@all';\n";
+
+try "
+    # now the fork succeeds
+    glt fork u1 foo/u1/u1a foo/u1/u1a2; ok;     /Cloning into bare repository '.*/foo/u1/u1a2.git'/
+                                                /foo/u1/u1a forked to foo/u1/u1a2/
+
+    # now the actual testing starts
+    # read error
+    glt fork u1 foo/u1/u1c foo/u1/u1d;  !ok;    /'foo/u1/u1c' does not exist or you are not allowed to read it/
+    glt fork u2 foo/u1/u1a foo/u1/u1d;  !ok;    /'foo/u1/u1a' does not exist or you are not allowed to read it/
+
+    # write error
+    glt fork u1 foo/u1/u1a foo/u2/u1d;  !ok;    /'foo/u2/u1d' already exists or you are not allowed to create it/
+
+    # no error
+    glt fork u1 foo/u1/u1a foo/u1/u1e;  ok;     /Cloning into bare repository '.*/foo/u1/u1e.git'/
+                                                /warning: You appear to have cloned an empty repository/
+                                                /foo/u1/u1a forked to foo/u1/u1e/
+    # both exist
+    glt fork u1 foo/u1/u1a foo/u1/u1e;  !ok;    /'foo/u1/u1e' already exists or you are not allowed to create it/
+";
+
+# now check the various files that should have been produced
+
+try "cd $rb; find . -name gl-perms | sort | xargs md5sum"; cmp
+'59b3a74b4d33c7631f08e75e7b60c7ce  ./foo/u1/u1a2.git/gl-perms
+59b3a74b4d33c7631f08e75e7b60c7ce  ./foo/u1/u1e.git/gl-perms
+';
+
+try "cd $rb; find . -name gl-creator | sort | xargs md5sum"; cmp
+'346955ff2eadbf76e19373f07dd370a9  ./foo/u1/u1a2.git/gl-creator
+e4774cdda0793f86414e8b9140bb6db4  ./foo/u1/u1a.git/gl-creator
+346955ff2eadbf76e19373f07dd370a9  ./foo/u1/u1e.git/gl-creator
+';

t/glt

@@ -13,6 +13,7 @@ my %extcmds = (
     help        => 1,
     info        => 1,
     desc        => 1,
+    fork        => 1,
     perms       => 1,
     writable    => 1,
 );