src/lib/Gitolite/Conf/Load.pm

   1 package Gitolite::Conf::Load;
   2
   3 # load conf data from stored files
   4 # ----------------------------------------------------------------------
   5
   6 @EXPORT = qw(
   7   load
   8
   9   access
  10   git_config
  11   env_options
  12
  13   option
  14   repo_missing
  15   creator
  16
  17   vrefs
  18   lister_dispatch
  19 );
  20
  21 use Exporter 'import';
  22 use Cwd;
  23
  24 use Gitolite::Rc;
  25 use Gitolite::Common;
  26
  27 use strict;
  28 use warnings;
  29
  30 # ----------------------------------------------------------------------
  31
  32 # our variables, because they get loaded by a 'do'
  33 our $data_version = '';
  34 our %repos;
  35 our %one_repo;
  36 our %groups;
  37 our %patterns;
  38 our %configs;
  39 our %one_config;
  40 our %split_conf;
  41
  42 my $subconf = 'master';
  43
  44 my %listers = (
  45     'list-groups'      => \&list_groups,
  46     'list-users'       => \&list_users,
  47     'list-repos'       => \&list_repos,
  48     'list-memberships' => \&list_memberships,
  49     'list-members'     => \&list_members,
  50 );
  51
  52 # helps maintain the "cache" in both "load_common" and "load_1"
  53 my $last_repo = '';
  54
  55 # ----------------------------------------------------------------------
  56
  57 {
  58     my $loaded_repo = '';
  59
  60     sub load {
  61         my $repo = shift or _die "load() needs a reponame";
  62         trace( 3, "$repo" );
  63         if ( $repo ne $loaded_repo ) {
  64             load_common();
  65             load_1($repo);
  66             $loaded_repo = $repo;
  67         }
  68     }
  69 }
  70
  71 sub access {
  72     my ( $repo, $user, $aa, $ref ) = @_;
  73     trace( 2, $repo, $user, $aa, $ref );
  74     _die "invalid user '$user'" if not( $user and $user =~ $USERNAME_PATT );
  75     sanity($repo);
  76     return "$aa any $repo $user DENIED by fallthru" unless update_hook_present($repo);
  77
  78     my @rules;
  79     my $deny_rules;
  80
  81     load($repo);
  82     @rules = rules( $repo, $user );
  83     $deny_rules = option( $repo, 'deny-rules' );
  84
  85     # sanity check the only piece the user can control
  86     _die "invalid characters in ref or filename: '$ref'\n" unless $ref =~ m(^VREF/NAME/) or $ref =~ $REF_OR_FILENAME_PATT;
  87     # apparently we can't always force sanity; at least what we *return*
  88     # should be sane/safe.  This pattern is based on REF_OR_FILENAME_PATT.
  89     ( my $safe_ref = $ref ) =~ s([^-0-9a-zA-Z._\@/+ :,])(.)g;
  90     trace( 3, "safe_ref", $safe_ref ) if $ref ne $safe_ref;
  91
  92     # when a real repo doesn't exist, ^C is a pre-requisite for any other
  93     # check to give valid results.
  94     if ( $aa ne '^C' and $repo !~ /^\@/ and $repo =~ $REPONAME_PATT and repo_missing($repo) ) {
  95         my $iret = access( $repo, $user, '^C', $ref );
  96         $iret =~ s/\^C/$aa/;
  97         return $iret if $iret =~ /DENIED/;
  98     }
  99     # similarly, ^C must be denied if the repo exists
 100     if ( $aa eq '^C' and not repo_missing($repo) ) {
 101         trace( 2, "DENIED by existence" );
 102         return "$aa $safe_ref $repo $user DENIED by existence";
 103     }
 104
 105     trace( 3, scalar(@rules) . " rules found" );
 106
 107     $rc{RULE_TRACE} = '';
 108     for my $r (@rules) {
 109         $rc{RULE_TRACE} .= " " . $r->[0] . " ";
 110
 111         my $perm = $r->[1];
 112         my $refex = $r->[2]; $refex =~ s(/USER/)(/$user/);
 113         trace( 3, "perm=$perm, refex=$refex" );
 114
 115         $rc{RULE_TRACE} .= "d";
 116         # skip 'deny' rules if the ref is not (yet) known
 117         next if $perm eq '-' and $ref eq 'any' and not $deny_rules;
 118
 119         $rc{RULE_TRACE} .= "r";
 120         # rule matches if ref matches or ref is any (see gitolite-shell)
 121         next unless $ref =~ /^$refex/ or $ref eq 'any';
 122
 123         $rc{RULE_TRACE} .= "D";
 124         trace( 2, "DENIED by $refex" ) if $perm eq '-';
 125         return "$aa $safe_ref $repo $user DENIED by $refex" if $perm eq '-';
 126
 127         # For repo creation, perm will be C and aa will be "^C".  For branch
 128         # access, $perm can be RW\+?(C|D|CD|DC)?M?, and $aa can be W, +, C or
 129         # D, or any of these followed by "M".
 130
 131         # We need to turn $aa into a regex that can match a suitable $perm.
 132         # This is trivially true for "^C", "W" and "D", but the others (+, C,
 133         # M) need some tweaking.
 134
 135         # first, quote the '+':
 136         ( my $aaq = $aa ) =~ s/\+/\\+/;
 137         # if aa is just "C", the user is trying to create a *branch* (not a
 138         # *repo*), so let's make the pattern clearer to reflect that.
 139         $aaq = "RW.*C" if $aaq eq "C";
 140         # if the aa is, say "WM", make this "W.*M" because the perm could be
 141         # 'RW+M', 'RW+CDM' etc, and they are all valid:
 142         $aaq =~ s/M/.*M/;
 143
 144         $rc{RULE_TRACE} .= "A";
 145
 146         # as far as *this* ref is concerned we're ok
 147         return $refex if ( $perm =~ /$aaq/ );
 148
 149         $rc{RULE_TRACE} .= "p";
 150     }
 151     $rc{RULE_TRACE} .= " F";
 152
 153     trace( 2, "DENIED by fallthru" );
 154     return "$aa $safe_ref $repo $user DENIED by fallthru";
 155 }
 156
 157 # cache control
 158 if ($rc{CACHE}) {
 159     require Gitolite::Cache;
 160     Gitolite::Cache::cache_wrap('Gitolite::Conf::Load::access');
 161 }
 162
 163 sub git_config {
 164     my ( $repo, $key, $empty_values_OK ) = @_;
 165     $key ||= '.';
 166
 167     if ( repo_missing($repo) ) {
 168         load_common();
 169     } else {
 170         load($repo);
 171     }
 172
 173     # read comments bottom up
 174     my %ret =
 175       # and take the second and third elements to make up your new hash
 176       map { $_->[1] => $_->[2] }
 177       # keep only the ones where the second element matches your key
 178       grep { $_->[1] =~ qr($key) }
 179       # sort this list of listrefs by the first element in each list ref'd to
 180       sort { $a->[0] <=> $b->[0] }
 181       # dereference it (into a list of listrefs)
 182       map { @$_ }
 183       # take the value of that entry
 184       map { $configs{$_} }
 185       # if it has an entry in %configs
 186       grep { $configs{$_} }
 187       # for each "repo" that represents us
 188       memberships( 'repo', $repo );
 189
 190     # %configs looks like this (for each 'foo' that is in memberships())
 191     # 'foo' => [ [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ] ],
 192     # the first map gets you the value
 193     #          [ [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ] ],
 194     # the deref gets you
 195     #            [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ], [ 8, 'foo.czar', 'jule' ]
 196     # the sort rearranges it (in this case it's already sorted but anyway...)
 197     # the grep gets you this, assuming the key is foo.bar (and "." is regex ".')
 198     #            [ 6, 'foo.bar', 'repo' ], [ 7, 'foodbar', 'repoD' ]
 199     # and the final map does this:
 200     #                 'foo.bar'=>'repo'  ,      'foodbar'=>'repoD'
 201
 202     # now some of these will have an empty key; we need to delete them unless
 203     # we're told empty values are OK
 204     unless ($empty_values_OK) {
 205         my ( $k, $v );
 206         while ( ( $k, $v ) = each %ret ) {
 207             delete $ret{$k} if not $v;
 208         }
 209     }
 210
 211     my ( $k, $v );
 212     my $creator = creator($repo);
 213     while ( ( $k, $v ) = each %ret ) {
 214         $v =~ s/%GL_REPO/$repo/g;
 215         $v =~ s/%GL_CREATOR/$creator/g if $creator;
 216         $ret{$k} = $v;
 217     }
 218
 219     map { trace( 3, "$_", "$ret{$_}" ) } ( sort keys %ret ) if $ENV{D};
 220     return \%ret;
 221 }
 222
 223 sub env_options {
 224     return unless -f "$rc{GL_ADMIN_BASE}/conf/gitolite.conf-compiled.pm";
 225     # prevent catch-22 during initial install
 226
 227     my $cwd = getcwd();
 228
 229     my $repo = shift;
 230     map { delete $ENV{$_} } grep { /^GL_OPTION_/ } keys %ENV;
 231     my $h = git_config( $repo, '^gitolite-options.ENV\.' );
 232     while ( my ( $k, $v ) = each %$h ) {
 233         next unless $k =~ /^gitolite-options.ENV\.(\w+)$/;
 234         $ENV{ "GL_OPTION_" . $1 } = $v;
 235     }
 236
 237     chdir($cwd);
 238 }
 239
 240 sub option {
 241     my ( $repo, $option ) = @_;
 242     $option = "gitolite-options.$option";
 243     my $ret = git_config( $repo, "^\Q$option\E\$" );
 244     return '' unless %$ret;
 245     return $ret->{$option};
 246 }
 247
 248 sub sanity {
 249     my ($repo, $patt) = @_;
 250     $patt ||= $REPOPATT_PATT;
 251
 252     _die "invalid repo '$repo'" if not( $repo and $repo =~ $patt );
 253     _die "'$repo' ends with a '/'"  if $repo =~ m(/$);
 254     _die "'$repo' contains '..'"    if $repo =~ $REPONAME_PATT and $repo =~ m(\.\.);
 255     _die "'$repo' contains '.git/'" if $repo =~ $REPONAME_PATT and $repo =~ m(\.git/);
 256     _die "'$repo' ends with '.git'" if $repo =~ m(\.git$);
 257 }
 258
 259 sub repo_missing {
 260     my $repo = shift;
 261     sanity($repo);
 262
 263     return not -d "$rc{GL_REPO_BASE}/$repo.git";
 264 }
 265
 266 # ----------------------------------------------------------------------
 267
 268 sub load_common {
 269
 270     _chdir( $rc{GL_ADMIN_BASE} );
 271
 272     # we take an unusual approach to caching this function!
 273     # (requires that first call to load_common is before first call to load_1)
 274     if ( $last_repo and $split_conf{$last_repo} ) {
 275         delete $repos{$last_repo};
 276         delete $configs{$last_repo};
 277         return;
 278     }
 279
 280     my $cc = "./conf/gitolite.conf-compiled.pm";
 281
 282     _die "parse '$cc' failed: " . ( $! or $@ ) unless do $cc;
 283
 284     if ( data_version_mismatch() ) {
 285         _system("gitolite setup");
 286         _die "parse '$cc' failed: " . ( $! or $@ ) unless do $cc;
 287         _die "data version update failed; this is serious" if data_version_mismatch();
 288     }
 289 }
 290
 291 sub load_1 {
 292     my $repo = shift;
 293     return if $repo =~ /^\@/;
 294     trace( 3, $repo );
 295
 296     if ( repo_missing($repo) ) {
 297         trace( 1, "repo '$repo' missing" ) if $repo =~ $REPONAME_PATT;
 298         return;
 299     }
 300     _chdir("$rc{GL_REPO_BASE}/$repo.git");
 301
 302     if ( $repo eq $last_repo ) {
 303         $repos{$repo} = $one_repo{$repo};
 304         $configs{$repo} = $one_config{$repo} if $one_config{$repo};
 305         return;
 306     }
 307
 308     if ( -f "gl-conf" ) {
 309         return if not $split_conf{$repo} and not $rc{ALLOW_ORPHAN_GL_CONF};
 310
 311         my $cc = "./gl-conf";
 312         _die "parse '$cc' failed: " . ( $@ or $! ) unless do $cc;
 313
 314         $last_repo = $repo;
 315         $repos{$repo} = $one_repo{$repo};
 316         $configs{$repo} = $one_config{$repo} if $one_config{$repo};
 317     } else {
 318         _die "split conf set, gl-conf not present for '$repo'" if $split_conf{$repo};
 319     }
 320 }
 321
 322 {
 323     my $lastrepo = '';
 324     my $lastuser = '';
 325     my @cached   = ();
 326
 327     sub rules {
 328         my ( $repo, $user ) = @_;
 329         trace( 3, $repo, $user );
 330
 331         return @cached if ( $lastrepo eq $repo and $lastuser eq $user and @cached );
 332
 333         my @rules = ();
 334
 335         my @repos = memberships( 'repo', $repo );
 336         my @users = memberships( 'user', $user, $repo );
 337         trace( 3, "memberships: " . scalar(@repos) . " repos and " . scalar(@users) . " users found" );
 338
 339         for my $r (@repos) {
 340             for my $u (@users) {
 341                 push @rules, @{ $repos{$r}{$u} } if exists $repos{$r} and exists $repos{$r}{$u};
 342             }
 343         }
 344
 345         @rules = sort { $a->[0] <=> $b->[0] } @rules;
 346
 347         $lastrepo = $repo;
 348         $lastuser = $user;
 349         @cached   = @rules;
 350
 351         # however if the repo was missing, invalidate the cache
 352         $lastrepo = '' if repo_missing($repo);
 353
 354         return @rules;
 355     }
 356
 357     sub vrefs {
 358         my ( $repo, $user ) = @_;
 359         # fill the cache if needed
 360         rules( $repo, $user ) unless ( $lastrepo eq $repo and $lastuser eq $user and @cached );
 361
 362         my %seen;
 363         my @vrefs = grep { /^VREF\// and not $seen{$_}++ } map { $_->[2] } @cached;
 364         return @vrefs;
 365     }
 366 }
 367
 368 sub memberships {
 369     trace( 3, @_ );
 370     my ( $type, $base, $repo ) = @_;
 371     $repo ||= '';
 372     my @ret;
 373     my $base2 = '';
 374
 375     @ret = ( $base, '@all' );
 376
 377     if ( $type eq 'repo' ) {
 378         # first, if a repo, say, pub/sitaram/project, has a gl-creator file
 379         # that says "sitaram", find memberships for pub/CREATOR/project also
 380         $base2 = generic_name($base);
 381
 382         # second, you need to check in %repos also
 383         for my $i ( keys %repos, keys %configs ) {
 384             if ( $base eq $i or $base =~ /^$i$/ or $base2 and ( $base2 eq $i or $base2 =~ /^$i$/ ) ) {
 385                 push @ret, $i;
 386             }
 387         }
 388
 389         # add in any group names explicitly given in (GIT_DIR)/gl-repo-groups
 390         push @ret,
 391             map { s/^\@?/\@/; $_ }
 392             grep { ! /[^\w@-]/ }
 393             split (' ', slurp("$ENV{GL_REPO_BASE}/$base.git/gl-repo-groups"))
 394                 if -f         "$ENV{GL_REPO_BASE}/$base.git/gl-repo-groups";
 395     }
 396
 397     push @ret, @{ $groups{$base} } if exists $groups{$base};
 398     push @ret, @{ $groups{$base2} } if $base2 and exists $groups{$base2};
 399     if ($type eq 'repo') {
 400         # regexes can only be used for repos, not for users
 401         for my $i ( keys %{ $patterns{groups} } ) {
 402             if ( $base =~ /^$i$/ or $base2 and ( $base2 =~ /^$i$/ ) ) {
 403                 push @ret, @{ $groups{$i} };
 404             }
 405         }
 406     }
 407
 408     push @ret, @{ ext_grouplist($base) } if $type eq 'user' and $rc{GROUPLIST_PGM};
 409
 410     if ( $type eq 'user' and $repo and not repo_missing($repo) ) {
 411         # find the roles this user has when accessing this repo and add those
 412         # in as groupnames he is a member of.  You need the already existing
 413         # memberships for this; see below this function for an example
 414         push @ret, user_roles( $base, $repo, @ret );
 415     }
 416
 417     @ret = @{ sort_u( \@ret ) };
 418     trace( 3, sort @ret );
 419     return @ret;
 420 }
 421
 422 =for example
 423
 424 conf/gitolite.conf:
 425     @g1 = u1
 426     @g2 = u1
 427     # now user is a member of both g1 and g2
 428
 429 gl-perms for repo being accessed:
 430     READERS @g1
 431
 432 This should result in @READERS being added to the memberships that u1 has
 433 (when accessing this repo).  So we send the current list (@g1, @g2) to
 434 user_roles(), otherwise it has to redo that logic.
 435
 436 =cut
 437
 438 sub data_version_mismatch {
 439     return $data_version ne glrc('current-data-version');
 440 }
 441
 442 sub user_roles {
 443     my ( $user, $repo, @eg ) = @_;
 444
 445     # eg == existing groups (that user is already known to be a member of)
 446     my %eg = map { $_ => 1 } @eg;
 447
 448     my %ret   = ();
 449     my $f     = "$rc{GL_REPO_BASE}/$repo.git/gl-perms";
 450     my @roles = ();
 451     if ( -f $f ) {
 452         my $fh = _open( "<", $f );
 453         chomp( @roles = <$fh> );
 454     }
 455     push @roles, "CREATOR = " . creator($repo);
 456     for (@roles) {
 457         # READERS u3 u4 @g1
 458         s/^\s+//; s/ +$//; s/=/ /; s/\s+/ /g; s/^\@//;
 459         next if /^#/;
 460         next unless /\S/;
 461         my ( $role, @members ) = split;
 462         # role = READERS, members = u3, u4, @g1
 463         if ( $role ne 'CREATOR' and not $rc{ROLES}{$role} ) {
 464             _warn "role '$role' not allowed, ignoring";
 465             next;
 466         }
 467         for my $m (@members) {
 468             if ( $m !~ $USERNAME_PATT ) {
 469                 _warn "ignoring '$m' in perms line";
 470                 next;
 471             }
 472             # if user eq u3/u4, or is a member of @g1, he has role READERS
 473             $ret{ '@' . $role } = 1 if $m eq $user or $eg{$m};
 474         }
 475     }
 476
 477     return keys %ret;
 478 }
 479
 480 sub generic_name {
 481     my $base  = shift;
 482     my $base2 = '';
 483     my $creator;
 484
 485     # get the creator name.  For not-yet-born repos this is $ENV{GL_USER},
 486     # which should be set in all cases that we care about, viz., where we are
 487     # checking ^C permissions before new_wild_repo(), and the info command.
 488     # In particular, 'gitolite access' can't be used to check ^C perms on wild
 489     # repos that contain "CREATOR" if GL_USER is not set.
 490     $creator = creator($base);
 491
 492     $base2 = $base;
 493     $base2 =~ s(\b$creator\b)(CREATOR) if $creator;
 494     $base2 = '' if $base2 eq $base;    # if there was no change
 495
 496     return $base2;
 497 }
 498
 499 sub creator {
 500     my $repo = shift;
 501     sanity($repo);
 502
 503     return ( $ENV{GL_USER} || '' ) if repo_missing($repo);
 504     my $f       = "$rc{GL_REPO_BASE}/$repo.git/gl-creator";
 505     my $creator = '';
 506     chomp( $creator = slurp($f) ) if -f $f;
 507     return $creator;
 508 }
 509
 510 {
 511     my %cache = ();
 512
 513     sub ext_grouplist {
 514         my $user = shift;
 515         my $pgm  = $rc{GROUPLIST_PGM};
 516         return [] if not $pgm;
 517
 518         return $cache{$user} if $cache{$user};
 519         my @extgroups = map { s/^@?/@/; $_; } split ' ', `$rc{GROUPLIST_PGM} $user`;
 520         return ( $cache{$user} = \@extgroups );
 521     }
 522 }
 523
 524 # ----------------------------------------------------------------------
 525 # api functions
 526 # ----------------------------------------------------------------------
 527
 528 sub lister_dispatch {
 529     my $command = shift;
 530
 531     my $fn = $listers{$command} or _die "unknown gitolite sub-command";
 532     return $fn;
 533 }
 534
 535 =for list_groups
 536 Usage:  gitolite list-groups
 537
 538   - lists all group names in conf
 539   - no options, no flags
 540 =cut
 541
 542 sub list_groups {
 543     usage() if @_;
 544
 545     load_common();
 546
 547     my @g = ();
 548     while ( my ( $k, $v ) = each(%groups) ) {
 549         push @g, @{$v};
 550     }
 551     return ( sort_u( \@g ) );
 552 }
 553
 554 =for list_users
 555 Usage:  gitolite list-users [<repo name pattern>]
 556
 557 List all users and groups explicitly named in a rule.
 558
 559 -   you will have to run 'list-members' on each group name to expand it -- for
 560     details and caveats on that please see its help message.
 561 -   User names not mentioned in an access rule will not show up at all (for
 562     example, if you have users who only have access via an '@all' rule).
 563
 564 WARNING: may be slow if you have thousands of repos.  The optional repo name
 565 pattern is an unanchored regex; it can speed things up if you're interested
 566 only in users of a matching set of repos.  This is only an optimisation, not
 567 an actual access list; you will still have to pipe it to 'gitolite access'
 568 with appropriate arguments to get an actual access list.
 569
 570 NOTE: If you're running in ssh mode, it may be simpler to parse the authorized
 571 keys file in ~/.ssh, like so:
 572     perl -lne '/ ([a-z0-9]+)"/; print $1 if $1' < ~/.ssh/authorized_keys | sort -u
 573 If you're running in http mode, only your web server knows all the potential
 574 user names.
 575 =cut
 576
 577 sub list_users {
 578     my $patt = shift || '.';
 579     usage() if $patt eq '-h' or @_;
 580     my $count = 0;
 581     my $total = 0;
 582
 583     load_common();
 584
 585     my @u = map { keys %{$_} } values %repos;
 586     $total = scalar( grep { /$patt/ } keys %split_conf );
 587     warn "WARNING: you have $total repos to check; this could take some time!\n" if $total > 100;
 588     for my $one ( grep { /$patt/ } keys %split_conf ) {
 589         load_1($one);
 590         $count++; print STDERR "$count / $total\r" if not( $count % 100 ) and timer(5);
 591         push @u, map { keys %{$_} } values %one_repo;
 592     }
 593     print STDERR "\n" if $count >= 100;
 594     return ( sort_u( \@u ) );
 595 }
 596
 597 =for list_repos
 598 Usage:  gitolite list-repos
 599
 600   - lists all repos/repo groups in conf
 601   - no options, no flags
 602 =cut
 603
 604 sub list_repos {
 605     usage() if @_;
 606
 607     load_common();
 608
 609     my @r = keys %repos;
 610     push @r, keys %split_conf;
 611
 612     return ( sort_u( \@r ) );
 613 }
 614
 615 =for list_memberships
 616 Usage:  gitolite list-memberships -u|-r <name>
 617
 618 List all groups a name is a member of.  One of the flags '-u' or '-r' is
 619 mandatory, to specify if the name is a user or a repo.
 620
 621 For users, the output includes the result from GROUPLIST_PGM, if it is
 622 defined.  For repos, the output includes any repo patterns that the repo name
 623 matches, as well as any groups that contain those patterns.
 624 =cut
 625
 626 sub list_memberships {
 627     require Getopt::Long;
 628
 629     my ( $user, $repo, $help );
 630
 631     Getopt::Long::GetOptionsFromArray(
 632         \@_,
 633         'user|u=s' => \$user,
 634         'repo|r=s' => \$repo,
 635         'help|h'   => \$help,
 636     );
 637     usage() if $help or ( not $user and not $repo );
 638
 639     load_common();
 640     my @m;
 641
 642     if ( $user and $repo ) {
 643         # unsupported/undocumented except via "in_role()" in Easy.pm
 644         @m = memberships( 'user', $user, $repo );
 645     } elsif ($user) {
 646         @m = memberships( 'user', $user );
 647     } elsif ($repo) {
 648         @m = memberships( 'repo', $repo );
 649     }
 650
 651     @m = grep { $_ ne '@all' and $_ ne ( $user || $repo ) } @m;
 652     return ( sort_u( \@m ) );
 653 }
 654
 655 =for list_members
 656 Usage:  gitolite list-members <group name>
 657
 658   - list all members of a group
 659   - takes one group name
 660
 661 '@all' is not expandable in this context.  Also, if you have GROUPLIST_PGM set
 662 in your rc file[1], gitolite cannot expand group names completely; only your
 663 external database can.
 664
 665 [1]: http://gitolite.com/gitolite/conf.html#getting-user-group-info-from-ldap
 666
 667 =cut
 668
 669 sub list_members {
 670     usage() if @_ and $_[0] eq '-h' or not @_;
 671
 672     my $name = shift;
 673
 674     load_common();
 675
 676     my @m = ();
 677     while ( my ( $k, $v ) = each(%groups) ) {
 678         for my $g ( @{$v} ) {
 679             push @m, $k if $g eq $name;
 680         }
 681     }
 682
 683     return ( sort_u( \@m ) );
 684 }
 685
 686 # ----------------------------------------------------------------------
 687
 688 {
 689     my $start_time = 0;
 690
 691     sub timer {
 692         unless ($start_time) {
 693             $start_time = time();
 694             return 0;
 695         }
 696         my $elapsed = shift;
 697         return 0 if time() - $start_time < $elapsed;
 698         $start_time = time();
 699         return 1;
 700     }
 701 }
 702
 703 1;
 704