mirror of
https://github.com/mozilla/gecko-dev.git
synced 2024-10-10 20:05:49 +00:00
Bug 224884: remove scripts/. The server directory is now (most
fittingly) named server/. r=jkeiser
This commit is contained in:
kiko%async.com.br
parent
a80c072618
commit
0fa60edcc1
@ -1,158 +0,0 @@
|
||||
package Tinderbox3::Bonsai;
|
||||
|
||||
use strict;
|
||||
|
||||
use CGI qw/-oldstyle_urls/;
|
||||
use LWP::UserAgent;
|
||||
use Date::Format;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
my ($start_time, $end_time, $tree, $cvs_module, $branch, $directory) = @_;
|
||||
|
||||
}
|
||||
|
||||
sub clear_cache {
|
||||
my ($dbh, $bonsai_id) = @_;
|
||||
$dbh->do("DELETE FROM tbox_bonsai_cache WHERE bonsai_id = ?", undef, $bonsai_id);
|
||||
$dbh->do("UPDATE tbox_bonsai SET start_cache = null, end_cache = null WHERE bonsai_id = ?", undef, $bonsai_id);
|
||||
}
|
||||
|
||||
sub _grab_cache {
|
||||
my ($dbh, $start_time, $end_time, $bonsai_id, $bonsai_url, $module, $branch, $directory, $cvsroot) = @_;
|
||||
my $p = new CGI(
|
||||
{ treeid => 'default',
|
||||
module => $module,
|
||||
branch => $branch,
|
||||
branchtype => 'match',
|
||||
dir => $directory,
|
||||
file => '',
|
||||
filetype => 'match',
|
||||
who => '',
|
||||
whotype => 'match',
|
||||
sortby => 'Date',
|
||||
hours => 2,
|
||||
date => 'explicit',
|
||||
mindate => $start_time,
|
||||
maxdate => $end_time,
|
||||
cvsroot => $cvsroot
|
||||
});
|
||||
my $url = $bonsai_url . "/cvsquery.cgi?" . $p->query_string;
|
||||
|
||||
my $ua = new LWP::UserAgent;
|
||||
$ua->agent("TinderboxServer/0.1");
|
||||
my $req = new HTTP::Request(GET => $url);
|
||||
my $response = $ua->request($req);
|
||||
if ($response->is_success) {
|
||||
my $content = $response->content;
|
||||
|
||||
my ($checkin_date, $who, $files, $revisions, $size_plus, $size_minus,
|
||||
$description);
|
||||
my $insert_sth = $dbh->prepare("INSERT INTO tbox_bonsai_cache (bonsai_id, checkin_date, who, files, revisions, size_plus, size_minus, description) VALUES (?, ?, ?, ?, ?, ?, ?, ?)");
|
||||
while ($content =~ m{
|
||||
<tr[^>]*>\s*
|
||||
|
||||
<td[^>]*>\s*(?:<\w+[^>]*>\s*)*
|
||||
(\d+/\d+/\d+)\D+(\d+:\d+) # 1+2=date
|
||||
\s*(?:</\w+[^>]*>)*
|
||||
|
||||
<td[^>]*>\s*(?:<\w+[^>]*>\s*)*
|
||||
([^<]*) # 3=who
|
||||
\s*(?:</\w+[^>]*>\s*)*
|
||||
|
||||
<td[^>]*>\s*(?:<\w+[^>]*>\s*)*
|
||||
([^<]*) # 4=file
|
||||
\s*(?:</\w+[^>]*>\s*)*
|
||||
|
||||
<td[^>]*>\s*(?:<\w+[^>]*>\s*)*
|
||||
([^<]*) # 5=version
|
||||
\s*(?:</\w+[^>]*>\s*)*
|
||||
|
||||
(?:<td[^>]*>\s*(?:<\w+[^>]*>\s*)*
|
||||
([^<]*) # 6=branch
|
||||
\s*(?:</\w+[^>]*>\s*)*)?
|
||||
|
||||
<td[^>]*>\s*(?:<\w+[^>]*>\s*)*
|
||||
(\d+)/(\d+) # 7/8=minus/plus lines
|
||||
\s*(?:</\w+[^>]*>\s*)*(?:\ )?\s*
|
||||
|
||||
(?:<td[^>]*>\s*
|
||||
((?:.(?!</(font|td|tr)>))*) # 9=description
|
||||
\s*(?:</\w+[^>]*>\s*)*)?
|
||||
}mgxi) {
|
||||
if (defined($9)) {
|
||||
if (defined($description)) {
|
||||
$checkin_date =~ s!(\d+)/(\d+)/(\d+)!$3/$1/$2!g;
|
||||
$insert_sth->execute($bonsai_id, $checkin_date, $who, $files,
|
||||
$revisions, $size_plus, $size_minus,
|
||||
$description);
|
||||
}
|
||||
($checkin_date, $who, $revisions, $size_plus, $size_minus,
|
||||
$description) = ("$1 $2", $3, $5, $7, $8, $9);
|
||||
} else {
|
||||
$revisions .= ",$5";
|
||||
$size_plus += $7;
|
||||
$size_minus += $8;
|
||||
}
|
||||
|
||||
# Do regexp things down here instead of above because it will disturb
|
||||
# $1-$8
|
||||
my $was_description = defined($8);
|
||||
my $file = $4;
|
||||
$file =~ s/\s//g;
|
||||
if ($was_description) {
|
||||
$files = $file;
|
||||
} else {
|
||||
$files .= ",$file";
|
||||
}
|
||||
# if ($was_description) {
|
||||
# $description =~ s/<br>/\n/mig;
|
||||
# $description =~ s/<\/?a[^>]*>//mig;
|
||||
# $description =~ s/</</mig;
|
||||
# $description =~ s/>/>/mig;
|
||||
# $description =~ s/&/&/mig;
|
||||
# }
|
||||
}
|
||||
if (defined($description)) {
|
||||
$insert_sth->execute($bonsai_id, $checkin_date, $who, $files, $revisions,
|
||||
$size_plus, $size_minus, $description);
|
||||
}
|
||||
} else {
|
||||
die "Invalid Bonsai URL '$bonsai_url' : $url";
|
||||
}
|
||||
}
|
||||
|
||||
sub update_cache {
|
||||
my ($dbh, $start_time, $end_time, $bonsai_id, $bonsai_url, $module, $branch,
|
||||
$directory, $cvsroot, $old_start_time, $old_end_time) = @_;
|
||||
|
||||
# Figure out what part of the cache needs updating and update it
|
||||
my ($new_start_time, $new_end_time) = ($old_start_time, $old_end_time);
|
||||
if (!defined($old_start_time) && !defined($old_end_time)) {
|
||||
# If both are undefined, this is our first grab into the cache
|
||||
_grab_cache($dbh, $start_time, $end_time, $bonsai_id, $bonsai_url,
|
||||
$module, $branch, $directory, $cvsroot);
|
||||
($new_start_time, $new_end_time) = ($start_time, $end_time);
|
||||
|
||||
} else {
|
||||
# Otherwise we are just extending our old start and end times
|
||||
if ($end_time > $old_end_time) {
|
||||
_grab_cache($dbh, $old_end_time+1, $end_time, $bonsai_id, $bonsai_url,
|
||||
$module, $branch, $directory, $cvsroot);
|
||||
$new_end_time = $end_time;
|
||||
}
|
||||
if ($start_time < $old_start_time) {
|
||||
_grab_cache($dbh, $start_time, $old_start_time-1, $bonsai_id, $bonsai_url,
|
||||
$module, $branch, $directory, $cvsroot);
|
||||
$new_start_time = $start_time;
|
||||
}
|
||||
}
|
||||
|
||||
$dbh->do("UPDATE tbox_bonsai SET start_cache = " . Tinderbox3::DB::sql_abstime("?") . ", end_cache = " . Tinderbox3::DB::sql_abstime("?") . " WHERE bonsai_id = ?", undef, int($new_start_time), int($new_end_time), $bonsai_id);
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,130 +0,0 @@
|
||||
package Tinderbox3::BonsaiColumns;
|
||||
|
||||
use strict;
|
||||
|
||||
use Tinderbox3::Util;
|
||||
use Date::Format;
|
||||
use CGI qw/-oldstyle_urls/;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
my ($start_time, $end_time, $bonsai_id, $display_name, $bonsai_url, $module, $branch,
|
||||
$directory, $cvsroot) = @_;
|
||||
$this->{START_TIME} = $start_time;
|
||||
$this->{END_TIME} = $end_time;
|
||||
$this->{BONSAI_ID} = $bonsai_id;
|
||||
$this->{DISPLAY_NAME} = $display_name;
|
||||
$this->{BONSAI_URL} = $bonsai_url;
|
||||
$this->{MODULE} = $module;
|
||||
$this->{BRANCH} = $branch;
|
||||
$this->{DIRECTORY} = $directory;
|
||||
$this->{CVSROOT} = $cvsroot;
|
||||
|
||||
$this->{EVENTS} = [];
|
||||
|
||||
return $this;
|
||||
}
|
||||
|
||||
sub first_event_time {
|
||||
my $this = shift;
|
||||
return $this->{EVENTS}[0]{checkin_date};
|
||||
}
|
||||
|
||||
sub pop_first {
|
||||
my $this = shift;
|
||||
return ($this->{EVENTS}[0]{checkin_date}, shift @{$this->{EVENTS}}, 0);
|
||||
}
|
||||
|
||||
sub is_empty {
|
||||
my $this = shift;
|
||||
return @{$this->{EVENTS}} ? 0 : 1;
|
||||
}
|
||||
|
||||
sub column_header {
|
||||
my $this = shift;
|
||||
return "<th>$this->{DISPLAY_NAME}</th>";
|
||||
}
|
||||
|
||||
sub column_header_2 {
|
||||
return "<td>Click on a name to see what they did</td>";
|
||||
}
|
||||
|
||||
sub _escape {
|
||||
my ($str) = @_;
|
||||
$str =~ s/(['"<>\\])/\\$1/g;
|
||||
return $str;
|
||||
}
|
||||
|
||||
sub cell {
|
||||
my $this = shift;
|
||||
my ($rows, $row_num, $column) = @_;
|
||||
my $cell = $rows->[$row_num][$column];
|
||||
|
||||
my $str;
|
||||
if (defined($cell)) {
|
||||
$str = "<td class=checkin>";
|
||||
foreach my $event (@{$cell}) {
|
||||
my $who = $event->{who};
|
||||
$who =~ s/%.+//g;
|
||||
my $who_email = $event->{who};
|
||||
$who_email =~ s/%/\@/g;
|
||||
my $checkin_date_str = time2str('%D %H:%M', $event->{checkin_date});
|
||||
my $bonsai_url = $this->build_bonsai_url($event->{checkin_date} - 7*60, $event->{checkin_date}, $event->{who});
|
||||
my $popup_str = <<EOM;
|
||||
<a href='mailto:$who_email'>$who_email</a><br>
|
||||
<a href='$bonsai_url'>View Checkin</a> (+$event->{size_plus}/-$event->{size_minus}) $checkin_date_str<br>
|
||||
$event->{description}
|
||||
EOM
|
||||
|
||||
$str .= "<a href='$bonsai_url' onclick='return do_popup(event, \"cvs\", \"" . escape_html(escape_js($popup_str)) . "\")'>$who</a> ";
|
||||
}
|
||||
} else {
|
||||
$str = "<td>";
|
||||
}
|
||||
|
||||
$str .= "</td>";
|
||||
return $str;
|
||||
}
|
||||
|
||||
sub build_bonsai_url {
|
||||
my $this = shift;
|
||||
my ($start_date, $end_date, $who) = @_;
|
||||
return "$this->{BONSAI_URL}/cvsquery.cgi?module=$this->{MODULE}&branch=$this->{BRANCH}&dir=$this->{DIRECTORY}&cvsroot=$this->{CVSROOT}&date=explicit&mindate=$start_date&maxdate=$end_date" . ($who ? "&who=" . escape_url($who) : "");
|
||||
}
|
||||
|
||||
sub get_bonsai_column_queues {
|
||||
my ($p, $dbh, $start_time, $end_time, $tree) = @_;
|
||||
|
||||
#
|
||||
# Get the list of bonsai installs
|
||||
#
|
||||
my %columns;
|
||||
my $sth = $dbh->prepare("SELECT bonsai_id, display_name, bonsai_url, module, branch, directory, cvsroot FROM tbox_bonsai WHERE tree_name = ?");
|
||||
$sth->execute($tree);
|
||||
while (my $row = $sth->fetchrow_arrayref) {
|
||||
$columns{$row->[0]} = new Tinderbox3::BonsaiColumns($start_time, $end_time, @{$row});
|
||||
}
|
||||
|
||||
if (keys %columns) {
|
||||
#
|
||||
# Fill in the bonsais with data
|
||||
#
|
||||
$sth = $dbh->prepare("SELECT bonsai_id, " . Tinderbox3::DB::sql_get_timestamp("checkin_date") . ", who, files, revisions, size_plus, size_minus, description FROM tbox_bonsai_cache WHERE checkin_date >= " . Tinderbox3::DB::sql_abstime("?") . " AND checkin_date <= " . Tinderbox3::DB::sql_abstime("?") . " AND bonsai_id IN (" . join(', ', map { "?" } keys %columns) . ") ORDER BY checkin_date");
|
||||
$sth->execute($start_time, $end_time, map { $_->{BONSAI_ID} } values %columns);
|
||||
while (my $row = $sth->fetchrow_arrayref) {
|
||||
push @{$columns{$row->[0]}{EVENTS}}, {
|
||||
checkin_date => $row->[1], who => $row->[2], files => $row->[3],
|
||||
revisions => $row->[4], size_plus => $row->[5], size_minus => $row->[6],
|
||||
description => $row->[7]
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
return sort { $a->{DISPLAY_NAME} cmp $b->{DISPLAY_NAME} } values %columns;
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,38 +0,0 @@
|
||||
package Tinderbox3::BuildTimeColumn;
|
||||
|
||||
use strict;
|
||||
use Date::Format;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
my ($p, $dbh) = @_;
|
||||
|
||||
return $this;
|
||||
}
|
||||
|
||||
sub column_header {
|
||||
return "<th>Build Time</th>";
|
||||
}
|
||||
|
||||
sub column_header_2 {
|
||||
return "<td>Click time to see changes since then</td>";
|
||||
}
|
||||
|
||||
sub cell {
|
||||
my $this = shift;
|
||||
my ($rows, $row_num, $column) = @_;
|
||||
my $class;
|
||||
if (time2str("%H", $rows->[$row_num][$column]) % 2 == 1) {
|
||||
$class = "time";
|
||||
} else {
|
||||
$class = "time_alt";
|
||||
}
|
||||
return "<td class=$class>" . time2str("%D %R", $rows->[$row_num][$column]) . "</td>";
|
||||
}
|
||||
|
||||
1
|
||||
|
||||
@ -1,416 +0,0 @@
|
||||
package Tinderbox3::DB;
|
||||
|
||||
use strict;
|
||||
use DBI;
|
||||
use Tinderbox3::InitialValues;
|
||||
use Tinderbox3::Bonsai;
|
||||
use Tinderbox3::Login;
|
||||
use Tinderbox3::Log;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(get_dbh sql_current_timestamp sql_abstime sql_get_last_id sql_get_timestamp sql_get_bool);
|
||||
|
||||
# dbtype = mysql or Pg
|
||||
our $dbtype = "mysql";
|
||||
our $dbname = "tbox3";
|
||||
our $username = "";
|
||||
our $password = "";
|
||||
sub get_dbh {
|
||||
my $dbh = DBI->connect("dbi:$dbtype:dbname=$dbname", $username, $password, { RaiseError => 1 });
|
||||
return $dbh;
|
||||
}
|
||||
|
||||
sub maybe_commit {
|
||||
my ($dbh) = @_;
|
||||
# $dbh->commit();
|
||||
}
|
||||
|
||||
sub check_edit_tree {
|
||||
my ($login, $dbh, $tree, $action) = @_;
|
||||
my $row = $dbh->selectrow_arrayref("SELECT editors FROM tbox_tree WHERE tree_name = ?", undef, $tree);
|
||||
if (!can_edit_tree($login, $row->[0])) {
|
||||
die "$login: Insufficient privileges to $action (need edit tree)!";
|
||||
}
|
||||
}
|
||||
|
||||
sub check_sheriff_tree {
|
||||
my ($login, $dbh, $tree, $action) = @_;
|
||||
my $row = $dbh->selectrow_arrayref("SELECT editors, sheriffs FROM tbox_tree WHERE tree_name = ?", undef, $tree);
|
||||
if (!can_sheriff_tree($login, $row->[0], $row->[1])) {
|
||||
die "$login: Insufficient privileges to $action (need sheriff tree)!";
|
||||
}
|
||||
}
|
||||
|
||||
sub check_edit_patch {
|
||||
my ($login, $dbh, $patch_id, $action) = @_;
|
||||
my $row = $dbh->selectrow_arrayref("SELECT t.editors FROM tbox_patch p, tbox_tree t WHERE p.patch_id = ? AND t.tree_name = p.tree_name", undef, $patch_id);
|
||||
if (!can_edit_tree($login, $row->[0])) {
|
||||
die "$login: Insufficient privileges to $action (need edit tree)!";
|
||||
}
|
||||
}
|
||||
|
||||
sub check_edit_machine {
|
||||
my ($login, $dbh, $machine_id, $action) = @_;
|
||||
my $row = $dbh->selectrow_arrayref("SELECT t.editors FROM tbox_machine m, tbox_tree t WHERE m.machine_id = ? AND t.tree_name = m.tree_name", undef, $machine_id);
|
||||
if (!can_edit_tree($login, $row->[0])) {
|
||||
die "$login: Insufficient privileges to $action (need edit tree)!";
|
||||
}
|
||||
}
|
||||
|
||||
sub check_edit_bonsai {
|
||||
my ($login, $dbh, $bonsai_id) = @_;
|
||||
my $row = $dbh->selectrow_arrayref("SELECT t.editors FROM tbox_bonsai b, tbox_tree t WHERE b.bonsai_id = ? AND t.tree_name = b.tree_name", undef, $bonsai_id);
|
||||
if (!can_edit_tree($login, $row->[0])) {
|
||||
die "Insufficient privileges to edit bonsai (need edit tree)!";
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Perform the upload_patch or edit_patch action
|
||||
#
|
||||
sub update_patch_action {
|
||||
my ($p, $dbh, $login) = @_;
|
||||
|
||||
my $patch_id = $p->param('patch_id') || "";
|
||||
my $action = $p->param('action') || "";
|
||||
if ($action eq 'upload_patch' || $action eq 'edit_patch') {
|
||||
my $patch_name = $p->param('patch_name') || "";
|
||||
my $bug_id = $p->param('bug_id') || "";
|
||||
my $in_use = sql_get_bool($p->param('in_use'));
|
||||
my $patch_ref = "Bug $bug_id";
|
||||
my $patch_ref_url = "http://bugzilla.mozilla.org/show_bug.cgi?id=$bug_id";
|
||||
|
||||
if (!$patch_name) { die "Must specify a non-blank patch name!"; }
|
||||
|
||||
if ($action eq 'upload_patch') {
|
||||
# Check security
|
||||
my $tree = $p->param('tree') || "";
|
||||
check_edit_tree($login, $dbh, $tree, "upload patch");
|
||||
|
||||
# Get patch
|
||||
my $patch_fh = $p->upload('patch');
|
||||
if (!$patch_fh) { die "No patch file uploaded!"; }
|
||||
my $patch = "";
|
||||
while (<$patch_fh>) {
|
||||
$patch .= $_;
|
||||
}
|
||||
|
||||
# Perform patch insert
|
||||
$dbh->do("INSERT INTO tbox_patch (tree_name, patch_name, patch_ref, patch_ref_url, patch, in_use) VALUES (?, ?, ?, ?, ?, ?)", undef, $tree, $patch_name, $patch_ref, $patch_ref_url, $patch, $in_use);
|
||||
maybe_commit($dbh);
|
||||
|
||||
} else {
|
||||
# Check security
|
||||
check_edit_patch($login, $dbh, $patch_id, "edit patch");
|
||||
|
||||
# Perform patch update
|
||||
my $rows = $dbh->do("UPDATE tbox_patch SET patch_name = ?, patch_ref = ?, patch_ref_url = ?, in_use = ? WHERE patch_id = ?", undef, $patch_name, $patch_ref, $patch_ref_url, $in_use, $patch_id);
|
||||
if (!$rows) {
|
||||
die "Could not find patch!";
|
||||
}
|
||||
maybe_commit($dbh);
|
||||
}
|
||||
|
||||
} elsif ($action eq 'delete_patch') {
|
||||
if (!$patch_id) { die "Need patch id!"; }
|
||||
|
||||
# Check security
|
||||
check_edit_patch($login, $dbh, $patch_id, "delete patch");
|
||||
|
||||
# Perform patch delete
|
||||
my $rows = $dbh->do("DELETE FROM tbox_patch WHERE patch_id = ?", undef, $patch_id);
|
||||
if (!$rows) {
|
||||
die "Delete failed. No such tree / patch.";
|
||||
}
|
||||
maybe_commit($dbh);
|
||||
|
||||
} elsif ($action eq 'stop_using_patch' || $action eq 'start_using_patch') {
|
||||
# Check security
|
||||
check_edit_patch($login, $dbh, $patch_id, "start/stop using patch");
|
||||
|
||||
if (!$patch_id) { die "Need patch id!" }
|
||||
my $rows = $dbh->do("UPDATE tbox_patch SET in_use = ? WHERE patch_id = ?", undef, sql_get_bool($action eq 'start_using_patch'), $patch_id);
|
||||
if (!$rows) {
|
||||
die "Update failed. No such tree / patch.";
|
||||
}
|
||||
maybe_commit($dbh);
|
||||
}
|
||||
|
||||
return $patch_id;
|
||||
}
|
||||
|
||||
#
|
||||
# Update / Insert the tree and perform other DB operations
|
||||
#
|
||||
sub update_tree_action {
|
||||
my ($p, $dbh, $login) = @_;
|
||||
|
||||
my $tree = $p->param('tree') || "";
|
||||
|
||||
my $action = $p->param('action') || "";
|
||||
if ($action eq 'edit_tree') {
|
||||
my $newtree = $p->param('tree_name') || "";
|
||||
my $field_short_names = $p->param('field_short_names') || "";
|
||||
my $field_processors = $p->param('field_processors') || "";
|
||||
my $statuses = $p->param('statuses') || "";
|
||||
my $min_row_size = $p->param('min_row_size') || "0";
|
||||
my $max_row_size = $p->param('max_row_size') || "0";
|
||||
my $default_tinderbox_view = $p->param('default_tinderbox_view') || "0";
|
||||
my $new_machines_visible = sql_get_bool($p->param('new_machines_visible'));
|
||||
my $editors = $p->param('editors') || "";
|
||||
|
||||
if (!$newtree) { die "Must specify a non-blank tree!"; }
|
||||
|
||||
# Update or insert the tree
|
||||
if ($tree) {
|
||||
# Check security
|
||||
check_edit_tree($login, $dbh, $tree, "edit tree");
|
||||
|
||||
# Perform tree update
|
||||
my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, field_short_names = ?, field_processors = ?, statuses = ?, min_row_size = ?, max_row_size = ?, default_tinderbox_view = ?, new_machines_visible = ?, editors = ? WHERE tree_name = ?", undef,
|
||||
$newtree, $field_short_names, $field_processors, $statuses,
|
||||
$min_row_size, $max_row_size, $default_tinderbox_view,
|
||||
$new_machines_visible, $editors,
|
||||
$tree);
|
||||
if (!$rows) {
|
||||
die "No tree named $tree!";
|
||||
}
|
||||
} else {
|
||||
# Check security
|
||||
if (!can_admin($login)) {
|
||||
die "Insufficient privileges to add tree! (Need superuser)";
|
||||
}
|
||||
|
||||
# Perform tree insert
|
||||
my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, field_short_names, field_processors, statuses, min_row_size, max_row_size, default_tinderbox_view, new_machines_visible, editors, header, footer, special_message, sheriff, build_engineer, status, sheriffs) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)", undef,
|
||||
$newtree, $field_short_names, $field_processors, $statuses,
|
||||
$min_row_size, $max_row_size, $default_tinderbox_view,
|
||||
$new_machines_visible, $editors,
|
||||
$Tinderbox3::InitialValues::header,
|
||||
$Tinderbox3::InitialValues::footer,
|
||||
$Tinderbox3::InitialValues::special_message,
|
||||
$Tinderbox3::InitialValues::sheriff,
|
||||
$Tinderbox3::InitialValues::build_engineer,
|
||||
$Tinderbox3::InitialValues::status,
|
||||
'');
|
||||
if (!$rows) {
|
||||
die "Passing strange. Insert failed.";
|
||||
}
|
||||
$tree = $newtree;
|
||||
}
|
||||
|
||||
# Update initial config values
|
||||
$dbh->do("DELETE FROM tbox_initial_machine_config WHERE tree_name = ?", undef, $newtree);
|
||||
my $i = 0;
|
||||
my $sth = $dbh->prepare("INSERT INTO tbox_initial_machine_config (tree_name, name, value) VALUES (?, ?, ?)");
|
||||
while (defined($p->param("initial_machine_config$i"))) {
|
||||
my $var = $p->param("initial_machine_config$i");
|
||||
if ($var) {
|
||||
my $val = $p->param("initial_machine_config${i}_val");
|
||||
$val =~ s/\r//g;
|
||||
$sth->execute($newtree, $var, $val);
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
|
||||
maybe_commit($dbh);
|
||||
|
||||
# Return the new tree name
|
||||
$tree = $newtree;
|
||||
} elsif ($action eq 'edit_sheriff') {
|
||||
# Check security
|
||||
check_sheriff_tree($login, $dbh, $tree, "sheriff tree");
|
||||
|
||||
my $header = $p->param('header') || "";
|
||||
my $footer = $p->param('footer') || "";
|
||||
my $special_message = $p->param('special_message') || "";
|
||||
my $sheriff = $p->param('sheriff') || "";
|
||||
my $build_engineer = $p->param('build_engineer') || "";
|
||||
my $status = $p->param('status') || "";
|
||||
my $sheriffs = $p->param('sheriffs') || "";
|
||||
my $rows = $dbh->do("UPDATE tbox_tree SET header = ?, footer = ?, special_message = ?, sheriff = ?, build_engineer = ?, status = ?, sheriffs = ? WHERE tree_name = ?", undef,
|
||||
$header, $footer, $special_message, $sheriff, $build_engineer, $status,
|
||||
$sheriffs,
|
||||
$tree);
|
||||
if (!$rows) {
|
||||
die "No tree named $tree!";
|
||||
}
|
||||
maybe_commit($dbh);
|
||||
}
|
||||
|
||||
return $tree;
|
||||
}
|
||||
|
||||
#
|
||||
# Update machine information
|
||||
#
|
||||
sub update_machine_action {
|
||||
my ($p, $dbh, $login) = @_;
|
||||
|
||||
my $machine_id = $p->param('machine_id') || "";
|
||||
$machine_id = $1 if $machine_id =~ /(\d+)/;
|
||||
|
||||
my $action = $p->param('action') || "";
|
||||
if ($action eq 'edit_machine') {
|
||||
die "Must pass machine_id!" if !$machine_id;
|
||||
|
||||
# Check security
|
||||
check_edit_machine($login, $dbh, $machine_id, "edit machine");
|
||||
|
||||
my $visible = sql_get_bool($p->param('visible'));
|
||||
my $commands = $p->param('commands');
|
||||
|
||||
my $rows = $dbh->do('UPDATE tbox_machine SET visible = ?, commands = ? WHERE machine_id = ?', undef, $visible, $commands, $machine_id);
|
||||
if (!$rows) {
|
||||
die "Could not update machine!";
|
||||
}
|
||||
|
||||
# Update config values
|
||||
$dbh->do("DELETE FROM tbox_machine_config WHERE machine_id = ?", undef, $machine_id);
|
||||
my $i = 0;
|
||||
my $sth = $dbh->prepare("INSERT INTO tbox_machine_config (machine_id, name, value) VALUES (?, ?, ?)");
|
||||
while (defined($p->param("machine_config$i"))) {
|
||||
my $var = $p->param("machine_config$i");
|
||||
if ($var) {
|
||||
my $val = $p->param("machine_config${i}_val");
|
||||
# Don't put mozconfig in the table if the value is empty
|
||||
if (!($var eq "mozconfig" && !$val)) {
|
||||
$val =~ s/\r//g;
|
||||
$sth->execute($machine_id, $var, $val);
|
||||
}
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
|
||||
maybe_commit($dbh);
|
||||
} elsif ($action eq 'kick_machine') {
|
||||
die "Must pass machine_id!" if !$machine_id;
|
||||
|
||||
# Check security
|
||||
check_edit_machine($login, $dbh, $machine_id, "kick machine");
|
||||
|
||||
my $commands = $dbh->selectrow_arrayref("SELECT commands FROM tbox_machine WHERE machine_id = ?", undef, $machine_id);
|
||||
if (!$commands) {
|
||||
die "Invalid machine id $machine_id!";
|
||||
}
|
||||
my @commands = split /,/, $commands->[0];
|
||||
if (! grep { $_ eq 'kick' } @commands) {
|
||||
push @commands, 'kick';
|
||||
}
|
||||
my $rows = $dbh->do('UPDATE tbox_machine SET commands = ? WHERE machine_id = ?', undef, join(',', @commands), $machine_id);
|
||||
if (!$rows) {
|
||||
die "Could not update machine!";
|
||||
}
|
||||
maybe_commit($dbh);
|
||||
} elsif ($action eq 'delete_machine') {
|
||||
die "Must pass machine_id!" if !$machine_id;
|
||||
|
||||
# Check security
|
||||
check_edit_machine($login, $dbh, $machine_id, "delete machine");
|
||||
|
||||
my $row = $dbh->do('DELETE FROM tbox_build_field WHERE machine_id = ?', undef, $machine_id);
|
||||
$row = $dbh->do('DELETE FROM tbox_build_comment WHERE machine_id = ?', undef, $machine_id);
|
||||
$row = $dbh->do('DELETE FROM tbox_build WHERE machine_id = ?', undef, $machine_id);
|
||||
$row = $dbh->do('DELETE FROM tbox_machine WHERE machine_id = ?', undef, $machine_id);
|
||||
die "Could not delete machine" if !$row;
|
||||
delete_logs($machine_id);
|
||||
maybe_commit($dbh);
|
||||
|
||||
}
|
||||
return $machine_id;
|
||||
}
|
||||
|
||||
|
||||
sub update_bonsai_action {
|
||||
my ($p, $dbh, $login) = @_;
|
||||
|
||||
my $tree = $p->param('tree') || "";
|
||||
my $bonsai_id = $p->param('bonsai_id') || "";
|
||||
|
||||
my $action = $p->param('action') || "";
|
||||
|
||||
if ($action eq 'edit_bonsai') {
|
||||
my $display_name = $p->param('display_name') || "";
|
||||
my $bonsai_url = $p->param('bonsai_url') || "";
|
||||
my $module = $p->param('module') || "";
|
||||
my $branch = $p->param('branch') || "";
|
||||
my $directory = $p->param('directory') || "";
|
||||
my $cvsroot = $p->param('cvsroot') || "";
|
||||
|
||||
if ($bonsai_id) {
|
||||
# Check security
|
||||
check_edit_bonsai($login, $dbh, $bonsai_id);
|
||||
|
||||
my $rows = $dbh->do("UPDATE tbox_bonsai SET display_name = ?, bonsai_url = ?, module = ?, branch = ?, directory = ?, cvsroot = ? WHERE bonsai_id = ?", undef, $display_name, $bonsai_url, $module, $branch, $directory, $cvsroot, $bonsai_id);
|
||||
if (!$rows) {
|
||||
die "Could not update bonsai!";
|
||||
}
|
||||
Tinderbox3::Bonsai::clear_cache($dbh, $bonsai_id);
|
||||
} else {
|
||||
# Check security
|
||||
check_edit_tree($login, $dbh, $tree, "edit machine");
|
||||
|
||||
$dbh->do("INSERT INTO tbox_bonsai (tree_name, display_name, bonsai_url, module, branch, directory, cvsroot) VALUES (?, ?, ?, ?, ?, ?, ?)", undef, $tree, $display_name, $bonsai_url, $module, $branch, $directory, $cvsroot);
|
||||
$bonsai_id = sql_get_last_id($dbh, 'tbox_bonsai_id_seq');
|
||||
}
|
||||
maybe_commit($dbh);
|
||||
} elsif ($action eq "delete_bonsai") {
|
||||
Tinderbox3::Bonsai::clear_cache($dbh, $bonsai_id);
|
||||
my $rows = $dbh->do("DELETE FROM tbox_bonsai WHERE bonsai_id = ?", undef, $bonsai_id);
|
||||
if (!$rows) {
|
||||
die "Could not delete bonsai!";
|
||||
}
|
||||
maybe_commit($dbh);
|
||||
}
|
||||
|
||||
return ($tree, $bonsai_id);
|
||||
}
|
||||
|
||||
sub sql_current_timestamp {
|
||||
if ($dbtype eq "Pg") {
|
||||
return "current_timestamp";
|
||||
} elsif ($dbtype eq "mysql") {
|
||||
return "current_timestamp()";
|
||||
}
|
||||
}
|
||||
|
||||
sub sql_get_timestamp {
|
||||
my ($arg) = @_;
|
||||
if ($dbtype eq "Pg") {
|
||||
return "EXTRACT (EPOCH FROM $arg)";
|
||||
} elsif ($dbtype eq "mysql") {
|
||||
return "unix_timestamp($arg)";
|
||||
}
|
||||
}
|
||||
|
||||
sub sql_abstime {
|
||||
my ($arg) = @_;
|
||||
if ($dbtype eq "Pg") {
|
||||
return "abstime($arg + 0)";
|
||||
} elsif ($dbtype eq "mysql") {
|
||||
return "from_unixtime($arg)";
|
||||
}
|
||||
}
|
||||
|
||||
sub sql_get_last_id {
|
||||
my ($dbh, $sequence) = @_;
|
||||
if ($dbtype eq "Pg") {
|
||||
my $row = $dbh->selectrow_arrayref("SELECT currval('$sequence')");
|
||||
return $row->[0];
|
||||
} elsif ($dbtype eq "mysql") {
|
||||
my $row = $dbh->selectrow_arrayref("SELECT last_insert_id()");
|
||||
return $row->[0];
|
||||
}
|
||||
}
|
||||
|
||||
sub sql_get_bool {
|
||||
my ($bool) = @_;
|
||||
if ($dbtype eq 'Pg') {
|
||||
return $bool ? 'Y' : 'N';
|
||||
} elsif ($dbtype eq 'mysql') {
|
||||
return $bool ? 1 : 0;
|
||||
}
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,20 +0,0 @@
|
||||
package Tinderbox3::FieldProcessors::Graph;
|
||||
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
return $this;
|
||||
}
|
||||
|
||||
sub process_field {
|
||||
my $this = shift;
|
||||
my ($tree_columns, $field, $value) = @_;
|
||||
return "$field: $value";
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,21 +0,0 @@
|
||||
package Tinderbox3::FieldProcessors::Patch;
|
||||
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
return $this;
|
||||
}
|
||||
|
||||
sub process_field {
|
||||
my $this = shift;
|
||||
my ($tree_columns, $field, $value) = @_;
|
||||
|
||||
return ($tree_columns->{PATCH_STR}{$value} || "(deleted patch)") . "<br>\n";
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,20 +0,0 @@
|
||||
package Tinderbox3::FieldProcessors::URL;
|
||||
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
return $this;
|
||||
}
|
||||
|
||||
sub process_field {
|
||||
my $this = shift;
|
||||
my ($tree_columns, $field, $value) = @_;
|
||||
return "<a href='$value'>$field</a>";
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,20 +0,0 @@
|
||||
package Tinderbox3::FieldProcessors::Warn;
|
||||
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
return $this;
|
||||
}
|
||||
|
||||
sub process_field {
|
||||
my $this = shift;
|
||||
my ($tree_columns, $field, $value) = @_;
|
||||
return "$field: $value";
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,20 +0,0 @@
|
||||
package Tinderbox3::FieldProcessors::default;
|
||||
|
||||
use strict;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
return $this;
|
||||
}
|
||||
|
||||
sub process_field {
|
||||
my $this = shift;
|
||||
my ($tree_columns, $field, $value) = @_;
|
||||
return "$field: $value";
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,52 +0,0 @@
|
||||
package Tinderbox3::Header;
|
||||
|
||||
use strict;
|
||||
|
||||
use CGI::Carp qw(fatalsToBrowser);
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(header footer);
|
||||
|
||||
sub header {
|
||||
my ($p, $login, $cookie, $title, $tree, $machine_id, $machine_name) = @_;
|
||||
print $p->header(-cookie => $cookie);
|
||||
print <<EOM;
|
||||
<html>
|
||||
<head>
|
||||
<title>Tinderbox - $title</title>
|
||||
<link rel="stylesheet" type="text/css" href="tbox3-admin.css">
|
||||
</head>
|
||||
<body>
|
||||
<h2>$title</h2>
|
||||
EOM
|
||||
|
||||
nav_links($login, $tree, $machine_id, $machine_name);
|
||||
}
|
||||
|
||||
sub footer {
|
||||
print <<EOM;
|
||||
</body>
|
||||
</html>
|
||||
EOM
|
||||
}
|
||||
|
||||
sub nav_links {
|
||||
my ($login, $tree, $machine_id, $machine_name) = @_;
|
||||
print "<p>\n";
|
||||
if ($login) {
|
||||
print "Logged in as: $login (<a href='admin.pl?-logout=1'>Log out</a>)\n";
|
||||
} else {
|
||||
print "Not Logged In (<a href='login.pl'>Log in</a>)\n";
|
||||
}
|
||||
print "<br><strong><a href='admin.pl'>Administrate Tinderbox</a></strong>";
|
||||
if ($tree) {
|
||||
print "<br>Tree $tree: <a href='sheriff.pl?tree=$tree'>Sheriff Tree</a> | <a href='admintree.pl?tree=$tree'>Edit Tree</a> | <a href='showbuilds.pl?tree=$tree'>View Tree</a>\n";
|
||||
if ($machine_id) {
|
||||
print "<br>$machine_name: <a href='adminmachine.pl?machine_id=$machine_id'>Edit</a> | <a href='adminmachine.pl?action=kick_machine&machine_id=$machine_id'>Kick</a>\n";
|
||||
}
|
||||
}
|
||||
print "</strong></p>\n";
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,199 +0,0 @@
|
||||
package Tinderbox3::InitialValues;
|
||||
|
||||
use strict;
|
||||
|
||||
# Tree info
|
||||
our $field_short_names = 'refcount_leaks=Lk,refcount_bloat=Bl,trace_malloc_leaks=Lk,trace_malloc_maxheap=MH,trace_malloc_allocs=A,pageload=Tp,codesize=Z,xulwinopen=Txul,startup=Ts,binary_url=Binary,warnings=Warn';
|
||||
our $field_processors = 'refcount_leaks=Graph,refcount_bloat=Graph,trace_malloc_leaks=Graph,trace_malloc_maxheap=Graph,trace_malloc_allocs=Graph,pageload=Graph,codesize=Graph,xulwinopen=Graph,startup=Graph,warnings=Warn,build_zip=URL,installer=URL';
|
||||
our $statuses = 'open,closed,restricted,metered';
|
||||
our $min_row_size = 0;
|
||||
our $max_row_size = 5;
|
||||
our $default_tinderbox_view = 24*60;
|
||||
our $new_machines_visible = 1;
|
||||
our %initial_machine_config = (
|
||||
branch => '',
|
||||
cvs_co_date => '',
|
||||
tests => 'Tp,Ts,Txul',
|
||||
cvsroot => ':pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot',
|
||||
clobber => 0,
|
||||
mozconfig => q^ac_add_options --disable-debug
|
||||
ac_add_options --enable-optimize
|
||||
ac_add_options --without-system-nspr
|
||||
ac_add_options --without-system-zlib
|
||||
ac_add_options --without-system-png
|
||||
ac_add_options --without-system-mng
|
||||
ac_add_options --enable-crypto
|
||||
^,
|
||||
);
|
||||
|
||||
|
||||
# Sheriff info
|
||||
our $header = q^<html>
|
||||
<head>
|
||||
<title>Tinderbox - #TREE#</title>
|
||||
<style>
|
||||
a img {
|
||||
border: 0px
|
||||
}
|
||||
body {
|
||||
background-color: #DDEEFF
|
||||
}
|
||||
table.tinderbox {
|
||||
background-color: white;
|
||||
width: 100%
|
||||
}
|
||||
table.tinderbox td {
|
||||
border: 1px solid gray;
|
||||
text-align: center;
|
||||
}
|
||||
table.tinderbox th {
|
||||
border: 1px solid gray;
|
||||
}
|
||||
.status0,.status1,.status2 {
|
||||
background-color: yellow
|
||||
}
|
||||
.status100,.status101,.status102,.status103 {
|
||||
background-color: lightgreen
|
||||
}
|
||||
th.status200,th.status201,th.status202,th.status203 {
|
||||
background: url("http://lounge.mozilla.org/tinderbox2/gif/flames1.gif");
|
||||
background-color: black;
|
||||
color: white
|
||||
}
|
||||
th.status200 a,th.status201 a,th.status202 a,th.status203 a {
|
||||
color: white
|
||||
}
|
||||
.status200,.status201,.status202,.status203 {
|
||||
background-color: red
|
||||
}
|
||||
.status300,.status301,.status302,.status303 {
|
||||
background-color: lightgray
|
||||
}
|
||||
.checkin {
|
||||
text-align: center
|
||||
}
|
||||
.time {
|
||||
text-align: right
|
||||
}
|
||||
.time_alt {
|
||||
text-align: right;
|
||||
background-color: #e7e7e7
|
||||
}
|
||||
.obsolete {
|
||||
text-decoration: line-through
|
||||
}
|
||||
#tree_status {
|
||||
font-weight: bold;
|
||||
padding: 10px
|
||||
}
|
||||
#tree_status span {
|
||||
font-size: x-large;
|
||||
}
|
||||
#tree_top {
|
||||
text-align: center;
|
||||
vertical-align: center;
|
||||
margin-bottom: 1em;
|
||||
}
|
||||
#tree_top span {
|
||||
font-size: x-large;
|
||||
font-weight: bold
|
||||
}
|
||||
#tree_info {
|
||||
border-collapse: collapse;
|
||||
background-color: white;
|
||||
margin-bottom: 1em
|
||||
}
|
||||
#tree_info td,th {
|
||||
border: 1px solid black
|
||||
}
|
||||
#checkin_info {
|
||||
border: 1px dashed black;
|
||||
background-color: white
|
||||
}
|
||||
#info_table td {
|
||||
vertical-align: top
|
||||
}
|
||||
|
||||
#popup {
|
||||
border: 2px solid black;
|
||||
background-color: white;
|
||||
padding: 0.5em;
|
||||
position: fixed;
|
||||
}
|
||||
</style>
|
||||
|
||||
<script>
|
||||
function closepopup() {
|
||||
document.getElementById('popup').style.display = 'none';
|
||||
}
|
||||
function do_popup(event,_class,str) {
|
||||
closepopup();
|
||||
var popup = document.getElementById('popup');
|
||||
popup.className = _class;
|
||||
popup.innerHTML = str;
|
||||
popup.style.left = event.clientX;
|
||||
popup.style.top = event.clientY;
|
||||
popup.style.display = 'block';
|
||||
event.preventBubble();
|
||||
return false;
|
||||
}
|
||||
</script>
|
||||
</head>
|
||||
<body>
|
||||
<table WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0 onclick="closepopup()">
|
||||
<tr><td>
|
||||
|
||||
<table id=tree_top><tr>
|
||||
<td><span>Tinderbox: #TREE#</span> (#TIME#)<br>(<a href='sheriff.pl?tree=#TREE#'>Sheriff</a> | <a href='admintree.pl?tree=#TREE#'>Edit</a>)</td>
|
||||
<td><a HREF="http://www.mozilla.org/"><img SRC="http://www.mozilla.org/images/mozilla-banner.gif" ALT="" BORDER=0 WIDTH=600 HEIGHT=58></a></td>
|
||||
</tr></table>
|
||||
|
||||
<div id="popup" style="display: none" onclick="event.preventBubble()">
|
||||
</div>
|
||||
|
||||
<table id="info_table">
|
||||
<tr><td>
|
||||
<table id="tree_info">
|
||||
<tr><td colspan=2 id=tree_status>The tree is <span>#STATUS#</span></td></tr>
|
||||
<tr><th>Sheriff:</th><td>#SHERIFF#</td></tr>
|
||||
<tr><th>Build Engineer:</th><td>#BUILD_ENGINEER#</td></tr>
|
||||
<tr><th>CVS pull:</th><td>#CVS_CO_DATE#</td></tr>
|
||||
<tr><th>Patches:</th><td colspan=3>#PATCHES#</td></tr>
|
||||
</table>
|
||||
</td>
|
||||
<td>
|
||||
<p id="checkin_info"><strong>Tree Rules: <font color=red>Do not check in on red.</font></strong> Do not checkin without <a href="http://www.mozilla.org/hacking/reviewers.html">r=/sr= and a=</a>. Watch this Tinderbox after checkin to ensure all platforms compile and run.<br>
|
||||
<strong>Checkin Comments:</strong> When you check in, be sure to include the bug number, who gave you r=/sr=/a=, and a clear description of what you did.</p>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
<div>
|
||||
<a href='showbuilds.pl?tree=#TREE#&start_time=#START_TIME_MINUS(86400)#'>previous (earlier) period</a> - <a href='showbuilds.pl?tree=#TREE#&start_time=#END_TIME#'>next (later) period</a> - <a href='showbuilds.pl?tree=#TREE#'>current period</a><br>
|
||||
^;
|
||||
|
||||
our $footer = q^<a href='showbuilds.pl?tree=#TREE#&start_time=#START_TIME_MINUS(86400)#'>previous (earlier) period</a> - <a href='showbuilds.pl?tree=#TREE#&start_time=#END_TIME#'>next (later) period</a> - <a href='showbuilds.pl?tree=#TREE#'>current period</a>
|
||||
</div>
|
||||
<address>Tinderbox 3: code problems to <a href='mailto:jkeiser@netscape.com'>John Keiser</a>, server problems to <a href='mailto:endico@mozilla.org'>Dawn Endico</a></address>
|
||||
</td></tr></table>
|
||||
</body>
|
||||
</html>^;
|
||||
|
||||
our $sheriff = q^<a href='mailto:annlanders@thepost.com'>Miss Manners</a>, IRC: <a href='irc://irc.mozilla.org/#mozilla'>pleasedontshout</a>, AIM: <a href='aim:ChangeYourBracingStyle'>ChangeYourBracingStyle</a>^;
|
||||
our $build_engineer = q^<a href='mailto:rubyrubydoo@mysteryvan.com'>Scooby Doo</a>, IRC: <a href='irc://irc.mozilla.org/#mozilla'>puppypower</a>, AIM: <a href='aim:scoobysnack'>scoobysnack</a>^;
|
||||
our $special_message = q^^;
|
||||
|
||||
our $status = "open";
|
||||
|
||||
#
|
||||
# bonsai defaults
|
||||
#
|
||||
our $display_name = "Mozilla checkins";
|
||||
our $bonsai_url = "http://bonsai.mozilla.org";
|
||||
our $module = "SeaMonkeyAll";
|
||||
our $branch = "HEAD";
|
||||
our $directory = "";
|
||||
our $cvsroot = "/cvsroot";
|
||||
|
||||
|
||||
1
|
||||
@ -1,99 +0,0 @@
|
||||
package Tinderbox3::Log;
|
||||
|
||||
use strict;
|
||||
use Date::Format;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(compress_log get_log_fh create_logfile_name delete_logs);
|
||||
|
||||
our $logdir;
|
||||
|
||||
sub BEGIN {
|
||||
if (-d "xml") {
|
||||
$logdir = "xml/logs";
|
||||
} else {
|
||||
$logdir = "logs";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# This is the path where gzip will be found
|
||||
$ENV{PATH} = "/bin";
|
||||
|
||||
#
|
||||
# Compress a logfile
|
||||
#
|
||||
sub compress_log {
|
||||
my ($machine_id, $logfile) = @_;
|
||||
|
||||
if (defined($logfile) && -f "$logdir/$machine_id/$logfile") {
|
||||
# XXX Need to lock here to avoid dataloss on occasion
|
||||
system("gzip", "$logdir/$machine_id/$logfile");
|
||||
}
|
||||
}
|
||||
|
||||
sub ensure_uncompressed {
|
||||
my ($machine_id, $logfile) = @_;
|
||||
|
||||
if (!-f "$logdir/$machine_id/$logfile") {
|
||||
if (-f "$logdir/$machine_id/$logfile.gz") {
|
||||
# XXX Would be nice if this did not occur while compress_log or some
|
||||
# append function happens. A lock would help that.
|
||||
system("gzip", "-d", "$logdir/$machine_id/$logfile.gz");
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub create_logfile_name {
|
||||
my ($machine_id) = @_;
|
||||
# This string is detainted in showlog.pl; if you change the format
|
||||
# be sure to change the detaint expression as well.
|
||||
return time2str("%Y%m%d%H%M%S.log", time);
|
||||
}
|
||||
|
||||
sub get_log_fh {
|
||||
my ($machine_id, $logfile, $mode) = @_;
|
||||
|
||||
$mode ||= "<";
|
||||
if (!ensure_uncompressed($machine_id, $logfile)) {
|
||||
# If the file isn't there and we try to read, don't do anything
|
||||
if ($mode eq "<") {
|
||||
return undef;
|
||||
}
|
||||
|
||||
# Make the directories so that > and >> will work
|
||||
if (! -d $logdir) {
|
||||
mkdir($logdir) or die "Could not mkdir $logdir: $!";
|
||||
}
|
||||
if (! -d "$logdir/$machine_id") {
|
||||
mkdir("$logdir/$machine_id") or die "Could not mkdir $logdir/$machine_id $!";
|
||||
}
|
||||
}
|
||||
|
||||
my $fh;
|
||||
open $fh, $mode, "$logdir/$machine_id/$logfile" or die "Could not open: $!";
|
||||
return $fh;
|
||||
}
|
||||
|
||||
sub delete_logfile {
|
||||
my ($machine_id, $logfile) = @_;
|
||||
|
||||
if (-f "$logdir/$machine_id/$logfile.gz") {
|
||||
unlink("$logdir/$machine_id/$logfile.gz");
|
||||
}
|
||||
if (-f "$logdir/$machine_id/$logfile") {
|
||||
unlink("$logdir/$machine_id/$logfile");
|
||||
}
|
||||
}
|
||||
|
||||
sub delete_logs {
|
||||
my ($machine_id) = @_;
|
||||
system("rm -rf $logdir/$machine_id");
|
||||
}
|
||||
|
||||
|
||||
1
|
||||
@ -1,115 +0,0 @@
|
||||
package Tinderbox3::Login;
|
||||
|
||||
use strict;
|
||||
use LWP::UserAgent;
|
||||
use CGI;
|
||||
use Tinderbox3::DB;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(check_session can_admin can_edit_tree can_sheriff_tree login_fields);
|
||||
|
||||
sub login {
|
||||
my ($login, $password) = @_;
|
||||
|
||||
return 1;
|
||||
|
||||
my $p = new CGI({Bugzilla_login => $login, Bugzilla_password => $password, GoAheadAndLogIn => 1});
|
||||
my $url = "http://bugzilla.mozilla.org/query.cgi?" . $p->query_string;
|
||||
|
||||
my $ua = new LWP::UserAgent;
|
||||
$ua->agent("TinderboxServer/0.1");
|
||||
my $req = new HTTP::Request(GET => $url);
|
||||
my $response = $ua->request($req);
|
||||
if ($response->is_success) {
|
||||
if (${$response->content_ref()} =~ /Log(\s| )*out/i &&
|
||||
${$response->content_ref()} =~ /$login/) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub delete_session {
|
||||
my ($dbh, $session_id) = @_;
|
||||
$dbh->do("DELETE FROM tbox_session WHERE session_id = ?", undef, $session_id);
|
||||
Tinderbox3::DB::maybe_commit($dbh);
|
||||
}
|
||||
|
||||
sub check_session {
|
||||
my ($p, $dbh) = @_;
|
||||
my $session_id = $p->cookie('tbox_session');
|
||||
my $login = $p->param('-login');
|
||||
my $password = $p->param('-password');
|
||||
|
||||
my ($login_return, $cookie);
|
||||
if ($login) {
|
||||
if (login($login, $password)) {
|
||||
if ($session_id) {
|
||||
delete_session($dbh, $session_id);
|
||||
}
|
||||
my $new_session_id = time . "-" . int(rand()*100000) . "-" . $login;
|
||||
$dbh->do("INSERT INTO tbox_session (login, session_id, activity_time) VALUES (?, ?, " . Tinderbox3::DB::sql_current_timestamp() . ")", undef, $login, $new_session_id);
|
||||
Tinderbox3::DB::maybe_commit($dbh);
|
||||
# Determine the path for the cookie
|
||||
my $path = $p->url(-absolute => 1);
|
||||
$path =~ s/\/[^\/]*$/\//g;
|
||||
$cookie = $p->cookie(-name => 'tbox_session', -value => $new_session_id, -path => $path);
|
||||
$login_return = $login;
|
||||
}
|
||||
} elsif ($p->param('-logout') && $session_id) {
|
||||
delete_session($dbh, $session_id);
|
||||
} elsif($session_id) {
|
||||
my $row = $dbh->selectrow_arrayref("SELECT login, " . Tinderbox3::DB::sql_get_timestamp("activity_time") . " FROM tbox_session WHERE session_id = ?", undef, $session_id);
|
||||
if (defined($row)) {
|
||||
if (time > $row->[1]+24*60*60) {
|
||||
delete_session($dbh, $session_id);
|
||||
} else {
|
||||
$dbh->do("UPDATE tbox_session SET activity_time = " . Tinderbox3::DB::sql_current_timestamp() . " WHERE session_id = ?", undef, $session_id);
|
||||
Tinderbox3::DB::maybe_commit($dbh);
|
||||
$login_return = $row->[0];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return ($login_return, $cookie);
|
||||
}
|
||||
|
||||
sub can_admin {
|
||||
my ($login) = @_;
|
||||
if (grep { $_ eq $login } @Tinderbox3::Login::superusers) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub can_edit_tree {
|
||||
my ($login, $editors) = @_;
|
||||
if ((grep { $_ eq $login } split(/,/, $editors)) ||
|
||||
(grep { $_ eq $login } @Tinderbox3::Login::superusers)) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub can_sheriff_tree {
|
||||
my ($login, $editors, $sheriffs) = @_;
|
||||
if ((grep { $_ eq $login } split(/,/, $editors)) ||
|
||||
(grep { $_ eq $login } split(/,/, $sheriffs)) ||
|
||||
(grep { $_ eq $login } @Tinderbox3::Login::superusers)) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub login_fields {
|
||||
return "<strong>Login:</strong> <input type=text name='-login'> <strong>Password:</strong> <input type=password name='-password'>";
|
||||
}
|
||||
|
||||
our @superusers = ('jkeiser@netscape.com');
|
||||
|
||||
1
|
||||
@ -1,264 +0,0 @@
|
||||
package Tinderbox3::ShowBuilds;
|
||||
|
||||
use strict;
|
||||
use Date::Format;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::TreeColumns;
|
||||
use Tinderbox3::BonsaiColumns;
|
||||
use Tinderbox3::BuildTimeColumn;
|
||||
|
||||
sub print_showbuilds {
|
||||
my ($p, $dbh, $fh, $tree, $start_time, $end_time,
|
||||
$min_row_size, $max_row_size) = @_;
|
||||
|
||||
#
|
||||
# Get tree and patch info
|
||||
#
|
||||
my $tree_info = $dbh->selectrow_arrayref("SELECT field_short_names, field_processors, header, footer, special_message, sheriff, build_engineer, cvs_co_date, status, min_row_size, max_row_size FROM tbox_tree WHERE tree_name = ?", undef, $tree);
|
||||
if (!$tree_info) {
|
||||
die "Tree $tree does not exist!";
|
||||
}
|
||||
my ($field_short_names, $field_processors_str, $header, $footer,
|
||||
$special_message, $sheriff, $build_engineer, $cvs_co_date, $status,
|
||||
$default_min_row_size, $default_max_row_size) = @{$tree_info};
|
||||
$min_row_size = $default_min_row_size if !defined($min_row_size);
|
||||
$max_row_size = $default_max_row_size if !defined($max_row_size);
|
||||
my %field_processors;
|
||||
# Create the handlers for the different fields
|
||||
require Tinderbox3::FieldProcessors::default;
|
||||
my %field_handlers = ( default => new Tinderbox3::FieldProcessors::default );
|
||||
foreach my $field_processor (split /,/, $field_processors_str) {
|
||||
my ($field, $processor) = split /=/, $field_processor;
|
||||
$field_processors{$field} = $processor;
|
||||
# Check if the processor is OK to put in an eval statement
|
||||
if ($processor =~ /^([A-Za-z]+)$/) {
|
||||
my $code = "require Tinderbox3::FieldProcessors::$1; \$field_handlers{$1} = new Tinderbox3::FieldProcessors::$1();";
|
||||
eval $code;
|
||||
}
|
||||
}
|
||||
|
||||
# Get sizes in seconds for easy comparisons
|
||||
$min_row_size *= 60;
|
||||
$max_row_size *= 60;
|
||||
|
||||
#
|
||||
# Construct the a href and such for the patches
|
||||
# XXX do this lazily in case there are no patches
|
||||
#
|
||||
my %patch_str;
|
||||
{
|
||||
my $sth = $dbh->prepare("SELECT patch_id, patch_name, patch_ref, patch_ref_url, in_use FROM tbox_patch WHERE tree_name = ?");
|
||||
$sth->execute($tree);
|
||||
while (my $row = $sth->fetchrow_arrayref) {
|
||||
my $str;
|
||||
my $class;
|
||||
if (!$row->[4]) {
|
||||
$class = " class=obsolete";
|
||||
} else {
|
||||
$class = "";
|
||||
}
|
||||
$str = "<span$class><a href='get_patch.pl?patch_id=$row->[0]'>$row->[1]</a>";
|
||||
if ($row->[2]) {
|
||||
$str .= " (";
|
||||
$str .= "<a href='$row->[3]'>" if ($row->[3]);
|
||||
$str .= $row->[2];
|
||||
$str .= "</a>" if ($row->[3]);
|
||||
$str .= ")";
|
||||
}
|
||||
$str .= "</span>";
|
||||
$patch_str{$row->[0]} = $str;
|
||||
}
|
||||
}
|
||||
|
||||
print $fh "",insert_dynamic_data($header, $tree, $sheriff, $build_engineer, $cvs_co_date, $status, \%patch_str, $start_time, $end_time);
|
||||
print $fh "",insert_dynamic_data($special_message, $tree, $sheriff, $build_engineer, $cvs_co_date, $status, \%patch_str, $start_time, $end_time);
|
||||
|
||||
print_tree($p, $dbh, $fh, $tree, $start_time, $end_time, $field_short_names,
|
||||
\%field_processors, \%field_handlers, $min_row_size, $max_row_size,
|
||||
\%patch_str);
|
||||
|
||||
print $fh "",insert_dynamic_data($footer, $tree, $sheriff, $build_engineer, $cvs_co_date, $status, \%patch_str, $start_time, $end_time);
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub insert_dynamic_data {
|
||||
my ($str, $tree, $sheriff, $build_engineer, $cvs_co_date, $status, $patch_str, $start_time, $end_time) = @_;
|
||||
|
||||
$str =~ s/#TREE#/$tree/g;
|
||||
my $time = time2str("%c %Z", time);
|
||||
$str =~ s/#TIME#/$time/g;
|
||||
$str =~ s/#SHERIFF#/$sheriff/g;
|
||||
$str =~ s/#BUILD_ENGINEER#/$build_engineer/g;
|
||||
$cvs_co_date = 'current' if !$cvs_co_date;
|
||||
$str =~ s/#CVS_CO_DATE#/$cvs_co_date/g;
|
||||
$str =~ s/#STATUS#/$status/g;
|
||||
$str =~ s/#START_TIME_MINUS\((\d+)\)#/$start_time - $1/eg;
|
||||
$str =~ s/#END_TIME#/$end_time/g;
|
||||
|
||||
if ($str =~ /#PATCHES#/) {
|
||||
my $patches_str = "";
|
||||
if (keys %{$patch_str}) {
|
||||
$patches_str = join(', ', values %{$patch_str});
|
||||
} else {
|
||||
$patches_str = "None";
|
||||
}
|
||||
$str =~ s/#PATCHES#/$patches_str/g;
|
||||
}
|
||||
|
||||
return $str;
|
||||
}
|
||||
|
||||
sub print_tree {
|
||||
my ($p, $dbh, $fh, $tree, $start_time, $end_time, $field_short_names,
|
||||
$field_processors, $field_handlers, $min_row_size, $max_row_size,
|
||||
$patch_str) = @_;
|
||||
|
||||
# Get the information we will be laying out in the table
|
||||
my @event_queues;
|
||||
push @event_queues, new Tinderbox3::BuildTimeColumn($p, $dbh);
|
||||
push @event_queues, Tinderbox3::BonsaiColumns::get_bonsai_column_queues($p, $dbh, $start_time, $end_time, $tree);
|
||||
push @event_queues, Tinderbox3::TreeColumns::get_tree_column_queues($p, $dbh, $start_time, $end_time, $tree, $field_short_names, $field_processors, $field_handlers, $patch_str);
|
||||
|
||||
my $row_num = -1;
|
||||
my @rows;
|
||||
EVENTLOOP:
|
||||
while (1) {
|
||||
#
|
||||
# Get the oldest event from a queue
|
||||
#
|
||||
my ($event_time, $event, $please_split);
|
||||
my $column;
|
||||
{
|
||||
my $most_recent_queue = -1;
|
||||
my $most_recent_time = -1;
|
||||
for (my $queue_num = 1; $queue_num < @event_queues; $queue_num++) {
|
||||
my $queue = $event_queues[$queue_num];
|
||||
if (!$queue->is_empty()) {
|
||||
if ($most_recent_time == -1 ||
|
||||
$queue->first_event_time() < $most_recent_time) {
|
||||
$most_recent_queue = $queue_num;
|
||||
$most_recent_time = $queue->first_event_time();
|
||||
}
|
||||
}
|
||||
}
|
||||
# Break if there were no non-empty queues
|
||||
if ($most_recent_time < 0) {
|
||||
last EVENTLOOP;
|
||||
}
|
||||
($event_time, $event, $please_split) = $event_queues[$most_recent_queue]->pop_first();
|
||||
if ($event_time != $most_recent_time) {
|
||||
die "Event time not what was expected!";
|
||||
}
|
||||
$column = $most_recent_queue;
|
||||
}
|
||||
|
||||
#
|
||||
# If there are no rows yet, create the first row with this event time
|
||||
#
|
||||
if ($row_num == -1) {
|
||||
push @rows, [ $event_time ];
|
||||
$row_num++;
|
||||
} else {
|
||||
#
|
||||
# If event is outside the maximum boundary, start adding rows of
|
||||
# max_row_size to compensate
|
||||
#
|
||||
# XXX potential problem: one really wants cells to start at events
|
||||
# whenever possible, and when we use this algorithm, if the event in
|
||||
# question happens to be inside the minimum row time, we will not split
|
||||
# for it so the cell will not start at the event. This can be compensated
|
||||
# for by building these new cells *down* from the cell in question, but
|
||||
# it would require more strange cases than I care to deal with right now
|
||||
# so I'm not coding it. JBK
|
||||
#
|
||||
if ($max_row_size > 0) {
|
||||
while ($event_time > ($rows[$row_num][0] + $max_row_size)) {
|
||||
push @rows, [ $rows[$row_num][0] + $max_row_size ];
|
||||
$row_num++;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# If event has asked to split, and is outside the minimum boundary (so
|
||||
# that we *can* split, split the row.
|
||||
#
|
||||
if ($please_split && $event_time > ($rows[$row_num][0] + $min_row_size)) {
|
||||
push @rows, [ $event_time ];
|
||||
$row_num++;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Finally, add the event to the current row.
|
||||
#
|
||||
push @{$rows[$row_num][$column]}, $event;
|
||||
}
|
||||
|
||||
#
|
||||
# Ensure there is at least one row
|
||||
#
|
||||
if ($row_num < 0) {
|
||||
push @rows, [ $start_time ];
|
||||
$row_num++;
|
||||
}
|
||||
|
||||
#
|
||||
# Add extra rows if the tinderbox does not go up to the end time
|
||||
#
|
||||
if ($max_row_size > 0) {
|
||||
while ($end_time > ($rows[$row_num][0] + $max_row_size)) {
|
||||
push @rows, [ $rows[$row_num][0] + $max_row_size ];
|
||||
$row_num++;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Add extra rows if the tinderbox does not start at the start time
|
||||
#
|
||||
if ($start_time < $rows[0][0]) {
|
||||
if ($max_row_size > 0) {
|
||||
do {
|
||||
unshift @rows, [ $rows[0][0] - $max_row_size ];
|
||||
} while ($start_time < $rows[0][0]);
|
||||
# Fix the last row to be start time ;)
|
||||
if ($rows[0][0] < $start_time) {
|
||||
$rows[0][0] = $start_time;
|
||||
}
|
||||
} else {
|
||||
unshift @rows, [ $start_time ];
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Print head of table
|
||||
#
|
||||
print $fh "<table class=tinderbox>\n";
|
||||
print $fh "<thead><tr>\n";
|
||||
for (my $queue_num = 0; $queue_num < @event_queues; $queue_num++) {
|
||||
print $fh $event_queues[$queue_num]->column_header(\@rows, $queue_num);
|
||||
}
|
||||
print $fh "</tr>\n";
|
||||
|
||||
print $fh "<tr>\n";
|
||||
for (my $queue_num = 0; $queue_num < @event_queues; $queue_num++) {
|
||||
print $fh $event_queues[$queue_num]->column_header_2(\@rows, $queue_num);
|
||||
}
|
||||
print $fh "</tr></thead>\n";
|
||||
|
||||
#
|
||||
# Print body of table
|
||||
#
|
||||
print $fh "<tbody>\n";
|
||||
for(my $row_num = (@rows - 1); $row_num >= 0; $row_num--) {
|
||||
print $fh "<tr>";
|
||||
for (my $queue_num = 0; $queue_num < @event_queues; $queue_num++) {
|
||||
print $fh $event_queues[$queue_num]->cell(\@rows, $row_num, $queue_num);
|
||||
}
|
||||
print $fh "</tr>\n";
|
||||
}
|
||||
print $fh "</tbody>\n";
|
||||
print $fh "</table>\n";
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,331 +0,0 @@
|
||||
package Tinderbox3::TreeColumns;
|
||||
|
||||
use strict;
|
||||
|
||||
use Date::Format;
|
||||
use Tinderbox3::Util;
|
||||
use CGI::Carp qw/fatalsToBrowser/;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
$class = ref($class) || $class;
|
||||
my $this = {};
|
||||
bless $this, $class;
|
||||
|
||||
my ($start_time, $end_time, $tree, $field_short_names, $field_processors,
|
||||
$field_handlers, $patch_str,
|
||||
$machine_id, $machine_name, $os, $os_version, $compiler, $clobber) = @_;
|
||||
|
||||
$this->{START_TIME} = $start_time;
|
||||
$this->{END_TIME} = $end_time;
|
||||
$this->{TREE} = $tree;
|
||||
$this->{FIELD_SHORT_NAMES} = $field_short_names;
|
||||
$this->{FIELD_PROCESSORS} = $field_processors;
|
||||
$this->{FIELD_HANDLERS} = $field_handlers;
|
||||
$this->{MACHINE_ID} = $machine_id;
|
||||
$this->{MACHINE_NAME} = $machine_name;
|
||||
$this->{OS} = $os;
|
||||
$this->{OS_VERSION} = $os_version;
|
||||
$this->{COMPILER} = $compiler;
|
||||
$this->{CLOBBER} = $clobber;
|
||||
$this->{PATCH_STR} = $patch_str;
|
||||
|
||||
$this->{AT_START} = 1;
|
||||
$this->{STARTED_PRINTING} = 0;
|
||||
$this->{PROCESSED_THROUGH} = -1;
|
||||
|
||||
return $this;
|
||||
}
|
||||
|
||||
sub check_boundaries {
|
||||
my $this = shift;
|
||||
my ($time) = @_;
|
||||
if ($time < $this->{START_TIME}) {
|
||||
return $this->{START_TIME};
|
||||
}
|
||||
if ($time > $this->{END_TIME}) {
|
||||
return $this->{END_TIME};
|
||||
}
|
||||
return $time;
|
||||
}
|
||||
|
||||
sub add_event {
|
||||
my $this = shift;
|
||||
my ($event) = @_;
|
||||
# "Fix" the previous event if it ended after this one began
|
||||
if (defined($this->{EVENTS}) && scalar(@{$this->{EVENTS}})) {
|
||||
if ($this->{EVENTS}[@{$this->{EVENTS}} - 1]{status_time} >
|
||||
$event->{build_time}) {
|
||||
$this->{EVENTS}[@{$this->{EVENTS}} - 1]{status_time} = $event->{build_time};
|
||||
}
|
||||
}
|
||||
push @{$this->{EVENTS}}, $event;
|
||||
}
|
||||
|
||||
sub first_event_time {
|
||||
my $this = shift;
|
||||
my ($event) = @_;
|
||||
return $this->check_boundaries($this->{AT_START} ?
|
||||
$this->{EVENTS}[0]{build_time} :
|
||||
$this->{EVENTS}[0]{status_time});
|
||||
}
|
||||
|
||||
sub pop_first {
|
||||
my $this = shift;
|
||||
my $event = $this->{EVENTS}[0];
|
||||
if ($this->{AT_START}) {
|
||||
$this->{AT_START} = 0;
|
||||
return ($this->check_boundaries($event->{build_time}), [$event, 1], 1);
|
||||
} else {
|
||||
shift @{$this->{EVENTS}};
|
||||
$this->{AT_START} = 1;
|
||||
return ($this->check_boundaries($event->{status_time}), [$event, 0], 0);
|
||||
}
|
||||
}
|
||||
|
||||
sub is_empty {
|
||||
my $this = shift;
|
||||
return !defined($this->{EVENTS}) || !scalar(@{$this->{EVENTS}});
|
||||
}
|
||||
|
||||
sub column_header {
|
||||
my $this = shift;
|
||||
my ($rows, $column) = @_;
|
||||
# Get the status from the first column
|
||||
my $class = "";
|
||||
for (my $row=0; $row < @{$rows}; $row++) {
|
||||
my $col = $rows->[$row][$column];
|
||||
if (defined($col)) {
|
||||
for (my $i=@{$col} - 1; $i >= 0; $i--) {
|
||||
# Ignore "incomplete" status and pick up first complete status to show
|
||||
# state of entire tree
|
||||
if ($col->[$i][0]{status} >= 100 && $col->[$i][0]{status} < 300) {
|
||||
$class = " class=status" . $col->[$i][0]{status};
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return "<th rowspan=2$class>$this->{MACHINE_NAME} $this->{OS} $this->{OS_VERSION} @{[$this->{CLOBBER} ? 'Clbr' : 'Dep']}<br><a href='adminmachine.pl?machine_id=$this->{MACHINE_ID}'>Edit</a> | <a href='adminmachine.pl?action=kick_machine&machine_id=$this->{MACHINE_ID}'>Kick</a></th>";
|
||||
}
|
||||
|
||||
sub column_header_2 {
|
||||
return "";
|
||||
}
|
||||
|
||||
sub cell {
|
||||
my $this = shift;
|
||||
my ($rows, $row_num, $column) = @_;
|
||||
|
||||
my $cell = $rows->[$row_num][$column];
|
||||
|
||||
#
|
||||
# If this is the first time cell() has been called, we look for the real
|
||||
# starting row, and if it has an in-progress status, we move the end event
|
||||
# into the current cell so it shows continuous like it should.
|
||||
#
|
||||
if (!$this->{STARTED_PRINTING}) {
|
||||
if (!defined($cell)) {
|
||||
for (my $i = $row_num-1; $i >= 0; $i--) {
|
||||
if (defined($rows->[$i][$column])) {
|
||||
my $last_event = @{$rows->[$i][$column]} - 1;
|
||||
if ($rows->[$i][$column][$last_event][0]{status} < 100) {
|
||||
# Take the top event from that cell and put it in this one
|
||||
push @{$cell}, pop @{$rows->[$i][$column]};
|
||||
if (!@{$rows->[$i][$column]}) {
|
||||
$rows->[$i][$column] = undef;
|
||||
}
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
# XXX uncomment for debug
|
||||
if (defined($cell)) {
|
||||
# die if it is a start cell
|
||||
if ($cell->[@{$cell} - 1][1]) {
|
||||
die "Start cell without end cell found!";
|
||||
}
|
||||
}
|
||||
# XXX end debug
|
||||
|
||||
$this->{STARTED_PRINTING} = 1;
|
||||
}
|
||||
|
||||
#
|
||||
# Print the cell
|
||||
#
|
||||
if (defined($cell)) {
|
||||
#
|
||||
# If the last event in this cell is an end event, we print a td all the way
|
||||
# down to and including the corresponding start cell.
|
||||
#
|
||||
# XXX If there is a start/end/start[/end] situation, print the other
|
||||
# start/end as well
|
||||
#
|
||||
my $top_event_info = $cell->[@{$cell} - 1];
|
||||
my ($top_event, $top_is_start) = @{$top_event_info};
|
||||
my $retval = "";
|
||||
if (!$top_is_start) {
|
||||
# Search for the start tag (only need to search if the end tag is the only
|
||||
# one in this cell)
|
||||
my $rowspan;
|
||||
if (@{$cell} == 1) {
|
||||
my $i;
|
||||
for ($i = $row_num - 1; $i >= 0; $i--) {
|
||||
if (defined($rows->[$i][$column])) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
$rowspan = $row_num - $i + 1;
|
||||
# XXX uncomment to debug
|
||||
if ($i == -1) {
|
||||
die "End tag without start tag found!";
|
||||
}
|
||||
# XXX end debug
|
||||
} else {
|
||||
$rowspan = 1;
|
||||
}
|
||||
|
||||
$retval = "<td class='status$top_event->{status}'";
|
||||
$retval .= ($rowspan == 1 ? "" : " rowspan=$rowspan") . ">";
|
||||
|
||||
# Print "L" (log and add comment)
|
||||
{
|
||||
my $popup_str = <<EOM;
|
||||
<b>$this->{MACHINE_NAME}</b><br>
|
||||
<a href='showlog.pl?machine_id=$this->{MACHINE_ID}&logfile=$top_event->{logfile}'>Show Log</a><br>
|
||||
<a href='buildcomment.pl?tree=$this->{TREE}&machine_id=$this->{MACHINE_ID}&build_time=$top_event->{build_time}'>Add Comment</a>
|
||||
EOM
|
||||
$retval .= "<a href='showlog.pl?machine_id=$this->{MACHINE_ID}&logfile=$top_event->{logfile}' onclick='return do_popup(event, \"log\", \"" . escape_html(escape_js($popup_str)) . "\")'>L</a>\n";
|
||||
}
|
||||
|
||||
# Print comment star
|
||||
if (defined($top_event->{comments}) && @{$top_event->{comments}} > 0) {
|
||||
my $popup_str = "<strong>Comments</strong> (<a href='buildcomment.pl?tree=$this->{TREE}&machine_id=$this->{MACHINE_ID}&build_time=$top_event->{build_time}'>Add Comment</a>)<br>";
|
||||
foreach my $comment (sort { $b->[2] <=> $a->[2] } @{$top_event->{comments}}) {
|
||||
$popup_str .= "<a href='mailto:$comment->[0]'>$comment->[0]</a> - " . time2str("%H:%M", $comment->[2]) .
|
||||
"<br><p><code>$comment->[1]</code></p>";
|
||||
}
|
||||
|
||||
|
||||
$retval .= "<a href='#' onclick='return do_popup(event, \"comments\", \"" . escape_html(escape_js($popup_str)) . "\")'><img src='star.gif'></a>\n";
|
||||
}
|
||||
|
||||
$retval .= "<br>\n";
|
||||
|
||||
{
|
||||
my $build_time = ($top_event->{status_time} - $top_event->{build_time});
|
||||
my $build_time_str = "";
|
||||
if ($build_time > 60*60) {
|
||||
$build_time_str .= int($build_time / (60*60)) . "h";
|
||||
$build_time %= 60*60;
|
||||
}
|
||||
if ($build_time > 60) {
|
||||
$build_time_str .= int($build_time / 60) . "m";
|
||||
$build_time %= 60;
|
||||
}
|
||||
if (!$build_time_str) {
|
||||
$build_time_str = $build_time . "s";
|
||||
}
|
||||
$retval .= "<b>Time:</b> $build_time_str<br>\n";
|
||||
}
|
||||
$retval .= "<b>Status:</b> $top_event->{status}<br>\n";
|
||||
foreach my $field (@{$top_event->{fields}}) {
|
||||
my $processor = $this->{FIELD_PROCESSORS}{$field->[0]};
|
||||
$processor = "default" if !$processor;
|
||||
my $handler = $this->{FIELD_HANDLERS}{$processor};
|
||||
$retval .= $handler->process_field($this, $field->[0], $field->[1]);
|
||||
}
|
||||
$retval .= "</td>";
|
||||
|
||||
$this->{PROCESSED_THROUGH} = $row_num - $rowspan + 1;
|
||||
}
|
||||
|
||||
#
|
||||
# If there are multiple events in the cell and the first event is an end
|
||||
# event, we move it into the next cell so it will be printed there.
|
||||
#
|
||||
if (@{$cell} > 1 && !$cell->[0][1]) {
|
||||
# XXX uncomment to debug
|
||||
if ($row_num == 0) {
|
||||
die "End tag without start tag found!";
|
||||
}
|
||||
# XXX end debug
|
||||
push @{$rows->[$row_num-1][$column]}, shift @{$cell};
|
||||
}
|
||||
|
||||
return $retval;
|
||||
} elsif ($row_num < $this->{PROCESSED_THROUGH} ||
|
||||
$this->{PROCESSED_THROUGH} == -1) {
|
||||
# Print empty cell large enough to cover empty rows
|
||||
my $i;
|
||||
for ($i = $row_num-1; $i >= 0; $i--) {
|
||||
if (defined($rows->[$i][$column])) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
$this->{PROCESSED_THROUGH} = $i + 1;
|
||||
my $rowspan = (($row_num - $i) > 1) ? " rowspan=" . ($row_num - $i) : "";
|
||||
return "<td$rowspan></td>\n";
|
||||
}
|
||||
return "";
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Method to get a the TreeColumns objects for a tree
|
||||
#
|
||||
sub get_tree_column_queues {
|
||||
my ($p, $dbh, $start_time, $end_time, $tree, $field_short_names, $field_processors, $field_handlers, $patch_str) = @_;
|
||||
#
|
||||
# Get the list of machines
|
||||
#
|
||||
my $sth = $dbh->prepare("SELECT machine_id, machine_name, os, os_version, compiler, clobber, visible FROM tbox_machine WHERE tree_name = ?");
|
||||
$sth->execute($tree);
|
||||
|
||||
my %columns;
|
||||
while (my $row = $sth->fetchrow_arrayref) {
|
||||
$columns{$row->[0]} = new Tinderbox3::TreeColumns($start_time, $end_time, $tree, $field_short_names, $field_processors, $field_handlers, $patch_str, @{$row});
|
||||
}
|
||||
|
||||
if (!keys %columns) {
|
||||
return ();
|
||||
}
|
||||
|
||||
#
|
||||
# Dump the relevant events into the columns
|
||||
#
|
||||
$sth = $dbh->prepare(
|
||||
"SELECT b.machine_id, " . Tinderbox3::DB::sql_get_timestamp("b.build_time") . ",
|
||||
" . Tinderbox3::DB::sql_get_timestamp("b.status_time") . ", b.status, b.log
|
||||
FROM tbox_build b
|
||||
WHERE b.machine_id IN (" . join(", ", map { "?" } keys %columns) . ")
|
||||
AND b.status_time >= " . Tinderbox3::DB::sql_abstime("?") . "
|
||||
AND b.build_time <= " . Tinderbox3::DB::sql_abstime("?") . "
|
||||
ORDER BY b.build_time, b.machine_id");
|
||||
$sth->execute(keys %columns, $start_time, $end_time);
|
||||
while (my $build = $sth->fetchrow_arrayref) {
|
||||
my $machine_id = $build->[0];
|
||||
my $build_time = $build->[1];
|
||||
my $event = { build_time => $build->[1], status_time => $build->[2],
|
||||
status => $build->[3], logfile => $build->[4], fields => [] };
|
||||
|
||||
my $fields = $dbh->selectall_arrayref("SELECT name, value FROM tbox_build_field WHERE machine_id = ? AND build_time = " . Tinderbox3::DB::sql_abstime("?"), undef, $machine_id, $build_time);
|
||||
foreach my $field (@{$fields}) {
|
||||
push @{$event->{fields}}, [ $field->[0], $field->[1] ];
|
||||
}
|
||||
|
||||
my $comments = $dbh->selectall_arrayref("SELECT login, build_comment, " . Tinderbox3::DB::sql_get_timestamp("comment_time") . " FROM tbox_build_comment WHERE machine_id = ? AND build_time = " . Tinderbox3::DB::sql_abstime("?"), undef, $machine_id, $build_time);
|
||||
foreach my $comment (@{$comments}) {
|
||||
push @{$event->{comments}}, [ $comment->[0], $comment->[1], $comment->[2] ];
|
||||
}
|
||||
|
||||
$columns{$machine_id}->add_event($event);
|
||||
}
|
||||
|
||||
return sort { $a->{MACHINE_NAME} cmp $b->{MACHINE_NAME} } (map { defined($_->{EVENTS}) ? ($_) : () } values %columns);
|
||||
}
|
||||
|
||||
|
||||
1
|
||||
@ -1,34 +0,0 @@
|
||||
package Tinderbox3::Util;
|
||||
|
||||
use strict;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(escape_html escape_js escape_url);
|
||||
|
||||
sub escape_html {
|
||||
my ($str) = @_;
|
||||
$str =~ s/>/>/g;
|
||||
$str =~ s/</</g;
|
||||
$str =~ s/'/'/g;
|
||||
$str =~ s/"/"/g;
|
||||
die if $str =~ /\n/;
|
||||
return $str;
|
||||
}
|
||||
|
||||
sub escape_js {
|
||||
my ($str) = @_;
|
||||
$str =~ s/(['"\\])/\\$1/g;
|
||||
$str =~ s/(\r?)\n/\\n/g;
|
||||
return $str;
|
||||
}
|
||||
|
||||
sub escape_url {
|
||||
my ($str) = @_;
|
||||
$str =~ s/ /+/g;
|
||||
$str =~ s/([%&])/sprintf('%%%x', ord($1))/eg;
|
||||
return $str;
|
||||
}
|
||||
|
||||
|
||||
1
|
||||
@ -1,18 +0,0 @@
|
||||
package Tinderbox3::XML;
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(die_xml_error);
|
||||
|
||||
sub die_xml_error {
|
||||
my ($p, $dbh, $error) = @_;
|
||||
print $p->header("text/xml");
|
||||
print "<error>", $p->escapeHTML($error), "</error>\n";
|
||||
$dbh->disconnect;
|
||||
exit(0);
|
||||
}
|
||||
|
||||
1
|
||||
@ -1,31 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
header($p, $login, $cookie, "Administrate Tinderbox");
|
||||
|
||||
print "<table class=editlist><tr><th>Trees</th></tr>\n";
|
||||
my $sth = $dbh->prepare("SELECT tree_name FROM tbox_tree");
|
||||
$sth->execute();
|
||||
while (my $tree_info = $sth->fetchrow_arrayref()) {
|
||||
my $tree = $tree_info->[0];
|
||||
my @actions;
|
||||
push @actions, "<a href='sheriff.pl?tree=$tree'>Sheriff</a>";
|
||||
push @actions, "<a href='admintree.pl?tree=$tree'>Edit</a>";
|
||||
push @actions, "<a href='showbuilds.pl?tree=$tree'>View</a>";
|
||||
print "<tr><td><a href='showbuilds.pl?tree=$tree'>$tree</a> (" . join(' | ', @actions) . ")</td></tr>\n";
|
||||
}
|
||||
|
||||
print "<tr><td><a href='admintree.pl'>Add Tree</a></td></tr>\n";
|
||||
print "</table>\n";
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,70 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
use strict;
|
||||
|
||||
#
|
||||
# Init
|
||||
#
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
|
||||
# For edit_bonsai
|
||||
my ($tree, $bonsai_id) = Tinderbox3::DB::update_bonsai_action($p, $dbh, $login);
|
||||
my ($display_name, $bonsai_url, $module, $branch, $directory, $cvsroot);
|
||||
# Get bonsai info from DB
|
||||
if ($bonsai_id) {
|
||||
my $bonsai_info = $dbh->selectrow_arrayref("SELECT tree_name, display_name, bonsai_url, module, branch, directory, cvsroot FROM tbox_bonsai WHERE bonsai_id = ?", undef, $bonsai_id);
|
||||
if (!defined($bonsai_info)) {
|
||||
die "Could not get bonsai info!";
|
||||
}
|
||||
($tree, $display_name, $bonsai_url, $module, $branch, $directory, $cvsroot) = @{$bonsai_info};
|
||||
} else {
|
||||
($display_name, $bonsai_url, $module, $branch, $directory, $cvsroot) = (
|
||||
$Tinderbox3::InitialValues::display_name,
|
||||
$Tinderbox3::InitialValues::bonsai_url,
|
||||
$Tinderbox3::InitialValues::module,
|
||||
$Tinderbox3::InitialValues::branch,
|
||||
$Tinderbox3::InitialValues::directory,
|
||||
$Tinderbox3::InitialValues::cvsroot);
|
||||
}
|
||||
|
||||
header($p, $login, $cookie, "Edit Bonsai $display_name", $tree);
|
||||
|
||||
#
|
||||
# Edit bonsai form
|
||||
#
|
||||
|
||||
print <<EOM;
|
||||
<form name=editform method=get action='adminbonsai.pl'>
|
||||
<input type=hidden name=action value='edit_bonsai'>
|
||||
<input type=hidden name=tree value='$tree'>
|
||||
<input type=hidden name=bonsai_id value='$bonsai_id'>
|
||||
<table>
|
||||
<tr><th>Display Name:</th><td>@{[$p->textfield(-name=>'display_name', -default=>$display_name)]}</td></tr>
|
||||
<tr><th>Bonsai URL:</th><td>@{[$p->textfield(-name=>'bonsai_url', -default=>$bonsai_url)]}</td></tr>
|
||||
<tr><th>Module:</th><td>@{[$p->textfield(-name=>'module', -default=>$module)]}</td></tr>
|
||||
<tr><th>Branch:</th><td>@{[$p->textfield(-name=>'branch', -default=>$branch)]}</td></tr>
|
||||
<tr><th>Directories (comma separated):</th><td>@{[$p->textfield(-name=>'directory', -default=>$directory)]}</td></tr>
|
||||
<tr><th>cvsroot (hidden parameter in Bonsai):</th><td>@{[$p->textfield(-name=>'cvsroot', -default=>$cvsroot)]}</td></th></tr>
|
||||
</table>
|
||||
<b>PLEASE NOTE that pressing submit will clear the Bonsai cache for this tree. This is not disastrous by any means, but don't submit unless you are actually changing or adding this tree.</p>
|
||||
EOM
|
||||
|
||||
if (!$login) {
|
||||
print login_fields();
|
||||
}
|
||||
|
||||
print <<EOM;
|
||||
<input type=submit>
|
||||
</form>
|
||||
EOM
|
||||
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,93 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
use strict;
|
||||
|
||||
#
|
||||
# Init
|
||||
#
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
|
||||
my $tree = $p->param('tree') || "";
|
||||
|
||||
# For edit_machine
|
||||
my $machine_id = Tinderbox3::DB::update_machine_action($p, $dbh, $login);
|
||||
|
||||
# Get patch from DB
|
||||
my $machine_info = $dbh->selectrow_arrayref("SELECT tree_name, machine_name, os, os_version, compiler, clobber, commands, visible FROM tbox_machine WHERE machine_id = ?", undef, $machine_id);
|
||||
if (!defined($machine_info)) {
|
||||
die "Could not get machine!";
|
||||
}
|
||||
my ($machine_name, $os, $os_version, $compiler, $clobber, $commands, $visible);
|
||||
($tree, $machine_name, $os, $os_version, $compiler, $clobber, $commands, $visible) = @{$machine_info};
|
||||
|
||||
my %machine_config;
|
||||
my $sth = $dbh->prepare("SELECT name, value FROM tbox_machine_config WHERE machine_id = ? ORDER BY name");
|
||||
$sth->execute($machine_id);
|
||||
while (my $row = $sth->fetchrow_arrayref) {
|
||||
$machine_config{$row->[0]} = $row->[1];
|
||||
}
|
||||
|
||||
header($p, $login, $cookie, "Edit Machine $machine_name", $tree, $machine_id, $machine_name);
|
||||
|
||||
#
|
||||
# Edit patch form
|
||||
#
|
||||
|
||||
print <<EOM;
|
||||
<form name=editform method=get action='adminmachine.pl'>
|
||||
<input type=hidden name=action value='edit_machine'>
|
||||
@{[$p->hidden(-name=>'tree', -default=>$tree)]}
|
||||
@{[$p->hidden(-name=>'machine_id', -default=>$machine_id)]}
|
||||
<table>
|
||||
<tr><th>Machine Name:</th><td>@{[$p->escapeHTML($machine_name)]}</td></tr>
|
||||
<tr><th>OS:</th><td>@{[$p->escapeHTML("$os $os_version")]}</td></tr>
|
||||
<tr><th>Compiler:</th><td>@{[$p->escapeHTML($compiler)]}</td></tr>
|
||||
<tr><th>Clobber:</th><td>@{[$clobber ? 'Clobber' : 'Depend']}</td></tr>
|
||||
<tr><th>Commands</th><td>@{[$p->textfield(-name=>'commands', -default=>$commands)]}</td></tr>
|
||||
<tr><th>Visible:</th><td><input type=checkbox name=visible@{[$visible ? " checked" : ""]}><td></tr>
|
||||
</table>
|
||||
|
||||
<strong>.mozconfig (set to blank to use default):</strong><br>
|
||||
<input type=hidden name=machine_config0 value=mozconfig>
|
||||
@{[$p->textarea(-name=>'machine_config0_val', -default=>$machine_config{mozconfig}, -rows=>5,
|
||||
-columns=>100)]}<br>
|
||||
EOM
|
||||
|
||||
print "<p><strong>Machine Config:</strong><br>";
|
||||
print "(Empty a line to use default for tree)<br>";
|
||||
print "<table><tr><th>Var</th><th>Value</th></tr>\n";
|
||||
my $config_num = 1;
|
||||
foreach my $var (sort keys %machine_config) {
|
||||
my $value = $machine_config{$var};
|
||||
if ($var ne "mozconfig") {
|
||||
print "<tr><td>", $p->textfield(-name=>"machine_config$config_num", -default=>$var, -override=>1), "</td>";
|
||||
print "<td>", $p->textfield(-name=>"machine_config${config_num}_val", -default=>$value, -override=>1), "</td></tr>\n";
|
||||
$config_num++;
|
||||
}
|
||||
}
|
||||
foreach my $i ($config_num..($config_num+2)) {
|
||||
print "<tr><td>", $p->textfield(-name=>"machine_config$i", -override=>1), "</td>";
|
||||
print "<td>", $p->textfield(-name=>"machine_config${i}_val", -override=>1), "</td></tr>\n";
|
||||
}
|
||||
print "</table></p>\n";
|
||||
|
||||
if (!$login) {
|
||||
print login_fields();
|
||||
}
|
||||
|
||||
print <<EOM;
|
||||
<input type=submit>
|
||||
</form>
|
||||
<form action='admintree.pl'>@{[$p->hidden(-name => 'tree', -default => $tree, -override => 1)]}@{[$p->hidden(-name => 'action', -default => 'delete_machine', -override => 1)]}@{[$p->hidden(-name => 'machine_id', -default => $machine_id, -override => 1)]}<input type=submit value='DELETE this machine and ALL logs associated with it' onclick='return confirm("Dude. Seriously, this will wipe out all the logs and fields and everything associated with this machine. Think hard here.\\n\\nDo you really want to do this?")'>
|
||||
</form>
|
||||
EOM
|
||||
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,61 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
use strict;
|
||||
|
||||
#
|
||||
# Init
|
||||
#
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
|
||||
# For edit_patch
|
||||
my $patch_id = Tinderbox3::DB::update_patch_action($p, $dbh, $login);
|
||||
# Get patch from DB
|
||||
my $patch_info = $dbh->selectrow_arrayref("SELECT tree_name, patch_name, patch_ref, patch, in_use FROM tbox_patch WHERE patch_id = ?", undef, $patch_id);
|
||||
if (!defined($patch_info)) {
|
||||
die "Could not get patch!";
|
||||
}
|
||||
my ($tree, $patch_name, $patch_ref, $patch, $in_use) = @{$patch_info};
|
||||
my $bug_id;
|
||||
if ($patch_ref =~ /Bug\s+(.*)/) {
|
||||
$bug_id = $1;
|
||||
}
|
||||
|
||||
header($p, $login, $cookie, "Edit Patch $patch_name", $tree);
|
||||
|
||||
#
|
||||
# Edit patch form
|
||||
#
|
||||
|
||||
print <<EOM;
|
||||
<form name=editform method=get action='adminpatch.pl'>
|
||||
<input type=hidden name=action value='edit_patch'>
|
||||
<input type=hidden name=patch_id value='$patch_id'>
|
||||
<table>
|
||||
<tr><th>Patch Name (just for display):</th><td>@{[$p->textfield(-name=>'patch_name', -default=>$patch_name)]}</td></tr>
|
||||
<tr><th>Bug #:</th><td>@{[$p->textfield(-name=>'bug_id', -default=>$bug_id)]}</td></tr>
|
||||
<tr><th>In Use:</th><td><input type=checkbox name=in_use@{[$in_use ? ' checked' : '']}></td></tr>
|
||||
</table>
|
||||
EOM
|
||||
|
||||
if (!$login) {
|
||||
print login_fields();
|
||||
}
|
||||
|
||||
print <<EOM;
|
||||
<input type=submit>
|
||||
</form>
|
||||
<hr>
|
||||
<PRE>
|
||||
$patch
|
||||
</PRE>
|
||||
EOM
|
||||
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,156 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::InitialValues;
|
||||
use Tinderbox3::Login;
|
||||
use strict;
|
||||
|
||||
#
|
||||
# Init
|
||||
#
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
|
||||
# For delete_machine
|
||||
Tinderbox3::DB::update_machine_action($p, $dbh, $login);
|
||||
# For delete_patch, stop_using_patch
|
||||
Tinderbox3::DB::update_patch_action($p, $dbh, $login);
|
||||
# For delete_bonsai
|
||||
Tinderbox3::DB::update_bonsai_action($p, $dbh, $login);
|
||||
# For edit_tree
|
||||
my $tree = Tinderbox3::DB::update_tree_action($p, $dbh, $login);
|
||||
|
||||
#
|
||||
# Get the tree info to fill in the fields
|
||||
#
|
||||
my $tree_info;
|
||||
my %initial_machine_config;
|
||||
if (!$tree) {
|
||||
$tree_info = [ $Tinderbox3::InitialValues::field_short_names,
|
||||
$Tinderbox3::InitialValues::field_processors,
|
||||
$Tinderbox3::InitialValues::statuses,
|
||||
$Tinderbox3::InitialValues::min_row_size,
|
||||
$Tinderbox3::InitialValues::max_row_size,
|
||||
$Tinderbox3::InitialValues::default_tinderbox_view,
|
||||
Tinderbox3::DB::sql_get_bool($Tinderbox3::InitialValues::new_machines_visible),
|
||||
'',
|
||||
];
|
||||
%initial_machine_config = %Tinderbox3::InitialValues::initial_machine_config;
|
||||
} else {
|
||||
$tree_info = $dbh->selectrow_arrayref("SELECT field_short_names, field_processors, statuses, min_row_size, max_row_size, default_tinderbox_view, new_machines_visible, editors FROM tbox_tree WHERE tree_name = ?", undef, $tree);
|
||||
if (!defined($tree_info)) {
|
||||
die "Could not get tree!";
|
||||
}
|
||||
|
||||
my $sth = $dbh->prepare("SELECT name, value FROM tbox_initial_machine_config WHERE tree_name = ?");
|
||||
$sth->execute($tree);
|
||||
while (my $row = $sth->fetchrow_arrayref) {
|
||||
$initial_machine_config{$row->[0]} = $row->[1];
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Edit / Add tree form
|
||||
#
|
||||
header($p, $login, $cookie, ($tree ? "Edit $tree" : "Add Tree"), $tree);
|
||||
|
||||
print <<EOM;
|
||||
<form name=editform method=get action='admintree.pl'>
|
||||
<input type=hidden name=action value='edit_tree'>
|
||||
@{[$p->hidden(-name=>'tree', -default=>$tree, -override=>1)]}
|
||||
<table>
|
||||
<tr><th>Tree Name (this is the name used to identify the tree):</th><td>@{[$p->textfield(-name=>'tree_name', -default=>$tree)]}</td></tr>
|
||||
<tr><th>Status Short Names (bloat=Bl,pageload=Tp...)</th><td>@{[$p->textfield(-name=>'field_short_names', -default=>$tree_info->[0], -size=>80)]}</td></tr>
|
||||
<tr><th>Status Handlers (bloat=Graph,binary_url=URL...)</th><td>@{[$p->textfield(-name=>'field_processors', -default=>$tree_info->[1], -size=>80)]}</td></tr>
|
||||
<tr><th>Tree Statuses (open,closed...)</th><td>@{[$p->textfield(-name=>'statuses', -default=>$tree_info->[2], -size=>80)]}</td></tr>
|
||||
<tr><th>Min Row Size (minutes)</th><td>@{[$p->textfield(-name=>'min_row_size', -default=>$tree_info->[3])]}</td></tr>
|
||||
<tr><th>Max Row Size (minutes)</th><td>@{[$p->textfield(-name=>'max_row_size', -default=>$tree_info->[4])]}</td></tr>
|
||||
<tr><th>Tinderbox Page Size (minutes)</th><td>@{[$p->textfield(-name=>'default_tinderbox_view', -default=>$tree_info->[5])]}</td></tr>
|
||||
<tr><th>New Machines Visible By Default?</th><td><input type=checkbox name=new_machines_visible@{[$tree_info->[6] ? ' checked' : '']}></td></tr>
|
||||
<tr><th>Editor Privileges (list of emails)</th><td>@{[$p->textfield(-name=>'editors', -default=>$tree_info->[7])]}</td></tr>
|
||||
</table>
|
||||
<p><strong>Initial .mozconfig:</strong><br>
|
||||
<input type=hidden name=initial_machine_config0 value=mozconfig>
|
||||
@{[$p->textarea(-name=>'initial_machine_config0_val', -default=>$initial_machine_config{mozconfig}, -rows=>5, -columns => 100)]}</p>
|
||||
EOM
|
||||
|
||||
print "<p><strong>Initial Machine Config:</strong><br>";
|
||||
print "(Empty a line to delete it)<br>";
|
||||
print "<table><tr><th>Var</th><th>Value</th></tr>\n";
|
||||
my $config_num = 1;
|
||||
foreach my $var (sort keys %initial_machine_config) {
|
||||
my $value = $initial_machine_config{$var};
|
||||
if ($var ne "mozconfig") {
|
||||
print "<tr><td>", $p->textfield(-name=>"initial_machine_config$config_num", -default=>$var, -override=>1), "</td>";
|
||||
print "<td>", $p->textfield(-name=>"initial_machine_config${config_num}_val", -default=>$value, -override=>1), "</td></tr>\n";
|
||||
$config_num++;
|
||||
}
|
||||
}
|
||||
foreach my $i ($config_num..($config_num+2)) {
|
||||
print "<tr><td>", $p->textfield(-name=>"initial_machine_config$i", -override=>1), "</td>";
|
||||
print "<td>", $p->textfield(-name=>"initial_machine_config${i}_val", -override=>1), "</td></tr>\n";
|
||||
}
|
||||
print "</table></p>\n";
|
||||
|
||||
if (!$login) {
|
||||
print login_fields();
|
||||
}
|
||||
|
||||
print <<EOM;
|
||||
<input type=submit>
|
||||
</form>
|
||||
EOM
|
||||
|
||||
#
|
||||
# If it's not new, have a list of patches and machines
|
||||
#
|
||||
if ($tree) {
|
||||
# Patch list
|
||||
print "<table class=editlist><tr><th>Patches</th></tr>\n";
|
||||
my $sth = $dbh->prepare('SELECT patch_id, patch_name, in_use FROM tbox_patch WHERE tree_name = ? ORDER BY patch_name');
|
||||
$sth->execute($tree);
|
||||
while (my $patch_info = $sth->fetchrow_arrayref) {
|
||||
my ($patch_class, $action, $action_name);
|
||||
if ($patch_info->[2]) {
|
||||
$patch_class = "";
|
||||
$action = "stop_using_patch";
|
||||
$action_name = "Obsolete";
|
||||
} else {
|
||||
$patch_class = " class=obsolete";
|
||||
$action = "start_using_patch";
|
||||
$action_name = "Resurrect";
|
||||
}
|
||||
print "<tr><td><a href='adminpatch.pl?patch_id=$patch_info->[0]'$patch_class>$patch_info->[1]</a> (<a href='admintree.pl?tree=$tree&action=delete_patch&patch_id=$patch_info->[0]'>Del</a> | <a href='admintree.pl?tree=$tree&action=$action&patch_id=$patch_info->[0]'>$action_name</a>)</td>\n";
|
||||
}
|
||||
print "<tr><td><a href='uploadpatch.pl?tree=$tree'>Upload Patch</a></td></tr>\n";
|
||||
print "</table>\n";
|
||||
|
||||
# Machine list
|
||||
print "<table class=editlist><tr><th>Machines</th></tr>\n";
|
||||
$sth = $dbh->prepare('SELECT machine_id, machine_name FROM tbox_machine WHERE tree_name = ? ORDER BY machine_name');
|
||||
$sth->execute($tree);
|
||||
while (my $machine_info = $sth->fetchrow_arrayref) {
|
||||
print "<tr><td><a href='adminmachine.pl?tree=$tree&machine_id=$machine_info->[0]'>$machine_info->[1]</a></td>\n";
|
||||
}
|
||||
# XXX Add this feature in if you decide not to automatically allow machines
|
||||
# into the federation
|
||||
# print "<tr><td><a href='adminmachine.pl?tree=$tree'>New Machine</a></td></tr>\n";
|
||||
print "</table>\n";
|
||||
|
||||
# Machine list
|
||||
print "<table class=editlist><tr><th>Bonsai Monitors</th></tr>\n";
|
||||
$sth = $dbh->prepare('SELECT bonsai_id, display_name FROM tbox_bonsai WHERE tree_name = ? ORDER BY display_name');
|
||||
$sth->execute($tree);
|
||||
while (my $bonsai_info = $sth->fetchrow_arrayref) {
|
||||
print "<tr><td><a href='adminbonsai.pl?tree=$tree&bonsai_id=$bonsai_info->[0]'>$bonsai_info->[1]</a> (<a href='admintree.pl?tree=$tree&action=delete_bonsai&bonsai_id=$bonsai_info->[0]'>Del</a>)</td>\n";
|
||||
}
|
||||
print "<tr><td><a href='adminbonsai.pl?tree=$tree'>New Bonsai</a></td></tr>\n";
|
||||
print "</table>\n";
|
||||
}
|
||||
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,48 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
header($p, $login, $cookie, "Add Comments");
|
||||
|
||||
my $machine_id = $p->param('machine_id');
|
||||
$machine_id =~ s/\D//g;
|
||||
|
||||
my $build_time = $p->param('build_time');
|
||||
$build_time =~ s/\D//g;
|
||||
|
||||
my $tree = $p->param('tree');
|
||||
|
||||
print qq^<form action='savecomment.pl'>
|
||||
@{[$p->hidden(-name=>'tree', -default=>$tree)]}
|
||||
<input type=hidden name=machine_id value='$machine_id'>
|
||||
<input type=hidden name=build_time value='$build_time'>
|
||||
<p>
|
||||
^;
|
||||
if (!$login) {
|
||||
print login_fields(), "<br>\n";;
|
||||
} else {
|
||||
print "<strong>Email:</strong> " . $login . "<br>\n";
|
||||
}
|
||||
print "<textarea name=build_comment rows=10 cols=30></textarea><br>\n";
|
||||
print "<input type=submit>\n</p>\n";
|
||||
|
||||
print "<p>Other builds to add comment to (will be added to most recent cycle):</p>\n";
|
||||
my $sth = $dbh->prepare("SELECT machine_id, machine_name FROM tbox_machine WHERE tree_name = ? AND visible");
|
||||
$sth->execute($tree);
|
||||
while (my $row = $sth->fetchrow_arrayref()) {
|
||||
next if $row->[0] == $machine_id;
|
||||
print "<input type=checkbox name=other_machine_id value='$row->[0]'> $row->[1]\n";
|
||||
}
|
||||
|
||||
print "</form>\n";
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,27 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use CGI;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::XML;
|
||||
my $p = new CGI();
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my $patch_id = $p->param('patch_id') || "";
|
||||
if (!$patch_id) {
|
||||
die_xml_error($p, $dbh, "Must specify patch id!");
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Get data for response
|
||||
#
|
||||
my $patch = $dbh->selectrow_arrayref("SELECT patch FROM tbox_patch WHERE patch_id = ?", undef, $patch_id);
|
||||
if (!defined($patch)) {
|
||||
die_xml_error($p, $dbh, "Could not get tree!");
|
||||
}
|
||||
|
||||
print $p->header("text/plain");
|
||||
|
||||
print $patch->[0];
|
||||
|
||||
$dbh->disconnect;
|
||||
@ -1,20 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
header($p, $login, $cookie, "Login");
|
||||
|
||||
print "<form action='admin.pl'>\n";
|
||||
print login_fields();
|
||||
print "<input type=submit></form>\n";
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,50 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
header($p, $login, $cookie, "Saved Comments");
|
||||
|
||||
my $machine_id = $p->param('machine_id');
|
||||
$machine_id =~ s/\D//g;
|
||||
|
||||
my $build_time = $p->param('build_time');
|
||||
$build_time =~ s/\D//g;
|
||||
|
||||
my $tree = $p->param('tree') || "";
|
||||
my $build_comment = $p->param('build_comment') || "";
|
||||
|
||||
if (!$build_comment) {
|
||||
die "Must enter a comment!";
|
||||
}
|
||||
|
||||
if (!$login) {
|
||||
die "Must log in!";
|
||||
}
|
||||
|
||||
# XXX For odd reasons, DBI doesn't want to make build_time an integer and
|
||||
# Postgres don't like that, so we put it directly into the SQL statement and
|
||||
# are subsequently unable to reuse the statement :(
|
||||
my $sth = $dbh->prepare("INSERT INTO tbox_build_comment (machine_id, build_time, login, build_comment, comment_time) VALUES (?, " . Tinderbox3::DB::sql_abstime("?") . ", ?, ?, " . Tinderbox3::DB::sql_current_timestamp() . ")");
|
||||
$sth->execute($machine_id, $build_time, $login, $build_comment);
|
||||
|
||||
foreach my $other_machine_id ($p->param('other_machine_id')) {
|
||||
my $other_build_time = $dbh->selectrow_arrayref("SELECT " . Tinderbox3::DB::sql_get_timestamp('build_time') . " FROM tbox_build WHERE machine_id = ? ORDER BY build_time DESC LIMIT 1", undef, $other_machine_id);
|
||||
if (defined($other_build_time)) {
|
||||
$sth->execute($other_machine_id, $other_build_time->[0], $login, $build_comment);
|
||||
}
|
||||
}
|
||||
|
||||
Tinderbox3::DB::maybe_commit($dbh);
|
||||
|
||||
print "<p>Comments added. Thank you for playing. <a href='showbuilds.pl?tree=$tree'>View Tree</a></p>\n";
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,64 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
use strict;
|
||||
|
||||
#
|
||||
# Init
|
||||
#
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
|
||||
# For edit_sheriff
|
||||
my $tree = Tinderbox3::DB::update_tree_action($p, $dbh, $login);
|
||||
# Get sheriff tree info from DB
|
||||
my $tree_info = $dbh->selectrow_arrayref("SELECT header, footer, special_message, sheriff, build_engineer, status, statuses, sheriffs FROM tbox_tree WHERE tree_name = ?", undef, $tree);
|
||||
if (!defined($tree_info)) {
|
||||
die "Could not get tree!";
|
||||
}
|
||||
|
||||
my ($header, $footer, $special_message, $sheriff, $build_engineer, $status, $statuses, $sheriffs) = @{$tree_info};
|
||||
|
||||
header($p, $login, $cookie, "Sheriff $tree", $tree);
|
||||
|
||||
#
|
||||
# Edit patch form
|
||||
#
|
||||
|
||||
print <<EOM;
|
||||
<form name=editform method=post action='sheriff.pl'>
|
||||
<input type=hidden name=action value='edit_sheriff'>
|
||||
@{[$p->hidden(-name=>'tree', -default=>$tree)]}
|
||||
<strong>Status:</strong> @{[$p->popup_menu(-name=>'status', -values=>[split /,/, $statuses], -default=>$status)]}<br>
|
||||
<strong>Special Message:</strong><br>
|
||||
@{[$p->textarea(-name=>'special_message', -default=>$special_message,
|
||||
-rows=>5, -columns=>100)]}<br>
|
||||
<strong>Sheriff:</strong><br>
|
||||
@{[$p->textfield(-name=>'sheriff', -default=>$sheriff, -size=>100)]}<br>
|
||||
<strong>Build Engineer</strong><br>
|
||||
@{[$p->textfield(-name=>'build_engineer', -default=>$build_engineer,
|
||||
-size=>100)]}<br>
|
||||
<strong>Sheriff Privileges (comma separated list of emails):</strong><br>
|
||||
@{[$p->textfield(-name=>'sheriffs', -default=>$sheriffs, -size=>100)]}<br>
|
||||
<strong>Header:</strong><br>
|
||||
@{[$p->textarea(-name=>'header', -default=>$header, -rows=>15, -columns=>100)]}<br>
|
||||
<strong>Footer</strong><br>
|
||||
@{[$p->textarea(-name=>'footer', -default=>$footer, -rows=>5, -columns=>100)]}<br>
|
||||
EOM
|
||||
|
||||
if (!$login) {
|
||||
print login_fields();
|
||||
}
|
||||
|
||||
print <<EOM;
|
||||
<input type=submit>
|
||||
</form>
|
||||
EOM
|
||||
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,34 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::ShowBuilds;
|
||||
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my $tree = $p->param('tree') || "";
|
||||
my ($start_time, $end_time);
|
||||
if ($p->param('start_time')) {
|
||||
$start_time = $p->param('start_time');
|
||||
if ($start_time > time) {
|
||||
$start_time = time;
|
||||
}
|
||||
$end_time = $start_time + ($p->param('interval') || (24*60*60));
|
||||
if ($end_time > time) {
|
||||
$end_time = time;
|
||||
}
|
||||
} else {
|
||||
$end_time = time;
|
||||
$start_time = $end_time - 24*60*60;
|
||||
}
|
||||
|
||||
my $min_row_size = $p->param('min_row_size');
|
||||
my $max_row_size = $p->param('max_row_size');
|
||||
|
||||
print $p->header;
|
||||
Tinderbox3::ShowBuilds::print_showbuilds($p, $dbh, *STDOUT, $tree, $start_time,
|
||||
$end_time, $min_row_size, $max_row_size);
|
||||
|
||||
$dbh->disconnect;
|
||||
@ -1,168 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use strict;
|
||||
use Fcntl qw/:seek/;
|
||||
use CGI;
|
||||
use CGI::Carp qw(fatalsToBrowser);
|
||||
use Tinderbox3::Log;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::Login;
|
||||
use Tinderbox3::DB;
|
||||
|
||||
my $p = new CGI;
|
||||
my $machine_id = $p->param('machine_id') || "";
|
||||
my $logfile = $p->param('logfile') || "";
|
||||
|
||||
# Detaint machine id / logfile
|
||||
$machine_id =~ /^(\d+)$/s;
|
||||
$machine_id = $1;
|
||||
$logfile =~ /^(\d+\.log)$/s;
|
||||
$logfile = $1;
|
||||
|
||||
|
||||
if (!$machine_id || !$logfile) {
|
||||
die "Must specify machine_id and logfile!";
|
||||
}
|
||||
|
||||
my $log_fh = get_log_fh($machine_id, $logfile, "<");
|
||||
if (!defined($log_fh)) {
|
||||
die "No such log found!";
|
||||
}
|
||||
|
||||
if ($p->param('format') && $p->param('format') eq 'raw') {
|
||||
print $p->header("text/plain");
|
||||
while (<$log_fh>) {
|
||||
print;
|
||||
}
|
||||
close $log_fh;
|
||||
} else {
|
||||
if (!$p->param('page') && !$p->param('format')) {
|
||||
$p->param('format', 'summary');
|
||||
}
|
||||
my $dbh = get_dbh();
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
my $bytes_per_page = 100 * 1024;
|
||||
my @log_stat = stat($log_fh);
|
||||
my $log_size = $log_stat[7];
|
||||
my $num_pages = int($log_size / $bytes_per_page) + 1;
|
||||
my $page;
|
||||
if (!$p->param('format') || $p->param('format') ne 'summary') {
|
||||
$page = $p->param('page');
|
||||
}
|
||||
if (!$page || $p->param('page') !~ /^\d+$/ || $page > $num_pages) {
|
||||
$page = $num_pages;
|
||||
}
|
||||
my $title;
|
||||
if ($p->param('format') && $p->param('format') eq 'summary') {
|
||||
$title = "Summary";
|
||||
} else {
|
||||
$title = "Page $page";
|
||||
}
|
||||
|
||||
#
|
||||
# Print the header
|
||||
#
|
||||
my $machine_info = $dbh->selectrow_arrayref("SELECT tree_name, machine_name FROM tbox_machine WHERE machine_id = ?", undef, $machine_id);
|
||||
my ($tree, $machine_name) = @{$machine_info};
|
||||
header($p, $login, $cookie, "Log $logfile - $title", $tree, $machine_id, $machine_name);
|
||||
|
||||
# Print the header links
|
||||
my $pages_per_line = 15;
|
||||
{
|
||||
my $num_kbytes = int($log_size / 1024) + 1;
|
||||
my $q = new CGI($p);
|
||||
$q->delete('page');
|
||||
$q->param('format', 'raw');
|
||||
my $q2 = new CGI($p);
|
||||
$q2->delete('page');
|
||||
$q2->param('format', 'summary');
|
||||
print "<table align=center style='border: 1px solid black'><tr><th style='border-bottom: 1px solid black' colspan=$pages_per_line>$title<br><a href='showlog.pl?" . $q2->query_string() . "'>Summary</a> - <a href='showlog.pl?" . $q->query_string() . "'>Raw Log</a> (${num_kbytes}K)</th></tr>\n";
|
||||
}
|
||||
|
||||
# Print the page links
|
||||
foreach my $i (1..$num_pages) {
|
||||
if (($i % $pages_per_line) == 1) {
|
||||
print "<tr>\n";
|
||||
}
|
||||
print "<td>";
|
||||
if ($title eq "Summary" || $i ne $page) {
|
||||
$p->delete('format');
|
||||
$p->param('page', $i);
|
||||
print "<a href='showlog.pl?" . $p->query_string() . "'>";
|
||||
}
|
||||
print $i;
|
||||
if ($title eq "Summary" || $i ne $page) {
|
||||
print "</a>";
|
||||
}
|
||||
print "</td>\n";
|
||||
if (($i % $pages_per_line) == 0) {
|
||||
print "</tr>\n";
|
||||
}
|
||||
}
|
||||
print "</table></p>\n";
|
||||
|
||||
#
|
||||
# Print the log summary
|
||||
#
|
||||
if ($title eq "Summary") {
|
||||
print "<h3>Event Summary</h3>\n";
|
||||
print "<pre>\n";
|
||||
my $tab = 0;
|
||||
my $pos;
|
||||
my $max_page_size = length($num_pages);
|
||||
my $last_page = -1;
|
||||
while (($pos = tell($log_fh)) != -1 && ($_ = readline($log_fh))) {
|
||||
if (/^<---/) {
|
||||
$tab--;
|
||||
}
|
||||
if (/^--->/ || /^<---/) {
|
||||
my $text_page = int($pos / $bytes_per_page) + 1;
|
||||
if ($text_page != $last_page) {
|
||||
$last_page = $text_page;
|
||||
my $q = new CGI($p);
|
||||
$q->delete('format');
|
||||
$q->param('page', $text_page);
|
||||
my $query_string = $q->query_string();
|
||||
|
||||
print "<a href='showlog.pl?$query_string'>p.", sprintf("%-${max_page_size}s", $text_page), "</a> ";
|
||||
} else {
|
||||
print " " x ($max_page_size+3);
|
||||
}
|
||||
print " " x ($tab*5);
|
||||
print;
|
||||
}
|
||||
if (/^--->/ && !/<---$/) {
|
||||
$tab++;
|
||||
}
|
||||
}
|
||||
print "</pre>\n";
|
||||
print "<h3>Last Page - Page $page</h3>\n";
|
||||
}
|
||||
|
||||
#
|
||||
# Print the log
|
||||
#
|
||||
|
||||
# Go to the right place in the log
|
||||
seek($log_fh, ($page - 1) * $bytes_per_page, SEEK_SET);
|
||||
# Go to the end of the line for page > 0
|
||||
if ($page > 1) {
|
||||
my $buf;
|
||||
while (1) {
|
||||
last if !read($log_fh,$buf,1);
|
||||
last if $buf eq "\n";
|
||||
}
|
||||
}
|
||||
|
||||
# Print the page
|
||||
print "<pre class=log>";
|
||||
my $pos = tell($log_fh);
|
||||
my $buf;
|
||||
while ($pos <= $page * $bytes_per_page && ($buf = readline($log_fh))) {
|
||||
print $buf;
|
||||
$pos = tell($log_fh);
|
||||
}
|
||||
print "</pre>\n";
|
||||
footer($p);
|
||||
$dbh->disconnect();
|
||||
}
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 227 B |
@ -1,24 +0,0 @@
|
||||
body {
|
||||
background-color: #CCCCCC;
|
||||
}
|
||||
|
||||
table {
|
||||
empty-cells: show
|
||||
}
|
||||
|
||||
table.editlist {
|
||||
border-spacing: 0px;
|
||||
border-collapse: collapse
|
||||
}
|
||||
|
||||
table.editlist td {
|
||||
border: 1px solid black
|
||||
}
|
||||
|
||||
table.editlist th {
|
||||
border: 0px solid black
|
||||
}
|
||||
|
||||
.obsolete {
|
||||
text-decoration: line-through
|
||||
}
|
||||
@ -1,36 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
use strict;
|
||||
|
||||
use Getopt::Long;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Bonsai;
|
||||
use DBI;
|
||||
|
||||
my %args;
|
||||
$args{start} = 3;
|
||||
$args{end} = 0;
|
||||
GetOptions(\%args, "start:i", "end:i", "help!");
|
||||
if ($args{help}) {
|
||||
print <<EOM;
|
||||
|
||||
Usage: tbox_bonsai_update.pl [--start=<# days ago>] [--end=<# days ago>]
|
||||
|
||||
Updates the bonsai cache to ensure it includes bonsai checkins from start to
|
||||
end days ago.
|
||||
|
||||
EOM
|
||||
}
|
||||
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my $sth = $dbh->prepare("SELECT bonsai_id, bonsai_url, module, branch, directory, cvsroot, " . Tinderbox3::DB::sql_get_timestamp("start_cache") . ", " . Tinderbox3::DB::sql_get_timestamp("end_cache") . " FROM tbox_bonsai");
|
||||
$sth->execute();
|
||||
while (my $row = $sth->fetchrow_arrayref) {
|
||||
#Tinderbox3::Bonsai::clear_cache($dbh, $row->[0]);
|
||||
Tinderbox3::Bonsai::update_cache($dbh, time - (60*60*24*$args{start}), time-(60*60*24*$args{end}), $row->[0],
|
||||
$row->[1], $row->[2], $row->[3], $row->[4],
|
||||
$row->[5], $row->[6], $row->[7]);
|
||||
}
|
||||
Tinderbox3::DB::maybe_commit($dbh);
|
||||
$dbh->disconnect();
|
||||
|
||||
@ -1,44 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::ShowBuilds;
|
||||
|
||||
open INDEX_FILE, ">index.html";
|
||||
|
||||
print INDEX_FILE <<EOM;
|
||||
<html>
|
||||
<head>
|
||||
<title>Tinderbox - Index</title>
|
||||
</head>
|
||||
<body>
|
||||
<h2>Tinderbox - Index</h2>
|
||||
<p><a href='admin.pl'>Administrate This Tinderbox</a></p>
|
||||
<p>This Tinderbox has the following trees:</p>
|
||||
EOM
|
||||
|
||||
#
|
||||
# Create the actual tree static pages
|
||||
#
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
|
||||
my $trees = $dbh->selectcol_arrayref("SELECT tree_name FROM tbox_tree");
|
||||
foreach my $tree (@{$trees}) {
|
||||
my $end_time = time;
|
||||
my $start_time = time - 24*60*60;
|
||||
|
||||
open OUTFILE, ">$tree.html";
|
||||
Tinderbox3::ShowBuilds::print_showbuilds($p, $dbh, *OUTFILE, $tree,
|
||||
$start_time, $end_time);
|
||||
close OUTFILE;
|
||||
|
||||
print INDEX_FILE "<a href='$tree.html'>$tree</a> (<a href='showbuilds.pl?tree=$tree'><a href='showbuilds.pl?tree=$tree'>Dynamic</a>)<br>\n";
|
||||
}
|
||||
|
||||
print INDEX_FILE "</body>
|
||||
</html>";
|
||||
close INDEX_FILE;
|
||||
|
||||
$dbh->disconnect;
|
||||
@ -1,16 +0,0 @@
|
||||
#!/usr/bin/perl -w -I.
|
||||
use strict;
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
my %args;
|
||||
$args{uncompressed_hours} = 24;
|
||||
GetOptions(\%args, "uncompressed_hours:i");
|
||||
|
||||
foreach my $file (glob("xml/logs/*/*.log")) {
|
||||
my @file_stat = stat($file);
|
||||
my $file_mtime = $file_stat[9];
|
||||
if ((time - $file_mtime) >= $args{uncompressed_hours}*60*60) {
|
||||
system("gzip", "-9", $file);
|
||||
}
|
||||
}
|
||||
@ -1,6 +0,0 @@
|
||||
#!/bin/sh
|
||||
cd /home/jkeiser/tbox3/scripts
|
||||
./tbox_bonsai_update.pl
|
||||
./tbox_build_static_pages.pl
|
||||
./tbox_recompress_logs.pl
|
||||
# ../client/tbox_build_quota.pl --url="http://127.0.0.1/tbox3" --quota=1024 --start=0 --end=0 ../client/quota_dirs.txt
|
||||
@ -1,50 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I.
|
||||
|
||||
use CGI;
|
||||
use Tinderbox3::Header;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::Login;
|
||||
use strict;
|
||||
|
||||
#
|
||||
# Init
|
||||
#
|
||||
my $p = new CGI;
|
||||
my $dbh = get_dbh();
|
||||
my ($login, $cookie) = check_session($p, $dbh);
|
||||
|
||||
my $tree = $p->param('tree') || "";
|
||||
if (!$tree) {
|
||||
die "Must specify a tree!";
|
||||
}
|
||||
|
||||
header($p, $login, $cookie, "Upload Patch for $tree", $tree);
|
||||
|
||||
#
|
||||
# Upload patch form
|
||||
#
|
||||
|
||||
print <<EOM;
|
||||
<form name=editform method=post enctype='multipart/form-data' action='admintree.pl'>
|
||||
<input type=hidden name=action value='upload_patch'>
|
||||
@{[$p->hidden(-name=>'tree', -default=>$tree)]}
|
||||
<table>
|
||||
<tr><th>Patch Name (just for display):</th><td><input type=text name=patch_name></td></tr>
|
||||
<tr><th>Bug #:</th><td><input type=text name=bug_id></td></tr>
|
||||
<tr><th>In Use:</th><td><input type=checkbox checked name=in_use></td></tr>
|
||||
<tr><th>Patch:</th><td><input type=file name=patch></td></tr>
|
||||
</table>
|
||||
EOM
|
||||
|
||||
if (!$login) {
|
||||
print login_fields();
|
||||
}
|
||||
|
||||
print <<EOM;
|
||||
<input type=submit>
|
||||
</form>
|
||||
EOM
|
||||
|
||||
|
||||
footer($p);
|
||||
$dbh->disconnect;
|
||||
@ -1,36 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I..
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::XML;
|
||||
use Tinderbox3::Log;
|
||||
|
||||
|
||||
our $p = new CGI();
|
||||
our $dbh = get_dbh();
|
||||
|
||||
$SIG{__DIE__} = sub { die_xml_error($p, $dbh, $_[0]); };
|
||||
|
||||
my $url = $p->param('url') || "";
|
||||
if (!$url) {
|
||||
die_xml_error($p, $dbh, "Must specify url!");
|
||||
}
|
||||
|
||||
my $rows = $dbh->do("DELETE FROM tbox_build_field WHERE name = ? AND value = ?", undef, "build_zip", $url);
|
||||
Tinderbox3::DB::maybe_commit($dbh);
|
||||
|
||||
if ($rows eq "0E0") {
|
||||
die_xml_error($p, $dbh, "No rows deleted!");
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Print response
|
||||
#
|
||||
print $p->header("text/xml");
|
||||
print "<response>\n";
|
||||
print "<builds_deleted rows='$rows'/>\n";
|
||||
print "</response>\n";
|
||||
|
||||
$dbh->disconnect;
|
||||
@ -1,125 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I..
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::XML;
|
||||
use Tinderbox3::Log;
|
||||
|
||||
|
||||
our $p = new CGI();
|
||||
our $dbh = get_dbh();
|
||||
|
||||
$SIG{__DIE__} = sub { die_xml_error($p, $dbh, $_[0]); };
|
||||
|
||||
my $tree = $p->param('tree') || "";
|
||||
if (!$tree) {
|
||||
die_xml_error($p, $dbh, "Must specify tree!");
|
||||
}
|
||||
my $machine_name = $p->param('machine_name') || "";
|
||||
if (!$machine_name) {
|
||||
die_xml_error($p, $dbh, "Must specify a machine name!");
|
||||
}
|
||||
my $os = $p->param('os') || "";
|
||||
my $os_version = $p->param('os_version') || "";
|
||||
my $compiler = $p->param('compiler') || "";
|
||||
my $status = $p->param('status') || 0;
|
||||
my $clobber = $p->param('clobber') || 0;
|
||||
|
||||
#
|
||||
# Get data for response
|
||||
#
|
||||
my $tree_info = $dbh->selectrow_arrayref("SELECT new_machines_visible FROM tbox_tree WHERE tree_name = ?", undef, $tree);
|
||||
if (!defined($tree_info)) {
|
||||
die_xml_error($p, $dbh, "Could not get tree!");
|
||||
}
|
||||
my ($new_machines_visible) = @{$tree_info};
|
||||
|
||||
my $patch_ids = $dbh->selectcol_arrayref("SELECT patch_id FROM tbox_patch WHERE tree_name = ? AND in_use", undef, $tree);
|
||||
if (!$patch_ids) {
|
||||
die_xml_error($p, $dbh, "Could not get patches!");
|
||||
}
|
||||
|
||||
#
|
||||
# Insert the machine into the machines table if it is not there
|
||||
#
|
||||
my $machine_info = $dbh->selectrow_arrayref("SELECT machine_id, commands FROM tbox_machine WHERE tree_name = ? AND machine_name = ? AND os = ? AND os_version = ? AND compiler = ?", undef, $tree, $machine_name, $os, $os_version, $compiler);
|
||||
if (!defined($machine_info)) {
|
||||
$dbh->do("INSERT INTO tbox_machine (tree_name, machine_name, visible, os, os_version, compiler, clobber) VALUES (?, ?, ?, ?, ?, ?, ?)", undef, $tree, $machine_name, $new_machines_visible, $os, $os_version, $compiler, Tinderbox3::DB::sql_get_bool($clobber));
|
||||
$machine_info = [ Tinderbox3::DB::sql_get_last_id($dbh, 'tbox_machine_machine_id_seq'), "" ]
|
||||
} else {
|
||||
$dbh->do("UPDATE tbox_machine SET clobber = ? WHERE machine_id = ?", undef, Tinderbox3::DB::sql_get_bool($clobber), $machine_info->[0]);
|
||||
}
|
||||
my ($machine_id, $commands) = @{$machine_info};
|
||||
$commands ||= "";
|
||||
|
||||
$machine_id =~ /(\d+)/;
|
||||
$machine_id = $1;
|
||||
|
||||
#
|
||||
# Get the machine config
|
||||
#
|
||||
my %machine_config;
|
||||
my $sth = $dbh->prepare("SELECT name, value FROM tbox_initial_machine_config WHERE tree_name = ?");
|
||||
$sth->execute($tree);
|
||||
while (my $row = $sth->fetchrow_arrayref()) {
|
||||
$machine_config{$row->[0]} = $row->[1];
|
||||
}
|
||||
$sth = $dbh->prepare("SELECT name, value FROM tbox_machine_config WHERE machine_id = ?");
|
||||
$sth->execute($machine_id);
|
||||
while (my $row = $sth->fetchrow_arrayref()) {
|
||||
$machine_config{$row->[0]} = $row->[1];
|
||||
}
|
||||
|
||||
{
|
||||
#
|
||||
# Close the last old build info if there is one and it was incomplete
|
||||
#
|
||||
my $last_build = $dbh->selectrow_arrayref("SELECT status, build_time, log FROM tbox_build WHERE machine_id = ? ORDER BY build_time DESC LIMIT 1", undef, $machine_id);
|
||||
if (defined($last_build) && $last_build->[0] >= 0 &&
|
||||
$last_build->[0] < 100) {
|
||||
my $rows = $dbh->do("UPDATE tbox_build SET status = ? WHERE machine_id = ? AND build_time = ?", undef, $last_build->[0] + 300, $machine_id, $last_build->[1]);
|
||||
# We have to compress the log too, be a good citizen
|
||||
compress_log($machine_id, $last_build->[2]);
|
||||
}
|
||||
|
||||
# Create logfile
|
||||
my $log = create_logfile_name($machine_id);
|
||||
my $fh = get_log_fh($machine_id, $log, ">");
|
||||
close $fh;
|
||||
|
||||
#
|
||||
# Insert a new build info signifying that the build has started
|
||||
#
|
||||
my $timestamp = Tinderbox3::DB::sql_current_timestamp();
|
||||
$dbh->do("INSERT INTO tbox_build (machine_id, build_time, status_time, status, log) VALUES (?, $timestamp, $timestamp, ?, ?)", undef, $machine_id, $status, $log);
|
||||
}
|
||||
|
||||
#
|
||||
# If there are commands, we have delivered them. Set to blank.
|
||||
#
|
||||
if ($commands) {
|
||||
$dbh->do("UPDATE tbox_machine SET commands = '' WHERE machine_id = $machine_id");
|
||||
}
|
||||
|
||||
Tinderbox3::DB::maybe_commit($dbh);
|
||||
|
||||
#
|
||||
# Print response
|
||||
#
|
||||
print $p->header("text/xml");
|
||||
print "<response>\n";
|
||||
print "<tree name='$tree'>\n";
|
||||
foreach my $patch_id (@{$patch_ids}) {
|
||||
print "<patch id='$patch_id'/>\n";
|
||||
}
|
||||
print "</tree>\n";
|
||||
print "<machine id='$machine_info->[0]'>\n";
|
||||
print "<commands>", $p->escapeHTML($commands), "</commands>\n";
|
||||
while (my ($var, $val) = each %machine_config) {
|
||||
print "<$var>", $p->escapeHTML($val), "</$var>\n";
|
||||
}
|
||||
print "</machine>\n";
|
||||
print "</response>\n";
|
||||
|
||||
$dbh->disconnect;
|
||||
@ -1,122 +0,0 @@
|
||||
#!/usr/bin/perl -wT -I..
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Tinderbox3::DB;
|
||||
use Tinderbox3::XML;
|
||||
use Tinderbox3::Log;
|
||||
use File::Temp qw(tempfile);
|
||||
|
||||
my $p = new CGI();
|
||||
my $dbh = get_dbh();
|
||||
|
||||
$SIG{__DIE__} = sub { die_xml_error($p, $dbh, $_[0]); };
|
||||
|
||||
my $tree = $p->param('tree') || "";
|
||||
if (!$tree) {
|
||||
die_xml_error($p, $dbh, "Must specify tree!");
|
||||
}
|
||||
my $machine_id = $p->param('machine_id') || "";
|
||||
if (!$machine_id) {
|
||||
die_xml_error($p, $dbh, "Must specify a machine name!");
|
||||
}
|
||||
if ($machine_id =~ /(\d+)/) {
|
||||
$machine_id = $1;
|
||||
} else {
|
||||
$machine_id = "";
|
||||
}
|
||||
my $status = $p->param('status');
|
||||
if (!defined($status) || $status !~ /^\d+$/) {
|
||||
die_xml_error($p, $dbh, "You really need to define a status.");
|
||||
}
|
||||
my $log_chunk_fh = $p->upload('log');
|
||||
|
||||
#
|
||||
# Get data for response
|
||||
#
|
||||
|
||||
#
|
||||
# Insert the machine into the machines table if it is not there
|
||||
#
|
||||
my $machine_info = $dbh->selectrow_arrayref("SELECT machine_name, commands FROM tbox_machine WHERE tree_name = ? AND machine_id = ?", undef, $tree, $machine_id);
|
||||
if (!defined($machine_info)) {
|
||||
die_xml_error($p, $dbh, "No such machine!");
|
||||
}
|
||||
my ($machine_name, $commands) = @{$machine_info};
|
||||
$commands ||= "";
|
||||
|
||||
#
|
||||
# Update build info
|
||||
#
|
||||
my $build_info = $dbh->selectrow_arrayref("SELECT build_time, log FROM tbox_build WHERE machine_id = ? ORDER BY build_time DESC LIMIT 1", undef, $machine_id);
|
||||
if (!defined($build_info)) {
|
||||
die_xml_error("No build time");
|
||||
}
|
||||
my ($build_time, $log) = @{$build_info};
|
||||
$log =~ /(.+)/;
|
||||
$log = $1;
|
||||
|
||||
my $done = $dbh->do("UPDATE tbox_build SET status_time = " . Tinderbox3::DB::sql_current_timestamp() . ", status = ? WHERE machine_id = ? AND build_time = ?", undef, $status, $machine_id, $build_time);
|
||||
|
||||
#
|
||||
# Update fields
|
||||
#
|
||||
my $insert_sth = $dbh->prepare("INSERT INTO tbox_build_field (machine_id, build_time, name, value) VALUES (?, ?, ?, ?)");
|
||||
foreach my $param ($p->param()) {
|
||||
if ($param =~ /^field_(\d+)$/) {
|
||||
my $field = $p->param("field_$1");
|
||||
my $field_val = $p->param("field_$1_val");
|
||||
$insert_sth->execute($machine_id, $build_time, $field, $field_val);
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Clear commands
|
||||
#
|
||||
if ($commands) {
|
||||
$dbh->do("UPDATE tbox_machine SET commands = '' WHERE machine_id = ?", undef, $machine_id);
|
||||
}
|
||||
|
||||
Tinderbox3::DB::maybe_commit($dbh);
|
||||
|
||||
#
|
||||
# Update logfile
|
||||
#
|
||||
if ($log_chunk_fh) {
|
||||
my $log_in_fh;
|
||||
if ($p->param('log_compressed')) {
|
||||
# XXX this is a very roundabout way of uncompressing the incoming logfile
|
||||
my ($fh, $filename) = tempfile(SUFFIX => '.gz');
|
||||
while (<$log_chunk_fh>) {
|
||||
print $fh $_;
|
||||
}
|
||||
close $fh;
|
||||
system("gzip", "-d", $filename);
|
||||
$filename =~ s/\.gz$//g;
|
||||
open $log_in_fh, $filename;
|
||||
} else {
|
||||
$log_in_fh = $log_chunk_fh;
|
||||
}
|
||||
|
||||
if (!$log) {
|
||||
die_xml_error($p, $dbh, "No log exists!");
|
||||
}
|
||||
my $log_fh = get_log_fh($machine_id, $log, ">>");
|
||||
while (<$log_in_fh>) {
|
||||
print $log_fh $_;
|
||||
}
|
||||
close $log_in_fh;
|
||||
close $log_fh;
|
||||
}
|
||||
|
||||
#
|
||||
# Print response
|
||||
#
|
||||
print $p->header("text/xml");
|
||||
print "<response>\n";
|
||||
print "<machine id='$machine_id'>\n";
|
||||
print "<commands>", $p->escapeHTML($commands), "</commands>\n";
|
||||
print "</machine>\n";
|
||||
print "</response>\n";
|
||||
|
||||
$dbh->disconnect;
|
||||
Loading…
Reference in New Issue
Block a user