Bring clean.pl up to date and make the log trimming code common
Bug #378530 r=bear git-svn-id: svn://10.0.0.236/trunk@227333 18797224-902f-48f8-a5cc-f745e15eee43
This commit is contained in:
cls%seawood.org
parent
598f5a7969
commit
dcc5b023a5
@ -79,9 +79,9 @@ doadmin.cgi Actually do the work to admin a tinderbox tree
|
||||
(change message of the day, turn off displays for a
|
||||
channel)
|
||||
|
||||
clean.pl Run `find . -name \"*.gz\" -mtime +7 -print ` and
|
||||
unlink those files. Does not appear to be run from
|
||||
other tools. It is a good candidate for a cron job.
|
||||
clean.pl Removes log files and build entries from status files
|
||||
for the given tree based upon a given number of days.
|
||||
Intended to be used from a cronjob.
|
||||
|
||||
|
||||
|
||||
@ -283,7 +283,7 @@ addnote.cgi Add a note to a build log.
|
||||
admintree.cgi Lets you perform various admin tasks on a Tinderbox tree.
|
||||
This just prompts for a password and posts to doadmin.cgi.
|
||||
|
||||
clean.pl ???
|
||||
clean.pl Cron script used to remove old builds from Tinderbox tree
|
||||
copydata.pl ???
|
||||
|
||||
doadmin.cgi Actually do the work to admin a tinderbox tree
|
||||
|
||||
@ -20,60 +20,37 @@
|
||||
#
|
||||
# Contributor(s):
|
||||
|
||||
# Figure out which directory tinderbox is in by looking at argv[0]
|
||||
|
||||
use File::Find;
|
||||
|
||||
$tinderboxdir = $0;
|
||||
$tinderboxdir =~ s:/[^/]*$::; # Remove last word, and slash before it.
|
||||
$tinderboxdir = '.' if $tinderboxdir eq '';
|
||||
$now = time();
|
||||
$expire_time = $now - 7 * 24 * 60 * 60;
|
||||
#print "tinderbox = $tinderboxdir\n";
|
||||
use lib "@TINDERBOX_DIR@";
|
||||
require 'tbglobals.pl'; # for $gzip
|
||||
use strict;
|
||||
use Getopt::Std;
|
||||
|
||||
my $verbose = 0;
|
||||
my $tinderboxdir = "@TINDERBOX_DIR@";
|
||||
chdir $tinderboxdir or die "Couldn't chdir to $tinderboxdir";
|
||||
|
||||
sub files_to_remove {
|
||||
# Remove files older than 7 days
|
||||
unlink if /^\d+\.\d+\.gz$|^tbx.[0-9]+$|^warn\d.*\.html$/ and int(-M $_) > 7;
|
||||
# Remove files older than 1 day
|
||||
unlink if /^\d+\.\d+\.brief\.html$/ and int(-M $_) > 1;
|
||||
}
|
||||
&find(\&files_to_remove, $tinderboxdir);
|
||||
our ($opt_h, $opt_v);
|
||||
getopts('hv');
|
||||
usage() if (defined($opt_h));
|
||||
$verbose++ if (defined($opt_v));
|
||||
print "$verbose\n";
|
||||
|
||||
# Remove build.dat entries older than 7 days
|
||||
#
|
||||
sub log_files_to_trim {
|
||||
return unless /^(?:notes.txt|build.dat|scrape.dat|warnings.dat)$/;
|
||||
warn "Cleaning $File::Find::name\n";
|
||||
my $file = $_;
|
||||
my $range_start = 0;
|
||||
my $line = 1;
|
||||
my $ed_cmds = '';
|
||||
open LOG, "<", $file;
|
||||
while (<LOG>) {
|
||||
$log_time = (split /\|/)[0];
|
||||
if ($log_time =~ /(\d+)\.\d+\.gz/) {
|
||||
# Log file name is first column in file. Pull time out of it.
|
||||
$log_time = $1;
|
||||
}
|
||||
if ($range_start == 0 and $log_time < $expire_time) {
|
||||
$range_start = $line;
|
||||
} elsif ($range_start != 0 and $log_time >= $expire_time) {
|
||||
if ($range_start == $line - 1) {
|
||||
$ed_cmds = "${range_start}d\n$ed_cmds";
|
||||
} else {
|
||||
$ed_cmds = "$range_start,".($line - 1)."d\n$ed_cmds";
|
||||
}
|
||||
$range_start = 0;
|
||||
}
|
||||
$line++;
|
||||
}
|
||||
close LOG;
|
||||
next if $ed_cmds eq '';
|
||||
open ED,"| ed $file" or die "died ed'ing: $!\n";
|
||||
print ED "${ed_cmds}w\nq\n";
|
||||
close ED;
|
||||
}
|
||||
&find(\&log_files_to_trim, $tinderboxdir);
|
||||
my $days = shift;
|
||||
my @trees = @ARGV;
|
||||
usage() if !defined($days) || !defined(@trees);
|
||||
|
||||
for my $tree (@trees) {
|
||||
tb_trim_logs($tree, $days, $verbose, 0);
|
||||
}
|
||||
|
||||
exit(0);
|
||||
# end of main
|
||||
######################################################################
|
||||
|
||||
sub usage() {
|
||||
print "Usage: $0 [-hv] days tree [tree1 .. treeN]\n";
|
||||
print " days = number of days of builds to keep\n";
|
||||
print " tree = name of tree to clean\n";
|
||||
exit(1);
|
||||
}
|
||||
|
||||
|
||||
@ -70,78 +70,8 @@ elsif ($command eq 'admin_builds') {
|
||||
}
|
||||
|
||||
sub trim_logs {
|
||||
my $days = $form{'days'};
|
||||
my $tree = $form{'tree'};
|
||||
|
||||
print "<h2>Trimming Log files for $tree...</h2>\n<p>";
|
||||
|
||||
my $min_date = time - (60*60*24 * $days);
|
||||
|
||||
#
|
||||
# Nuke the old log files
|
||||
#
|
||||
my $i = 0;
|
||||
my $tblocks;
|
||||
opendir( D, &shell_escape($tree) );
|
||||
while( my $fn = readdir( D ) ){
|
||||
if( $fn =~ /\.(?:gz|brief\.html)$/ ||
|
||||
$fn =~ m/^warn.*?\.html$/){
|
||||
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
|
||||
$ctime,$blksize,$blocks) = stat("$tree/$fn");
|
||||
if( $mtime && ($mtime < $min_date) ){
|
||||
print "$fn\n";
|
||||
$tblocks += $blocks;
|
||||
unlink( "$tree/$fn" );
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
}
|
||||
closedir( D );
|
||||
my $k = $tblocks*512/1024;
|
||||
print "<br><b>$i Logfiles ( $k K bytes ) removed</b><br>\n";
|
||||
|
||||
#
|
||||
# Trim build.dat
|
||||
#
|
||||
my $builds_removed = 0;
|
||||
open(BD, "<", "$tree/build.dat");
|
||||
open(NBD, ">", "$tree/build.dat.new");
|
||||
while( <BD> ){
|
||||
my ($endtime,$buildtime,$buildname) = split( /\|/ );
|
||||
if( $buildtime >= $min_date ){
|
||||
print NBD $_;
|
||||
}
|
||||
else {
|
||||
$builds_removed++;
|
||||
}
|
||||
}
|
||||
close( BD );
|
||||
close( NBD );
|
||||
|
||||
unlink( "$tree/build.dat.old" );
|
||||
rename( "$tree/build.dat", "$tree/build.dat.old" );
|
||||
rename( "$tree/build.dat.new", "$tree/build.dat" );
|
||||
|
||||
#
|
||||
# Trim scrape.dat & warnings.dat
|
||||
#
|
||||
for my $file ("scrape.dat", "warnings.dat") {
|
||||
open(BD, "<", "$tree/$file");
|
||||
open(NBD, ">", "$tree/$file.new");
|
||||
while (<BD>) {
|
||||
my ($logfile, $junk) = split (/\|/);
|
||||
my ($buildtime, $processtime, $pid) = split (/\./, $logfile);
|
||||
if ($buildtime >= $min_date) {
|
||||
print NBD $_;
|
||||
}
|
||||
}
|
||||
close(BD);
|
||||
close(NBD);
|
||||
unlink("$tree/$file.old");
|
||||
rename("$tree/$file", "$tree/$file.old");
|
||||
rename("$tree/$file.new", "$tree/$file");
|
||||
}
|
||||
|
||||
print "<h2>Trimming Log files for $form{'tree'}...</h2><p>\n";
|
||||
my $builds_removed = tb_trim_logs($form{'tree'}, $form{'days'}, 1, 1);
|
||||
print "<h2>$builds_removed builds removed from build.dat</h2>\n";
|
||||
print "<h2><a href=\"showbuilds.cgi?tree=$tree\">Back to tree</a></h2>\n";
|
||||
}
|
||||
|
||||
@ -740,6 +740,88 @@ sub write_treedata() {
|
||||
close( F );
|
||||
}
|
||||
|
||||
sub tb_trim_logs($$$$) {
|
||||
my ($tree, $days, $verbose, $do_html) = (@_);
|
||||
|
||||
# Do nothing if incomplete params are given
|
||||
return if (!defined($days) || !defined($tree) || !defined($verbose) ||
|
||||
!defined($do_html));
|
||||
|
||||
my $min_date = time - (60*60*24 * $days);
|
||||
|
||||
#
|
||||
# Nuke the old log files
|
||||
#
|
||||
my $i = 0;
|
||||
my $tblocks;
|
||||
opendir( D, &shell_escape($tree) );
|
||||
while( my $fn = readdir( D ) ){
|
||||
if( $fn =~ /\.(?:gz|brief\.html)$/ ||
|
||||
$fn =~ m/^warn.*?\.html$/){
|
||||
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
|
||||
$ctime,$blksize,$blocks) = stat("$tree/$fn");
|
||||
if( $mtime && ($mtime < $min_date) ){
|
||||
print "$fn\n" if ($verbose > 1);
|
||||
$tblocks += $blocks;
|
||||
unlink( "$tree/$fn" );
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
}
|
||||
closedir( D );
|
||||
my $k = $tblocks*512/1024;
|
||||
if ($verbose) {
|
||||
print "<br><b>" if ($do_html);
|
||||
print "$i Logfiles ( $k K bytes ) removed";
|
||||
print "</b><br>" if ($do_html);
|
||||
print "\n";
|
||||
}
|
||||
|
||||
#
|
||||
# Trim build.dat
|
||||
#
|
||||
my $builds_removed = 0;
|
||||
open(BD, "<", "$tree/build.dat");
|
||||
open(NBD, ">", "$tree/build.dat.new");
|
||||
while( <BD> ){
|
||||
my ($endtime,$buildtime,$buildname) = split( /\|/ );
|
||||
if( $buildtime >= $min_date ){
|
||||
print NBD $_;
|
||||
}
|
||||
else {
|
||||
$builds_removed++;
|
||||
}
|
||||
}
|
||||
close( BD );
|
||||
close( NBD );
|
||||
|
||||
unlink( "$tree/build.dat.old" );
|
||||
rename( "$tree/build.dat", "$tree/build.dat.old" );
|
||||
rename( "$tree/build.dat.new", "$tree/build.dat" );
|
||||
|
||||
#
|
||||
# Trim scrape.dat & warnings.dat
|
||||
#
|
||||
for my $file ("scrape.dat", "warnings.dat") {
|
||||
open(BD, "<", "$tree/$file");
|
||||
open(NBD, ">", "$tree/$file.new");
|
||||
while (<BD>) {
|
||||
my ($logfile, $junk) = split (/\|/);
|
||||
my ($buildtime, $processtime, $pid) = split (/\./, $logfile);
|
||||
if ($buildtime >= $min_date) {
|
||||
print NBD $_;
|
||||
}
|
||||
}
|
||||
close(BD);
|
||||
close(NBD);
|
||||
unlink("$tree/$file.old");
|
||||
rename("$tree/$file", "$tree/$file.old");
|
||||
rename("$tree/$file.new", "$tree/$file");
|
||||
}
|
||||
|
||||
return $builds_removed;
|
||||
}
|
||||
|
||||
# end of public functions
|
||||
#============================================================
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user