mozilla
/
gecko-dev
зеркало из https://github.com/mozilla/gecko-dev.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

Add 'use strict;' to expose globals. 

Remove uses of global $tree & $form.
Remove tabs from showbuilds.pl
Bug #359451 r=bear
This commit is contained in:
cls%seawood.org 2007-01-23 17:49:10 +00:00
Родитель 65e3ee6467
Коммит 47ca2eda78
21 изменённых файлов: 1457 добавлений и 1373 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

74
webtools/tinderbox/addimage.cgi
Просмотреть файл

@ -20,6 +20,7 @@
#
# Contributor(s):
use strict;
use Socket;
require 'header.pl';
@ -33,7 +34,7 @@ $| = 1;
require "tbglobals.pl";
require "imagelog.pl";
&split_cgi_args;
my %form = &split_cgi_args();
sub Error {
@ -50,6 +51,8 @@ sub Error {
}
my ($url, $quote, $width, $height, $size );
if( $url = $form{"url"} ){
$quote = $form{"quote"};
@ -62,7 +65,7 @@ if( $url = $form{"url"} ){
# $width = $form{"width"};
# $height = $form{"height"};
if ($width eq "" || $height eq "") {
# if ($width eq "" || $height eq "") {
$size = &URLsize($url);
if ($size =~ /WIDTH=([0-9]*)/) {
$width = $1;
@ -73,7 +76,7 @@ if( $url = $form{"url"} ){
if ($width eq "" || $height eq "") {
Error "Couldn't get image size for \"$url\".\n";
}
}
# }
print "
@ -173,22 +176,6 @@ have even seen it.
";
}
sub split_cgi_args {
local($i,$var,$value, $s);
$s = $ENV{"QUERY_STRING"};
@args= split(/\&/, $s );
for $i (@args) {
($var, $value) = split(/=/, $i);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$form{$var} = $value;
}
}
#sub imgsize {
# local($file)= @_;
#
@ -237,7 +224,9 @@ sub split_cgi_args {
sub gifsize {
local($GIF) = @_;
my ($GIF) = @_;
my ($size, $type, $s);
my ($a,$b,$c,$d);
read($GIF, $type, 6);
if(!($type =~ /GIF8[7,9]a/) ||
!(read($GIF, $s, 4) == 4) ){
@ -251,8 +240,9 @@ sub gifsize {
}
sub xbmsize {
local($XBM) = @_;
local($input)="";
my ($XBM) = @_;
my $input ="";
my ($size, $a, $b);
$input .= <$XBM>;
$input .= <$XBM>;
@ -270,9 +260,11 @@ sub xbmsize {
# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
# modified slightly by alex@ed.ac.uk
sub jpegsize {
local($JPEG) = @_;
local($done)=0;
$size="";
my ($JPEG) = @_;
my $done=0;
my $size="";
my ($c1, $c2, $ch, $s, $length, $marker, $junk);
my ($a,$b,$c,$d);
read($JPEG, $c1, 1); read($JPEG, $c2, 1);
if( !((ord($c1) == 0xFF) && (ord($c2) == 0xD8))){
@ -319,6 +311,7 @@ sub jpegsize {
sub URLsize {
my ($fullurl) = @_;
my $S = new IO::Handle;
$_ = $fullurl;
if ( ! m@^http://@ ) {
@ -329,6 +322,7 @@ sub URLsize {
my($them,$port) = split(/:/, $serverstring);
my $port = 80 unless $port;
my $size="";
my ($newheight, $newwidth);
$_ = $them;
if ( m@^[^.]*$@ ) {
@ -344,22 +338,22 @@ sub URLsize {
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(S, $paddr) || die "connect: $!";
select(S); $| = 1; select(STDOUT);
socket($S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect($S, $paddr) || die "connect: $!";
select($S); $| = 1; select(STDOUT);
print S "GET /$url HTTP/1.0\r\n";
print S "Host: $them\r\n";
print S "User-Agent: Tinderbox/0.0\r\n";
print S "\r\n";
print $S "GET /$url HTTP/1.0\r\n";
print $S "Host: $them\r\n";
print $S "User-Agent: Tinderbox/0.0\r\n";
print $S "\r\n";
$_ = <S>;
$_ = <$S>;
if (! m@^HTTP/[0-9.]+ 200@ ) {
Error "$them responded:<BR> $_";
}
my $ctype = "";
while (<S>) {
while (<$S>) {
# print "read: $_<br>\n";
if ( m@^Content-Type:[ \t]*([^ \t\r\n]+)@io ) {
$ctype = $1;
@ -371,11 +365,11 @@ sub URLsize {
if ( $_ eq "" ) {
Error "Server returned no content-type for \"$fullurl\"?";
} elsif ( m@image/jpeg@i || m@image/pjpeg@i ) {
$size = &jpegsize(S);
$size = &jpegsize($S);
} elsif ( m@image/gif@i ) {
$size = &gifsize(S);
$size = &gifsize($S);
} elsif ( m@image/xbm@i || m@image/x-xbm@i || m@image/x-xbitmap@i ) {
$size = &xbmsize(S);
$size = &xbmsize($S);
} else {
Error "Not a GIF, JPEG, or XBM: that was of type \"$ctype\".";
}
@ -401,6 +395,6 @@ sub URLsize {
}
}
sub dokill {
kill 9,$child if $child;
}
#sub dokill {
# kill 9,$child if $child;
#}

17
webtools/tinderbox/addnote.cgi
Просмотреть файл

@ -20,14 +20,17 @@
#
# Contributor(s):
use Fcntl;
use strict;
use Fcntl qw(:flock);
require 'tbglobals.pl';
require 'showbuilds.pl';
# Process the form arguments
%form = ();
&split_cgi_args();
my %form = &split_cgi_args();
my %cookie_jar = &split_cookie_args();
my ($args, $tree, $logfile, $errorparser, $buildname, $buildtime);
if (defined($args = $form{log})) {
# Use simplified arguments that uses the logfile as a key.
@ -111,7 +114,9 @@ if ($form{note}) {
."Go back to the build Page</a>";
# Rebuild the static tinderbox pages
tb_build_static();
my %new_form = ();
$new_form{tree} = $tree;
&tb_build_static(\$new_form);
} else {
# Print the form to submit a comment
@ -123,7 +128,7 @@ if ($form{note}) {
# Retrieve the email address from the cookie jar.
#
$emailvalue = '';
my $emailvalue = '';
$emailvalue = " value='$cookie_jar{email}'" if defined $cookie_jar{email};
print <<__END_FORM;
@ -174,7 +179,7 @@ __END_FORM
# Add a checkbox for the each of the other builds
for my $other_build_name (sort keys %build_status) {
if ($other_build_name ne '' and $other_build_name ne $buildname
and not $ignore_builds->{$other_build_name}) {
and not $::ignore_builds->{$other_build_name}) {
print "<INPUT TYPE='checkbox' NAME='$other_build_name'>";
print "$other_build_name<BR>\n";
}

48
webtools/tinderbox/admintree.cgi
Просмотреть файл

@ -20,12 +20,12 @@
#
# Contributor(s):
use strict;
require 'tbglobals.pl';
require 'header.pl';
# Process the form arguments
%form = ();
&split_cgi_args();
my %form = &split_cgi_args();
$|=1;
@ -33,11 +33,14 @@ print "Content-type: text/html\n\n";
$form{noignore} = 1; # Force us to load all build info, not
# paying any attention to ignore_builds stuff.
$maxdate = time();
$mindate = $maxdate - 24*60*60;
tb_load_data();
$::maxdate = time();
$::mindate = $::maxdate - 24*60*60;
my $treedata = &tb_load_data(\%form);
if (defined($tree)) {
my (@names, $i, $checked);
if (defined($treedata)) {
my $tree = $treedata->{name};
my $safe_tree = value_encode($tree);
EmitHtmlHeader("administer tinderbox", "tree: $safe_tree");
@ -45,25 +48,25 @@ if (defined($tree)) {
# Sheriff
if( -r "$tree/sheriff.pl" ){
require "$tree/sheriff.pl";
$current_sheriff =~ s/\s*$//; # Trim trailing whitespace;
$::current_sheriff =~ s/\s*$//; # Trim trailing whitespace;
} else {
$current_sheriff = "";
$::current_sheriff = "";
}
# Status message.
if( -r "$tree/status.pl" ){
require "$tree/status.pl";
$status_message =~ s/\s*$//; # Trim trailing whitespace;
$::status_message =~ s/\s*$//; # Trim trailing whitespace;
} else {
$status_message = "";
$::status_message = "";
}
# Tree rules.
if( -r "$tree/rules.pl" ){
require "$tree/rules.pl";
$rules_message =~ s/\s*$//; # Trim trailing whitespace;
$::rules_message =~ s/\s*$//; # Trim trailing whitespace;
} else {
$rules_message = "";
$::rules_message = "";
}
@ -75,7 +78,7 @@ if (defined($tree)) {
<INPUT TYPE=HIDDEN NAME=tree VALUE='$safe_tree'>
<INPUT TYPE=HIDDEN NAME=command VALUE=set_sheriff>
<br><b>Change sheriff info.</b> (mailto: url, phone number, etc.)<br>
<TEXTAREA NAME=sheriff ROWS=8 COLS=75 WRAP=SOFT>$current_sheriff
<TEXTAREA NAME=sheriff ROWS=8 COLS=75 WRAP=SOFT>$::current_sheriff
</TEXTAREA>
<br>
<B>Password:</B> <INPUT NAME=password TYPE=password>
@ -93,7 +96,7 @@ if (defined($tree)) {
<INPUT TYPE=HIDDEN NAME=tree VALUE='$safe_tree'>
<INPUT TYPE=HIDDEN NAME=command VALUE=set_status_message>
<br><b>Status message.</b> (Use this for stay-out-of-the-tree warnings, etc.)<br>
<TEXTAREA NAME=status ROWS=8 COLS=75 WRAP=SOFT>$status_message
<TEXTAREA NAME=status ROWS=8 COLS=75 WRAP=SOFT>$::status_message
</TEXTAREA>
<br>
<b>
@ -113,7 +116,7 @@ if (defined($tree)) {
<INPUT TYPE=HIDDEN NAME=tree VALUE='$safe_tree'>
<INPUT TYPE=HIDDEN NAME=command VALUE=set_rules_message>
<br><b>The tree rules.</b>
<br><TEXTAREA NAME=rules ROWS=18 COLS=75 WRAP=SOFT>$rules_message
<br><TEXTAREA NAME=rules ROWS=18 COLS=75 WRAP=SOFT>$::rules_message
</TEXTAREA>
<br>
<B>Password:</B> <INPUT NAME=password TYPE=password>
@ -131,6 +134,7 @@ if (defined($tree)) {
my @trim_files = grep { /\.(?:gz|brief\.html)$/ && -f "$tree/$_" } readdir(TRIM_DIR);
close(TRIM_DIR);
my $trim_bytes = 0;
my $trim_size;
my $now = time();
my $trim_oldest = $now;
my $size_K = 1024;
@ -141,8 +145,8 @@ if (defined($tree)) {
$trim_bytes += $file_stat[7];
$trim_oldest = $file_stat[9] if ($trim_oldest > $file_stat[9]);
}
$trim_days = int (($now - $trim_oldest) / 86400);
if ($trim_bytes < $size_k) {
my $trim_days = int (($now - $trim_oldest) / 86400);
if ($trim_bytes < $size_K) {
$trim_size = "$trim_bytes b";
} elsif ($trim_bytes < $size_M) {
$trim_size = int($trim_bytes / $size_K) . " Kb";
@ -158,7 +162,7 @@ if (defined($tree)) {
<INPUT TYPE=HIDDEN NAME=command VALUE=trim_logs>
<b>Trim Logs</b><br>
Trim Logs to <INPUT NAME=days size=5 VALUE='$trim_days'> days<br>
Tinderbox is configured to show up to $who_days days of log history. Currently, there are $trim_days days of logging taking up $trim_size of space.<br>
Tinderbox is configured to show up to $::who_days days of log history. Currently, there are $trim_days days of logging taking up $trim_size of space.<br>
<B>Password:</B> <INPUT NAME=password TYPE=password>
<INPUT TYPE=SUBMIT VALUE='Trim Logs'>
</FORM>
@ -175,11 +179,11 @@ Tinderbox is configured to show up to $who_days days of log history. Currently,
<INPUT TYPE=HIDDEN NAME=command VALUE=scrape_builds>
";
@names = sort (@$build_names) ;
@names = sort (@$::build_names) ;
for $i (@names){
if( $i ne "" ){
$checked = ($scrape_builds->{$i} != 0 ? "CHECKED": "" );
$checked = ($::scrape_builds->{$i} != 0 ? "CHECKED": "" );
print "<INPUT TYPE=checkbox NAME='build_".value_encode($i)."' $checked >";
print value_encode($i)."<br>\n";
}
@ -204,11 +208,11 @@ the tinderbox URL to override.<br>
<INPUT TYPE=HIDDEN NAME=command VALUE=disable_builds>
";
@names = sort (@$build_names) ;
@names = sort (@$::build_names) ;
for $i (@names){
if( $i ne "" ){
$checked = ($ignore_builds->{$i} != 0 ? "": "CHECKED" );
$checked = ($::ignore_builds->{$i} != 0 ? "": "CHECKED" );
print "<INPUT TYPE=checkbox NAME='build_".value_encode($i)."' $checked >";
print value_encode($i)."<br>\n";
}

70
webtools/tinderbox/buildwho.pl
Просмотреть файл

@ -20,18 +20,20 @@
#
# Contributor(s):
use strict;
use File::Copy 'move';
use lib "@TINDERBOX_DIR@";
require 'tbglobals.pl';
$F_DEBUG=0;
my $F_DEBUG=0;
$ENV{'PATH'} = "@SETUID_PATH@";
# Process args:
# $days: How many days of data to process.
# $tree: Which tree to use.
$days = $tree = undef;
my $days = undef;
my $tree = undef;
if ($ARGV[0] eq '-days') {
shift;
@ -50,36 +52,36 @@ $tree = &trick_taint(shift);
# $viewvc_repository: Repository path used by viewvc for this tree
require "$tree/treedata.pl";
$days = $who_days if (!defined($days));
$days = $::who_days if (!defined($days));
# Exit early if no query system is enabled
exit 0 if (!$use_bonsai && !$use_viewvc);
exit 0 if (!$::use_bonsai && !$::use_viewvc);
# Only allow one process at a time to re-write "who.dat".
#
my $lockfile = "$tree/buildwho.sem";
my $lock = lock_datafile($lockfile);
if ($use_bonsai) {
if ($::use_bonsai) {
# Setup global variables for bonsai query
#
if ($cvs_root eq '') {
$CVS_ROOT = "$default_cvsroot";
if ($::cvs_root eq '') {
$::CVS_ROOT = "$::default_cvsroot";
} else {
$CVS_ROOT = $cvs_root;
$::CVS_ROOT = $::cvs_root;
}
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
$::CVS_REPOS_SUFIX = $::CVS_ROOT;
$::CVS_REPOS_SUFIX =~ s/\//_/g;
$CHECKIN_DATA_FILE = "$bonsai_dir/data/checkinlog${CVS_REPOS_SUFIX}";
$CHECKIN_INDEX_FILE = "$bonsai_dir/data/index${CVS_REPOS_SUFIX}";
$::CHECKIN_DATA_FILE = "$::bonsai_dir/data/checkinlog$::CVS_REPOS_SUFIX";
$::CHECKIN_INDEX_FILE = "$::bonsai_dir/data/index$::CVS_REPOS_SUFIX";
use lib "@BONSAI_DIR@";
require 'cvsquery.pl';
print "cvsroot='$CVS_ROOT'\n" if $F_DEBUG;
} elsif ($use_viewvc) {
print "cvsroot='$::CVS_ROOT'\n" if $F_DEBUG;
} elsif ($::use_viewvc) {
require 'viewvc.pl';
}
@ -97,44 +99,44 @@ sub usage() {
sub build_who {
my ($tree) = @_;
$query_date_min = time - (60 * 60 * 24 * $days);
$::query_date_min = time - (60 * 60 * 24 * $days);
print "Minimum date: $query_date_min\n" if $F_DEBUG;
print "Minimum date: $::query_date_min\n" if $F_DEBUG;
if ($use_viewvc) {
$query_module=$viewvc_repository;
} elsif ($use_bonsai) {
$query_module=$cvs_module;
$query_branch=$cvs_branch;
if ($::use_viewvc) {
$::query_module=$::viewvc_repository;
} elsif ($::use_bonsai) {
$::query_module=$::cvs_module;
$::query_branch=$::cvs_branch;
} else {
# Should never reach this
return;
}
$query_branchtype='regexp' if $query_branch =~ /\*|\?|\+/;
$::query_branchtype='regexp' if $::query_branch =~ /\*|\?|\+/;
$::query_branch_head=1 if $::query_branch eq 'HEAD';
my $who_file = "$tree/who.dat";
my $temp_who_file = "$who_file.$$";
open(WHOLOG, ">", "$temp_who_file");
if ($use_bonsai) {
chdir $bonsai_dir;
$::TreeID = $bonsai_tree;
if ($::use_bonsai) {
chdir $::bonsai_dir;
$::TreeID = $::bonsai_tree;
}
my $result = &query_checkins(%mod_map);
my $result = &query_checkins(%::mod_map);
$last_who='';
$last_date=0;
for $ci (@$result) {
if ($ci->[$CI_DATE] != $last_date or $ci->[$CI_WHO] ne $last_who) {
print WHOLOG "$ci->[$CI_DATE]|$ci->[$CI_WHO]\n";
my $last_who='';
my $last_date=0;
for my $ci (@$result) {
if ($ci->[$::CI_DATE] != $last_date or $ci->[$::CI_WHO] ne $last_who) {
print WHOLOG "$ci->[$::CI_DATE]|$ci->[$::CI_WHO]\n";
}
$last_who=$ci->[$CI_WHO];
$last_date=$ci->[$CI_DATE];
$last_who=$ci->[$::CI_WHO];
$last_date=$ci->[$::CI_DATE];
}
close (WHOLOG);
if ($use_bonsai) {
if ($::use_bonsai) {
chdir "@TINDERBOX_DIR@";
}
move($temp_who_file, $who_file);

4
webtools/tinderbox/bustagestats.cgi
Просмотреть файл

@ -20,6 +20,7 @@
#
# Contributor(s):
use strict;
require 'tbglobals.pl';
require 'header.pl';
@ -29,8 +30,7 @@ use Date::Format;
my $TIMEFORMAT = "%D %T";
# Process the form arguments
%form = ();
&split_cgi_args();
my %form = &split_cgi_args();
$|=1;

2
webtools/tinderbox/copylogs
Просмотреть файл

@ -30,7 +30,7 @@ sub last_successful_builds {
print STDERR "Loading build data...";
require 'tbglobals.pl';
tb_load_data();
tb_load_data(\%form);
print STDERR "done\n";

53
webtools/tinderbox/doadmin.cgi
Просмотреть файл

@ -20,26 +20,27 @@
#
# Contributor(s):
use strict;
use Tie::IxHash;
require 'tbglobals.pl';
umask 002;
$perm = "0660"; # Permission of created files
$dir_perm = "0770"; # Permission of created dirs
my $perm = "0660"; # Permission of created files
my $dir_perm = "0770"; # Permission of created dirs
# Process the form arguments
%form = ();
&split_cgi_args();
my %form = &split_cgi_args();
my %cookie_jar = &split_cookie_args();
$|=1;
tb_check_password();
&tb_check_password(\%form, \%cookie_jar);
print "Content-type: text/html\n\n<HTML>\n";
$command = $form{'command'};
$tree= $form{'tree'};
my $command = $form{'command'};
my $tree= $form{'tree'};
if( $command eq 'create_tree' ){
&create_tree;
@ -66,21 +67,22 @@ elsif( $command eq 'scrape_builds' ){
}
sub trim_logs {
$days = $form{'days'};
$tree = $form{'tree'};
my $days = $form{'days'};
my $tree = $form{'tree'};
print "<h2>Trimming Log files for $tree...</h2>\n<p>";
$min_date = time - (60*60*24 * $days);
my $min_date = time - (60*60*24 * $days);
#
# Nuke the old log files
#
$i = 0;
my $i = 0;
my $tblocks;
opendir( D, &shell_escape($tree) );
while( $fn = readdir( D ) ){
while( my $fn = readdir( D ) ){
if( $fn =~ /\.(?:gz|brief\.html)$/ ){
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
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";
@ -91,17 +93,17 @@ sub trim_logs {
}
}
closedir( D );
$k = $tblocks*512/1024;
my $k = $tblocks*512/1024;
print "<br><b>$i Logfiles ( $k K bytes ) removed</b><br>\n";
#
# Trim build.dat
#
$builds_removed = 0;
my $builds_removed = 0;
open(BD, "<", "$tree/build.dat");
open(NBD, ">", "$tree/build.dat.new");
while( <BD> ){
($endtime,$buildtime,$buildname) = split( /\|/ );
my ($endtime,$buildtime,$buildname) = split( /\|/ );
if( $buildtime >= $min_date ){
print NBD $_;
}
@ -112,6 +114,7 @@ sub trim_logs {
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" );
@ -121,7 +124,7 @@ sub trim_logs {
sub create_tree {
tie my %treedata => 'Tie::IxHash';
# make a copy of default_treedata to preserve order
%treedata = %default_treedata;
%treedata = %::default_treedata;
$treedata{who_days} = $form{'who_days'};
$treedata{cvs_root} = $form{'repository'};
$treedata{cvs_module} = $form{'modulename'};
@ -138,7 +141,7 @@ sub create_tree {
$treedata{use_bonsai} = $treedata{use_viewvc} = 0;
$treename = $form{'treename'};
my $treename = $form{'treename'};
for my $var ( 'cvs_module', 'cvs_branch', 'bonsai_tree') {
$treedata{use_bonsai}++ if (defined($treedata{$var}) &&
@ -188,12 +191,12 @@ sub create_tree {
sub disable_builds {
my $i,%buildnames;
my ($i,%buildnames);
# Read build.dat
open(BD, "<", "$tree/build.dat");
while( <BD> ){
($endtime,$buildtime,$bname) = split( /\|/ );
my ($endtime,$buildtime,$bname) = split( /\|/ );
$buildnames{$bname} = 0;
}
close( BD );
@ -220,12 +223,12 @@ sub disable_builds {
sub scrape_builds {
my $i,%buildnames;
my ($i,%buildnames);
# Read build.dat
open(BD, "<", "$tree/build.dat");
while( <BD> ){
($endtime,$buildtime,$bname) = split( /\|/ );
my ($endtime,$buildtime,$bname) = split( /\|/ );
$buildnames{$bname} = 1;
}
close( BD );
@ -252,7 +255,7 @@ sub scrape_builds {
sub set_sheriff {
$m = $form{'sheriff'};
my $m = $form{'sheriff'};
$m =~ s/\'/\\\'/g;
open(SHERIFF, ">", "$tree/sheriff.pl");
print SHERIFF "\$current_sheriff = '$m';\n1;";
@ -263,7 +266,7 @@ sub set_sheriff {
}
sub set_status_message {
$m = $form{'status'};
my $m = $form{'status'};
$m =~ s/\'/\\\'/g;
open(TREESTATUS, ">", "$tree/status.pl");
print TREESTATUS "\$status_message = \'$m\'\;\n1;";
@ -274,7 +277,7 @@ sub set_status_message {
}
sub set_rules_message {
$m = $form{'rules'};
my $m = $form{'rules'};
$m =~ s/\'/\\\'/g;
open(RULES, ">", "$tree/rules.pl");
print RULES "\$rules_message = \'$m\';\n1;";

56
webtools/tinderbox/fixupimages.pl
Просмотреть файл

@ -20,6 +20,7 @@
#
# Contributor(s):
use strict;
use Socket;
require 'tbglobals.pl';
@ -30,13 +31,14 @@ $SIG{ALRM} = sub { die "timeout" };
# Move an old imagelog to a new one
open( IMAGELOG, "<", "$data_dir/imagelog.txt" ) || die "can't open file";
open (OUT, ">", "$data_dir/newimagelog.txt") || die "can't open output file";
open( IMAGELOG, "<", "$::data_dir/imagelog.txt" ) || die "can't open file";
open (OUT, ">", "$::data_dir/newimagelog.txt") || die "can't open output file";
select(OUT); $| = 1; select(STDOUT);
my ($size, $height, $width);
while( <IMAGELOG> ){
chop;
($url,$quote) = split(/\`/);
my ($url,$quote) = split(/\`/);
print "$url\n";
eval {
@ -77,19 +79,21 @@ while( <IMAGELOG> ){
sub imgsize {
local($file)= @_;
my ($file)= @_;
my ($size, $s, $newwidth, $newheight);
my $STREAM = new IO::Handle;
#first try to open the file
if( !open(STREAM, "<", $file) ){
if( !open($STREAM, "<", $file) ){
print "Can't open IMG $file";
$size="";
} else {
if ($file =~ /.jpg/i || $file =~ /.jpeg/i) {
$size = &jpegsize(STREAM);
$size = &jpegsize($STREAM);
} elsif($file =~ /.gif/i) {
$size = &gifsize(STREAM);
$size = &gifsize($STREAM);
} elsif($file =~ /.xbm/i) {
$size = &xbmsize(STREAM);
$size = &xbmsize($STREAM);
} else {
return "";
}
@ -100,7 +104,7 @@ sub imgsize {
if( /\s*height\s*=\s*([0-9]*)\s*/i ){
($newheight)=/\s*height\s*=\s*(\d*)\s*/i;
}
close(STREAM);
close($STREAM);
}
return $size;
}
@ -109,7 +113,10 @@ sub imgsize {
# Subroutine gets the size of the specified GIF
###########################################################################
sub gifsize {
local($GIF) = @_;
my ($GIF) = @_;
my ($size, $s, $type);
my ($a,$b,$c,$d);
read($GIF, $type, 6);
if(!($type =~ /GIF8[7,9]a/) ||
!(read($GIF, $s, 4) == 4) ){
@ -123,8 +130,9 @@ sub gifsize {
}
sub xbmsize {
local($XBM) = @_;
local($input)="";
my ($XBM) = @_;
my ($input)="";
my ($size, $a, $b);
$input .= <$XBM>;
$input .= <$XBM>;
@ -142,9 +150,11 @@ sub xbmsize {
# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
# modified slightly by alex@ed.ac.uk
sub jpegsize {
local($JPEG) = @_;
local($done)=0;
$size="";
my ($JPEG) = @_;
my ($done)=0;
my $size="";
my ($c1, $c2, $ch, $s, $length, $marker, $junk, $done);
my ($a,$b,$c,$d);
read($JPEG, $c1, 1); read($JPEG, $c2, 1);
if( !((ord($c1) == 0xFF) && (ord($c2) == 0xD8))){
@ -195,6 +205,8 @@ sub URLsize {
my $port = 80 unless $port;
$them = 'localhost' unless $them;
my $size="";
my ($newheight, $newwidth);
my $S = new IO::Handle;
$_=$url;
if( /gif/i || /jpeg/i || /jpg/i || /xbm/i ) {
@ -206,19 +218,19 @@ sub URLsize {
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(S, PF_INET, SOCK_STREAM, $proto) || return "socket: $!";
connect(S, $paddr) || return "connect: $!";
select(S); $| = 1; select(STDOUT);
socket($S, PF_INET, SOCK_STREAM, $proto) || return "socket: $!";
connect($S, $paddr) || return "connect: $!";
select($S); $| = 1; select(STDOUT);
print S "GET /$url\n";
print $S "GET /$url\n";
if ($url =~ /.jpg/i || $url =~ /.jpeg/i) {
$size = &jpegsize(S);
$size = &jpegsize($S);
} elsif($url =~ /.gif/i) {
$size = &gifsize(S);
$size = &gifsize($S);
} elsif($url =~ /.xbm/i) {
$size = &xbmsize(S);
$size = &xbmsize($S);
} else {
return "";
}

7
webtools/tinderbox/handlemail.pl
Просмотреть файл

@ -20,16 +20,17 @@
#
# Contributor(s):
use strict;
use lib "@TINDERBOX_DIR@";
require 'tbglobals.pl';
$ENV{'PATH'} = "@SETUID_PATH@";
$tinderboxdir = "@TINDERBOX_DIR@";
my $tinderboxdir = "@TINDERBOX_DIR@";
chdir $tinderboxdir or die "Couldn't chdir to $tinderboxdir";
$time = time();
open(OUT, ">$data_dir/tbx.$time.$$") or die ("Could not open data file, tbx.$time.$$\n");
my $time = time();
open(OUT, ">$::data_dir/tbx.$time.$$") or die ("Could not open data file, tbx.$time.$$\n");
while (<STDIN>) {
print OUT $_;
}

7
webtools/tinderbox/header.pl
Просмотреть файл

@ -19,6 +19,7 @@
#
# Contributor(s):
use strict;
sub EmitHtmlTitleAndHeader {
my($doctitle,$heading,$subheading) = @_;
@ -29,10 +30,10 @@ sub EmitHtmlTitleAndHeader {
print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"";
print "LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">";
if (open(BANNER, "<", "data/banner.html")) {
if (open(BANNER, "<", "$::data_dir/banner.html")) {
while (<BANNER>) { print; }
close BANNER;
} elsif (open(BANNER, "<", "$bonsai_dir/data/banner.html")) {
} elsif (open(BANNER, "<", "$::bonsai_dir/data/banner.html")) {
while (<BANNER>) { print; }
close BANNER;
}
@ -50,7 +51,7 @@ sub EmitHtmlTitleAndHeader {
print " </TD>\n";
print " <TD>\n";
if (open(BLURB, "<", "data/blurb")) {
if (open(BLURB, "<", "$::data_dir/blurb")) {
while (<BLURB>) { print; }
close BLURB;
}

10
webtools/tinderbox/imagelog.pl
Просмотреть файл

@ -22,17 +22,19 @@
1;
use strict;
sub add_imagelog {
local($url,$quote,$width,$height) = @_;
open( IMAGELOG, ">>", "$data_dir/imagelog.txt" ) || die "Oops; can't open imagelog.txt";
my ($url,$quote,$width,$height) = @_;
open( IMAGELOG, ">>", "$::data_dir/imagelog.txt" ) || die "Oops; can't open imagelog.txt";
print IMAGELOG "$url`$width`$height`$quote\n";
close( IMAGELOG );
}
sub get_image{
local(@log,@ret,$i);
my (@log,@ret,$i);
open( IMAGELOG, "<", "$data_dir/imagelog.txt" );
open( IMAGELOG, "<", "$::data_dir/imagelog.txt" );
@log = <IMAGELOG>;
# return a random line

56
webtools/tinderbox/processbuild.pl
Просмотреть файл

@ -28,13 +28,13 @@ use File::Copy;
use File::Basename;
use lib "@TINDERBOX_DIR@";
require 'tbglobals.pl'; # for $gzip
#use strict;
use strict;
umask 002;
# setuid globals
$ENV{'PATH'} = "@SETUID_PATH@";
$tinderboxdir = "@TINDERBOX_DIR@";
my $tinderboxdir = "@TINDERBOX_DIR@";
# globals
my ($only_check_mail);
@ -42,7 +42,7 @@ my @changed_trees=();
my %scraped_trees;
my $debug = 0;
my $err = 0;
my $rejected_mail_dir = "$data_dir/bad";
my $rejected_mail_dir = "$::data_dir/bad";
chdir $tinderboxdir or die "Couldn't chdir to $tinderboxdir";
@ -50,7 +50,7 @@ chdir $tinderboxdir or die "Couldn't chdir to $tinderboxdir";
GetOptions("check-mail" => \$only_check_mail) or die ("Error parsing args.");
# Acquire a lock first so that we don't step on ourselves
my $lockfile = "$data_dir/processbuild.sem";
my $lockfile = "$::data_dir/processbuild.sem";
my $lock = &lock_datafile($lockfile);
opendir(DIR, &shell_escape($::data_dir)) or $err++;
if ($err) {
@ -59,29 +59,29 @@ if ($err) {
die("Can't opendir($::data_dir): $!");
}
my @datafiles =
sort(grep { /^tbx\.\d+\.\d+$/ && -f "$data_dir/$_" } readdir(DIR));
sort(grep { /^tbx\.\d+\.\d+$/ && -f "$::data_dir/$_" } readdir(DIR));
closedir(DIR);
print "Files: @datafiles\n" if ($debug && $#datafiles > 0);
for my $file (@datafiles) {
&process_mailfile("$data_dir/$file");
&process_mailfile("$::data_dir/$file");
}
&unlock_datafile($lock);
unlink($lockfile);
require 'showbuilds.pl';
# Hardcode static pages to only showing 12 hrs of data
$nowdate = $maxdate = time;
$hours = 12;
$mindate = $maxdate - ($hours*60*60);
$::nowdate = $::maxdate = time;
$::hours = 12;
$::mindate = $::maxdate - ($::hours*60*60);
print "Changed trees:\n\t@changed_trees\n" if ($debug && $#changed_trees > 0);
for my $t (@changed_trees) {
# Override globals used in static page creation
%form = ();
$tree = $t;
my %form = ();
$form{tree} = $t;
print "Tree: $t\n" if ($debug);
# Static pages - For Sidebar flash and tinderbox panels.
$rel_path = '';
&tb_build_static();
$::rel_path = '';
&tb_build_static(\%form);
# Who data
$err = system("./buildwho.pl", "$t");
if ($err) {
@ -101,8 +101,8 @@ sub process_mailfile($) {
print "process_mailfile($mail_file)\n" if ($debug);
%MAIL_HEADER = ();
%tinderbox = ();
my %MAIL_HEADER = ();
my %tinderbox = ();
# Scan the logfile once to get mail header and build variables
#
@ -118,7 +118,7 @@ sub process_mailfile($) {
print "Parsing: end\n" if ($debug);
# If the mail does not contain any tinderbox header info, just drop it.
@tbkeys = keys %tinderbox;
my @tbkeys = keys %tinderbox;
if ($#tbkeys == -1) {
print "Dropping spam mail: $mail_file\n" if ($debug);
unlink $mail_file;
@ -166,33 +166,35 @@ sub process_mailfile($) {
# Compare the name with $warning_buildnames_pat which is defined in
# $tinderbox{tree}/treedata.pl if at all.
print "Warnings($tinderbox{tree}/$tinderbox{logfile})\n" if ($debug);
undef $warning_buildnames_pat;
undef $::warning_buildnames_pat;
open(TD, "$tinderbox{tree}/treedata.pl");
my $line;
while ($line=<TD>) {
if ($line =~ m/^\$warning_build_names_pat\s*=.*;$/) {
$line =~ s/^\$warning/\$::warning/;
eval($line);
}
}
close(TD);
if (defined $warning_buildnames_pat
and $tinderbox{build} =~ /^$warning_buildnames_pat$/
if (defined $::warning_buildnames_pat
and $tinderbox{build} =~ /^$::warning_buildnames_pat$/
and $tinderbox{status} ne 'failed') {
$err = system("./warnings.pl", "$tinderbox{tree}/$tinderbox{logfile}");
warn "warnings.pl($tinderbox{tree}/$tinderbox{logfile} returned an error\n" if ($err);
undef $warning_buildnames_pat;
undef $::warning_buildnames_pat;
}
# Scrape data
# Look for build name in scrapedata.pl.
print "Scrape($tinderbox{tree},$tinderbox{logfile})\n" if ($debug);
undef $scrape_builds;
undef $::scrape_builds;
require "$tinderbox{tree}/scrapebuilds.pl"
if -r "$tinderbox{tree}/scrapebuilds.pl";
# required files are only loaded once so preserve scraped_builds value
if (defined($scrape_builds)) {
$scraped_trees{$tinderbox{tree}} = $scrape_builds;
if (defined($::scrape_builds)) {
$scraped_trees{$tinderbox{tree}} = $::scrape_builds;
}
$sb = $scraped_trees{$tinderbox{tree}};
my $sb = $scraped_trees{$tinderbox{tree}};
if (defined($sb) and $sb->{$tinderbox{build}}) {
$err = system("./scrape.pl", "$tinderbox{tree}", "$tinderbox{logfile}");
warn "scrape.pl($tinderbox{tree},$tinderbox{logfile}) returned an error\n" if ($err);
@ -224,15 +226,15 @@ sub parse_mail_header {
while(<$fh>) {
chomp;
last if $line eq '';
last if $_ eq '';
if (/([^ :]*)\:[ \t]+([^\n]*)/) {
$name = $1;
$name =~ tr/A-Z/a-z/;
$mail_ref{$name} = $2;
$mail_ref->{$name} = $2;
}
elsif ($name ne '') {
$mail_ref{$name} .= $2;
$mail_ref->{$name} .= $2;
}
}
}

6
webtools/tinderbox/scrape.pl
Просмотреть файл

@ -26,6 +26,8 @@
# <logfilename>|blurb1|blurb2|blurb3 ...
#
use strict;
sub usage {
warn "./scrape.pl <tree> <logfile>";
}
@ -42,7 +44,7 @@ unless ($#ARGV == 1) {
die "Error: Wrong number of arguments\n";
}
($tree, $logfile) = @ARGV;
my ($tree, $logfile) = @ARGV;
print "scrape.pl($tree, $logfile)\n" if ($debug);
@ -56,7 +58,7 @@ require "$tree/treedata.pl";
#
my $gz = gzopen("$tree/$logfile", "rb")
or die "gzopen($tree/$logfile): $!\n";
@scrape_data = find_scrape_data($gz);
my @scrape_data = find_scrape_data($gz);
$gz->gzclose();
if (!defined(@scrape_data)) {

51
webtools/tinderbox/showbuilds.cgi
Просмотреть файл

@ -20,6 +20,7 @@
#
# Contributor(s):
use strict;
use lib "@TINDERBOX_DIR@";
require 'tbglobals.pl';
require 'imagelog.pl';
@ -28,43 +29,39 @@ require 'showbuilds.pl';
umask 002;
# Process the form arguments
%form = ();
&split_cgi_args();
my %form = &split_cgi_args();
# Show 12 hours by default
#
$nowdate = time;
if (not defined($maxdate = $form{maxdate})) {
$maxdate = $nowdate;
$::nowdate = time;
if (not defined($::maxdate = $form{maxdate})) {
$::maxdate = $::nowdate;
}
if ($form{showall}) {
$mindate = 0;
$::mindate = 0;
} else {
$::default_hours = 12;
$::hours = $::default_hours;
$::hours = $form{hours} if $form{hours};
$::mindate = $::maxdate - ($::hours*60*60);
}
else {
$default_hours = 12;
$hours = $default_hours;
$hours = $form{hours} if $form{hours};
$mindate = $maxdate - ($hours*60*60);
}
$::tree = $form{tree};
# $rel_path is the relative path to webtools/tinderbox used for links.
# It changes to "../" if the page is generated statically, because then
# it is placed in tinderbox/$::tree.
$rel_path = '';
# it is placed in tinderbox/$tree.
$::rel_path = '';
&show_tree_selector, exit if $::tree eq '';
&do_quickparse, exit if $form{quickparse};
&do_express, exit if $form{express};
&do_rdf, exit if $form{rdf};
&do_static, exit if $form{static};
&do_flash, exit if $form{flash};
&do_panel, exit if $form{panel};
&do_hdml, exit if $form{hdml};
&do_vxml, exit if $form{vxml};
&do_wml, exit if $form{wml};
&do_tinderbox, exit;
&show_tree_selector(\%form), exit if $form{tree} eq '';
&do_quickparse(\%form), exit if $form{quickparse};
&do_express(\%form), exit if $form{express};
&do_rdf(\%form), exit if $form{rdf};
&do_static(\%form), exit if $form{static};
&do_flash(\%form), exit if $form{flash};
&do_panel(\%form), exit if $form{panel};
&do_hdml(\%form), exit if $form{hdml};
&do_vxml(\%form), exit if $form{vxml};
&do_wml(\%form), exit if $form{wml};
&do_tinderbox(\%form), exit;
# end of main
#=====================================================================

1673
webtools/tinderbox/showbuilds.pl
Просмотреть файл

Разница между файлами не показана из-за своего большого размера Загрузить разницу

31
webtools/tinderbox/showimages.cgi
Просмотреть файл

@ -23,23 +23,26 @@
$| = 1;
use strict;
require 'tbglobals.pl';
require 'imagelog.pl';
require 'header.pl';
# Process the form arguments
%form = ();
&split_cgi_args();
my %form = &split_cgi_args();
my %cookie_jar = &split_cookie_args();
tb_check_password();
&tb_check_password(\%form, \%cookie_jar);
print "Content-type: text/html\n\n";
@url = ();
@quote = ();
@width = ();
@height = ();
$i = 0;
my @url = ();
my @quote = ();
my @width = ();
my @height = ();
my $i = 0;
my ($oldname, $newname, $foundit, $url, $quote, $width, $height);
EmitHtmlHeader("tinderbox: all images");
@ -60,13 +63,13 @@ too? Where\'s your sense of mystery and anticipation?
if ($form{'url'} ne "") {
$oldname = "$data_dir/imagelog.txt";
$oldname = "$::data_dir/imagelog.txt";
open (OLD, "<$oldname") || die "Oops; can't open imagelog.txt";
$newname = "$oldname-$$";
open (NEW, ">$newname") || die "Can't open $newname";
$foundit = 0;
while (<OLD>) {
chop;
chomp;
($url, $width, $height, $quote) = split(/\`/);
if ($url eq $form{'url'} && $quote eq $form{'origquote'}) {
$foundit = 1;
@ -93,7 +96,7 @@ if ($form{'url'} ne "") {
$doedit = ($form{'doedit'} ne "");
my $doedit = ($form{'doedit'} ne "");
if (!$doedit) {
print "
@ -106,7 +109,7 @@ if (!$doedit) {
open( IMAGELOG, "<$data_dir/imagelog.txt" ) || die "can't open file";
open( IMAGELOG, "<$::data_dir/imagelog.txt" ) || die "can't open file";
while( <IMAGELOG> ){
chop;
($url[$i],$width[$i],$height[$i],$quote[$i]) = split(/\`/);
@ -117,8 +120,8 @@ close( IMAGELOG );
$i--;
print "<center>";
while( $i >= 0 ){
$qurl = value_encode($url[$i]);
$qquote = value_encode($quote[$i]);
my $qurl = value_encode($url[$i]);
my $qquote = value_encode($quote[$i]);
print "
<img border=2 src='$url[$i]' width='$width[$i]' height='$height[$i]'><br>
<i>$quote[$i]</i>";

82
webtools/tinderbox/showlog.cgi
Просмотреть файл

@ -20,36 +20,40 @@
#
# Contributor(s):
use strict;
use Compress::Zlib;
require 'tbglobals.pl';
require 'header.pl';
require 'showbuilds.pl';
# Process the form arguments
%form = ();
&split_cgi_args();
my %form = &split_cgi_args();
#############################################################
# Global variables
$LINES_AFTER_ERROR = 5;
$LINES_BEFORE_ERROR = 30;
my $LINES_AFTER_ERROR = 5;
my $LINES_BEFORE_ERROR = 30;
my $last_modified_time = 0;
my $expires_time = time() + 3600;
# These variables are set by the error parser functions:
# has_error(), has_warning(), and has_errorline().
$error_file = '';
$error_file_ref = '';
$error_line = 0;
$error_guess = 0;
my $error_file = '';
my $error_file_ref = '';
my $error_line = 0;
my $error_guess = 0;
my ($args, $tree, $full_logfile, $linenum, $logfile);
my ($errorparser, $buildname, $buildtime, $numlines, $fulltext);
my ($enc_buildname, $brief_filename);
#############################################################
# CGI inputs
if (defined($args = $form{log}) or defined($args = $form{exerpt})) {
($full_logfile, $linenum) = split /:/, $args;
my ($full_logfile, $linenum) = split /:/, $args;
($tree, $logfile) = split /\//, $full_logfile;
my $br = tb_find_build_record($tree, $logfile);
@ -70,10 +74,10 @@ $fulltext = $form{fulltext};
$enc_buildname = url_encode($buildname);
&require_only_one_tree();
$tree = &require_only_one_tree($tree);
require "$tree/treedata.pl";
$time_str = print_time($buildtime);
my $time_str = print_time($buildtime);
$|=1;
@ -166,6 +170,8 @@ sub print_header {
print "Expires: " . gmtime($expires_time) . "\n";
print "\n";
my ($s, $s1, $s2);
if ($fulltext) {
$s = 'Show <b>Brief</b> Log';
$s1 = '';
@ -197,21 +203,21 @@ sub print_notes {
#
# Print notes
#
$found_note = 0;
my $found_note = 0;
open(NOTES,"<", "$tree/notes.txt")
or print "<h2>warning: Couldn't open $tree/notes.txt </h2>\n";
print "$buildtime, $buildname<br>\n";
while (<NOTES>) {
chop;
($nbuildtime,$nbuildname,$nwho,$nnow,$nenc_note) = split(/\|/);
my ($nbuildtime,$nbuildname,$nwho,$nnow,$nenc_note) = split(/\|/);
#print "$_<br>\n";
if ($nbuildtime == $buildtime and $nbuildname eq $buildname) {
if (not $found_note) {
print "<H2>Build Comments</H2>\n";
$found_note = 1;
}
$now_str = print_time($nnow);
$note = url_decode($nenc_note);
my $now_str = print_time($nnow);
my $note = url_decode($nenc_note);
print "<pre>\n[<b><a href=mailto:$nwho>$nwho</a> - $now_str</b>]\n$note\n</pre>";
}
}
@ -224,7 +230,7 @@ sub print_summary {
#
logprint('<H2>Build Error Summary</H2><PRE>');
@log_errors = ();
my @log_errors = ();
my $line_num = 0;
my $error_num = 0;
@ -232,7 +238,7 @@ sub print_summary {
warn "gzopen($tree/$logfile): $!\n";
my ($bytesread, $line);
while (defined($gz) && (($bytesread = $gz->gzreadline($line)) > 0)) {
$line_has_error = output_summary_line($line, $error_num);
my $line_has_error = output_summary_line($line, $error_num);
if ($line_has_error) {
push @log_errors, $line_num;
@ -266,7 +272,7 @@ sub print_log_section {
$ii++;
next if $ii < $first_line;
last if $ii > $last_line;
if ($ii == $line_of_intested) {
if ($ii == $line_of_interest) {
print "<b>$_</b>";
} else {
print;
@ -285,7 +291,7 @@ sub print_log {
logprint('<H2>Build Error Log</H2><pre>');
$line_num = 0;
my $line_num = 0;
my $gz = gzopen("$tree/$logfile", "rb") or
warn "gzopen($tree/$logfile): $!\n";
my ($bytesread, $line);
@ -301,6 +307,10 @@ sub print_log {
BEGIN {
my $last_was_error = 0;
my $next_error = 0;
my $log_skip = 0;
my $cur_error = 0;
my $log_line = 0;
sub output_summary_line {
my ($line, $error_id) = @_;
@ -320,11 +330,6 @@ BEGIN {
}
return $last_was_error;
}
}
BEGIN {
my $next_error = 0;
sub output_log_line {
my ($line, $line_num, $errors) = @_;
@ -341,10 +346,10 @@ BEGIN {
my %out = ();
if (($has_error or $has_warning) and has_errorline($line, \%out)) {
$q = quotemeta($out{error_file});
$goto_line = $out{error_line} > 10 ? $out{error_line} - 10 : 1;
$cvsblame = $out{error_guess} ? "cvsguess.cgi" : "cvsblame.cgi";
$line =~ s@$q@<a href=$bonsai_url/$cvsblame?file=$out{error_file_ref}&rev=$cvs_branch&mark=$out{error_line}#$goto_line>$out{error_file}</a>@
my $q = quotemeta($out{error_file});
my $goto_line = $out{error_line} > 10 ? $out{error_line} - 10 : 1;
my $cvsblame = $out{error_guess} ? "cvsguess.cgi" : "cvsblame.cgi";
$line =~ s@$q@<a href=$::bonsai_url/$cvsblame?file=$out{error_file_ref}&rev=$::cvs_branch&mark=$out{error_line}#$goto_line>$out{error_file}</a>@
}
if ($has_error) {
@ -354,7 +359,7 @@ BEGIN {
$logline .= "<a name='err".($next_error - 1)."'></a>";
# Only print "NEXT ERROR" link if there is another error to jump to
$have_more_errors = 0;
my $have_more_errors = 0;
my $ii = $next_error;
while ($ii < $#{$errors} - 1) {
if ($errors->[$ii] != $errors->[$ii + 1] - 1) {
@ -381,11 +386,10 @@ BEGIN {
push_log_line($logline, $errors);
}
}
sub push_log_line {
sub push_log_line {
my ($line, $log_errors) = @_;
if ($fulltext) {
logprint($line);
return;
@ -406,10 +410,12 @@ sub push_log_line {
$log_skip++;
}
$log_line++;
}
sub logprint {
my $line = $_[0];
print $line;
print BRIEFFILE $line if not $fulltext;
}
}
sub logprint {
my $line = $_[0];
print $line;
print BRIEFFILE $line if not $fulltext;
}

444
webtools/tinderbox/tbglobals.pl
Просмотреть файл

@ -19,6 +19,7 @@
#
# Contributor(s):
use strict;
# Reading the log backwards saves time when we only want the tail.
use Backwards;
use Digest::MD5 qw(md5_hex);
@ -26,6 +27,8 @@ use Tie::IxHash;
use FileHandle;
use Fcntl qw(:DEFAULT :flock);
require 'header.pl';
#
# Global variabls and functions for tinderbox
#
@ -51,42 +54,42 @@ $::CI_LOG=11;
#
# Variables set from Makefile
$bonsai_dir = "@BONSAI_DIR@";
$bonsai_url = "@BONSAI_URL@";
$default_cvsroot = "@CVSROOT@";
$registry_url = "@REGISTRY_URL@";
$::bonsai_dir = "@BONSAI_DIR@";
$::bonsai_url = "@BONSAI_URL@";
$::default_cvsroot = "@CVSROOT@";
$::registry_url = "@REGISTRY_URL@";
# From load_data()
$ignore_builds = {};
$scrape_builds = {};
$::ignore_builds = {};
$::scrape_builds = {};
# From get_build_name_index()
$build_name_index = {};
$build_names = [];
$name_count = 0;
$::build_name_index = {};
$::build_names = [];
$::name_count = 0;
# From get_build_time_index()
$build_time_index = {};
$build_time_times = [];
$mindate_time_count = 0; # time_count that corresponds to the mindate
$time_count = 0;
$::build_time_index = {};
$::build_time_times = [];
$::mindate_time_count = 0; # time_count that corresponds to the mindate
$::time_count = 0;
$build_table = [];
$who_list = [];
@note_array = ();
$::build_table = [];
$::who_list = [];
@::note_array = ();
$data_dir='data';
$::data_dir='data';
@global_tree_list = ();
undef @global_tree_list;
@::global_tree_list = ();
undef @::global_tree_list;
# Set this to show real end times for builds instead of just using
# the start of the next build as the end time.
$display_accurate_build_end_times = 1;
my $display_accurate_build_end_times = 1;
# Format version of treedata.pl
# Use Tie::IxHash to keep order of treedata variables
tie %default_treedata => 'Tie::IxHash',
tie %::default_treedata => 'Tie::IxHash',
treedata_version => 1,
who_days => 14,
use_bonsai => 1,
@ -114,21 +117,51 @@ sub trick_taint{
}
sub make_tree_list {
return @global_tree_list if defined(@global_tree_list);
return @::global_tree_list if defined(@::global_tree_list);
while(<*>) {
if( -d $_ && $_ ne "$data_dir" && $_ ne 'CVS' && -f "$_/treedata.pl") {
push @global_tree_list, $_;
if( -d $_ && $_ ne "$::data_dir" && $_ ne 'CVS' && -f "$_/treedata.pl") {
push @::global_tree_list, $_;
}
}
return @global_tree_list;
return @::global_tree_list;
}
sub require_only_one_tree {
my ($t) = @_;
my @treelist = &make_tree_list();
$t = $::tree if !defined($t);
$t = '' if (!grep {$t eq $_} @treelist);
&show_tree_selector, exit if $t eq '';
&::show_tree_selector, exit if $t eq '';
return $t;
}
sub show_tree_selector {
print "Content-type: text/html\n\n";
&EmitHtmlHeader("tinderbox");
print "<P><TABLE WIDTH=\"100%\">";
print "<TR><TD ALIGN=CENTER>Select one of the following trees:</TD></TR>";
print "<TR><TD ALIGN=CENTER>\n";
print " <TABLE><TR><TD><UL>\n";
my @list = &make_tree_list();
foreach (@list) {
print "<LI><a href=showbuilds.cgi?tree=$_>$_</a>\n";
}
print "</UL></TD></TR></TABLE></TD></TR></TABLE>";
print "<P><TABLE WIDTH=\"100%\">";
print "<TR><TD ALIGN=CENTER><a href=admintree.cgi>";
print "Create a new tree</a> or administer one of the following trees:</TD></TR>";
print "<TR><TD ALIGN=CENTER>\n";
print " <TABLE><TR><TD><UL>\n";
foreach (@list) {
print "<LI><a href=admintree.cgi?tree=$_>$_</a>\n";
}
print "</UL></TD></TR></TABLE></TD></TR></TABLE>";
}
sub lock_datafile {
@ -377,49 +410,49 @@ sub shell_escape {
sub tb_load_treedata {
my $tree = shift;
do "$tree/treedata.pl" if -r "$tree/treedata.pl";
}
sub tb_load_data {
$tree = $form{'tree'}; # Testing: $tree = "SeaMonkey";
sub tb_load_data() {
my ($form_ref) = (@_);
my $tree = $form_ref->{tree};
return undef unless $tree;
return undef unless $tree;
&tb_load_treedata($tree);
# Reset globals
$::ignore_builds = {};
$::scrape_builds = {};
undef $::ignore_builds;
undef $::scrape_builds;
do "$tree/ignorebuilds.pl" if -r "$tree/ignorebuilds.pl";
do "$tree/scrapebuilds.pl" if -r "$tree/scrapebuilds.pl";
my $td = {};
$td->{name} = $tree;
$td->{num} = 0;
$td->{cvs_module} = $::cvs_module;
$td->{cvs_branch} = $::cvs_branch;
$td->{ignore_builds} = $::ignore_builds;
$td->{scrape_builds} = $::scrape_builds;
$::cvs_root = '/m/src' if $::cvs_root eq '';
$td->{cvs_root} = $::cvs_root;
my $build_list = &load_buildlog($td, $form_ref);
tb_load_treedata($tree);
# Reset globals
$ignore_builds = {};
$scrape_builds = {};
undef $ignore_builds;
undef $scrape_builds;
do "$tree/ignorebuilds.pl" if -r "$tree/ignorebuilds.pl";
do "$tree/scrapebuilds.pl" if -r "$tree/scrapebuilds.pl";
$td = {};
$td->{name} = $tree;
$td->{num} = 0;
$td->{cvs_module} = $cvs_module;
$td->{cvs_branch} = $cvs_branch;
$td->{ignore_builds} = $ignore_builds;
$td->{scrape_builds} = $scrape_builds;
$cvs_root = '/m/src' if $cvs_root eq '';
$td->{cvs_root} = $cvs_root;
$build_list = load_buildlog($td);
&get_build_name_index($build_list);
&get_build_time_index($build_list);
get_build_name_index($build_list);
get_build_time_index($build_list);
load_who($td);
&load_who($td);
make_build_table($td, $build_list);
&make_build_table($td, $build_list);
$td->{scrape} = load_scrape($td);
$td->{warnings} = load_warnings($td);
$td->{scrape} = &load_scrape($td);
$td->{warnings} = &load_warnings($td);
return $td;
return $td;
}
sub tb_loadquickparseinfo {
@ -427,8 +460,8 @@ sub tb_loadquickparseinfo {
local $_;
return if (! -d "$tree" || ! -r "$tree/build.dat");
$maxdate = time if !defined($maxdate);
undef $ignore_builds;
$::maxdate = time if !defined($::maxdate);
undef $::ignore_builds;
do "$tree/ignorebuilds.pl" if -r "$tree/ignorebuilds.pl";
my $bw = Backwards->new("$tree/build.dat") or die;
@ -443,7 +476,7 @@ sub tb_loadquickparseinfo {
$buildstatus =~ /^success|busted|testfailed$/) {
# Ignore stuff in the future.
next if $buildtime > $maxdate;
next if $buildtime > $::maxdate;
$latest_time = $buildtime if $buildtime > $latest_time;
@ -461,7 +494,7 @@ sub tb_loadquickparseinfo {
}
$tooearly = 0;
next if exists $ignore_builds->{$buildname};
next if exists $::ignore_builds->{$buildname};
next if exists $build->{$buildname}
and $times->{$buildname} >= $buildtime;
@ -474,71 +507,75 @@ sub tb_loadquickparseinfo {
sub tb_last_status {
my ($build_index) = @_;
for (my $tt=0; $tt < $time_count; $tt++) {
my $br = $build_table->[$tt][$build_index];
next unless defined $br and $br->{buildstatus};
for (my $tt=0; $tt < $::time_count; $tt++) {
my $br = $::build_table->[$tt][$build_index];
next unless defined $br and $br != -1 and $br->{buildstatus};
next unless $br->{buildstatus} =~ /^(success|busted|testfailed)$/;
return $br->{buildstatus};
}
return 'building';
}
sub tb_check_password {
if ($form{password} eq '' and defined $cookie_jar{tinderbox_password}) {
$form{password} = $cookie_jar{tinderbox_password};
}
my $correct = '';
if (open(REAL, "<", "data/passwd")) {
$correct = <REAL>;
close REAL;
$correct =~ s/\s+$//; # Strip trailing whitespace.
}
$form{password} =~ s/\s+$//; # Strip trailing whitespace.
if ($form{password} ne '') {
my $encoded = md5_hex($form{password});
$encoded =~ s/\s+$//; # Strip trailing whitespace.
if ($encoded eq $correct) {
if ($form{rememberpassword} ne '') {
print "Set-Cookie: tinderbox_password=$form{'password'} ;"
." path=/ ; expires = Sun, 1-Mar-2020 00:00:00 GMT\n";
}
return;
sub tb_check_password($$) {
my ($form_ref, $cj_ref) = (@_);
my %form = %{$form_ref};
my %cookie_jar = %{$cj_ref};
if ($form{password} eq '' and defined $cookie_jar{tinderbox_password}) {
$form{password} = $cookie_jar{tinderbox_password};
}
my $correct = '';
if (open(REAL, "<", "data/passwd")) {
$correct = <REAL>;
close REAL;
$correct =~ s/\s+$//; # Strip trailing whitespace.
}
$form{password} =~ s/\s+$//; # Strip trailing whitespace.
if ($form{password} ne '') {
my $encoded = md5_hex($form{password});
$encoded =~ s/\s+$//; # Strip trailing whitespace.
if ($encoded eq $correct) {
if ($form{rememberpassword} ne '') {
print "Set-Cookie: tinderbox_password=$form{'password'} ;"
." path=/ ; expires = Sun, 1-Mar-2020 00:00:00 GMT\n";
}
return;
}
}
}
# Force a return here to test w/o a password.
# return;
# Force a return here to test w/o a password.
# return;
require 'header.pl';
require 'header.pl';
print "Content-type: text/html\n";
print "Set-Cookie: tinderbox_password= ; path=/ ; "
." Expires = Sun, 1-Mar-2020 00:00:00 GMT\n";
print "\n";
print "Content-type: text/html\n";
print "Set-Cookie: tinderbox_password= ; path=/ ; "
." Expires = Sun, 1-Mar-2020 00:00:00 GMT\n";
print "\n";
EmitHtmlHeader("What's the magic word?",
"You need to know the magic word to use this page.");
EmitHtmlHeader("What's the magic word?",
"You need to know the magic word to use this page.");
if ($form{password} ne '') {
print "<B>Invalid password; try again.<BR></B>";
}
print q(
<FORM method=post>
<B>Password:</B>
<INPUT NAME=password TYPE=password><BR>
<INPUT NAME=rememberpassword TYPE=checkbox>
If correct, remember password as a cookie<BR>
);
if ($form{password} ne '') {
print "<B>Invalid password; try again.<BR></B>";
}
print q(
<FORM method=post>
<B>Password:</B>
<INPUT NAME=password TYPE=password><BR>
<INPUT NAME=rememberpassword TYPE=checkbox>
If correct, remember password as a cookie<BR>
);
while (my ($key,$value) = each %form) {
next if $key eq "password" or $key eq "rememberpassword";
while (my ($key,$value) = each %form) {
next if $key eq "password" or $key eq "rememberpassword";
my $enc_key = value_encode($key);
my $enc_value = value_encode($value);
print "<INPUT TYPE=HIDDEN NAME=\"$enc_key\" VALUE=\"$enc_value\">\n";
}
print "<INPUT TYPE=SUBMIT value=Submit></FORM>\n";
exit;
my $enc_key = value_encode($key);
my $enc_value = value_encode($value);
print "<INPUT TYPE=HIDDEN NAME=\"$enc_key\" VALUE=\"$enc_value\">\n";
}
print "<INPUT TYPE=SUBMIT value=Submit></FORM>\n";
exit;
}
sub tb_find_build_record {
@ -556,7 +593,7 @@ sub tb_find_build_record {
my ($endtime, $buildtime, $buildname, $errorparser,
$buildstatus, $binaryurl) = (split /\|/, $log_entry)[0..4,6];
$buildrec = {
my $buildrec = {
endtime => $endtime,
buildtime => $buildtime,
buildname => $buildname,
@ -590,8 +627,8 @@ sub write_treedata() {
# end of public functions
#============================================================
sub load_buildlog {
my ($treedata) = $_[0];
sub load_buildlog($$) {
my ($treedata, $form_ref) = (@_);
# In general you always want to make "$_" a local
# if it is used. That way it is restored upon return.
@ -599,11 +636,11 @@ sub load_buildlog {
my $build_list = [];
if (not defined $maxdate) {
$maxdate = time();
if (not defined $::maxdate) {
$::maxdate = time();
}
if (not defined $mindate) {
$mindate = $maxdate - 24*60*60;
if (not defined $::mindate) {
$::mindate = $::maxdate - 24*60*60;
}
my ($bw) = Backwards->new("$treedata->{name}/build.dat") or die;
@ -616,10 +653,10 @@ sub load_buildlog {
$errorparser, $buildstatus, $logfile, $binaryurl) = split /\|/;
# Ignore stuff in the future.
next if $buildtime > $maxdate;
next if $buildtime > $::maxdate;
# Ignore stuff in the past (but get a 2 hours of extra data)
if ($buildtime < $mindate - 2*60*60) {
if ($buildtime < $::mindate - 2*60*60) {
# Occasionally, a build might show up with a bogus time. So,
# we won't judge ourselves as having hit the end until we
# hit a full 20 lines in a row that are too early.
@ -633,7 +670,7 @@ sub load_buildlog {
}
$tooearly = 0;
if ($form{noignore} or not $treedata->{ignore_builds}->{$buildname}) {
if ($form_ref->{noignore} or not $treedata->{ignore_builds}->{$buildname}) {
# Latest record in build.dat for this (buildtime, buildname) tuple wins.
if ( $internal_build_list->{$buildtime}->{$buildname} ) {
@ -666,7 +703,7 @@ sub load_who {
local $_;
# Reset globals
$who_list = [];
$::who_list = [];
open(WHOLOG, "<", "$treedata->{name}/who.dat");
while (<WHOLOG>) {
@ -674,20 +711,20 @@ sub load_who {
my ($checkin_time, $email) = split /\|/;
# Find the time slice where this checkin belongs.
for (my $ii = $time_count - 1; $ii >= 0; $ii--) {
if ($checkin_time < $build_time_times->[$ii]) {
$who_list->[$ii+1]->{$email} = 1;
for (my $ii = $::time_count - 1; $ii >= 0; $ii--) {
if ($checkin_time < $::build_time_times->[$ii]) {
$::who_list->[$ii+1]->{$email} = 1;
last;
} elsif ($ii == 0) {
$who_list->[0]->{$email} = 1;
$::who_list->[0]->{$email} = 1;
}
}
}
# Ignore the last one
#
#if ($time_count > 0) {
# $who_list->[$time_count] = {};
#if ($::time_count > 0) {
# $::who_list->[$::time_count] = {};
#}
}
@ -737,88 +774,89 @@ sub get_build_name_index {
my ($build_list) = @_;
# Reset globals
$build_name_index = {};
$build_names = [];
$name_count = 0;
$::build_name_index = {};
$::build_names = [];
$::name_count = 0;
# Get all the unique build names.
#
foreach my $build_record (@{$build_list}) {
$build_name_index->{$build_record->{buildname}} = 1;
$::build_name_index->{$build_record->{buildname}} = 1;
}
my $ii = 0;
foreach my $name (sort keys %{$build_name_index}) {
$build_names->[$ii] = $name;
$build_name_index->{$name} = $ii;
foreach my $name (sort keys %{$::build_name_index}) {
$::build_names->[$ii] = $name;
$::build_name_index->{$name} = $ii;
$ii++;
}
$name_count = $#{$build_names} + 1;
$::name_count = $#{$::build_names} + 1;
}
sub get_build_time_index {
my ($build_list) = @_;
# Reset globals
$build_time_index = {};
$build_time_times = [];
$mindate_time_count = 0; # time_count that corresponds to the mindate
$time_count = 0;
$::build_time_index = {};
$::build_time_times = [];
$::mindate_time_count = 0; # time_count that corresponds to the mindate
$::time_count = 0;
# Get all the unique build names.
#
foreach my $br (@{$build_list}) {
$build_time_index->{$br->{buildtime}} = 1;
$::build_time_index->{$br->{buildtime}} = 1;
if ($display_accurate_build_end_times) {
$build_time_index->{$br->{endtime}} = 1;
$::build_time_index->{$br->{endtime}} = 1;
}
}
my $ii = 0;
foreach my $time (sort {$b <=> $a} keys %{$build_time_index}) {
$build_time_times->[$ii] = $time;
$build_time_index->{$time} = $ii;
$mindate_time_count = $ii if $time >= $mindate;
foreach my $time (sort {$b <=> $a} keys %{$::build_time_index}) {
$::build_time_times->[$ii] = $time;
$::build_time_index->{$time} = $ii;
$::mindate_time_count = $ii if $time >= $::mindate;
$ii++;
}
$time_count = $#{$build_time_times} + 1;
$::time_count = $#{$::build_time_times} + 1;
}
sub make_build_table {
my ($treedata, $build_list) = @_;
my ($ti, $bi, $ti1, $br);
my ($ti, $bi, $ti1, $br, $br1);
# Reset globals
$build_table = [];
$::build_table = [];
# Create the build table
#
for (my $ii=0; $ii < $time_count; $ii++){
$build_table->[$ii] = [];
for (my $ii=0; $ii < $::time_count; $ii++){
$::build_table->[$ii] = [];
}
# Populate the build table with build data
#
foreach $br (reverse @{$build_list}) {
$ti = $build_time_index->{$br->{buildtime}};
$bi = $build_name_index->{$br->{buildname}};
$build_table->[$ti][$bi] = $br;
$ti = $::build_time_index->{$br->{buildtime}};
$bi = $::build_name_index->{$br->{buildname}};
$::build_table->[$ti][$bi] = $br;
}
&load_notes($treedata);
for ($bi = $name_count - 1; $bi >= 0; $bi--) {
for ($ti = $time_count - 1; $ti >= 0; $ti--) {
if (defined($br = $build_table->[$ti][$bi])
and not defined($br->{rowspan})) {
for ($bi = $::name_count - 1; $bi >= 0; $bi--) {
for ($ti = $::time_count - 1; $ti >= 0; $ti--) {
if (defined($br = $::build_table->[$ti][$bi])
and $br != -1
and not defined($br->{'rowspan'})) {
# Find the next-defined cell after us. We may run all the way to the
# end of the page and not find a defined cell. That's okay.
$ti1 = $ti+1;
while ( $ti1 < $time_count and not defined $build_table->[$ti1][$bi] ) {
while ( $ti1 < $::time_count and not defined $::build_table->[$ti1][$bi] ) {
$ti1++;
}
if (defined($br1 = $build_table->[$ti1][$bi])) {
if (defined($br1 = $::build_table->[$ti1][$bi])) {
$br->{previousbuildtime} = $br1->{buildtime};
}
@ -828,28 +866,28 @@ sub make_build_table {
# If the current record represents a system that's still building,
# we'll use the old style and let the build window "slide" up to the
# next defined build record.
while ( $ti1 >= 0 and not defined $build_table->[$ti1][$bi] ) {
$build_table->[$ti1][$bi] = -1;
while ( $ti1 >= 0 and not defined $::build_table->[$ti1][$bi] ) {
$::build_table->[$ti1][$bi] = -1;
$ti1--;
}
} else {
# If the current record has a non 'building' status, we stop the
# build window at its "endtime".
while ( $ti1 >= 0 and not defined $build_table->[$ti1][$bi]
and $build_time_times->[$ti1] < $br->{endtime} ) {
$build_table->[$ti1][$bi] = -1;
while ( $ti1 >= 0 and not defined $::build_table->[$ti1][$bi]
and $::build_time_times->[$ti1] < $br->{endtime} ) {
$::build_table->[$ti1][$bi] = -1;
$ti1--;
}
}
if ($ti1 > 0 and defined($br1 = $build_table->[$ti1][$bi])) {
if ($ti1 > 0 and defined($br1 = $::build_table->[$ti1][$bi])) {
$br->{nextbuildtime} = $br1->{buildtime};
}
$br->{rowspan} = $ti - $ti1;
unless ($br->{rowspan} == 1) {
$build_table->[$ti1+1][$bi] = $br;
$build_table->[$ti][$bi] = -1;
$::build_table->[$ti1+1][$bi] = $br;
$::build_table->[$ti][$bi] = -1;
}
}
}
@ -863,58 +901,58 @@ sub make_build_table {
# section of code is a no-op. Every cell will be defined, either with a
# real $br or being set to -1.
for ($bi = $name_count - 1; $bi >= 0; $bi--) {
for ($ti = $time_count - 1; $ti >= 0; $ti--) {
if (not defined($build_table->[$ti][$bi])) {
for ($bi = $::name_count - 1; $bi >= 0; $bi--) {
for ($ti = $::time_count - 1; $ti >= 0; $ti--) {
if (not defined($::build_table->[$ti][$bi])) {
my $ti1 = $ti;
while ( $ti1 >= 0 and not defined $build_table->[$ti1][$bi] ) {
$build_table->[$ti1][$bi] = -1;
while ( $ti1 >= 0 and not defined $::build_table->[$ti1][$bi] ) {
$::build_table->[$ti1][$bi] = -1;
$ti1--;
}
my $null_record_br = {};
$null_record_br->{buildstatus} = "null";
$null_record_br->{rowspan} = $ti - $ti1;
$build_table->[$ti1+1][$bi] = $null_record_br;
$::build_table->[$ti1+1][$bi] = $null_record_br;
}
}
}
}
sub load_notes {
sub load_notes($) {
my $treedata = $_[0];
# Reset globals
@note_array = ();
@::note_array = ();
open(NOTES, "<", "$treedata->{name}/notes.txt")
or print "<h2>warning: Couldn't open $treedata->{name}/notes.txt </h2>\n";
while (<NOTES>) {
chop;
chomp;
my ($nbuildtime,$nbuildname,$nwho,$nnow,$nenc_note) = split /\|/;
my $ti = $build_time_index->{$nbuildtime};
my $bi = $build_name_index->{$nbuildname};
my $ti = $::build_time_index->{$nbuildtime};
my $bi = $::build_name_index->{$nbuildname};
if (defined $ti and defined $bi) {
$build_table->[$ti][$bi]->{hasnote} = 1;
unless (defined $build_table->[$ti][$bi]->{noteid}) {
$build_table->[$ti][$bi]->{noteid} = $#note_array + 1;
$::build_table->[$ti][$bi]->{hasnote} = 1;
unless (defined $::build_table->[$ti][$bi]->{noteid}) {
$::build_table->[$ti][$bi]->{noteid} = $#::note_array + 1;
}
$noteid = $build_table->[$ti][$bi]->{noteid};
$now_str = &print_time($nnow);
$note = &url_decode($nenc_note);
my $noteid = $::build_table->[$ti][$bi]->{noteid};
my $now_str = &print_time($nnow);
my $note = &url_decode($nenc_note);
$note_array[$noteid] = '' unless $note_array[$noteid];
$note_array[$noteid] = "<pre>\n[<b><a href=mailto:$nwho>"
$::note_array[$noteid] = '' unless $::note_array[$noteid];
$::note_array[$noteid] = "<pre>\n[<b><a href=mailto:$nwho>"
."$nwho</a> - $now_str</b>]\n$note\n</pre>"
.$note_array[$noteid];
.$::note_array[$noteid];
}
}
close NOTES;
}
sub split_cgi_args {
local (@args, $pair, $key, $value, $s);
my (@args, $pair, $key, $value, $s, %form);
if ($ENV{"REQUEST_METHOD"} eq 'POST') {
$s .= $_ while (<>);
@ -933,12 +971,18 @@ sub split_cgi_args {
$form{$key} = $value;
}
return %form;
}
sub split_cookie_args {
# extract the cookies from the HTTP_COOKIE environment
%cookie_jar = split('[;=] *',$ENV{'HTTP_COOKIE'});
my %cookie_jar = split('[;=] *',$ENV{'HTTP_COOKIE'});
return %cookie_jar;
}
sub make_cgi_args {
local($k,$v,$ret);
my (%form) = (@_);
my ($k,$v,$ret);
for $k (sort keys %form){
$ret .= ($ret eq "" ? '?' : '&');
$v = $form{$k};
@ -949,14 +993,14 @@ sub make_cgi_args {
return $ret;
}
@weekdays = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
@months = ('Jan','Feb','Mar','Apr','May','Jun',
my @weekdays = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
my @months = ('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
sub toGMTString {
local ($seconds) = $_[0];
my ($seconds) = $_[0];
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
= gmtime($seconds);
$year += 1900;

3
webtools/tinderbox/viewallnotes.cgi
Просмотреть файл

@ -29,8 +29,7 @@ use Date::Format;
my $TIMEFORMAT = "%D %T";
# Process the form arguments
%form = ();
&split_cgi_args();
my %form = &split_cgi_args();
$| = 1;

30
webtools/tinderbox/viewvc.pl
Просмотреть файл

@ -4,6 +4,7 @@
# These generic DBI routines should live somewhere common
#
use strict;
use DBI;
use POSIX qw(strftime mktime);
use Time::Local;
@ -14,15 +15,16 @@ sub ConnectToDatabase {
my ($dsn);
if (!defined $::db) {
$dsn = "DBI:${viewvc_dbdriver}:database=${viewvc_dbname};";
$dsn .= "host=${viewvc_dbhost};"
if (defined($viewvc_dbhost) && "$viewvc_dbhost" ne "");
$dsn .= "port=${viewvc_dbport};"
if (defined($viewvc_dbport) && "$viewvc_dbport" ne "");
$dsn = "DBI:" . $::viewvc_dbdriver . ":database=" .
$::viewvc_dbname . ";";
$dsn .= "host=" . $::viewvc_dbhost . ";"
if (defined($::viewvc_dbhost) && "$::viewvc_dbhost" ne "");
$dsn .= "port=" . $::viewvc_dbport . ";"
if (defined($::viewvc_dbport) && "$::viewvc_dbport" ne "");
# DBI->trace(1, "/tmp/dbi.out");
$::db = DBI->connect($dsn, $viewvc_dbuser, $viewvc_dbpasswd)
$::db = DBI->connect($dsn, $::viewvc_dbuser, $::viewvc_dbpasswd)
|| die "Can't connect to database server.";
}
}
@ -76,7 +78,7 @@ sub FetchOneColumn {
sub formatSqlTime {
my ($date) = @_;
$time = strftime("%Y/%m/%d %T", gmtime($date));
my $time = strftime("%Y/%m/%d %T", gmtime($date));
return $time;
}
@ -127,8 +129,8 @@ sub query_checkins($) {
# print "values: @bind_values\n";
&SendSQL($qstring, @bind_values);
$lastlog = 0;
my @row;
my $lastlog = 0;
my (@row, $ci, $rev, $result);
while (@row = &FetchSQLData()) {
#print "<pre>";
$ci = [];
@ -149,21 +151,21 @@ sub query_checkins($) {
next if ($key =~ m@^CVSROOT/@);
if( $have_mod_map &&
if( $::have_mod_map &&
!&in_module(\%mod_map, $ci->[$::CI_DIR], $ci->[$::CI_FILE] ) ){
next;
}
if( $begin_tag) {
$rev = $begin_tag->{$key};
if( $::begin_tag) {
$rev = $::begin_tag->{$key};
print "<BR>$key begintag is $rev<BR>\n";
if ($rev == "" || rev_is_after($ci->[$::CI_REV], $rev)) {
next;
}
}
if( $end_tag) {
$rev = $end_tag->{$key};
if( $::end_tag) {
$rev = $::end_tag->{$key};
print "<BR>$key endtag is $rev<BR>\n";
if ($rev == "" || rev_is_after($rev, $ci->[$::CI_REV])) {
next;

106
webtools/tinderbox/warnings.pl
Просмотреть файл

@ -29,6 +29,7 @@
# ./warnings.pl [--debug]
#
use strict;
use FileHandle;
use Compress::Zlib;
use lib "@TINDERBOX_DIR@";
@ -84,34 +85,39 @@ sub usage {
$ENV{PATH} = "@SETUID_PATH@";
my $debug = 0;
$debug = 1, shift @ARGV if $ARGV[0] eq '--debug';
&usage, die "Error: Not enough arguments\n" if $#ARGV == -1;
# Load tinderbox build data.
# (So we can find the last successful build for the tree of intestest.)
$log_file = shift @ARGV;
my $log_file = shift @ARGV;
# tinderbox/tbglobals.pl uses many shameful globals
&usage, die "Logfile does not exist, $log_file\n" unless -e $log_file;
my $tree;
($tree, $log_file) = split '/', $log_file;
$form{tree} = $tree;
my %form;
&require_only_one_tree();
$tree = &require_only_one_tree($tree);
$form{tree} = $tree;
require "$tree/treedata.pl";
$source_root = 'mozilla';
my $source_root = 'mozilla';
my ($exclude_pat, $tag, %bases, %fullpath, %modules, %module_files);
my (%seen, %unblamed, @who_list);
# ===================================================================
# Warnings to ignore
@mac_ignore = (
my @mac_ignore = (
'function has no prototype',
'inline function call .* not inlined',
);
@ignore = (
my @ignore = (
'location of the previous definition',
'\' was hidden',
#'declaration of \`index\' shadows global',
@ -124,7 +130,7 @@ $source_root = 'mozilla';
# Patterns that need to match warning text and source directory
#
@ignore_dir = (
my @ignore_dir = (
# mailnews is stuck with this
{ warning=>'aggregate has a partly bracketed initializer',
dir=>'mailnews/mime/' }
@ -132,7 +138,7 @@ $source_root = 'mozilla';
# Patterns that need to match warning text and source code text
#
@ignore_match = (
my @ignore_match = (
{ warning=>'statement with no effect', source=>'(?:JS_|PR_)?ASSERT'},
);
@ -146,19 +152,19 @@ $source_root = 'mozilla';
# paths to files.
#
print STDERR "Building hash of file names...";
($file_bases, $file_fullpaths) = build_file_hash($cvs_root, @cvs_modules)
if ($cvs_module ne '');
my ($file_bases, $file_fullpaths) = build_file_hash($::cvs_root, @::cvs_modules)
if ($::cvs_module ne '');
print STDERR "done.\n";
# Find the build we want and generate warnings for it
#
$br = find_build_record($tree,$log_file);
my $br = find_build_record($tree,$log_file);
%warnings = ();
%warnings_by_who = ();
%who_count = ();
$total_warnings_count = 0;
$total_ignored_count = 0;
my %warnings = ();
my %warnings_by_who = ();
my %who_count = ();
my $total_warnings_count = 0;
my $total_ignored_count = 0;
# Parse the build log for warnings
#
@ -167,15 +173,15 @@ $total_ignored_count = 0;
my $gz = gzopen("$tree/$log_file", "rb") or
die "gzopen($tree/$log_file): $!\n";
if ($br->{errorparser} eq 'unix') {
gcc_parser($gz, $cvs_root, $tree, $log_file, $file_bases, $file_fullpaths);
gcc_parser($gz, $::cvs_root, $tree, $log_file, $file_bases, $file_fullpaths);
} elsif ($br->{errorparser} eq 'mac') {
mac_parser($gz, $cvs_root, $tree, $log_file, $file_bases, $file_fullpaths);
mac_parser($gz, $::cvs_root, $tree, $log_file, $file_bases, $file_fullpaths);
}
$gz->gzclose();
# Attach blame to all the warnings
# (Yes, global variables are flying around.)
&build_blame($cvs_root, $file_fullpaths) if ($cvs_module ne '');
&build_blame($::cvs_root, $file_fullpaths) if ($::cvs_module ne '');
# Come up with the temporary filenames for the output
#
@ -186,7 +192,7 @@ $total_ignored_count = 0;
# Write the warnings indexed by who
#
$fh = new FileHandle;
my $fh = new FileHandle;
$fh->open($warn_file, ">") or die "Unable to open $warn_file: $!\n";
my $time_str = print_html_by_who($fh, $br);
$fh->close;
@ -221,12 +227,12 @@ sub build_file_hash {
read_cvs_modules_file();
local %bases = (); # Set in find_cvs_files
local %fullpath = (); # Set in find_cvs_files
%bases = (); # Set in find_cvs_files
%fullpath = (); # Set in find_cvs_files
for my $module_item (@modules) {
my $module = $module_item->[0];
local $tag = $module_item->[1]; # Used in find_cvs_files
$tag = $module_item->[1]; # Used in find_cvs_files
my @include_list = ();
my @exclude_list = ();
@ -237,7 +243,7 @@ sub build_file_hash {
expand_cvs_modules($module, \@include_list, \@exclude_list);
}
local $exclude_pat = join '|', @exclude_list; # Used in find_cvs_files
$exclude_pat = join '|', @exclude_list; # Used in find_cvs_files
use Cwd;
my $save_dir = cwd;
@ -256,8 +262,8 @@ sub build_file_hash {
sub read_cvs_modules_file
{
local $_;
open(MODULES, "<", "$cvs_root/CVSROOT/modules")
or die "Unable to open modules file: $cvs_root/CVSROOT/modules\n";
open(MODULES, "<", "$::cvs_root/CVSROOT/modules")
or die "Unable to open modules file: $::cvs_root/CVSROOT/modules\n";
while (<MODULES>) {
if (/ -a /) {
while (/\\$/) {
@ -294,7 +300,7 @@ sub find_cvs_files {
return;
}
my $dir = $File::Find::dir;
$dir =~ s|^$cvs_root/$source_root/||o;
$dir =~ s|^$::cvs_root/$source_root/||o;
$dir =~ s|/$||;
my $file = substr $_, 0, -2;
@ -312,16 +318,16 @@ sub find_build_record {
my @build_records = ();
my $br;
$maxdate = time;
$mindate = $maxdate - 5*60*60; # Go back 5 hours
$::maxdate = time;
$::mindate = $::maxdate - 5*60*60; # Go back 5 hours
print STDERR "Loading build data...";
tb_load_data();
tb_load_data(\%form);
print STDERR "done\n";
for (my $ii=0; $ii <= $name_count; $ii++) {
for (my $tt=0; $tt <= $time_count; $tt++) {
if (defined($br = $build_table->[$tt][$ii])
for (my $ii=0; $ii <= $::name_count; $ii++) {
for (my $tt=0; $tt <= $::time_count; $tt++) {
if (defined($br = $::build_table->[$tt][$ii])
and $br->{logfile} eq $log_file) {
return $br;
} } }
@ -380,7 +386,7 @@ sub gcc_parser {
my $ignore_it = /$ignore_pat/o;
unless ($ignore_it) {
# Now check if the warning should be ignored based on directory
for $ignore_rec (@ignore_dir) {
for my $ignore_rec (@ignore_dir) {
next unless $dir =~ /^$ignore_rec->{dir}/;
next unless /$ignore_rec->{warning}/;
$ignore_it = 1;
@ -413,10 +419,11 @@ sub gcc_parser {
sub mac_parser {
my ($gz, $cvs_root, $tree, $log_file, $file_bases, $file_fullnames) = @_;
my $build_dir = '';
my ($bytesread, $line);
my $ignore_pat = "(?:".join('|',@mac_ignore).")";
PARSE_TOP: while (defined($gz) && (($bytesred=$gz->gzreadline($line)) > 0)) {
PARSE_TOP: while (defined($gz) && (($bytesread=$gz->gzreadline($line)) > 0)) {
$_ = $line ;
# Now only match lines with "warning:"
next unless /^Warning :/;
@ -425,7 +432,7 @@ sub mac_parser {
warn "debug> $_\n" if $debug;
my ($filename, $line, $warning_text);
my ($filename, $warning_text);
(undef, $warning_text) = split /:\s*/, $_, 2;
$_ = <$fh>;
while (not /^\S+ line \d+/) {
@ -448,11 +455,11 @@ sub mac_parser {
$warnings{$file}{$line}->{first_seen_line} = $.;
$warnings{$file}{$line}->{ignorecount} = 0;
}
$ignore_it = 0;
my $ignore_it = 0;
$ignore_it = 1 if $warning_text =~ /^$ignore_pat$/o;
if (0) { # unless ($ignore_it) {
# Now check if the warning should be ignored based on directory
for $ignore_rec (@ignore_dir) {
for my $ignore_rec (@ignore_dir) {
next unless $dir =~ /^$ignore_rec->{dir}/;
next unless /$ignore_rec->{warning}/;
$ignore_it = 1;
@ -484,6 +491,7 @@ sub mac_parser {
sub build_blame {
my ($cvs_root, $tags) = @_;
my ($file, $lines_hash);
use lib "@BONSAI_DIR@";
require 'cvsblame.pl';
@ -510,8 +518,8 @@ sub build_blame {
}
my @text = &extract_revision($revision);
LINE: while (my ($line, $line_rec) = each %{$lines_hash}) {
my $line_rev = $revision_map[$line-1];
my $who = $revision_author{$line_rev};
my $line_rev = $::revision_map[$line-1];
my $who = $::revision_author{$line_rev};
my $source_text = join '', @text[$line-3..$line+1];
$source_text =~ s/\t/ /g;
@ -520,7 +528,7 @@ sub build_blame {
$line_rec->{line_rev} = $line_rev;
$line_rec->{source} = $source_text;
for $ignore_rec (@ignore_match) {
for my $ignore_rec (@ignore_match) {
for my $warn_rec (@{ $line_rec->{list}}) {
if ($warn_rec->{warning_text} =~ /$ignore_rec->{warning}/
and $source_text =~ /$ignore_rec->{source}/
@ -582,7 +590,7 @@ sub print_html_by_who {
my $old_fh = select($fh);
my $total_unignored_count = $total_warnings_count - $total_ignored_count;
for $who (sort { $who_count{$b} <=> $who_count{$a}
for my $who (sort { $who_count{$b} <=> $who_count{$a}
|| $a cmp $b } keys %who_count) {
next if $who_count{$who} == 0;
push @who_list, $who;
@ -628,7 +636,7 @@ __END_HEADER
# Print all the warnings
#
for $who (@who_list, "Unblamed") {
for my $who (@who_list, "Unblamed") {
my $total_count = $who_count{$who};
next if $total_count == 0;
@ -647,8 +655,8 @@ __END_HEADER
print "\n<table>\n";
my $count = 1;
for $file (sort keys %{$warnings_by_who{$who}}) {
for $linenum (sort keys %{$warnings_by_who{$who}{$file}}) {
for my $file (sort keys %{$warnings_by_who{$who}}) {
for my $linenum (sort keys %{$warnings_by_who{$who}{$file}}) {
my $line_rec = $warnings_by_who{$who}{$file}{$linenum};
my $count_for_line = $line_rec->{count} - $line_rec->{ignorecount};
next if $count_for_line == 0;
@ -703,7 +711,7 @@ __END_HEADER
# Print all the warnings
#
for $who (@who_list, "Unblamed") {
for my $who (@who_list, "Unblamed") {
my $total_count = $who_count{$who};
my ($name, $email);
($name = $who) =~ s/%.*//;
@ -719,8 +727,8 @@ __END_HEADER
print "\n<table>\n";
my $count = 1;
for $file (sort keys %{$warnings_by_who{$who}}) {
for $linenum (sort keys %{$warnings_by_who{$who}{$file}}) {
for my $file (sort keys %{$warnings_by_who{$who}}) {
for my $linenum (sort keys %{$warnings_by_who{$who}{$file}}) {
my $line_rec = $warnings_by_who{$who}{$file}{$linenum};
my $count_for_line = $line_rec->{count} - $line_rec->{ignorecount};
next if $count_for_line == 0;
@ -840,7 +848,7 @@ sub build_url {
sub file_url {
my ($file, $linenum) = @_;
return "$bonsai_url/cvsblame.cgi"
return "$::bonsai_url/cvsblame.cgi"
."?file=mozilla/$file&mark=$linenum#".($linenum-10);
}