make site-local scripts easier to write

- new Gitolite::Easy module hides all the other stuff
  - (put GL_ADMIN_BASE and GL_REPO_BASE into %ENV)
  - new 'gitolite creator' shell command
  - 'writes' command modified to use Gitolite::Easy.  It is also the
    only dual mode command -- it can be invoked remotely as well as
    locally.  I deem that the required trick to make other remote-only
    commands work locally is too much trouble for what is probably a
    rarely used command.

src/Gitolite/Easy.pm

@@ -0,0 +1,95 @@
+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.
+
+#<<<
+@EXPORT = qw(
+  is_admin
+  is_super_admin
+  in_group
+  owns
+  can_read
+  can_write
+
+  %rc
+  say
+  say2
+  _print
+  usage
+);
+#>>>
+use Exporter 'import';
+
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Load;
+
+use strict;
+use warnings;
+
+my $user;
+
+# ----------------------------------------------------------------------
+
+# 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/ );
+}
+
+# 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/ );
+}
+
+# shell equivalent
+#   if gitolite list-memberships $GL_USER | grep -x $GROUPNAME >/dev/null; then ...
+sub in_group {
+    valid_user();
+    my $g = shift;
+
+    return grep { $_ eq $g } @{ list_memberships($user) };
+}
+
+# shell equivalent
+#   if gitolite creator $REPONAME $GL_USER; 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 );
+}
+
+# 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/ );
+}
+
+# shell equivalent
+#   if gitolite access -q $REPONAME $GL_USER W; then ...
+sub can_write {
+    valid_user();
+    my $r = shift;
+    return not( access( $r, $user, 'W', 'any' ) =~ /DENIED/ );
+}
+
+# ----------------------------------------------------------------------
+
+sub valid_user {
+    _die "GL_USER not set" unless exists $ENV{GL_USER};
+    $user = $ENV{GL_USER};
+}
+
+1;

src/Gitolite/Rc.pm

@@ -77,6 +77,11 @@ $ENV{PATH} = "$ENV{GL_BINDIR}:$ENV{PATH}";
     $rc{GL_TS}      = $ENV{GL_TS}      = $ts;
 }
 
+# these two are meant to help externally written commands (see
+# src/commands/writes for an example)
+$ENV{GL_REPO_BASE}  = $rc{GL_REPO_BASE};
+$ENV{GL_ADMIN_BASE} = $rc{GL_ADMIN_BASE};
+
 # ----------------------------------------------------------------------
 
 use strict;
@@ -267,6 +272,7 @@ __DATA__
             'help'              =>  1,
             'info'              =>  1,
             'perms'             =>  1,
+            'writes'            =>  1,
         },
 );
 

src/commands/creator

@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use lib $ENV{GL_BINDIR};
+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";

src/commands/writes

@@ -3,9 +3,7 @@ use strict;
 use warnings;
 
 use lib $ENV{GL_BINDIR};
-use Gitolite::Rc;
+use Gitolite::Easy;
-use Gitolite::Common;
-use Gitolite::Conf::Load;
 
 =for usage
 Usage: gitolite writes on|off <reponame>|@all
@@ -24,6 +22,12 @@ my $on = ( shift eq 'on' );
 
 my $repo = shift;
 
+if ( $repo eq '@all' ) {
+    die "you are not authorized\n" if $ENV{GL_USER} and not is_admin();
+} else {
+    die "you are not authorized\n" if $ENV{GL_USER} and not owns($repo);
+}
+
 my $msg = join( " ", @ARGV );
 # try STDIN only if no msg found in args *and* it's an 'off' command
 if ( not $msg and not $on ) {
@@ -32,7 +36,7 @@ if ( not $msg and not $on ) {
 }
 
 my $sf = ".gitolite.down";
-my $rb = $rc{GL_REPO_BASE};
+my $rb = $ENV{GL_REPO_BASE};
 
 if ( $repo eq '@all' ) {
     target( $ENV{HOME} );

t/glt

@@ -13,6 +13,7 @@ my %extcmds = (
     help        => 1,
     info        => 1,
     perms       => 1,
+    writes      => 1,
 );
 
 $ENV{G3T_USER} = $user;