aboutsummaryrefslogtreecommitdiff
blob: 5568b3f7bd35612101addf60dcd608cdf0cc9dc6 (plain)
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
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
        hook_1($repo) if -d "$repo.git" and not -f "$repo.git/gl-conf";

        if ( not -d "$repo.git" ) {
            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} );
    my $phy_repos = list_phy_repos(1);

    for my $repo ( @{$phy_repos} ) {
        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 ( $repos{$repo} or $configs{$repo} ) and -d "$repo.git";

    my ( %one_repo, %one_config );

    open( my $compiled_fh, ">", "$repo.git/gl-conf" ) or return;

    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 $compiled_fh $dumped_data;
    close $compiled_fh;

    $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;