1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
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
|
