diff --git a/mozilla/webtools/tinderbox3/scripts/xml/build_start.pl b/mozilla/webtools/tinderbox3/scripts/xml/build_start.pl new file mode 100755 index 00000000000..40066835a36 --- /dev/null +++ b/mozilla/webtools/tinderbox3/scripts/xml/build_start.pl @@ -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 "\n"; +print "\n"; +foreach my $patch_id (@{$patch_ids}) { + print "\n"; +} +print "\n"; +print "\n"; +print "", $p->escapeHTML($commands), "\n"; +while (my ($var, $val) = each %machine_config) { + print "<$var>", $p->escapeHTML($val), "\n"; +} +print "\n"; +print "\n"; + +$dbh->disconnect; diff --git a/mozilla/webtools/tinderbox3/scripts/xml/build_status.pl b/mozilla/webtools/tinderbox3/scripts/xml/build_status.pl new file mode 100755 index 00000000000..53b76842a77 --- /dev/null +++ b/mozilla/webtools/tinderbox3/scripts/xml/build_status.pl @@ -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 "\n"; +print "\n"; +print "", $p->escapeHTML($commands), "\n"; +print "\n"; +print "\n"; + +$dbh->disconnect; diff --git a/mozilla/webtools/tinderbox3/server/xml/build_start.pl b/mozilla/webtools/tinderbox3/server/xml/build_start.pl new file mode 100755 index 00000000000..40066835a36 --- /dev/null +++ b/mozilla/webtools/tinderbox3/server/xml/build_start.pl @@ -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 "\n"; +print "\n"; +foreach my $patch_id (@{$patch_ids}) { + print "\n"; +} +print "\n"; +print "\n"; +print "", $p->escapeHTML($commands), "\n"; +while (my ($var, $val) = each %machine_config) { + print "<$var>", $p->escapeHTML($val), "\n"; +} +print "\n"; +print "\n"; + +$dbh->disconnect; diff --git a/mozilla/webtools/tinderbox3/server/xml/build_status.pl b/mozilla/webtools/tinderbox3/server/xml/build_status.pl new file mode 100755 index 00000000000..53b76842a77 --- /dev/null +++ b/mozilla/webtools/tinderbox3/server/xml/build_status.pl @@ -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 "\n"; +print "\n"; +print "", $p->escapeHTML($commands), "\n"; +print "\n"; +print "\n"; + +$dbh->disconnect;