1998-06-17 01:43:24 +04:00
|
|
|
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
|
|
|
|
#
|
|
|
|
|
# The contents of this file are subject to the Netscape Public License
|
|
|
|
|
# Version 1.0 (the "License"); you may not use this file except in
|
|
|
|
|
# compliance with the License. You may obtain a copy of the License at
|
|
|
|
|
# http://www.mozilla.org/NPL/
|
|
|
|
|
#
|
|
|
|
|
# Software distributed under the License is distributed on an "AS IS"
|
|
|
|
|
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
|
|
|
|
|
# License for the specific language governing rights and limitations
|
|
|
|
|
# under the License.
|
|
|
|
|
#
|
|
|
|
|
# The Original Code is the Tinderbox build tool.
|
|
|
|
|
#
|
|
|
|
|
# The Initial Developer of the Original Code is Netscape Communications
|
|
|
|
|
# Corporation. Portions created by Netscape are Copyright (C) 1998
|
|
|
|
|
# Netscape Communications Corporation. All Rights Reserved.
|
|
|
|
|
|
|
|
|
|
#
|
|
|
|
|
# Global variabls and functions for tinderbox
|
|
|
|
|
#
|
|
|
|
|
|
|
|
|
|
#
|
|
|
|
|
# Global variables
|
|
|
|
|
#
|
|
|
|
|
|
|
|
|
|
$td1 = {};
|
|
|
|
|
$td2 = {};
|
|
|
|
|
|
|
|
|
|
$build_list = []; # array of all build records
|
|
|
|
|
$build_name_index = {};
|
1998-06-23 01:28:47 +04:00
|
|
|
$ignore_builds = {};
|
1998-06-17 01:43:24 +04:00
|
|
|
$build_name_names = [];
|
|
|
|
|
$name_count = 0;
|
|
|
|
|
|
|
|
|
|
$build_time_index = {};
|
|
|
|
|
$build_time_times = [];
|
|
|
|
|
$time_count = 0;
|
1999-04-15 23:23:44 +04:00
|
|
|
$mindate_time_count = 0; # time_count that corresponds to the mindate
|
1998-06-17 01:43:24 +04:00
|
|
|
|
|
|
|
|
$build_table = [];
|
|
|
|
|
$who_list = [];
|
|
|
|
|
$who_list2 = [];
|
|
|
|
|
@note_array = ();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#$body_tag = "<BODY TEXT=#000000 BGCOLOR=#8080C0 LINK=#FFFFFF VLINK=#800080 ALINK=#FFFF00>";
|
|
|
|
|
#$body_tag = "<BODY TEXT=#000000 BGCOLOR=#FFFFC0 LINK=#0000FF VLINK=#800080 ALINK=#FF00FF>";
|
|
|
|
|
if( $ENV{'USERNAME'} eq 'ltabb' ){
|
|
|
|
|
$gzip = 'gzip';
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
$gzip = '/usr/local/bin/gzip';
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$data_dir='data';
|
|
|
|
|
|
|
|
|
|
$lock_count = 0;
|
|
|
|
|
|
|
|
|
|
1;
|
|
|
|
|
|
|
|
|
|
sub lock{
|
|
|
|
|
#if( $lock_count == 0 ){
|
|
|
|
|
# print "locking $tree/LOCKFILE.lck\n";
|
|
|
|
|
# open( LOCKFILE_LOCK, ">$tree/LOCKFILE.lck" );
|
|
|
|
|
# flock( LOCKFILE_LOCK, 2 );
|
|
|
|
|
#}
|
|
|
|
|
#$lock_count++;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub unlock{
|
|
|
|
|
#$lock_count--;
|
|
|
|
|
#if( $lock_count == 0 ){
|
|
|
|
|
# flock( LOCKFILE_LOCK, 8 );
|
|
|
|
|
# close( LOCKFILE_LOCK );
|
|
|
|
|
#}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub print_time {
|
1999-05-25 01:03:10 +04:00
|
|
|
my ($t) = @_;
|
|
|
|
|
my ($minute,$hour,$mday,$mon);
|
|
|
|
|
(undef,$minute,$hour,$mday,$mon,undef) = localtime($t);
|
|
|
|
|
sprintf("%02d/%02d %02d:%02d",$mon+1,$mday,$hour,$minute);
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub url_encode {
|
1999-05-25 01:03:10 +04:00
|
|
|
my ($s) = @_;
|
|
|
|
|
|
|
|
|
|
$s =~ s/\%/\%25/g;
|
|
|
|
|
$s =~ s/\=/\%3d/g;
|
|
|
|
|
$s =~ s/\?/\%3f/g;
|
|
|
|
|
$s =~ s/ /\%20/g;
|
|
|
|
|
$s =~ s/\n/\%0a/g;
|
|
|
|
|
$s =~ s/\r//g;
|
|
|
|
|
$s =~ s/\"/\%22/g;
|
|
|
|
|
$s =~ s/\'/\%27/g;
|
|
|
|
|
$s =~ s/\|/\%7c/g;
|
|
|
|
|
$s =~ s/\&/\%26/g;
|
|
|
|
|
return $s;
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub url_decode {
|
1999-05-25 01:03:10 +04:00
|
|
|
my ($value) = @_;
|
|
|
|
|
$value =~ tr/+/ /;
|
|
|
|
|
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
|
|
|
|
return $value;
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub value_encode {
|
1999-05-25 01:03:10 +04:00
|
|
|
my ($s) = @_;
|
|
|
|
|
$s =~ s@&@&@g;
|
|
|
|
|
$s =~ s@<@<@g;
|
|
|
|
|
$s =~ s@>@>@g;
|
|
|
|
|
$s =~ s@\"@"@g;
|
|
|
|
|
return $s;
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub load_data {
|
1999-05-25 01:03:10 +04:00
|
|
|
$tree2 = $form{'tree2'};
|
|
|
|
|
if( $tree2 ne '' ){
|
|
|
|
|
require "$tree2/treedata.pl";
|
|
|
|
|
if( -r "$tree2/ignorebuilds.pl" ){
|
|
|
|
|
require "$tree2/ignorebuilds.pl";
|
1998-06-23 01:28:47 +04:00
|
|
|
}
|
1999-05-24 22:39:30 +04:00
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
$td2 = {};
|
|
|
|
|
$td2->{name} = $tree2;
|
|
|
|
|
$td2->{cvs_module} = $cvs_module;
|
|
|
|
|
$td2->{cvs_branch} = $cvs_branch;
|
|
|
|
|
$td2->{num} = 1;
|
|
|
|
|
$td2->{ignore_builds} = $ignore_builds;
|
|
|
|
|
if( $cvs_root eq '' ){
|
|
|
|
|
$cvs_root = '/m/src';
|
1999-05-24 22:39:30 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
$td2->{cvs_root} = $cvs_root;
|
|
|
|
|
|
|
|
|
|
$tree = $form{'tree'};
|
|
|
|
|
require "$tree/treedata.pl";
|
1998-06-17 01:43:24 +04:00
|
|
|
if( $cvs_root eq '' ){
|
1999-05-25 01:03:10 +04:00
|
|
|
$cvs_root = '/m/src';
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
$tree = $form{'tree'};
|
1998-06-17 01:43:24 +04:00
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
return unless $tree;
|
|
|
|
|
#die "the 'tree' parameter must be provided\n" unless $tree;
|
|
|
|
|
|
|
|
|
|
if ( -r "$tree/treedata.pl" ) {
|
|
|
|
|
require "$tree/treedata.pl";
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
$ignore_builds = {};
|
|
|
|
|
if( -r "$tree/ignorebuilds.pl" ){
|
|
|
|
|
require "$tree/ignorebuilds.pl";
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$td1 = {};
|
|
|
|
|
$td1->{name} = $tree;
|
|
|
|
|
$td1->{num} = 0;
|
|
|
|
|
$td1->{cvs_module} = $cvs_module;
|
|
|
|
|
$td1->{cvs_branch} = $cvs_branch;
|
|
|
|
|
$td1->{ignore_builds} = $ignore_builds;
|
|
|
|
|
if( $cvs_root eq '' ){
|
|
|
|
|
$cvs_root = '/m/src';
|
|
|
|
|
}
|
|
|
|
|
$td1->{cvs_root} = $cvs_root;
|
|
|
|
|
|
|
|
|
|
&lock;
|
|
|
|
|
&load_buildlog;
|
|
|
|
|
&unlock;
|
|
|
|
|
|
|
|
|
|
&get_build_name_index;
|
|
|
|
|
&get_build_time_index;
|
|
|
|
|
|
|
|
|
|
&load_who($who_list, $td1);
|
|
|
|
|
if( $tree2 ne '' ){
|
|
|
|
|
&load_who($who_list2, $td2);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
&make_build_table;
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub load_buildlog {
|
1999-05-25 01:03:10 +04:00
|
|
|
my $mailtime, $buildtime, $buildname, $errorparser;
|
|
|
|
|
my $buildstatus, $logfile,$binaryname;
|
|
|
|
|
my $buildrec, @treelist, $t;
|
|
|
|
|
|
|
|
|
|
if (not defined $maxdate) {
|
|
|
|
|
$maxdate = time();
|
|
|
|
|
}
|
|
|
|
|
if (not defined $mindate) {
|
|
|
|
|
$mindate = $maxdate - 24*60*60;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if ($tree2 ne '') {
|
|
|
|
|
@treelist = ($td1, $td2);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
@treelist = ($td1);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
for $t (@treelist) {
|
|
|
|
|
use Backwards;
|
|
|
|
|
my ($bw) = Backwards->new("$t->{name}/build.dat") or die;
|
|
|
|
|
|
|
|
|
|
my $tooearly = 0;
|
|
|
|
|
while( $_ = $bw->readline ) {
|
|
|
|
|
chomp;
|
|
|
|
|
($mailtime, $buildtime, $buildname,
|
|
|
|
|
$errorparser, $buildstatus, $logfile, $binaryname) = split /\|/;
|
|
|
|
|
|
|
|
|
|
# Ignore stuff in the future.
|
|
|
|
|
next if $buildtime > $maxdate;
|
|
|
|
|
|
|
|
|
|
# Ignore stuff in the past (but get a 2 hours of extra data)
|
|
|
|
|
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.
|
|
|
|
|
last if $tooearly++ > 20;
|
|
|
|
|
|
|
|
|
|
next;
|
|
|
|
|
}
|
|
|
|
|
$tooearly = 0;
|
|
|
|
|
$buildrec = {
|
1999-06-28 22:21:40 +04:00
|
|
|
mailtime => $mailtime,
|
|
|
|
|
buildtime => $buildtime,
|
|
|
|
|
buildname => ($tree2 ne '' ? $t->{name} . ' ' : '' ) . $buildname,
|
1999-05-25 01:03:10 +04:00
|
|
|
errorparser => $errorparser,
|
|
|
|
|
buildstatus => $buildstatus,
|
1999-06-28 22:21:40 +04:00
|
|
|
logfile => $logfile,
|
|
|
|
|
binaryname => $binaryname,
|
|
|
|
|
td => $t
|
1999-05-25 01:03:10 +04:00
|
|
|
};
|
1999-06-10 02:32:42 +04:00
|
|
|
if ($form{noignore} or not $t->{ignore_builds}->{$buildname}) {
|
1999-05-25 01:03:10 +04:00
|
|
|
push @{$build_list}, $buildrec;
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
1999-05-26 22:12:11 +04:00
|
|
|
sub loadquickparseinfo {
|
|
|
|
|
my ($tree, $build, $times) = (@_);
|
|
|
|
|
|
|
|
|
|
do "$tree/ignorebuilds.pl";
|
|
|
|
|
|
|
|
|
|
use Backwards;
|
|
|
|
|
|
|
|
|
|
my ($bw) = Backwards->new("$form{tree}/build.dat") or die;
|
|
|
|
|
|
|
|
|
|
my $latest_time = 0;
|
|
|
|
|
my $tooearly = 0;
|
|
|
|
|
while( $_ = $bw->readline ) {
|
|
|
|
|
chop;
|
|
|
|
|
my ($buildtime, $buildname, $buildstatus) = (split /\|/)[1,2,4];
|
|
|
|
|
|
|
|
|
|
if ($buildstatus =~ /^success|busted|testfailed$/) {
|
|
|
|
|
|
|
|
|
|
# Ignore stuff in the future.
|
|
|
|
|
next if $buildtime > $maxdate;
|
|
|
|
|
|
|
|
|
|
$latest_time = $buildtime if $buildtime > $latest_time;
|
|
|
|
|
|
|
|
|
|
# Ignore stuff more than 12 hours old
|
|
|
|
|
if ($buildtime < $latest_time - 12*60*60) {
|
|
|
|
|
# Hack: A build may give a bogus time. To compensate, we will
|
|
|
|
|
# not stop until we hit 20 consecutive lines that are too early.
|
|
|
|
|
|
|
|
|
|
last if $tooearly++ > 20;
|
|
|
|
|
next;
|
|
|
|
|
}
|
|
|
|
|
$tooearly = 0;
|
|
|
|
|
|
|
|
|
|
next if exists $ignore_builds->{$buildname};
|
|
|
|
|
next if exists $build->{$buildname}
|
|
|
|
|
and $times->{$buildname} >= $buildtime;
|
|
|
|
|
|
|
|
|
|
$build->{$buildname} = $buildstatus;
|
|
|
|
|
$times->{$buildname} = $buildtime;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
1998-06-17 01:43:24 +04:00
|
|
|
sub load_who {
|
1999-05-25 01:03:10 +04:00
|
|
|
my ($who_list, $td) = @_;
|
|
|
|
|
my $d, $w, $i, $bfound;
|
|
|
|
|
|
|
|
|
|
open(WHOLOG, "<$td->{name}/who.dat");
|
|
|
|
|
while (<WHOLOG>) {
|
|
|
|
|
$i = $time_count;
|
|
|
|
|
chop;
|
|
|
|
|
($d,$w) = split /\|/;
|
|
|
|
|
$bfound = 0;
|
|
|
|
|
while ($i > 0 and not $bfound) {
|
|
|
|
|
if ($d <= $build_time_times->[$i]) {
|
|
|
|
|
$who_list->[$i+1]->{$w} = 1;
|
|
|
|
|
$bfound = 1;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
$i--;
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# Ignore the last one
|
|
|
|
|
#
|
|
|
|
|
if ($time_count > 0) {
|
|
|
|
|
$who_list->[$time_count] = {};
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub get_build_name_index {
|
1999-05-25 01:03:10 +04:00
|
|
|
my $i,$br;
|
1998-06-17 01:43:24 +04:00
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
# Get all the unique build names.
|
|
|
|
|
#
|
|
|
|
|
foreach $br (@{$build_list}) {
|
|
|
|
|
$build_name_index->{$br->{buildname}} = 1;
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
$i = 1;
|
|
|
|
|
foreach $n (sort keys (%{$build_name_index})) {
|
|
|
|
|
$build_name_names->[$i] = $n;
|
|
|
|
|
$i++;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$name_count = @{$build_name_names}-1;
|
|
|
|
|
|
|
|
|
|
# Update the map so it points to the right index
|
|
|
|
|
#
|
|
|
|
|
for ($i=1; $i < $name_count+1; $i++) {
|
|
|
|
|
$build_name_index->{$build_name_names->[$i]} = $i;
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub get_build_time_index {
|
1999-05-25 01:03:10 +04:00
|
|
|
my $i,$br;
|
|
|
|
|
|
|
|
|
|
# Get all the unique build names.
|
|
|
|
|
#
|
|
|
|
|
foreach $br (@{$build_list}) {
|
|
|
|
|
$build_time_index->{$br->{buildtime}} = 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$i = 1;
|
|
|
|
|
foreach $n (sort {$b <=> $a} keys (%{$build_time_index})) {
|
|
|
|
|
$build_time_times->[$i] = $n;
|
|
|
|
|
$mindate_time_count = $i if $n >= $mindate;
|
|
|
|
|
$i++;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$time_count = @{$build_time_times}-1;
|
|
|
|
|
|
|
|
|
|
# Update the map so it points to the right index
|
|
|
|
|
#
|
|
|
|
|
for ($i=1; $i < $time_count+1; $i++) {
|
|
|
|
|
$build_time_index->{$build_time_times->[$i]} = $i;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#for $i (@{$build_time_times}) {
|
|
|
|
|
# print $i . "\n";
|
|
|
|
|
#}
|
|
|
|
|
|
|
|
|
|
#while( ($k,$v) = each(%{$build_time_index})) {
|
|
|
|
|
# print "$k=$v\n";
|
|
|
|
|
#}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub make_build_table {
|
1999-05-25 01:03:10 +04:00
|
|
|
my $i,$ti,$bi,$ti1,$br;
|
|
|
|
|
|
|
|
|
|
# Create the build table
|
|
|
|
|
#
|
|
|
|
|
for ($i=1; $i <= $time_count; $i++){
|
|
|
|
|
$build_table->[$i] = [];
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# 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;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
&load_notes;
|
|
|
|
|
|
|
|
|
|
for ($bi = $name_count; $bi > 0; $bi--) {
|
|
|
|
|
for ($ti = $time_count; $ti > 0; $ti--) {
|
|
|
|
|
if (defined($br = $build_table->[$ti][$bi])
|
|
|
|
|
and not defined($br->{rowspan})) {
|
|
|
|
|
|
1999-05-25 23:35:13 +04:00
|
|
|
# If the cell immediately after us is defined, then we
|
1999-05-25 01:03:10 +04:00
|
|
|
# can have a previousbuildtime.
|
|
|
|
|
if (defined($br1 = $build_table->[$ti+1][$bi])) {
|
|
|
|
|
$br->{previousbuildtime} = $br1->{buildtime};
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
$ti1 = $ti-1;
|
|
|
|
|
while ($ti1 > 0 and not defined($build_table->[$ti1][$bi])) {
|
|
|
|
|
$build_table->[$ti1][$bi] = -1;
|
|
|
|
|
$ti1--;
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
$br->{rowspan} = $ti - $ti1;
|
|
|
|
|
if ($br->{rowspan} != 1) {
|
|
|
|
|
$build_table->[$ti1+1][$bi] = $br;
|
|
|
|
|
$build_table->[$ti][$bi] = -1;
|
|
|
|
|
}
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub load_notes {
|
1999-05-25 01:03:10 +04:00
|
|
|
if ($tree2 ne '') {
|
|
|
|
|
@treelist = ($td1, $td2);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
@treelist = ($td1);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
foreach $t (@treelist) {
|
|
|
|
|
open(NOTES,"<$t->{name}/notes.txt")
|
|
|
|
|
or print "<h2>warning: Couldn't open $t->{name}/notes.txt </h2>\n";
|
|
|
|
|
while (<NOTES>) {
|
|
|
|
|
chop;
|
|
|
|
|
($nbuildtime,$nbuildname,$nwho,$nnow,$nenc_note) = split /\|/;
|
|
|
|
|
$nbuildname = "$t->{name} $nbuildname" if $tree2 ne '';
|
|
|
|
|
$ti = $build_time_index->{$nbuildtime};
|
|
|
|
|
$bi = $build_name_index->{$nbuildname};
|
|
|
|
|
#print "[ti = $ti][bi=$bi][buildname='$nbuildname' $_<br>";
|
|
|
|
|
if ($ti != 0 and $bi != 0) {
|
|
|
|
|
$build_table->[$ti][$bi]->{hasnote} = 1;
|
|
|
|
|
if (not defined($build_table->[$ti][$bi]->{noteid})) {
|
|
|
|
|
$build_table->[$ti][$bi]->{noteid} = (0+@note_array);
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
$noteid = $build_table->[$ti][$bi]->{noteid};
|
|
|
|
|
$now_str = &print_time($nnow);
|
|
|
|
|
$note = &url_decode($nenc_note);
|
1999-06-10 02:32:42 +04:00
|
|
|
$note_array[$noteid] = "<pre>\n[<b><a href=mailto:$nwho>"
|
|
|
|
|
."$nwho</a> - $now_str</b>]\n$note\n</pre>"
|
|
|
|
|
.$note_array[$noteid];
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
close(NOTES);
|
|
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
sub last_success_time {
|
|
|
|
|
my ($row) = @_;
|
|
|
|
|
|
|
|
|
|
for (my $tt=1; $tt <= $time_count; $tt++) {
|
|
|
|
|
my $br = $build_table->[$tt][$row];
|
1999-05-25 23:35:13 +04:00
|
|
|
next unless defined $br;
|
1999-05-25 01:03:10 +04:00
|
|
|
next unless $br->{buildstatus} eq 'success';
|
|
|
|
|
return $build_time_times->[$tt + $br->{rowspan} ];
|
|
|
|
|
}
|
|
|
|
|
return 0;
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
|
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
sub last_status {
|
|
|
|
|
my ($row) = @_;
|
|
|
|
|
|
|
|
|
|
for (my $tt=1; $tt <= $time_count; $tt++) {
|
1999-05-25 23:35:13 +04:00
|
|
|
my $br = $build_table->[$tt][$row];
|
|
|
|
|
next unless defined $br;
|
|
|
|
|
next unless $br->{buildstatus} =~ /^(success|busted|testfailed)$/;
|
|
|
|
|
return $br->{buildstatus};
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
1999-05-25 23:04:09 +04:00
|
|
|
return 'building';
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
1998-06-17 01:43:24 +04:00
|
|
|
|
|
|
|
|
sub check_password {
|
1999-05-25 01:03:10 +04:00
|
|
|
if ($form{password} eq '') {
|
|
|
|
|
if (defined $cookie_jar{tinderbox_password}) {
|
|
|
|
|
$form{password} = $cookie_jar{tinderbox_password};
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
|
|
|
|
my $correct = '';
|
|
|
|
|
if (open(REAL, '<data/passwd')) {
|
|
|
|
|
$correct = <REAL>;
|
|
|
|
|
close REAL;
|
|
|
|
|
$correct =~ s/\s+$//; # Strip trailing whitespace.
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
$form{password} =~ s/\s+$//; # Strip trailing whitespace.
|
|
|
|
|
if ($form{password} ne '') {
|
|
|
|
|
open(TRAPDOOR, "../bonsai/data/trapdoor $form{'password'} |")
|
|
|
|
|
or die "Can't run trapdoor func!";
|
|
|
|
|
my $encoded = <TRAPDOOR>;
|
|
|
|
|
close TRAPDOOR;
|
|
|
|
|
$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;
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-05-25 01:03:10 +04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
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";
|
|
|
|
|
|
|
|
|
|
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>
|
|
|
|
|
);
|
1998-06-17 01:43:24 +04:00
|
|
|
|
1999-05-25 01:03:10 +04:00
|
|
|
while (my ($key,$value) = each %form) {
|
|
|
|
|
next if $key eq "password" or $key eq "rememberpassword";
|
|
|
|
|
|
|
|
|
|
my $enc = value_encode($value);
|
|
|
|
|
print "<INPUT TYPE=HIDDEN NAME=$key VALUE='$enc'>\n";
|
|
|
|
|
}
|
|
|
|
|
print "<INPUT TYPE=SUBMIT value=Submit></FORM>\n";
|
|
|
|
|
exit;
|
1998-06-17 01:43:24 +04:00
|
|
|
}
|
1999-06-28 22:21:40 +04:00
|
|
|
|
|
|
|
|
sub find_build_record {
|
|
|
|
|
my ($tree, $logfile) = @_;
|
|
|
|
|
|
|
|
|
|
my $log_entry = `grep $logfile $tree/build.dat`;
|
|
|
|
|
|
|
|
|
|
chomp($log_entry);
|
|
|
|
|
my ($mailtime, $buildtime, $buildname, $errorparser,
|
|
|
|
|
$buildstatus, $logfile, $binaryname) = split /\|/, $log_entry;
|
|
|
|
|
|
|
|
|
|
$buildrec = {
|
|
|
|
|
mailtime => $mailtime,
|
|
|
|
|
buildtime => $buildtime,
|
|
|
|
|
buildname => $buildname,
|
|
|
|
|
errorparser => $errorparser,
|
|
|
|
|
buildstatus => $buildstatus,
|
|
|
|
|
logfile => $logfile,
|
|
|
|
|
binaryname => $binaryname,
|
|
|
|
|
td => undef
|
|
|
|
|
};
|
|
|
|
|
return $buildrec;
|
|
|
|
|
}
|
