logging, tracing, and perltidy, ...

...plus renamed a couple of log events for consistency
This commit is contained in:
Sitaram Chamarty 2012-03-30 06:11:06 +05:30
parent a439f47a67
commit 906ed4cbe2
20 changed files with 75 additions and 65 deletions

View file

@ -39,6 +39,8 @@ sub say2 {
}
sub trace {
gl_log( "\t" . join( ",", @_[ 1 .. $#_ ] ) ) if $_[0] <= 1 and defined $Gitolite::Rc::rc{LOG_EXTRA};
return unless defined( $ENV{D} );
my $level = shift; return if $ENV{D} < $level;
@ -111,8 +113,7 @@ 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, @_ );
gl_log( 'system', @_ );
trace( 1, 'system', @_ );
if ( system(@_) != 0 ) {
trace( 1, "system() failed", @_, "-> $?" );
if ( $? == -1 ) {
@ -238,10 +239,12 @@ sub gl_log {
# the log filename and the timestamp come from the environment. If we get
# called even before they are set, we have no choice but to dump to STDERR
# (and probably call "logger").
# tab sep if there's more than one field
my $msg = join( "\t", @_ );
$msg =~ s/[\n\r]+/<<newline>>/g;
my $ts = gen_ts();
my $ts = gen_ts();
my $tid = $ENV{GL_TID} ||= $$;
my $fh;

View file

@ -86,7 +86,7 @@ sub prefix_groupnames {
if ($lhs) {
$line =~ s/^@\S+ = /"\@$subconf.$lhs = "/e;
$prefixed_groupname{$subconf}{"\@$lhs"} = "\@$subconf.$lhs";
trace( 2, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" );
trace( 3, "prefixed_groupname.$subconf.\@$lhs = \@$subconf.$lhs" );
}
return $line;
@ -105,7 +105,7 @@ sub already_included {
sub device_inode {
my $file = shift;
trace( 2, $file, ( stat $file )[ 0, 1 ] );
trace( 3, $file, ( stat $file )[ 0, 1 ] );
return join( "/", ( stat $file )[ 0, 1 ] );
}

View file

@ -67,7 +67,7 @@ my $last_repo = '';
sub access {
my ( $repo, $user, $aa, $ref ) = @_;
my $deny_rules = option($repo, 'deny-rules');
my $deny_rules = option( $repo, 'deny-rules' );
load($repo);
# sanity check the only piece the user can control
@ -192,7 +192,7 @@ sub load_1 {
trace( 3, $repo );
if ( repo_missing($repo) ) {
trace( 2, "repo '$repo' missing" );
trace( 1, "repo '$repo' missing" );
return;
}
_chdir("$rc{GL_REPO_BASE}/$repo.git");
@ -289,7 +289,7 @@ sub memberships {
}
}
if ( $type eq 'user' and $repo and not repo_missing($repo) ) {
if ( $type eq 'user' and $repo and not repo_missing($repo) ) {
# find the roles this user has when accessing this repo and add those
# in as groupnames he is a member of. You need the already existing
# memberships for this; see below this function for an example

View file

@ -277,7 +277,7 @@ sub store_common {
my $compiled_fh = _open( ">", "$cc.new" );
my $data_version = glrc('current-data-version');
trace( 1, "data_version = $data_version" );
trace( 3, "data_version = $data_version" );
print $compiled_fh Data::Dumper->Dump( [$data_version], [qw(*data_version)] );
my $dumped_data = Data::Dumper->Dump( [ \%repos ], [qw(*repos)] );

View file

@ -130,11 +130,11 @@ sub can_write {
# foo=$(gitolite git-config -r $REPONAME foo\\.bar)
sub config {
my $repo = shift;
my $key = shift;
my $key = shift;
return () if repo_missing($repo);
my $ret = git_config($repo, $key);
my $ret = git_config( $repo, $key );
return %$ret;
}

View file

@ -19,8 +19,7 @@ use warnings;
# ----------------------------------------------------------------------
sub post_update {
trace( 2, @ARGV );
gl_log( 'post-up', @ARGV );
trace( 1, 'post-up', @ARGV );
# this is the *real* post_update hook for gitolite
tsh_try("git ls-tree --name-only master");

View file

@ -20,27 +20,27 @@ use warnings;
# ----------------------------------------------------------------------
sub update {
trace( 2, @ARGV );
gl_log( 'update', @ARGV );
# this is the *real* update hook for gitolite
my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = args(@ARGV);
trace( 1, 'update', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, @ARGV );
my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref );
trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref)", "-> $ret" );
trigger( 'ACCESS_2', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref, $ret );
_die $ret if $ret =~ /DENIED/;
check_vrefs( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa );
gl_log( 'check2', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, @ARGV, '->', $ret );
trace( 1, "-> $ret" );
gl_log( 'update', $ENV{GL_REPO}, $ENV{GL_USER}, $aa, @ARGV );
exit 0;
}
sub check_vrefs {
my ( $ref, $oldsha, $newsha, $oldtree, $newtree, $aa ) = @_;
my $name_seen = 0;
my $n_vrefs = 0;
my $n_vrefs = 0;
for my $vref ( vrefs( $ENV{GL_REPO}, $ENV{GL_USER} ) ) {
$n_vrefs++;
if ( $vref =~ m(^VREF/NAME/) ) {
@ -72,10 +72,10 @@ sub check_vref {
my ( $aa, $ref, $deny_message ) = @_;
my $ret = access( $ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref );
trace( 1, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref)", "-> $ret" );
trace( 2, "access($ENV{GL_REPO}, $ENV{GL_USER}, $aa, $ref)", "-> $ret" );
_die "$ret" . ( $deny_message ? "\n$deny_message" : '' )
if $ret =~ /DENIED/ and $ret !~ /by fallthru/;
trace( 1, "remember, fallthru is success here!" ) if $ret =~ /by fallthru/;
trace( 2, "remember, fallthru is success here!" ) if $ret =~ /by fallthru/;
}
{

View file

@ -58,8 +58,7 @@ my $rc = glrc('filename');
do $rc if -r $rc;
if ( defined($GL_ADMINDIR) ) {
say2 "";
say2 "FATAL: $rc seems to be for older gitolite; please see doc/g2migr.mkd\n" .
"(online at http://sitaramc.github.com/gitolite/g3/g2migr.html)";
say2 "FATAL: $rc seems to be for older gitolite; please see doc/g2migr.mkd\n" . "(online at http://sitaramc.github.com/gitolite/g3/g2migr.html)";
exit 1;
}
@ -177,12 +176,13 @@ sub trigger {
_die "$rc_section section in rc file is not a perl list";
} else {
for my $s ( @{ $rc{$rc_section} } ) {
my ($pgm, @args) = split ' ', $s;
my ( $pgm, @args ) = split ' ', $s;
if ( my($module, $sub) = ($pgm =~ /^(.*)::(\w+)$/ ) ) {
if ( my ( $module, $sub ) = ( $pgm =~ /^(.*)::(\w+)$/ ) ) {
require Gitolite::Triggers;
Gitolite::Triggers::run($module, $sub, @args, $rc_section, @_);
trace(1, 'trigger', $module, $sub, @args, $rc_section, @_ );
Gitolite::Triggers::run( $module, $sub, @args, $rc_section, @_ );
} else {
$pgm = "$ENV{GL_BINDIR}/triggers/$pgm";
@ -251,6 +251,9 @@ __DATA__
UMASK => 0077,
GIT_CONFIG_KEYS => '',
# comment out if you don't need all the extra detail in the logfile
LOG_EXTRA => 1,
# settings used by external programs; uncomment and change as needed. You
# can add your own variables for use in your own external programs; take a
# look at the cpu-time and desc commands for perl and shell samples.

View file

@ -64,11 +64,11 @@ sub args {
'help|h' => \$help,
) or usage();
usage() if $help or ($pubkey and $admin);
usage() if $help or ( $pubkey and $admin );
if ($pubkey) {
$pubkey =~ /\.pub$/ or _die "$pubkey name does not end in .pub";
$pubkey =~ /\@/ and _die "$pubkey name contains '\@'";
$pubkey =~ /\@/ and _die "$pubkey name contains '\@'";
tsh_try("cat $pubkey") or _die "$pubkey not a readable file";
tsh_lines() == 1 or _die "$pubkey must have exactly one line";
tsh_try("ssh-keygen -l -f $pubkey") or _die "$pubkey does not seem to be a valid ssh pubkey file";

View file

@ -18,7 +18,7 @@ use warnings;
# ----------------------------------------------------------------------
sub run {
my ($module, $sub, @args) = @_;
my ( $module, $sub, @args ) = @_;
$module = "Gitolite::Triggers::$module" if $module !~ /^Gitolite::/;
eval "require $module";

View file

@ -4,10 +4,10 @@ use Gitolite::Rc;
use Gitolite::Common;
sub writable {
my ($repo, $aa, $result) = @_[1, 3, 5];
my ( $repo, $aa, $result ) = @_[ 1, 3, 5 ];
return if $aa eq 'R' or $result =~ /DENIED/;
for my $f ("$ENV{HOME}/.gitolite.down", "$rc{GL_REPO_BASE}/$repo.git/.gitolite.down") {
for my $f ( "$ENV{HOME}/.gitolite.down", "$rc{GL_REPO_BASE}/$repo.git/.gitolite.down" ) {
next unless -f $f;
_die slurp($f) if -s $f;
_die "sorry, writes are currently disabled (no more info available)\n";

View file

@ -23,7 +23,7 @@ printing anything, which makes it possible to do this in shell:
usage() if not @ARGV or $ARGV[0] eq '-h';
my $nl = "\n";
if ($ARGV[0] eq '-n') {
if ( $ARGV[0] eq '-n' ) {
$nl = '';
shift;
}
@ -36,5 +36,5 @@ if ($user) {
exit 0 if $creator eq $user;
exit 1;
}
return ($creator eq $user) if $user;
return ( $creator eq $user ) if $user;
print "$creator$nl";

View file

@ -26,8 +26,8 @@ my ( $lc, $patt ) = args();
print_version();
print_patterns(); # repos he can create for himself
print_phy_repos(); # repos already created
print_patterns(); # repos he can create for himself
print_phy_repos(); # repos already created
print "\n$rc{SITE_INFO}\n" if $rc{SITE_INFO};
# ----------------------------------------------------------------------

View file

@ -35,7 +35,7 @@ if ( $ARGV[0] eq '-l' ) {
}
setperms(@ARGV);
_system("gitolite", "trigger", "POST_CREATE");
_system( "gitolite", "trigger", "POST_CREATE" );
# ----------------------------------------------------------------------

View file

@ -46,7 +46,7 @@ use warnings;
# ----------------------------------------------------------------------
my ( $command, @args ) = @ARGV;
gl_log( 'command', @ARGV ) if -d $rc{GL_ADMIN_BASE};
gl_log( 'cli', 'gitolite', @ARGV ) if -d $rc{GL_ADMIN_BASE} and $$ == ( $ENV{GL_TID} || 0 );
args();
# the first two commands need options via @ARGV, as they have their own
@ -60,7 +60,7 @@ if ( $command eq 'setup' ) {
} elsif ( $command eq 'query-rc' ) {
shift @ARGV;
query_rc(); # doesn't return
query_rc(); # doesn't return
# the rest don't need @ARGV per se
@ -91,7 +91,7 @@ if ( $command eq 'setup' ) {
_die "unknown gitolite sub-command";
}
gl_log( '==end==' ) if $$ == $ENV{GL_TID};
gl_log('END') if $$ == $ENV{GL_TID};
sub args {
usage() if not $command or $command eq '-h';

View file

@ -17,7 +17,7 @@ use warnings;
# the main() sub expects ssh-ish things; set them up...
my $id = '';
if ( exists $ENV{G3T_USER} ) {
$id = in_local(); # file:// masquerading as ssh:// for easy testing
$id = in_file(); # file:// masquerading as ssh:// for easy testing
} elsif ( exists $ENV{SSH_CONNECTION} ) {
$id = in_ssh();
} elsif ( exists $ENV{REQUEST_URI} ) {
@ -28,18 +28,20 @@ if ( exists $ENV{G3T_USER} ) {
main($id);
gl_log( '==end==' ) if $$ == $ENV{GL_TID};
gl_log('END') if $$ == $ENV{GL_TID};
exit 0;
# ----------------------------------------------------------------------
sub in_local {
sub in_file {
gl_log( 'file', "ARGV=" . join( ",", @ARGV ), "SOC=$ENV{SSH_ORIGINAL_COMMAND}" );
if ( $ENV{SSH_ORIGINAL_COMMAND} =~ /git-\w+-pack/ ) {
print STDERR "TRACE: gsh(", join( ")(", @ARGV ), ")\n";
print STDERR "TRACE: gsh(SOC=$ENV{SSH_ORIGINAL_COMMAND})\n";
}
return 'local';
return 'file';
}
sub in_http {
@ -47,13 +49,16 @@ sub in_http {
}
sub in_ssh {
my $ip;
( $ip = $ENV{SSH_CONNECTION} || '(no-IP)' ) =~ s/ .*//;
gl_log( 'ssh', "ARGV=" . join( ",", @ARGV ), "SOC=$ENV{SSH_ORIGINAL_COMMAND}", "FROM=$ip" );
$ENV{SSH_ORIGINAL_COMMAND} ||= '';
my $soc = $ENV{SSH_ORIGINAL_COMMAND};
$soc =~ s/[\n\r]+/<<newline>>/g;
_die "I don't like newlines in the command: $soc\n" if $ENV{SSH_ORIGINAL_COMMAND} ne $soc;
my $ip;
($ip = $ENV{SSH_CONNECTION} || '(no-IP)') =~ s/ .*//;
return $ip;
}
@ -64,7 +69,6 @@ sub in_ssh {
sub main {
my $id = shift;
gl_log( 'remote', $id, @ARGV, $ENV{SSH_ORIGINAL_COMMAND} );
umask $rc{UMASK};
# set up the user
@ -88,12 +92,13 @@ sub main {
# yet know the ref that will be eventually pushed (and even that won't
# apply if it's a read operation). See the matching code in access() for
# more information.
unless ($ENV{GL_BYPASS_ACCESS_CHECKS}) {
unless ( $ENV{GL_BYPASS_ACCESS_CHECKS} ) {
my $ret = access( $repo, $user, $aa, 'any' );
trace( 1, "access($repo, $user, $aa, 'any')", "-> $ret" );
gl_log( 'check1', $repo, $user, $aa, 'any', '->', $ret );
trigger( 'ACCESS_1', $repo, $user, $aa, 'any', $ret );
_die $ret . "\n(or you mis-spelled the reponame)" if $ret =~ /DENIED/;
gl_log( "pre_git", $repo, $user, $aa, 'any', "-> $ret" );
}
trigger( 'PRE_GIT', $repo, $user, $aa, 'any', $verb );

View file

@ -5,7 +5,7 @@ use warnings;
use lib $ENV{GL_BINDIR};
use Gitolite::Easy;
my ($trigger, $repo, $user, $aa, $ref, $verb, $utime, $stime, $cutime, $cstime) = @ARGV;
my ( $trigger, $repo, $user, $aa, $ref, $verb, $utime, $stime, $cutime, $cstime ) = @ARGV;
# now do whatever you want with this data; the following is just an example.
@ -14,13 +14,13 @@ my ($trigger, $repo, $user, $aa, $ref, $verb, $utime, $stime, $cutime, $cstime)
# to the rc file, and (c) change your rc file to call your program at the end
# of the POST_GIT list.
if (my $limit = $rc{CPU_TIME_WARN_LIMIT}) {
if ( my $limit = $rc{CPU_TIME_WARN_LIMIT} ) {
my $total = $utime + $cutime + $stime + $cstime;
# some code to send an email or whatever...
say2 "limit = $limit, actual = $total" if $total > $limit;
}
if ($rc{DISPLAY_CPU_TIME}) {
if ( $rc{DISPLAY_CPU_TIME} ) {
say2 "perf stats for $verb on repo '$repo':";
say2 " user CPU time: " . ( $utime + $cutime );
say2 " sys CPU time: " . ( $stime + $cstime );

View file

@ -14,13 +14,13 @@ $|++;
# arguments anyway, it hardly matters.
tsh_try("sestatus");
my $selinux = (tsh_text() =~ /enabled/);
my $selinux = ( tsh_text() =~ /enabled/ );
my $ab = `gitolite query-rc -n GL_ADMIN_BASE`;
trace( 2, "'keydir' not found in '$ab'; exiting" ), exit if not -d "$ab/keydir";
my $akdir = "$ENV{HOME}/.ssh";
my $akfile = "$ENV{HOME}/.ssh/authorized_keys";
my $glshell = `gitolite query-rc -n GL_BINDIR` . "/gitolite-shell";
my $akdir = "$ENV{HOME}/.ssh";
my $akfile = "$ENV{HOME}/.ssh/authorized_keys";
my $glshell = `gitolite query-rc -n GL_BINDIR` . "/gitolite-shell";
my $auth_options = auth_options();
sanity();
@ -65,10 +65,10 @@ sub sanity {
_die "$glshell found but not readable; this should NOT happen..." if not -r $glshell;
_die "$glshell found but not executable; this should NOT happen..." if not -x $glshell;
_warn "$akdir missing; creating a new one" if not -d $akdir;
_warn "$akfile missing; creating a new one" if not -f $akfile;
_warn "$akdir missing; creating a new one" if not -d $akdir;
_warn "$akfile missing; creating a new one" if not -f $akfile;
_mkdir($akdir, 0700) if not -d $akfile;
_mkdir( $akdir, 0700 ) if not -d $akfile;
if ( not -f $akfile ) {
_print( $akfile, "" );
chmod 0700, $akfile;
@ -101,7 +101,7 @@ sub fp {
}
sub fp_file {
return $selinux++ if $selinux; # return a unique "fingerprint" to prevent noise
return $selinux++ if $selinux; # return a unique "fingerprint" to prevent noise
my $f = shift;
my $fp = `ssh-keygen -l -f '$f'`;
chomp($fp);

View file

@ -16,19 +16,19 @@ use warnings;
# ----------------------------------------------------------------------
my $RB = $rc{GL_REPO_BASE};
_chdir ($RB);
_chdir($RB);
my $lpr = list_phy_repos();
for my $pr (@$lpr) {
my $gc = git_config($pr, '.');
while ( my ($key, $value) = each(%{ $gc }) ) {
my $gc = git_config( $pr, '.' );
while ( my ( $key, $value ) = each( %{$gc} ) ) {
next if $key =~ /^gitolite-options\./;
if ($value ne "") {
if ( $value ne "" ) {
$value =~ s/^['"](.*)["']$/$1/;
$value =~ s/%GL_REPO/$pr/g;
system("git", "config", "--file", "$RB/$pr.git/config", $key, $value);
system( "git", "config", "--file", "$RB/$pr.git/config", $key, $value );
} else {
system("git", "config", "--file", "$RB/$pr.git/config", "--unset-all", $key);
system( "git", "config", "--file", "$RB/$pr.git/config", "--unset-all", $key );
}
}
}

View file

@ -53,7 +53,7 @@ try "
# log file
cat \$(gitolite query-rc GL_LOGFILE);
ok; /check2/
ok; /\tupdate\t/
/aa\tu1\t\\+\trefs/heads/master/
/2d066fb4860c29cf321170c17695c6883f3d50e8/
/284951dfa11d58f99ab76b9f4e4c1ad2f2461236/