src/lib/Gitolite/Conf/Explode.pm

   1 package Gitolite::Conf::Explode;
   2
   3 # include/subconf processor
   4 # ----------------------------------------------------------------------
   5
   6 @EXPORT = qw(
   7   explode
   8 );
   9
  10 use Exporter 'import';
  11
  12 use Gitolite::Rc;
  13 use Gitolite::Common;
  14
  15 use strict;
  16 use warnings;
  17
  18 # ----------------------------------------------------------------------
  19
  20 # 'seen' for include/subconf files
  21 my %included = ();
  22 # 'seen' for group names on LHS
  23 my %prefixed_groupname = ();
  24
  25 sub explode {
  26     trace( 3, @_ );
  27     my ( $file, $subconf, $out ) = @_;
  28
  29     # seed the 'seen' list if it's empty
  30     $included{ device_inode("gitolite.conf") }++ unless %included;
  31
  32     my $fh = _open( "<", $file );
  33     while (<$fh>) {
  34         my $line = cleanup_conf_line($_);
  35         next unless $line =~ /\S/;
  36
  37         # subst %HOSTNAME word if rc defines a hostname, else leave as is
  38         $line =~ s/%HOSTNAME\b/$rc{HOSTNAME}/g if $rc{HOSTNAME};
  39
  40         $line = prefix_groupnames( $line, $subconf ) if $subconf ne 'master';
  41
  42         if ( $line =~ /^(include|subconf) (?:(\S+) )?(\S.+)$/ ) {
  43             incsub( $1, $2, $3, $subconf, $out );
  44         } else {
  45             # normal line, send it to the callback function
  46             push @{$out}, "# $file $.";
  47             push @{$out}, $line;
  48         }
  49     }
  50 }
  51
  52 sub incsub {
  53     my $is_subconf = ( +shift eq 'subconf' );
  54     my ( $new_subconf, $include_glob, $current_subconf, $out ) = @_;
  55
  56     _die "subconf '$current_subconf' attempting to run 'subconf'\n" if $is_subconf and $current_subconf ne 'master';
  57
  58     _die "invalid include/subconf file/glob '$include_glob'"
  59       unless $include_glob =~ /^"(.+)"$/
  60       or $include_glob =~ /^'(.+)'$/;
  61     $include_glob = $1;
  62
  63     trace( 3, $is_subconf, $include_glob );
  64
  65     for my $file ( glob($include_glob) ) {
  66         _warn("included file not found: '$file'"), next unless -f $file;
  67         _die "invalid include/subconf filename '$file'" unless $file =~ m(([^/]+).conf$);
  68         my $basename = $1;
  69
  70         next if already_included($file);
  71
  72         if ($is_subconf) {
  73             push @{$out}, "subconf " . ( $new_subconf || $basename );
  74             explode( $file, ( $new_subconf || $basename ), $out );
  75             push @{$out}, "subconf $current_subconf";
  76         } else {
  77             explode( $file, $current_subconf, $out );
  78         }
  79     }
  80 }
  81
  82 sub prefix_groupnames {
  83     my ( $line, $subconf ) = @_;
  84
  85     my $lhs = '';
  86     # save 'foo' if it's an '@foo = list' line
  87     $lhs = $1 if $line =~ /^@(\S+) = /;
  88     # prefix all @groups in the line
  89     $line =~ s/(^| )(@\S+)(?= |$)/ $1 . ($prefixed_groupname{$subconf}{$2} || $2) /ge;
  90     # now prefix the LHS and store it if needed
  91     if ($lhs) {
  92         $line =~ s/^@\S+ = /"\@$subconf.$lhs = "/e;
  93         $prefixed_groupname{$subconf}{"\@$lhs"} = "\@$subconf.$lhs";
  94         trace( 3, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" );
  95     }
  96
  97     return $line;
  98 }
  99
 100 sub already_included {
 101     my $file = shift;
 102
 103     my $file_id = device_inode($file);
 104     return 0 unless $included{$file_id}++;
 105
 106     _warn("$file already included");
 107     trace( 3, "$file already included" );
 108     return 1;
 109 }
 110
 111 sub device_inode {
 112     my $file = shift;
 113     trace( 3, $file, ( stat $file )[ 0, 1 ] );
 114     return join( "/", ( stat $file )[ 0, 1 ] );
 115 }
 116
 117 1;
 118