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

trace messages rationalised to 3 levels

Browse source
This commit is contained in:
Sitaram Chamarty 2012-03-15 21:00:39 +05:30
parent 8714b77eae
commit 38cb9bfda9
12 changed files with 37 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/Gitolite/Common.pm
View file

@ -107,8 +107,9 @@ sub _chdir {
sub _system { sub _system {
# run system(), catch errors. Be verbose only if $ENV{D} exists. If not, # run system(), catch errors. Be verbose only if $ENV{D} exists. If not,
# exit with <rc of system()> if it applies, else just "exit 1". # exit with <rc of system()> if it applies, else just "exit 1".
trace( 2, @_ );
if ( system(@_) != 0 ) { if ( system(@_) != 0 ) {
say2 "system @_ failed" if $ENV{D}; trace( 1, "system() failed", @_, "-> $?" );
if ( $? == -1 ) { if ( $? == -1 ) {
die "failed to execute: $!\n" if $ENV{D}; die "failed to execute: $!\n" if $ENV{D};
} elsif ( $? & 127 ) { } elsif ( $? & 127 ) {
@ -150,7 +151,7 @@ sub dos2unix {
} }
sub ln_sf { sub ln_sf {
trace( 4, @_ ); trace( 3, @_ );
my ( $srcdir, $glob, $dstdir ) = @_; my ( $srcdir, $glob, $dstdir ) = @_;
for my $hook ( glob("$srcdir/$glob") ) { for my $hook ( glob("$srcdir/$glob") ) {
$hook =~ s/$srcdir\///; $hook =~ s/$srcdir\///;
@ -185,8 +186,6 @@ sub cleanup_conf_line {
my @phy_repos = (); my @phy_repos = ();
sub list_phy_repos { sub list_phy_repos {
trace(3);
# use cached value only if it exists *and* no arg was received (i.e., # use cached value only if it exists *and* no arg was received (i.e.,
# receiving *any* arg invalidates cache) # receiving *any* arg invalidates cache)
return \@phy_repos if ( @phy_repos and not @_ ); return \@phy_repos if ( @phy_repos and not @_ );
@ -196,6 +195,7 @@ sub cleanup_conf_line {
$repo =~ s(\./(.*)\.git$)($1); $repo =~ s(\./(.*)\.git$)($1);
push @phy_repos, $repo; push @phy_repos, $repo;
} }
trace( 2, scalar(@phy_repos) . " physical repos found" );
return sort_u( \@phy_repos ); return sort_u( \@phy_repos );
} }
} }
@ -214,7 +214,7 @@ sub cleanup_conf_line {
$text = `( $cmd ) 2>&1; echo -n RC=\$?`; $text = `( $cmd ) 2>&1; echo -n RC=\$?`;
if ( $text =~ s/RC=(\d+)$// ) { if ( $text =~ s/RC=(\d+)$// ) {
$rc = $1; $rc = $1;
trace( 4, $text ); trace( 3, $text );
return ( not $rc ); return ( not $rc );
} }
die "couldnt find RC= in result; this should not happen:\n$text\n\n...\n"; die "couldnt find RC= in result; this should not happen:\n$text\n\n...\n";
@ -225,7 +225,7 @@ sub cleanup_conf_line {
local $/ = undef; $text = <$fh>; local $/ = undef; $text = <$fh>;
close $fh; warn "pclose failed: $!" if $!; close $fh; warn "pclose failed: $!" if $!;
$rc = ( $? >> 8 ); $rc = ( $? >> 8 );
trace( 4, $text ); trace( 3, $text );
return $text; return $text;
} }
} }

4
src/Gitolite/Conf.pm
View file

@ -23,7 +23,6 @@ use warnings;
# ---------------------------------------------------------------------- # ----------------------------------------------------------------------
sub compile { sub compile {
trace(3);
_die "'gitolite compile' does not take any arguments" if @_; _die "'gitolite compile' does not take any arguments" if @_;
_chdir( $rc{GL_ADMIN_BASE} ); _chdir( $rc{GL_ADMIN_BASE} );
@ -39,7 +38,7 @@ sub compile {
sub parse { sub parse {
my $lines = shift; my $lines = shift;
trace( 4, scalar(@$lines) . " lines incoming" ); trace( 2, scalar(@$lines) . " lines incoming" );
for my $line (@$lines) { for my $line (@$lines) {
# user or repo groups # user or repo groups
@ -68,6 +67,7 @@ sub parse {
# 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+)$/ ) {
trace( 2, $line );
set_subconf($1); set_subconf($1);
} else { } else {
_warn "?? $line"; _warn "?? $line";

10
src/Gitolite/Conf/Explode.pm
View file

@ -22,7 +22,7 @@ my %included = ();
my %prefixed_groupname = (); my %prefixed_groupname = ();
sub explode { sub explode {
trace( 4, @_ ); trace( 3, @_ );
my ( $file, $subconf, $out ) = @_; my ( $file, $subconf, $out ) = @_;
# seed the 'seen' list if it's empty # seed the 'seen' list if it's empty
@ -61,7 +61,7 @@ sub incsub {
# XXX g2 diff: include glob is *implicitly* from $rc{GL_ADMIN_BASE}/conf, not *explicitly* # 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")) { # for my $file (glob($include_glob =~ m(^/) ? $include_glob : "$rc{GL_ADMIN_BASE}/conf/$include_glob")) {
trace( 3, $is_subconf, $include_glob ); trace( 2, $is_subconf, $include_glob );
for my $file ( glob($include_glob) ) { for my $file ( glob($include_glob) ) {
_warn("included file not found: '$file'"), next unless -f $file; _warn("included file not found: '$file'"), next unless -f $file;
@ -93,7 +93,7 @@ sub prefix_groupnames {
if ($lhs) { if ($lhs) {
$line =~ s/^@\S+ = /"\@$subconf.$lhs = "/e; $line =~ s/^@\S+ = /"\@$subconf.$lhs = "/e;
$prefixed_groupname{$subconf}{"\@$lhs"} = "\@$subconf.$lhs"; $prefixed_groupname{$subconf}{"\@$lhs"} = "\@$subconf.$lhs";
trace( 3, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" ); trace( 2, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" );
} }
return $line; return $line;
@ -106,13 +106,13 @@ sub already_included {
return 0 unless $included{$file_id}++; return 0 unless $included{$file_id}++;
_warn("$file already included"); _warn("$file already included");
trace( 3, "$file already included" ); trace( 2, "$file already included" );
return 1; return 1;
} }
sub device_inode { sub device_inode {
my $file = shift; my $file = shift;
trace( 3, $file, ( stat $file )[ 0, 1 ] ); trace( 2, $file, ( stat $file )[ 0, 1 ] );
return join( "/", ( stat $file )[ 0, 1 ] ); return join( "/", ( stat $file )[ 0, 1 ] );
} }

19
src/Gitolite/Conf/Load.pm
View file

@ -49,9 +49,8 @@ my $last_repo = '';
sub load { sub load {
my $repo = shift or _die "load() needs a reponame"; my $repo = shift or _die "load() needs a reponame";
trace( 4, "$repo" ); trace( 3, "$repo" );
if ( $repo ne $loaded_repo ) { if ( $repo ne $loaded_repo ) {
trace( 3, "loading $repo..." );
load_common(); load_common();
load_1($repo); load_1($repo);
$loaded_repo = $repo; $loaded_repo = $repo;
@ -61,15 +60,14 @@ my $last_repo = '';
sub access { sub access {
my ( $repo, $user, $aa, $ref ) = @_; my ( $repo, $user, $aa, $ref ) = @_;
trace( 3, "repo=$repo, user=$user, aa=$aa, ref=$ref" );
load($repo); load($repo);
my @rules = rules( $repo, $user ); my @rules = rules( $repo, $user );
trace( 3, scalar(@rules) . " rules found" ); trace( 2, scalar(@rules) . " rules found" );
for my $r (@rules) { for my $r (@rules) {
my $perm = $r->[1]; my $perm = $r->[1];
my $refex = $r->[2]; $refex =~ s(/USER/)(/$user/); my $refex = $r->[2]; $refex =~ s(/USER/)(/$user/);
trace( 4, "perm=$perm, refex=$refex" ); trace( 3, "perm=$perm, refex=$refex" );
# skip 'deny' rules if the ref is not (yet) known # skip 'deny' rules if the ref is not (yet) known
next if $perm eq '-' and $ref eq 'any'; next if $perm eq '-' and $ref eq 'any';
@ -77,7 +75,7 @@ sub access {
# rule matches if ref matches or ref is any (see gitolite-shell) # rule matches if ref matches or ref is any (see gitolite-shell)
next unless $ref =~ /^$refex/ or $ref eq 'any'; next unless $ref =~ /^$refex/ or $ref eq 'any';
trace( 3, "DENIED by $refex" ) if $perm eq '-'; trace( 2, "DENIED by $refex" ) if $perm eq '-';
return "$aa $ref $repo $user DENIED by $refex" if $perm eq '-'; return "$aa $ref $repo $user DENIED by $refex" if $perm eq '-';
# $perm can be RW\+?(C|D|CD|DC)?M?. $aa can be W, +, C or D, or # $perm can be RW\+?(C|D|CD|DC)?M?. $aa can be W, +, C or D, or
@ -87,7 +85,7 @@ sub access {
# as far as *this* ref is concerned we're ok # as far as *this* ref is concerned we're ok
return $refex if ( $perm =~ /$aaq/ ); return $refex if ( $perm =~ /$aaq/ );
} }
trace( 3, "DENIED by fallthru" ); trace( 2, "DENIED by fallthru" );
return "$aa $ref $repo $user DENIED by fallthru"; return "$aa $ref $repo $user DENIED by fallthru";
} }
@ -105,7 +103,6 @@ sub load_common {
return; return;
} }
trace(4);
my $cc = "conf/gitolite.conf-compiled.pm"; my $cc = "conf/gitolite.conf-compiled.pm";
_die "parse $cc failed: " . ( $! or $@ ) unless do $cc; _die "parse $cc failed: " . ( $! or $@ ) unless do $cc;
@ -120,7 +117,7 @@ sub load_common {
sub load_1 { sub load_1 {
my $repo = shift; my $repo = shift;
return if $repo =~ /^\@/; return if $repo =~ /^\@/;
trace( 4, $repo ); trace( 3, $repo );
_chdir("$rc{GL_REPO_BASE}/$repo.git"); _chdir("$rc{GL_REPO_BASE}/$repo.git");
@ -151,7 +148,7 @@ sub load_1 {
sub rules { sub rules {
my ( $repo, $user ) = @_; my ( $repo, $user ) = @_;
trace( 4, "repo=$repo, user=$user" ); trace( 3, "repo=$repo, user=$user" );
return @cached if ( $lastrepo eq $repo and $lastuser eq $user and @cached ); return @cached if ( $lastrepo eq $repo and $lastuser eq $user and @cached );
@ -159,7 +156,7 @@ sub load_1 {
my @repos = memberships($repo); my @repos = memberships($repo);
my @users = memberships($user); my @users = memberships($user);
trace( 4, "memberships: " . scalar(@repos) . " repos and " . scalar(@users) . " users found" ); trace( 3, "memberships: " . scalar(@repos) . " repos and " . scalar(@users) . " users found" );
for my $r (@repos) { for my $r (@repos) {
for my $u (@users) { for my $u (@users) {

12
src/Gitolite/Conf/Store.pm
View file

@ -144,7 +144,6 @@ sub add_rule {
sub set_subconf { sub set_subconf {
$subconf = shift; $subconf = shift;
_die "bad subconf '$subconf'" unless $subconf =~ /^[-\w.]+$/; _die "bad subconf '$subconf'" unless $subconf =~ /^[-\w.]+$/;
trace( 1, $subconf );
} }
sub new_repos { sub new_repos {
@ -167,7 +166,7 @@ sub new_repos {
sub new_repo { sub new_repo {
my $repo = shift; my $repo = shift;
trace( 4, $repo ); trace( 3, $repo );
# XXX ignoring UMASK for now # XXX ignoring UMASK for now
@ -221,6 +220,7 @@ sub parse_done {
sub check_subconf_repo_disallowed { sub check_subconf_repo_disallowed {
# trying to set access for $repo (='foo')... # trying to set access for $repo (='foo')...
my ( $subconf, $repo ) = @_; my ( $subconf, $repo ) = @_;
trace( 2, $subconf, $repo );
# processing the master config, not a subconf # processing the master config, not a subconf
return 0 if $subconf eq 'master'; return 0 if $subconf eq 'master';
@ -234,14 +234,14 @@ sub check_subconf_repo_disallowed {
sort keys %{ $groups{"\@$subconf"} }; sort keys %{ $groups{"\@$subconf"} };
return 0 if @matched > 0; return 0 if @matched > 0;
trace( 3, "disallowed: $subconf for $repo" ); trace( 2, "-> disallowed" );
return 1; return 1;
} }
sub store_1 { sub store_1 {
# warning: writes and *deletes* it from %repos and %configs # warning: writes and *deletes* it from %repos and %configs
my ($repo) = shift; my ($repo) = shift;
trace( 4, $repo ); trace( 3, $repo );
return unless $repos{$repo} and -d "$repo.git"; return unless $repos{$repo} and -d "$repo.git";
my ( %one_repo, %one_config ); my ( %one_repo, %one_config );
@ -267,7 +267,7 @@ sub store_1 {
} }
sub store_common { sub store_common {
trace(4); trace(3);
my $cc = "conf/gitolite.conf-compiled.pm"; my $cc = "conf/gitolite.conf-compiled.pm";
my $compiled_fh = _open( ">", "$cc.new" ); my $compiled_fh = _open( ">", "$cc.new" );
@ -301,7 +301,7 @@ sub store_common {
sub hook_1 { sub hook_1 {
my $repo = shift; my $repo = shift;
trace( 4, $repo ); trace( 3, $repo );
# reset the gitolite supplied hooks, in case someone fiddled with # reset the gitolite supplied hooks, in case someone fiddled with
# them, but only once per run # them, but only once per run

4
src/Gitolite/Hooks/PostUpdate.pm
View file

@ -19,7 +19,7 @@ use warnings;
# ---------------------------------------------------------------------- # ----------------------------------------------------------------------
sub post_update { sub post_update {
trace( 3, @ARGV ); trace( 2, @ARGV );
# this is the *real* post_update hook for gitolite # this is the *real* post_update hook for gitolite
tsh_try("git ls-tree --name-only master"); tsh_try("git ls-tree --name-only master");
@ -44,6 +44,7 @@ sub post_update {
my $sfp = "$ENV{GL_BINDIR}/post-compile/$s"; my $sfp = "$ENV{GL_BINDIR}/post-compile/$s";
_warn("skipped post-compile script '$s'"), next if not -x $sfp; _warn("skipped post-compile script '$s'"), next if not -x $sfp;
trace( 2, "post-compile $s" );
_system( $sfp, @ARGV ); # they better all return with 0 exit codes! _system( $sfp, @ARGV ); # they better all return with 0 exit codes!
} }
} }
@ -56,7 +57,6 @@ sub post_update {
my $text = ''; my $text = '';
sub post_update_hook { sub post_update_hook {
trace(1);
if ( not $text ) { if ( not $text ) {
local $/ = undef; local $/ = undef;
$text = <DATA>; $text = <DATA>;

6
src/Gitolite/Hooks/Update.pm
View file

@ -19,13 +19,13 @@ use warnings;
# ---------------------------------------------------------------------- # ----------------------------------------------------------------------
sub update { sub update {
trace( 3, @ARGV ); trace( 2, @ARGV );
# this is the *real* update hook for gitolite # this is the *real* update hook for gitolite
my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = args(@ARGV); my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = args(@ARGV);
my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref ); my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref );
trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref) -> $ret" ); trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref)", "-> $ret" );
_die $ret if $ret =~ /DENIED/; _die $ret if $ret =~ /DENIED/;
check_vrefs( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ); check_vrefs( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa );
@ -37,7 +37,6 @@ sub check_vrefs {
my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = @_; my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = @_;
my $name_seen = 0; my $name_seen = 0;
for my $vref ( vrefs( $ENV{GL_REPO}, $ENV{GL_USER} ) ) { for my $vref ( vrefs( $ENV{GL_REPO}, $ENV{GL_USER} ) ) {
trace( 1, "vref=$vref" );
if ( $vref =~ m(^VREF/NAME/) ) { if ( $vref =~ m(^VREF/NAME/) ) {
# this one is special; we process it right here, and only once # this one is special; we process it right here, and only once
next if $name_seen++; next if $name_seen++;
@ -76,7 +75,6 @@ sub check_vref {
my $text = ''; my $text = '';
sub update_hook { sub update_hook {
trace(1);
if ( not $text ) { if ( not $text ) {
local $/ = undef; local $/ = undef;
$text = <DATA>; $text = <DATA>;

5
src/Gitolite/Rc.pm
View file

@ -76,19 +76,15 @@ my $glrc_default_text = '';
sub glrc { sub glrc {
my $cmd = shift; my $cmd = shift;
if ( $cmd eq 'default-filename' ) { if ( $cmd eq 'default-filename' ) {
trace( 1, "..should happen only on first run" );
return "$ENV{HOME}/.gitolite.rc"; return "$ENV{HOME}/.gitolite.rc";
} elsif ( $cmd eq 'default-text' ) { } elsif ( $cmd eq 'default-text' ) {
trace( 1, "..should happen only on first run" );
return $glrc_default_text if $glrc_default_text; return $glrc_default_text if $glrc_default_text;
_die "rc file default text not set; this should not happen!"; _die "rc file default text not set; this should not happen!";
} elsif ( $cmd eq 'filename' ) { } elsif ( $cmd eq 'filename' ) {
# where is the rc file? # where is the rc file?
trace(4);
# search $HOME first # search $HOME first
return "$ENV{HOME}/.gitolite.rc" if -f "$ENV{HOME}/.gitolite.rc"; return "$ENV{HOME}/.gitolite.rc" if -f "$ENV{HOME}/.gitolite.rc";
trace( 2, "$ENV{HOME}/.gitolite.rc not found" );
# XXX for fedora, we can add the following line, but I would really prefer # XXX for fedora, we can add the following line, but I would really prefer
# if ~/.gitolite.rc on each $HOME was just a symlink to /etc/gitolite.rc # if ~/.gitolite.rc on each $HOME was just a symlink to /etc/gitolite.rc
@ -112,7 +108,6 @@ my $all = 0;
my $nonl = 0; my $nonl = 0;
sub query_rc { sub query_rc {
trace( 1, "rc file not found; default should be " . glrc('default-filename') ) if not glrc('filename');
my @vars = args(); my @vars = args();

2
src/Gitolite/Setup.pm
View file

@ -73,13 +73,11 @@ sub args {
} }
sub setup_glrc { sub setup_glrc {
trace(1);
_print( glrc('default-filename'), glrc('default-text') ) if not glrc('filename'); _print( glrc('default-filename'), glrc('default-text') ) if not glrc('filename');
} }
sub setup_gladmin { sub setup_gladmin {
my ( $admin, $pubkey, $argv ) = @_; my ( $admin, $pubkey, $argv ) = @_;
trace( 1, $admin || '<no admin name given>' );
_die "no existing conf file found, '-a' required" _die "no existing conf file found, '-a' required"
if not $admin and not -f "$rc{GL_ADMIN_BASE}/conf/gitolite.conf"; if not $admin and not -f "$rc{GL_ADMIN_BASE}/conf/gitolite.conf";

2
src/gitolite
View file

@ -69,6 +69,7 @@ if ( $command eq 'setup' ) {
post_compile(@args); post_compile(@args);
} elsif ( -x "$rc{GL_BINDIR}/commands/$command" ) { } elsif ( -x "$rc{GL_BINDIR}/commands/$command" ) {
trace( 2, "attempting gitolite command $command" );
run_command( $command, @args ); run_command( $command, @args );
} elsif ( $command eq 'list-phy-repos' ) { } elsif ( $command eq 'list-phy-repos' ) {
@ -76,6 +77,7 @@ if ( $command eq 'setup' ) {
print "$_\n" for ( @{ list_phy_repos(@args) } ); print "$_\n" for ( @{ list_phy_repos(@args) } );
} elsif ( $command =~ /^list-/ ) { } elsif ( $command =~ /^list-/ ) {
trace( 2, "attempting lister command $command" );
require Gitolite::Conf::Load; require Gitolite::Conf::Load;
Gitolite::Conf::Load->import; Gitolite::Conf::Load->import;
my $fn = lister_dispatch($command); my $fn = lister_dispatch($command);

4
src/gitolite-shell
View file

@ -64,7 +64,7 @@ sub main {
# apply if it's a read operation). See the matching code in access() for # apply if it's a read operation). See the matching code in access() for
# more information. # more information.
my $ret = access( $repo, $user, $aa, 'any' ); my $ret = access( $repo, $user, $aa, 'any' );
trace( 1, "access($repo, $user, $aa, 'any') -> $ret" ); trace( 1, "access($repo, $user, $aa, 'any')", "-> $ret" );
_die $ret if $ret =~ /DENIED/; _die $ret if $ret =~ /DENIED/;
$repo = "'$rc{GL_REPO_BASE}/$repo.git'"; $repo = "'$rc{GL_REPO_BASE}/$repo.git'";
@ -81,6 +81,7 @@ sub parse_soc {
# TODO git archive # TODO git archive
my ( $verb, $repo ) = ( $1, $2 ); my ( $verb, $repo ) = ( $1, $2 );
_die "invalid repo name: '$repo'" if $repo !~ $REPONAME_PATT; _die "invalid repo name: '$repo'" if $repo !~ $REPONAME_PATT;
trace( 2, "git command", $soc );
return ( $verb, $repo ); return ( $verb, $repo );
} }
@ -91,6 +92,7 @@ sub parse_soc {
my @words = split ' ', $soc; my @words = split ' ', $soc;
if ( $rc{COMMANDS}{ $words[0] } ) { if ( $rc{COMMANDS}{ $words[0] } ) {
trace( 2, "gitolite command", $soc );
_system( "gitolite", @words ); _system( "gitolite", @words );
exit 0; exit 0;
} }

1
src/syntactic-sugar/keysubdirs-as-groups
View file

@ -7,6 +7,7 @@
# taken as the group name. # taken as the group name.
sub sugar_script { sub sugar_script {
trace( 2, "running 'keysubdirs-as-groups' sugar script..." );
my $lines = shift; my $lines = shift;
my @out = @{$lines}; my @out = @{$lines};