use a redis cache. (no sausage making!)

src/lib/Gitolite/Cache.pm

@@ -0,0 +1,137 @@
+package Gitolite::Cache;
+
+# cache stuff using an external database (redis)
+# ----------------------------------------------------------------------
+
+@EXPORT = qw(
+  cache_set
+  cache_get
+  cache_flush_repo
+  cache_control
+);
+
+use Exporter 'import';
+
+use Gitolite::Common;
+use Gitolite::Rc;
+use Storable qw(freeze thaw);
+use Redis;
+
+my $redis;
+my $cache_up = 1;
+
+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 $ttl = ( $rc{CACHE_TTL} || ( $rc{GROUPLIST_PGM} ? 60 : 99999 ) );
+
+sub cache_set {
+    my $type = shift;
+    my $hash = shift;
+    my $key  = shift;
+    my $val;
+
+    return if not $redis->exists('cache-up');
+
+    if ( $type eq 'SCALAR' ) {
+        $val = shift;
+    } elsif ( $type eq 'ARRAY' ) {
+        $val = freeze( \@_ );
+    } elsif ( $type eq 'HASH' ) {
+        %val = @_;
+        $val = freeze( \%val );
+    }
+    $redis->set( "$hash: $key", $val );
+    $redis->expire( "$hash: $key", $ttl ) if $ttl;
+}
+
+sub cache_get {
+    my ( $type, $hash, $key, $ref ) = @_;
+
+    return 0 if not $cache_up;
+    # and don't touch the 'ref'1
+
+    my $val = $redis->get("$hash: $key");
+    return 0 if not defined($val);
+
+    if ( $type eq 'SCALAR' ) {
+        ${$ref} = $val;
+    }
+    if ( $type eq 'ARRAY' ) {
+        @{$ref} = @{ thaw($val) };
+    } elsif ( $type eq 'HASH' ) {
+        %{$ref} = %{ thaw($val) };
+    }
+    return 1;
+}
+
+sub cache_flush_repo {
+    my $repo = shift;
+    for my $glob ("memberships: user, $repo,*", "rules: $repo,*") {
+        my @keys = $redis->keys($glob);
+        $redis->del( @keys ) if @keys;
+    }
+}
+
+sub cache_control {
+    my $op = shift;
+    if ( $op eq 'stop' ) {
+        $redis->flushall();
+    } elsif ( $op eq 'start' ) {
+        $redis->set( 'cache-up', 1 );
+    }
+}
+
+# ----------------------------------------------------------------------
+
+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

src/lib/Gitolite/Conf.pm

@@ -13,6 +13,7 @@ use Exporter 'import';
 use Getopt::Long;
 
 use Gitolite::Common;
+use Gitolite::Cache;
 use Gitolite::Rc;
 use Gitolite::Conf::Sugar;
 use Gitolite::Conf::Store;
@@ -33,7 +34,10 @@ sub compile {
     # 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('stop');
     store();
+    cache_control('start');
 
     for my $repo ( @{ $rc{NEW_REPOS_CREATED} } ) {
         trigger( 'POST_CREATE', $repo );

src/lib/Gitolite/Conf/Load.pm

@@ -20,6 +20,7 @@ package Gitolite::Conf::Load;
 use Exporter 'import';
 
 use Gitolite::Common;
+use Gitolite::Cache;
 use Gitolite::Rc;
 
 use strict;
@@ -74,9 +75,23 @@ sub access {
     my @rules;
     my $deny_rules;
 
-    load($repo);
-    @rules = rules( $repo, $user );
-    $deny_rules = option( $repo, 'deny-rules' );
+    # -- deal with cache --
+    my $n_ts;
+    if (    _cache_permsTS_ok( $repo, \$n_ts )
+        and cache_get( 'SCALAR', 'deny-rules', $repo,          \$deny_rules )
+        and cache_get( 'ARRAY',  'rules',      "$repo, $user", \@rules ) ) {
+        # nothing to do
+    } else {
+        load($repo);
+        @rules = rules( $repo, $user );
+        $deny_rules = option( $repo, 'deny-rules' );
+
+        # save stuff
+        cache_set( 'SCALAR', 'deny-rules', $repo, $deny_rules || 0 );
+        cache_set( 'ARRAY', 'rules', "$repo, $user", @rules );
+        # save gl-perms timestamp
+        cache_set( 'SCALAR', 'gl-perms.TS', $repo, $n_ts );
+    }
 
     # sanity check the only piece the user can control
     _die "invalid characters in ref or filename: '$ref'\n" unless $ref =~ $REF_OR_FILENAME_PATT;
@@ -310,6 +325,8 @@ sub memberships {
     my ( $type, $base, $repo ) = @_;
     $repo ||= '';
     my @ret;
+    return @ret if cache_get( 'ARRAY', 'memberships', "$type, $base, $repo", \@ret );
+
     my $base2 = '';
 
     @ret = ( $base, '@all' );
@@ -346,6 +363,16 @@ sub memberships {
 
     @ret = @{ sort_u( \@ret ) };
     trace( 3, sort @ret );
+    cache_set(
+        'ARRAY',
+        'memberships',
+        (
+            $type eq 'user'
+            ? "$type, $repo, $base"     # need repo up front for easy flushing
+            : "$type, $base, $repo"
+        ),
+        @ret
+    );
     return @ret;
 }
 
@@ -449,6 +476,17 @@ sub creator {
     }
 }
 
+sub _cache_permsTS_ok {
+    my ($repo, $ref) = @_;
+
+    # timestamp of gl-perms file, on disk versus cached
+    my $o_ts; cache_get('SCALAR', 'gl-perms.TS', $repo, \$o_ts); $o_ts ||= 0;
+    my $n_ts = ( stat "$ENV{GL_REPO_BASE}/$repo.git/gl-perms" )[9] || 0;
+    ${$ref} = $n_ts;
+    cache_flush_repo($repo) if $o_ts != $n_ts;
+    return $o_ts == $n_ts;
+}
+
 # ----------------------------------------------------------------------
 # api functions
 # ----------------------------------------------------------------------