Scripts that receive status from tinderboxen
git-svn-id: svn://10.0.0.236/trunk@137301 18797224-902f-48f8-a5cc-f745e15eee43
This commit is contained in:
johnkeis
122
mozilla/webtools/tinderbox3/scripts/xml/build_start.pl
Executable file
122
mozilla/webtools/tinderbox3/scripts/xml/build_start.pl
Executable file
@@ -0,0 +1,122 @@
|
||||
#!/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, ($clobber ? 'Y' : 'N'));
|
||||
my $machine_id = $dbh->selectrow_arrayref("SELECT currval('tbox_machine_machine_id_seq')");
|
||||
$machine_info = [ $machine_id->[0], "" ];
|
||||
} else {
|
||||
$dbh->do("UPDATE tbox_machine SET clobber = ? WHERE machine_id = ?", undef, ($clobber ? 'Y' : 'N'), $machine_info->[0]);
|
||||
}
|
||||
my ($machine_id, $commands) = @{$machine_info};
|
||||
$commands ||= "";
|
||||
|
||||
#
|
||||
# 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
|
||||
#
|
||||
$dbh->do("INSERT INTO tbox_build (machine_id, build_time, status_time, status, log) VALUES (?, current_timestamp(), current_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");
|
||||
}
|
||||
|
||||
$dbh->commit;
|
||||
|
||||
#
|
||||
# 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;
|
||||
120
mozilla/webtools/tinderbox3/scripts/xml/build_status.pl
Executable file
120
mozilla/webtools/tinderbox3/scripts/xml/build_status.pl
Executable file
@@ -0,0 +1,120 @@
|
||||
#!/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};
|
||||
|
||||
$dbh->do("UPDATE tbox_build SET status_time = 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);
|
||||
}
|
||||
|
||||
$dbh->commit;
|
||||
|
||||
#
|
||||
# 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;
|
||||
122
mozilla/webtools/tinderbox3/server/xml/build_start.pl
Executable file
122
mozilla/webtools/tinderbox3/server/xml/build_start.pl
Executable file
@@ -0,0 +1,122 @@
|
||||
#!/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, ($clobber ? 'Y' : 'N'));
|
||||
my $machine_id = $dbh->selectrow_arrayref("SELECT currval('tbox_machine_machine_id_seq')");
|
||||
$machine_info = [ $machine_id->[0], "" ];
|
||||
} else {
|
||||
$dbh->do("UPDATE tbox_machine SET clobber = ? WHERE machine_id = ?", undef, ($clobber ? 'Y' : 'N'), $machine_info->[0]);
|
||||
}
|
||||
my ($machine_id, $commands) = @{$machine_info};
|
||||
$commands ||= "";
|
||||
|
||||
#
|
||||
# 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
|
||||
#
|
||||
$dbh->do("INSERT INTO tbox_build (machine_id, build_time, status_time, status, log) VALUES (?, current_timestamp(), current_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");
|
||||
}
|
||||
|
||||
$dbh->commit;
|
||||
|
||||
#
|
||||
# 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;
|
||||
120
mozilla/webtools/tinderbox3/server/xml/build_status.pl
Executable file
120
mozilla/webtools/tinderbox3/server/xml/build_status.pl
Executable file
@@ -0,0 +1,120 @@
|
||||
#!/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};
|
||||
|
||||
$dbh->do("UPDATE tbox_build SET status_time = 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);
|
||||
}
|
||||
|
||||
$dbh->commit;
|
||||
|
||||
#
|
||||
# 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;
|
||||
Reference in New Issue
Block a user