trace messages rationalised to 3 levels
This commit is contained in:
Sitaram Chamarty
parent
8714b77eae
commit
38cb9bfda9
|
|
@ -107,8 +107,9 @@ sub _chdir {
|
|||
sub _system {
|
||||
# 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".
|
||||
trace( 2, @_ );
|
||||
if ( system(@_) != 0 ) {
|
||||
say2 "system @_ failed" if $ENV{D};
|
||||
trace( 1, "system() failed", @_, "-> $?" );
|
||||
if ( $? == -1 ) {
|
||||
die "failed to execute: $!\n" if $ENV{D};
|
||||
} elsif ( $? & 127 ) {
|
||||
|
|
@ -150,7 +151,7 @@ sub dos2unix {
|
|||
}
|
||||
|
||||
sub ln_sf {
|
||||
trace( 4, @_ );
|
||||
trace( 3, @_ );
|
||||
my ( $srcdir, $glob, $dstdir ) = @_;
|
||||
for my $hook ( glob("$srcdir/$glob") ) {
|
||||
$hook =~ s/$srcdir\///;
|
||||
|
|
@ -185,8 +186,6 @@ sub cleanup_conf_line {
|
|||
my @phy_repos = ();
|
||||
|
||||
sub list_phy_repos {
|
||||
trace(3);
|
||||
|
||||
# use cached value only if it exists *and* no arg was received (i.e.,
|
||||
# receiving *any* arg invalidates cache)
|
||||
return \@phy_repos if ( @phy_repos and not @_ );
|
||||
|
|
@ -196,6 +195,7 @@ sub cleanup_conf_line {
|
|||
$repo =~ s(\./(.*)\.git$)($1);
|
||||
push @phy_repos, $repo;
|
||||
}
|
||||
trace( 2, scalar(@phy_repos) . " physical repos found" );
|
||||
return sort_u( \@phy_repos );
|
||||
}
|
||||
}
|
||||
|
|
@ -214,7 +214,7 @@ sub cleanup_conf_line {
|
|||
$text = `( $cmd ) 2>&1; echo -n RC=\$?`;
|
||||
if ( $text =~ s/RC=(\d+)$// ) {
|
||||
$rc = $1;
|
||||
trace( 4, $text );
|
||||
trace( 3, $text );
|
||||
return ( not $rc );
|
||||
}
|
||||
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>;
|
||||
close $fh; warn "pclose failed: $!" if $!;
|
||||
$rc = ( $? >> 8 );
|
||||
trace( 4, $text );
|
||||
trace( 3, $text );
|
||||
return $text;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -23,7 +23,6 @@ use warnings;
|
|||
# ----------------------------------------------------------------------
|
||||
|
||||
sub compile {
|
||||
trace(3);
|
||||
_die "'gitolite compile' does not take any arguments" if @_;
|
||||
|
||||
_chdir( $rc{GL_ADMIN_BASE} );
|
||||
|
|
@ -39,7 +38,7 @@ sub compile {
|
|||
|
||||
sub parse {
|
||||
my $lines = shift;
|
||||
trace( 4, scalar(@$lines) . " lines incoming" );
|
||||
trace( 2, scalar(@$lines) . " lines incoming" );
|
||||
|
||||
for my $line (@$lines) {
|
||||
# user or repo groups
|
||||
|
|
@ -68,6 +67,7 @@ sub parse {
|
|||
# XXX both $key and $value must satisfy a liberal but secure pattern
|
||||
add_config( 1, $key, $value );
|
||||
} elsif ( $line =~ /^subconf (\S+)$/ ) {
|
||||
trace( 2, $line );
|
||||
set_subconf($1);
|
||||
} else {
|
||||
_warn "?? $line";
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ my %included = ();
|
|||
my %prefixed_groupname = ();
|
||||
|
||||
sub explode {
|
||||
trace( 4, @_ );
|
||||
trace( 3, @_ );
|
||||
my ( $file, $subconf, $out ) = @_;
|
||||
|
||||
# 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*
|
||||
# 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) ) {
|
||||
_warn("included file not found: '$file'"), next unless -f $file;
|
||||
|
|
@ -93,7 +93,7 @@ sub prefix_groupnames {
|
|||
if ($lhs) {
|
||||
$line =~ s/^@\S+ = /"\@$subconf.$lhs = "/e;
|
||||
$prefixed_groupname{$subconf}{"\@$lhs"} = "\@$subconf.$lhs";
|
||||
trace( 3, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" );
|
||||
trace( 2, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" );
|
||||
}
|
||||
|
||||
return $line;
|
||||
|
|
@ -106,13 +106,13 @@ sub already_included {
|
|||
return 0 unless $included{$file_id}++;
|
||||
|
||||
_warn("$file already included");
|
||||
trace( 3, "$file already included" );
|
||||
trace( 2, "$file already included" );
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub device_inode {
|
||||
my $file = shift;
|
||||
trace( 3, $file, ( stat $file )[ 0, 1 ] );
|
||||
trace( 2, $file, ( stat $file )[ 0, 1 ] );
|
||||
return join( "/", ( stat $file )[ 0, 1 ] );
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -49,9 +49,8 @@ my $last_repo = '';
|
|||
|
||||
sub load {
|
||||
my $repo = shift or _die "load() needs a reponame";
|
||||
trace( 4, "$repo" );
|
||||
trace( 3, "$repo" );
|
||||
if ( $repo ne $loaded_repo ) {
|
||||
trace( 3, "loading $repo..." );
|
||||
load_common();
|
||||
load_1($repo);
|
||||
$loaded_repo = $repo;
|
||||
|
|
@ -61,15 +60,14 @@ my $last_repo = '';
|
|||
|
||||
sub access {
|
||||
my ( $repo, $user, $aa, $ref ) = @_;
|
||||
trace( 3, "repo=$repo, user=$user, aa=$aa, ref=$ref" );
|
||||
load($repo);
|
||||
|
||||
my @rules = rules( $repo, $user );
|
||||
trace( 3, scalar(@rules) . " rules found" );
|
||||
trace( 2, scalar(@rules) . " rules found" );
|
||||
for my $r (@rules) {
|
||||
my $perm = $r->[1];
|
||||
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
|
||||
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)
|
||||
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 '-';
|
||||
|
||||
# $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
|
||||
return $refex if ( $perm =~ /$aaq/ );
|
||||
}
|
||||
trace( 3, "DENIED by fallthru" );
|
||||
trace( 2, "DENIED by fallthru" );
|
||||
return "$aa $ref $repo $user DENIED by fallthru";
|
||||
}
|
||||
|
||||
|
|
@ -105,7 +103,6 @@ sub load_common {
|
|||
return;
|
||||
}
|
||||
|
||||
trace(4);
|
||||
my $cc = "conf/gitolite.conf-compiled.pm";
|
||||
|
||||
_die "parse $cc failed: " . ( $! or $@ ) unless do $cc;
|
||||
|
|
@ -120,7 +117,7 @@ sub load_common {
|
|||
sub load_1 {
|
||||
my $repo = shift;
|
||||
return if $repo =~ /^\@/;
|
||||
trace( 4, $repo );
|
||||
trace( 3, $repo );
|
||||
|
||||
_chdir("$rc{GL_REPO_BASE}/$repo.git");
|
||||
|
||||
|
|
@ -151,7 +148,7 @@ sub load_1 {
|
|||
|
||||
sub rules {
|
||||
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 );
|
||||
|
||||
|
|
@ -159,7 +156,7 @@ sub load_1 {
|
|||
|
||||
my @repos = memberships($repo);
|
||||
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 $u (@users) {
|
||||
|
|
|
|||
|
|
@ -144,7 +144,6 @@ sub add_rule {
|
|||
sub set_subconf {
|
||||
$subconf = shift;
|
||||
_die "bad subconf '$subconf'" unless $subconf =~ /^[-\w.]+$/;
|
||||
trace( 1, $subconf );
|
||||
}
|
||||
|
||||
sub new_repos {
|
||||
|
|
@ -167,7 +166,7 @@ sub new_repos {
|
|||
|
||||
sub new_repo {
|
||||
my $repo = shift;
|
||||
trace( 4, $repo );
|
||||
trace( 3, $repo );
|
||||
|
||||
# XXX ignoring UMASK for now
|
||||
|
||||
|
|
@ -221,6 +220,7 @@ sub parse_done {
|
|||
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';
|
||||
|
|
@ -234,14 +234,14 @@ sub check_subconf_repo_disallowed {
|
|||
sort keys %{ $groups{"\@$subconf"} };
|
||||
return 0 if @matched > 0;
|
||||
|
||||
trace( 3, "disallowed: $subconf for $repo" );
|
||||
trace( 2, "-> disallowed" );
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub store_1 {
|
||||
# warning: writes and *deletes* it from %repos and %configs
|
||||
my ($repo) = shift;
|
||||
trace( 4, $repo );
|
||||
trace( 3, $repo );
|
||||
return unless $repos{$repo} and -d "$repo.git";
|
||||
|
||||
my ( %one_repo, %one_config );
|
||||
|
|
@ -267,7 +267,7 @@ sub store_1 {
|
|||
}
|
||||
|
||||
sub store_common {
|
||||
trace(4);
|
||||
trace(3);
|
||||
my $cc = "conf/gitolite.conf-compiled.pm";
|
||||
my $compiled_fh = _open( ">", "$cc.new" );
|
||||
|
||||
|
|
@ -301,7 +301,7 @@ sub store_common {
|
|||
|
||||
sub hook_1 {
|
||||
my $repo = shift;
|
||||
trace( 4, $repo );
|
||||
trace( 3, $repo );
|
||||
|
||||
# reset the gitolite supplied hooks, in case someone fiddled with
|
||||
# them, but only once per run
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ use warnings;
|
|||
# ----------------------------------------------------------------------
|
||||
|
||||
sub post_update {
|
||||
trace( 3, @ARGV );
|
||||
trace( 2, @ARGV );
|
||||
# this is the *real* post_update hook for gitolite
|
||||
|
||||
tsh_try("git ls-tree --name-only master");
|
||||
|
|
@ -44,6 +44,7 @@ sub post_update {
|
|||
my $sfp = "$ENV{GL_BINDIR}/post-compile/$s";
|
||||
|
||||
_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!
|
||||
}
|
||||
}
|
||||
|
|
@ -56,7 +57,6 @@ sub post_update {
|
|||
my $text = '';
|
||||
|
||||
sub post_update_hook {
|
||||
trace(1);
|
||||
if ( not $text ) {
|
||||
local $/ = undef;
|
||||
$text = <DATA>;
|
||||
|
|
|
|||
|
|
@ -19,13 +19,13 @@ use warnings;
|
|||
# ----------------------------------------------------------------------
|
||||
|
||||
sub update {
|
||||
trace( 3, @ARGV );
|
||||
trace( 2, @ARGV );
|
||||
# this is the *real* update hook for gitolite
|
||||
|
||||
my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = args(@ARGV);
|
||||
|
||||
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/;
|
||||
|
||||
check_vrefs( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa );
|
||||
|
|
@ -37,7 +37,6 @@ sub check_vrefs {
|
|||
my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = @_;
|
||||
my $name_seen = 0;
|
||||
for my $vref ( vrefs( $ENV{GL_REPO}, $ENV{GL_USER} ) ) {
|
||||
trace( 1, "vref=$vref" );
|
||||
if ( $vref =~ m(^VREF/NAME/) ) {
|
||||
# this one is special; we process it right here, and only once
|
||||
next if $name_seen++;
|
||||
|
|
@ -76,7 +75,6 @@ sub check_vref {
|
|||
my $text = '';
|
||||
|
||||
sub update_hook {
|
||||
trace(1);
|
||||
if ( not $text ) {
|
||||
local $/ = undef;
|
||||
$text = <DATA>;
|
||||
|
|
|
|||
|
|
@ -76,19 +76,15 @@ my $glrc_default_text = '';
|
|||
sub glrc {
|
||||
my $cmd = shift;
|
||||
if ( $cmd eq 'default-filename' ) {
|
||||
trace( 1, "..should happen only on first run" );
|
||||
return "$ENV{HOME}/.gitolite.rc";
|
||||
} elsif ( $cmd eq 'default-text' ) {
|
||||
trace( 1, "..should happen only on first run" );
|
||||
return $glrc_default_text if $glrc_default_text;
|
||||
_die "rc file default text not set; this should not happen!";
|
||||
} elsif ( $cmd eq 'filename' ) {
|
||||
# where is the rc file?
|
||||
trace(4);
|
||||
|
||||
# search $HOME first
|
||||
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
|
||||
# if ~/.gitolite.rc on each $HOME was just a symlink to /etc/gitolite.rc
|
||||
|
|
@ -112,7 +108,6 @@ my $all = 0;
|
|||
my $nonl = 0;
|
||||
|
||||
sub query_rc {
|
||||
trace( 1, "rc file not found; default should be " . glrc('default-filename') ) if not glrc('filename');
|
||||
|
||||
my @vars = args();
|
||||
|
||||
|
|
|
|||
|
|
@ -73,13 +73,11 @@ sub args {
|
|||
}
|
||||
|
||||
sub setup_glrc {
|
||||
trace(1);
|
||||
_print( glrc('default-filename'), glrc('default-text') ) if not glrc('filename');
|
||||
}
|
||||
|
||||
sub setup_gladmin {
|
||||
my ( $admin, $pubkey, $argv ) = @_;
|
||||
trace( 1, $admin || '<no admin name given>' );
|
||||
_die "no existing conf file found, '-a' required"
|
||||
if not $admin and not -f "$rc{GL_ADMIN_BASE}/conf/gitolite.conf";
|
||||
|
||||
|
|
|
|||
|
|
@ -69,6 +69,7 @@ if ( $command eq 'setup' ) {
|
|||
post_compile(@args);
|
||||
|
||||
} elsif ( -x "$rc{GL_BINDIR}/commands/$command" ) {
|
||||
trace( 2, "attempting gitolite command $command" );
|
||||
run_command( $command, @args );
|
||||
|
||||
} elsif ( $command eq 'list-phy-repos' ) {
|
||||
|
|
@ -76,6 +77,7 @@ if ( $command eq 'setup' ) {
|
|||
print "$_\n" for ( @{ list_phy_repos(@args) } );
|
||||
|
||||
} elsif ( $command =~ /^list-/ ) {
|
||||
trace( 2, "attempting lister command $command" );
|
||||
require Gitolite::Conf::Load;
|
||||
Gitolite::Conf::Load->import;
|
||||
my $fn = lister_dispatch($command);
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ sub main {
|
|||
# apply if it's a read operation). See the matching code in access() for
|
||||
# more information.
|
||||
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/;
|
||||
|
||||
$repo = "'$rc{GL_REPO_BASE}/$repo.git'";
|
||||
|
|
@ -81,6 +81,7 @@ sub parse_soc {
|
|||
# TODO git archive
|
||||
my ( $verb, $repo ) = ( $1, $2 );
|
||||
_die "invalid repo name: '$repo'" if $repo !~ $REPONAME_PATT;
|
||||
trace( 2, "git command", $soc );
|
||||
return ( $verb, $repo );
|
||||
}
|
||||
|
||||
|
|
@ -91,6 +92,7 @@ sub parse_soc {
|
|||
|
||||
my @words = split ' ', $soc;
|
||||
if ( $rc{COMMANDS}{ $words[0] } ) {
|
||||
trace( 2, "gitolite command", $soc );
|
||||
_system( "gitolite", @words );
|
||||
exit 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@
|
|||
# taken as the group name.
|
||||
|
||||
sub sugar_script {
|
||||
trace( 2, "running 'keysubdirs-as-groups' sugar script..." );
|
||||
my $lines = shift;
|
||||
|
||||
my @out = @{$lines};
|
||||
|
|
|
|||
Loading…
Reference in a new issue