deac/gitolite
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

sugar high!

Browse source 
make it easy to handle syntactic sugar.  In summary, compile now calls
parse(sugar('gitolite.conf')).

Details:

  - cleanup_conf_line went from subar.pm to common.pm
  - explode() and minions went from conf.pm to the new explode.pm
  - the callback went away; everyone just passes whole arrays around now
  - the new sugar() takes a filename and returns a listref
  - all sugar scripts take and return a listref

  - the first "built-in" sugar is written (setting gitweb.owner and
    gitweb.description)

the new RC file format (of being a hash called %rc) is getting a nice
workout :-)
This commit is contained in:
Sitaram Chamarty 2012-03-09 21:23:16 +05:30
parent 4ab8db4925
commit acb2f8fe8e
4 changed files with 219 additions and 170 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
Gitolite/Common.pm
View file

@ -8,7 +8,7 @@ package Gitolite::Common;
print2 dbg _mkdir _open ln_sf tsh_rc sort_u print2 dbg _mkdir _open ln_sf tsh_rc sort_u
say _warn _chdir _print tsh_text list_phy_repos say _warn _chdir _print tsh_text list_phy_repos
say2 _die slurp tsh_lines say2 _die slurp tsh_lines
trace tsh_try trace cleanup_conf_line tsh_try
usage tsh_run usage tsh_run
); );
#>>> #>>>
@ -143,6 +143,19 @@ sub sort_u {
return \@sort_u; return \@sort_u;
} }
sub cleanup_conf_line {
my $line = shift;
# kill comments, but take care of "#" inside *simple* strings
$line =~ s/^((".*?"|[^#"])*)#.*/$1/;
# normalise whitespace; keeps later regexes very simple
$line =~ s/=/ = /;
$line =~ s/\s+/ /g;
$line =~ s/^ //;
$line =~ s/ $//;
return $line;
}
{ {
my @phy_repos = (); my @phy_repos = ();

162
Gitolite/Conf.pm
View file

@ -23,13 +23,6 @@ use warnings;
# ---------------------------------------------------------------------- # ----------------------------------------------------------------------
# 'seen' for include/subconf files
my %included = ();
# 'seen' for group names on LHS
my %prefixed_groupname = ();
# ----------------------------------------------------------------------
sub compile { sub compile {
trace(3); trace(3);
# XXX assume we're in admin-base/conf # XXX assume we're in admin-base/conf
@ -37,7 +30,7 @@ sub compile {
_chdir( $rc{GL_ADMIN_BASE} ); _chdir( $rc{GL_ADMIN_BASE} );
_chdir("conf"); _chdir("conf");
explode( 'gitolite.conf', 'master', \&parse ); parse(sugar('gitolite.conf'));
# the order matters; new repos should be created first, to give store a # the order matters; new repos should be created first, to give store a
# place to put the individual gl-conf files # place to put the individual gl-conf files
@ -45,139 +38,42 @@ sub compile {
store(); store();
} }
sub explode {
trace( 4, @_ );
my ( $file, $subconf, $parser ) = @_;
# $parser is a ref to a callback; if not supplied we just print
$parser ||= sub { print shift, "\n"; };
# seed the 'seen' list if it's empty
$included{ device_inode("conf/gitolite.conf") }++ unless %included;
my $fh = _open( "<", $file );
my @fh = <$fh>;
my @lines = macro_expand( "# BEGIN $file\n", @fh, "# END $file\n" );
my $line;
while (@lines) {
$line = shift @lines;
$line = cleanup_conf_line($line);
next unless $line =~ /\S/;
$line = prefix_groupnames( $line, $subconf ) if $subconf ne 'master';
if ( $line =~ /^(include|subconf) "(.+)"$/ or $line =~ /^(include|subconf) '(.+)'$/ ) {
incsub( $1, $2, $subconf, $parser );
} else {
# normal line, send it to the callback function
$parser->($line);
}
}
}
sub parse { sub parse {
trace( 4, @_ ); my $lines = shift;
my $line = shift; trace(4, scalar(@$lines) . " lines incoming");
# user or repo groups for my $line (@$lines) {
if ( $line =~ /^(@\S+) = (.*)/ ) { # user or repo groups
add_to_group( $1, split( ' ', $2 ) ); if ( $line =~ /^(@\S+) = (.*)/ ) {
} elsif ( $line =~ /^repo (.*)/ ) { add_to_group( $1, split( ' ', $2 ) );
set_repolist( split( ' ', $1 ) ); } elsif ( $line =~ /^repo (.*)/ ) {
} elsif ( $line =~ /^(-|C|R|RW\+?(?:C?D?|D?C?)M?) (.* )?= (.+)/ ) { set_repolist( split( ' ', $1 ) );
my $perm = $1; } elsif ( $line =~ /^(-|C|R|RW\+?(?:C?D?|D?C?)M?) (.* )?= (.+)/ ) {
my @refs = parse_refs( $2 || '' ); my $perm = $1;
my @users = parse_users($3); my @refs = parse_refs( $2 || '' );
my @users = parse_users($3);
# XXX what do we do? s/\bCREAT[EO]R\b/~\$creator/g for @users; # XXX what do we do? s/\bCREAT[EO]R\b/~\$creator/g for @users;
for my $ref (@refs) { for my $ref (@refs) {
for my $user (@users) { for my $user (@users) {
add_rule( $perm, $ref, $user ); add_rule( $perm, $ref, $user );
}
} }
} } elsif ( $line =~ /^config (.+) = ?(.*)/ ) {
} elsif ( $line =~ /^config (.+) = ?(.*)/ ) { my ( $key, $value ) = ( $1, $2 );
my ( $key, $value ) = ( $1, $2 ); my @validkeys = split( ' ', ( $rc{GL_GITCONFIG_KEYS} || '' ) );
my @validkeys = split( ' ', ( $rc{GL_GITCONFIG_KEYS} || '' ) ); push @validkeys, "gitolite-options\\..*";
push @validkeys, "gitolite-options\\..*"; my @matched = grep { $key =~ /^$_$/ } @validkeys;
my @matched = grep { $key =~ /^$_$/ } @validkeys; # XXX move this also to add_config: _die "git config $key not allowed\ncheck GL_GITCONFIG_KEYS in the rc file for how to allow it" if (@matched < 1);
# XXX move this also to add_config: _die "git config $key not allowed\ncheck GL_GITCONFIG_KEYS in the rc file for how to allow it" if (@matched < 1); # XXX both $key and $value must satisfy a liberal but secure pattern
# XXX both $key and $value must satisfy a liberal but secure pattern add_config( 1, $key, $value );
add_config( 1, $key, $value ); } elsif ( $line =~ /^subconf (\S+)$/ ) {
} elsif ( $line =~ /^subconf (\S+)$/ ) { set_subconf($1);
set_subconf($1);
} else {
_warn "?? $line";
}
}
# ----------------------------------------------------------------------
sub incsub {
my $is_subconf = ( +shift eq 'subconf' );
my ( $include_glob, $subconf, $parser ) = @_;
_die "subconf $subconf attempting to run 'subconf'\n" if $is_subconf and $subconf ne 'master';
# XXX move this to Macros... substitute HOSTNAME word if GL_HOSTNAME defined, otherwise leave as is
# $include_glob =~ s/\bHOSTNAME\b/$GL_HOSTNAME/ if $GL_HOSTNAME;
# XXX g2 diff: include glob is *implicitly* from $rc{GL_ADMIN_BASE}/conf, not *explicitly*
# for my $file (glob($include_glob =~ m(^/) ? $include_glob : "$rc{GL_ADMIN_BASE}/conf/$include_glob")) {
trace( 3, $is_subconf, $include_glob );
for my $file ( glob($include_glob) ) {
_warn("included file not found: '$file'"), next unless -f $file;
_die "invalid include/subconf filename $file" unless $file =~ m(([^/]+).conf$);
my $basename = $1;
next if already_included($file);
if ($is_subconf) {
$parser->("subconf $basename");
explode( $file, $basename, $parser );
$parser->("subconf $subconf");
# XXX g2 delegaton compat: deal with this: $subconf_seen++;
} else { } else {
explode( $file, $subconf, $parser ); _warn "?? $line";
} }
} }
} }
sub prefix_groupnames {
my ( $line, $subconf ) = @_;
my $lhs = '';
# save 'foo' if it's an '@foo = list' line
$lhs = $1 if $line =~ /^@(\S+) = /;
# prefix all @groups in the line
$line =~ s/(^| )(@\S+)(?= |$)/ $1 . ($prefixed_groupname{$subconf}{$2} || $2) /ge;
# now prefix the LHS and store it if needed
if ($lhs) {
$line =~ s/^@\S+ = /"\@$subconf.$lhs = "/e;
trace( 3, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" );
}
return $line;
}
sub already_included {
my $file = shift;
my $file_id = device_inode($file);
return 0 unless $included{$file_id}++;
_warn("$file already included");
trace( 3, "$file already included" );
return 1;
}
sub device_inode {
my $file = shift;
trace( 3, $file, ( stat $file )[ 0, 1 ] );
return join( "/", ( stat $file )[ 0, 1 ] );
}
1; 1;

121
Gitolite/Conf/Explode.pm Normal file
View file

@ -0,0 +1,121 @@
package Gitolite::Conf::Explode;
# include/subconf processor
# ----------------------------------------------------------------------
@EXPORT = qw(
explode
);
use Exporter 'import';
use lib $ENV{GL_BINDIR};
use Gitolite::Common;
use strict;
use warnings;
# ----------------------------------------------------------------------
# 'seen' for include/subconf files
my %included = ();
# 'seen' for group names on LHS
my %prefixed_groupname = ();
sub explode {
trace( 4, @_ );
my ( $file, $subconf, $out ) = @_;
# seed the 'seen' list if it's empty
$included{ device_inode("conf/gitolite.conf") }++ unless %included;
my $fh = _open( "<", $file );
while (<$fh>) {
my $line = cleanup_conf_line($_);
next unless $line =~ /\S/;
$line = prefix_groupnames( $line, $subconf ) if $subconf ne 'master';
if ( $line =~ /^(include|subconf) (\S.+)$/ ) {
incsub( $1, $2, $subconf, $out );
} else {
# normal line, send it to the callback function
push @{$out}, $line;
}
}
}
sub incsub {
my $is_subconf = ( +shift eq 'subconf' );
my ( $include_glob, $subconf, $out ) = @_;
_die "subconf $subconf attempting to run 'subconf'\n" if $is_subconf and $subconf ne 'master';
_die "invalid include/subconf file/glob '$include_glob'"
unless $include_glob =~ /^"(.+)"$/
or $include_glob =~ /^'(.+)'$/;
$include_glob = $1;
# XXX move this to Macros... substitute HOSTNAME word if GL_HOSTNAME defined, otherwise leave as is
# $include_glob =~ s/\bHOSTNAME\b/$GL_HOSTNAME/ if $GL_HOSTNAME;
# XXX g2 diff: include glob is *implicitly* from $rc{GL_ADMIN_BASE}/conf, not *explicitly*
# for my $file (glob($include_glob =~ m(^/) ? $include_glob : "$rc{GL_ADMIN_BASE}/conf/$include_glob")) {
trace( 3, $is_subconf, $include_glob );
for my $file ( glob($include_glob) ) {
_warn("included file not found: '$file'"), next unless -f $file;
_die "invalid include/subconf filename $file" unless $file =~ m(([^/]+).conf$);
my $basename = $1;
next if already_included($file);
if ($is_subconf) {
push @{$out}, "subconf $basename";
explode( $file, $basename, $out );
push @{$out}, "subconf $subconf";
# XXX g2 delegaton compat: deal with this: $subconf_seen++;
} else {
explode( $file, $subconf, $out );
}
}
}
sub prefix_groupnames {
my ( $line, $subconf ) = @_;
my $lhs = '';
# save 'foo' if it's an '@foo = list' line
$lhs = $1 if $line =~ /^@(\S+) = /;
# prefix all @groups in the line
$line =~ s/(^| )(@\S+)(?= |$)/ $1 . ($prefixed_groupname{$subconf}{$2} || $2) /ge;
# now prefix the LHS and store it if needed
if ($lhs) {
$line =~ s/^@\S+ = /"\@$subconf.$lhs = "/e;
$prefixed_groupname{$subconf}{"\@$lhs"} = "\@$subconf.$lhs";
trace( 3, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" );
}
return $line;
}
sub already_included {
my $file = shift;
my $file_id = device_inode($file);
return 0 unless $included{$file_id}++;
_warn("$file already included");
trace( 3, "$file already included" );
return 1;
}
sub device_inode {
my $file = shift;
trace( 3, $file, ( stat $file )[ 0, 1 ] );
return join( "/", ( stat $file )[ 0, 1 ] );
}
1;

91
Gitolite/Conf/Sugar.pm
View file

@ -4,78 +4,97 @@ package Gitolite::Conf::Sugar;
# ---------------------------------------------------------------------- # ----------------------------------------------------------------------
@EXPORT = qw( @EXPORT = qw(
macro_expand sugar
cleanup_conf_line
); );
use Exporter 'import'; use Exporter 'import';
use lib $ENV{GL_BINDIR}; use lib $ENV{GL_BINDIR};
use Gitolite::Common;
use Gitolite::Rc; use Gitolite::Rc;
use Gitolite::Common;
use Gitolite::Conf::Explode;
use strict; use strict;
use warnings; use warnings;
# ---------------------------------------------------------------------- # ----------------------------------------------------------------------
sub macro_expand { sub sugar {
# site-local macros, if any, then gitolite internal macros, to munge the # gets a filename, returns a listref
# input conf line if needed
my @lines = @_; my @lines = ();
explode(shift, 'master', \@lines);
# TODO: user macros, how to allow the user to specify them? my $lines;
$lines = \@lines;
# cheat, to keep *our* regexes simple :) # run through the sugar stack one by one
# XXX but this also kills the special '# BEGIN filename' and '# END
# filename' lines that explode() surrounds the actual data with when it
# called macro_expand(). Right now we don't need it, but...
@lines = grep /\S/, map { cleanup_conf_line($_) } @lines;
@lines = owner_desc(@lines); # first, user supplied sugar:
if (exists $rc{SYNTACTIC_SUGAR}) {
if (ref($rc{SYNTACTIC_SUGAR}) ne 'ARRAY') {
_warn "bad syntax for specifying sugar scripts; see docs";
} else {
for my $s (@{ $rc{SYNTACTIC_SUGAR} }) {
_warn "ignoring unreadable sugar script $s" if not -r $s;
do $s if -r $s;
$lines = sugar_script($lines);
$lines = [ grep /\S/, map { cleanup_conf_line($_) } @$lines ];
}
}
}
return @lines; # then our stuff:
}
sub cleanup_conf_line { $lines = owner_desc($lines);
my $line = shift; # $lines = name_vref($lines);
# kill comments, but take care of "#" inside *simple* strings return $lines;
$line =~ s/^((".*?"|[^#"])*)#.*/$1/;
# normalise whitespace; keeps later regexes very simple
$line =~ s/=/ = /;
$line =~ s/\s+/ /g;
$line =~ s/^ //;
$line =~ s/ $//;
return $line;
} }
sub owner_desc { sub owner_desc {
my @lines = @_; my $lines = shift;
my @ret; my @ret;
for my $line (@lines) { # XXX compat breakage: (1) adding repo/owner does not automatically add an
# reponame = "some description string" # entry to projects.list -- we need a post-procesor for that, and (2)
# reponame "owner name" = "some description string" # removing the 'repo' line no longer suffices to remove the config entry
# from projects.list. Maybe the post-procesor should do that as well?
# owner = "owner name"
# -> config gitweb.owner = owner name
# description = "some long description"
# -> config gitweb.description = some long description
# category = "whatever..."
# -> config gitweb.category = whatever...
# older formats:
# repo = "some long description"
# repo = "owner name" = "some long description"
# -> config gitweb.owner = owner name
# -> config gitweb.description = some long description
for my $line (@$lines) {
if ( $line =~ /^(\S+)(?: "(.*?)")? = "(.*)"$/ ) { if ( $line =~ /^(\S+)(?: "(.*?)")? = "(.*)"$/ ) {
my ( $repo, $owner, $desc ) = ( $1, $2, $3 ); my ( $repo, $owner, $desc ) = ( $1, $2, $3 );
# XXX these two checks should go into add_config # XXX these two checks should go into add_config
# _die "bad repo name '$repo'" unless $repo =~ $REPONAME_PATT; # _die "bad repo name '$repo'" unless $repo =~ $REPONAME_PATT;
# _die "$fragment attempting to set description for $repo" # _die "$fragment attempting to set description for $repo"
# if check_fragment_repo_disallowed( $fragment, $repo ); # if check_fragment_repo_disallowed( $fragment, $repo );
push @ret, "config gitolite-options.repo-desc = $desc"; push @ret, "repo $repo";
push @ret, "config gitolite-options.repo-owner = $owner" if $owner; push @ret, "config gitweb.description = $desc";
push @ret, "config gitweb.owner = $owner" if $owner;
} elsif ( $line =~ /^desc = (\S.*)/ ) { } elsif ( $line =~ /^desc = (\S.*)/ ) {
push @ret, "config gitolite-options.repo-desc = $1"; push @ret, "config gitweb.description = $1";
} elsif ( $line =~ /^owner = (\S.*)/ ) { } elsif ( $line =~ /^owner = (\S.*)/ ) {
my ( $repo, $owner, $desc ) = ( $1, $2, $3 ); push @ret, "config gitweb.owner = $1";
push @ret, "config gitolite-options.repo-owner = $1"; } elsif ( $line =~ /^category = (\S.*)/ ) {
push @ret, "config gitweb.category = $1";
} else { } else {
push @ret, $line; push @ret, $line;
} }
} }
return @ret; return \@ret;
} }
1; 1;