clean_tbx (4820B)
1 #! /bin/perl 2 3 ####################################################################### 4 # 5 # /u/sonmi/bin/clean_tbx.pl 6 # 7 # this script is supposed to remove tinderbox QA if: 8 # QA has passed, there are 2+ newer QA dirs of the same machine and 9 # platform (32/64) and it is older than 2 hours 10 # QA has failed, there are 2+ newer QA dirsof the same machine and 11 # platform (32/64) with _identical failures and it is older than 12 # 2 hours 13 # directory is older than 48 hours 14 # 15 ####################################################################### 16 17 use Time::Local; 18 19 $ANY_TBX_KEEP_HOURS=48; 20 $NOT_FAILED_TBX_KEEP_HOURS=24; 21 $PASSED_TBX_KEEP_HOURS=2; 22 $IF_TBX_KEEP_HOURS=2; 23 $PASSED_NEWER_DIRS=2; 24 $IF_NEWER_DIRS=2; 25 $verbose = 1; 26 27 $TBX_TESTDIR="/share/builds/mccrel3/nss/nsstip/tinderbox/tests_results/security"; 28 $FTP_STAGE="/u/sonmi/tmp/ftp_stage/tinderbox"; 29 30 @tbx_dirs = (); 31 32 $eANY_TBX_KEEP=$ANY_TBX_KEEP_HOURS*60*60; 33 $ePASSED_TBX_KEEP=$PASSED_TBX_KEEP_HOURS*60*60; 34 $eIF_TBX_KEEP=$IF_TBX_KEEP_HOURS*60*60; 35 $eNOT_FAILED_TBX_KEEP=$NOT_FAILED_TBX_KEEP_HOURS*60*60; 36 37 $year, $month, $days, $hours, $minutes, $seconds; 38 $efulldate=0; 39 40 $fulldate=0; 41 42 $no_bits=""; 43 $last_no_bits=""; 44 45 $host=""; 46 $last_host=""; 47 48 @tbx_dirs = `ls -r $TBX_TESTDIR`; #sort first by host, 49 #then 64, 50 #then newest - oldest 51 debug ("found $#tbx_dirs directories "); 52 53 ($seconds, $minutes, $hours, $days, $month, $year) = localtime; 54 55 debug ("$seconds, $minutes, $hours, $days, $month, $year"); 56 57 $enow = timelocal(localtime); 58 59 sub debug; 60 sub warning; 61 sub error; 62 sub msg; 63 sub init; 64 sub check_tbx_dirs; 65 66 sub check_tbx_dirs 67 { 68 my $platform_idx=0; # counts directories per platform, newest 69 # to oldest (ignores incomplete) 70 my $passed_idx=0; # counts passed directories newest to oldest 71 my $QAstatus="unknown"; 72 foreach $tbx_dir (@tbx_dirs) { 73 $tbx_dir =~ s/\n//g; 74 $fulldate = $tbx_dir; 75 $fulldate =~ s/^.*-(20.*-..\...$)/$1/; 76 $day = $month = $year = $hour = $min = $fulldate; 77 $host = $tbx_dir; 78 $host =~ s/-20.*//; 79 $no_bits = $host; 80 $host =~ s/64$//; 81 $no_bits =~ s/.*64$/64/; 82 $no_bits =~ s/^[^6].*/other/; 83 $year =~ s/(....).*/$1/; 84 $month =~ s/....(..).*/$1/; 85 $day =~ s/......(..).*/$1/; 86 $hour =~ s/........-(..).*/$1/; 87 $min =~ s/.*\.(..)$/$1/; 88 89 90 if ( -f "$TBX_TESTDIR/$tbx_dir/QAstatus" ) { 91 $QAstatus=`cat $TBX_TESTDIR/$tbx_dir/QAstatus 2>/dev/null`; 92 $QAstatus =~ s/\n$//g; 93 } else { 94 $QAstatus="unknown"; 95 } 96 97 $efulldate = timelocal( 0, $min, $hour, $day, $month-1, $year-1900); 98 if ( "$host" !~ "$last_host" || "$no_bits" !~ "$last_no_bits" ) { 99 if ( $QAstatus !~ "QA running" ) { 100 $platform_idx = 0; 101 } else { 102 $platform_idx = -1; 103 } 104 $passed_idx = 0; 105 106 $last_host = $host; 107 $last_no_bits = $no_bits; 108 } else { 109 $platform_idx ++; 110 $passed_idx++ if ( $QAstatus =~ "QA passed" ) ; 111 } 112 113 debug ("$tbx_dir host $host date $fulldate bits $no_bits $year/$month/$day $hour:$min QAstatus $QAstatus pli $platform_idx pai $passed_idx"); 114 115 if ( $passed_idx > $PASSED_NEWER_DIRS && $QAstatus =~ "QA passed" ) { 116 $ekeeptime=$efulldate + $ePASSED_TBX_KEEP; 117 #($s, $m, $h, $d, $mo, $y) = localtime($ekeeptime); 118 #debug ("$passed_idx > $PASSED_NEWER_DIRS ekeeptime ($s, $m, $h, $d, $mo, $y) == $ekeeptime"); 119 rm_tbx ("Passed $PASSED_TBX_KEEP_HOURS + hours old") if ( $ekeeptime <= $enow ); 120 } elsif ( $QAstatus !~ "QA failed" ) { 121 $ekeeptime=$efulldate + $eNOT_FAILED_TBX_KEEP; 122 rm_tbx ("Not failed $NOT_FAILED_TBX_KEEP_HOURS + hours old") if ( $ekeeptime <= $enow ); 123 } else { 124 $ekeeptime=$efulldate + $eANY_TBX_KEEP; 125 rm_tbx ("Passed 2+ hours old") if ( $ekeeptime <= $enow ); 126 } 127 if ( $QAstatus =~ "QA failed" ) { 128 $ekeeptime=$efulldate + $eIF_TBX_KEEP; 129 #FIXME - compare to the previous failure by filtering and 130 #FIXME diffing the results.html files (first grep failed) 131 } 132 } 133 134 } 135 136 sub rm_tbx() 137 { 138 139 debug ("DELETING $tbx_dir... (@_[0]) "); 140 system("rm -rf $TBX_TESTDIR/$tbx_dir"); 141 #debug ("rm -rf $TBX_TESTDIR/$tbx_dir"); 142 143 } 144 145 sub msg 146 { 147 my $i; 148 for ($i = 0; $i <= $#_ ; $i++ ) { 149 print "@_[$i] "; 150 } 151 print "\n"; 152 153 } 154 sub error 155 { 156 msg ("ERROR: " ,@_ ); 157 } 158 159 sub warning 160 { 161 msg ("WARNING:" ,@_ ); 162 } 163 sub debug 164 { 165 if ( $verbose == 1 ) { 166 msg ("DEBUG: " ,@_ ); 167 } elsif ( $verbose == 2 ) { 168 msg (@_ ); 169 } 170 } 171 172 check_tbx_dirs;