michael@0: #! /bin/perl
michael@0: 
michael@0: #######################################################################
michael@0: #
michael@0: # /u/sonmi/bin/clean_tbx.pl
michael@0: #
michael@0: # this script is supposed to remove tinderbox  QA if:
michael@0: # QA has passed, there are 2+ newer QA dirs of the same machine and 
michael@0: #     platform (32/64) and it is older than 2 hours
michael@0: # QA has failed, there are 2+ newer QA dirsof the same machine and 
michael@0: #     platform (32/64) with _identical failures and it is older than 
michael@0: #     2 hours
michael@0: # directory is older than 48 hours
michael@0: #
michael@0: #######################################################################
michael@0: 
michael@0: use Time::Local;
michael@0: 
michael@0: $ANY_TBX_KEEP_HOURS=48;
michael@0: $NOT_FAILED_TBX_KEEP_HOURS=24;
michael@0: $PASSED_TBX_KEEP_HOURS=2;
michael@0: $IF_TBX_KEEP_HOURS=2;
michael@0: $PASSED_NEWER_DIRS=2;
michael@0: $IF_NEWER_DIRS=2;
michael@0: $verbose = 1;
michael@0: 
michael@0: $TBX_TESTDIR="/share/builds/mccrel3/nss/nsstip/tinderbox/tests_results/security";
michael@0: $FTP_STAGE="/u/sonmi/tmp/ftp_stage/tinderbox";
michael@0: 
michael@0: @tbx_dirs = ();  
michael@0: 
michael@0: $eANY_TBX_KEEP=$ANY_TBX_KEEP_HOURS*60*60;
michael@0: $ePASSED_TBX_KEEP=$PASSED_TBX_KEEP_HOURS*60*60;
michael@0: $eIF_TBX_KEEP=$IF_TBX_KEEP_HOURS*60*60;
michael@0: $eNOT_FAILED_TBX_KEEP=$NOT_FAILED_TBX_KEEP_HOURS*60*60;
michael@0: 
michael@0: $year, $month, $days, $hours, $minutes, $seconds;
michael@0: $efulldate=0;
michael@0: 
michael@0: $fulldate=0;
michael@0: 
michael@0: $no_bits="";
michael@0: $last_no_bits="";
michael@0: 
michael@0: $host="";
michael@0: $last_host="";
michael@0: 
michael@0: @tbx_dirs = `ls -r $TBX_TESTDIR`; #sort first by host, 
michael@0:                                #then 64, 
michael@0:                                #then newest - oldest
michael@0: debug ("found $#tbx_dirs directories ");
michael@0: 
michael@0: ($seconds, $minutes, $hours, $days, $month, $year) = localtime; 
michael@0: 
michael@0: debug ("$seconds, $minutes, $hours, $days, $month, $year");
michael@0: 
michael@0: $enow = timelocal(localtime);
michael@0: 
michael@0: sub debug;
michael@0: sub warning;
michael@0: sub error;
michael@0: sub msg;
michael@0: sub init;
michael@0: sub check_tbx_dirs;
michael@0: 
michael@0: sub check_tbx_dirs
michael@0: {
michael@0:     my $platform_idx=0; # counts directories per platform, newest 
michael@0:                         # to oldest (ignores incomplete)
michael@0:     my $passed_idx=0;   # counts passed  directories newest to oldest
michael@0:     my $QAstatus="unknown";
michael@0:     foreach $tbx_dir  (@tbx_dirs) {
michael@0:         $tbx_dir =~ s/\n//g;
michael@0:         $fulldate = $tbx_dir;
michael@0:         $fulldate =~ s/^.*-(20.*-..\...$)/$1/;
michael@0:         $day = $month = $year = $hour = $min = $fulldate;
michael@0:         $host = $tbx_dir;
michael@0:         $host =~ s/-20.*//;
michael@0:         $no_bits = $host;
michael@0:         $host =~ s/64$//;
michael@0:         $no_bits =~ s/.*64$/64/;
michael@0:         $no_bits =~ s/^[^6].*/other/;
michael@0:         $year =~ s/(....).*/$1/;
michael@0:         $month =~ s/....(..).*/$1/;
michael@0:         $day =~ s/......(..).*/$1/;
michael@0:         $hour =~ s/........-(..).*/$1/;
michael@0:         $min =~ s/.*\.(..)$/$1/;
michael@0:         
michael@0: 
michael@0:         if ( -f "$TBX_TESTDIR/$tbx_dir/QAstatus" ) {
michael@0:             $QAstatus=`cat $TBX_TESTDIR/$tbx_dir/QAstatus 2>/dev/null`;
michael@0:             $QAstatus =~ s/\n$//g;
michael@0:         } else {
michael@0:             $QAstatus="unknown";
michael@0:         }
michael@0: 
michael@0:         $efulldate = timelocal( 0, $min, $hour, $day, $month-1, $year-1900);
michael@0:         if ( "$host" !~ "$last_host" || "$no_bits" !~ "$last_no_bits" ) {
michael@0:             if ( $QAstatus !~ "QA running" ) {
michael@0:                 $platform_idx = 0;
michael@0:             } else {
michael@0:                 $platform_idx = -1;
michael@0:             }
michael@0:             $passed_idx = 0;
michael@0: 
michael@0:             $last_host = $host;
michael@0:             $last_no_bits = $no_bits;
michael@0:         } else {
michael@0:             $platform_idx ++;
michael@0:             $passed_idx++ if ( $QAstatus =~ "QA passed" ) ;
michael@0:         }
michael@0: 
michael@0:         debug ("$tbx_dir host $host date $fulldate bits $no_bits $year/$month/$day  $hour:$min QAstatus $QAstatus pli $platform_idx pai $passed_idx");
michael@0: 
michael@0:         if ( $passed_idx > $PASSED_NEWER_DIRS && $QAstatus =~ "QA passed" ) {
michael@0:             $ekeeptime=$efulldate + $ePASSED_TBX_KEEP;
michael@0:             #($s, $m, $h, $d, $mo, $y) = localtime($ekeeptime);
michael@0:             #debug ("$passed_idx > $PASSED_NEWER_DIRS ekeeptime ($s, $m, $h, $d, $mo, $y) == $ekeeptime");
michael@0:              rm_tbx ("Passed $PASSED_TBX_KEEP_HOURS +  hours old") if ( $ekeeptime <= $enow );
michael@0:         } elsif ( $QAstatus !~ "QA failed" ) {
michael@0:             $ekeeptime=$efulldate + $eNOT_FAILED_TBX_KEEP;
michael@0:             rm_tbx ("Not failed $NOT_FAILED_TBX_KEEP_HOURS + hours old") if ( $ekeeptime <= $enow );
michael@0: 	} else {
michael@0:             $ekeeptime=$efulldate + $eANY_TBX_KEEP;
michael@0:              rm_tbx ("Passed 2+ hours old") if ( $ekeeptime <= $enow );
michael@0:         }
michael@0:         if  ( $QAstatus =~ "QA failed" ) {
michael@0:             $ekeeptime=$efulldate + $eIF_TBX_KEEP;
michael@0:             #FIXME - compare to the previous failure by filtering and 
michael@0:             #FIXME diffing the results.html files (first grep failed)
michael@0:         }
michael@0:     }
michael@0: 
michael@0: }
michael@0: 
michael@0: sub rm_tbx()
michael@0: {
michael@0: 
michael@0: debug ("DELETING $tbx_dir... (@_[0]) ");
michael@0: system("rm -rf $TBX_TESTDIR/$tbx_dir");
michael@0: #debug ("rm -rf $TBX_TESTDIR/$tbx_dir");
michael@0: 
michael@0: }
michael@0: 
michael@0: sub msg
michael@0: {
michael@0:     my $i;
michael@0:     for ($i = 0; $i <= $#_ ; $i++ ) {
michael@0:         print "@_[$i] ";
michael@0:     }
michael@0:     print "\n";
michael@0: 
michael@0: }
michael@0: sub error
michael@0: {
michael@0:     msg ("ERROR:  " ,@_ );
michael@0: }
michael@0: 
michael@0: sub warning
michael@0: {
michael@0:     msg ("WARNING:" ,@_ );
michael@0: }
michael@0: sub debug
michael@0: {
michael@0:     if ( $verbose == 1 ) {
michael@0:         msg ("DEBUG:  " ,@_ );
michael@0:     } elsif ( $verbose == 2 ) {
michael@0:         msg (@_ );
michael@0:     }
michael@0: }
michael@0: 
michael@0: check_tbx_dirs;