Magic-Mirror/gecko-dev
1
0
Fork 0
mirror of https://github.com/mozilla/gecko-dev.git synced 2024-12-11 16:32:59 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Initial Revision

Browse Source
This commit is contained in:
johnkeis 2002-12-13 19:43:18 +00:00
parent 3e6d515d45
commit 4e6d1fdcc1
13 changed files with 1113 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
webtools/tinderbox3/scripts/Tinderbox3/DB.pm Normal file
View File

@ -0,0 +1,15 @@
package Tinderbox3::DB;
use strict;
use DBI;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(get_dbh);
sub get_dbh {
my $dbh = DBI->connect("dbi:Pg:dbname=tbox", "jkeiser", "scuttlebutt", { RaiseError => 1, AutoCommit => 0 });
return $dbh;
}
1

31
webtools/tinderbox3/scripts/Tinderbox3/Header.pm Normal file
View File

@ -0,0 +1,31 @@
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, $title) = @_;
print $p->header;
print <<EOM;
<html>
<head>
<title>Tinderbox - $title</title>
<link rel="stylesheet" type="text/css" href="/~jkeiser/tbox3.css">
</head>
<body>
EOM
}
sub footer {
print <<EOM;
</body>
</html>
EOM
}
1

23
webtools/tinderbox3/scripts/admin.pl Executable file
View File

@ -0,0 +1,23 @@
#!/usr/bin/perl -wT -I.
use strict;
use CGI;
use Tinderbox3::Header;
use Tinderbox3::DB;
my $p = new CGI;
my $dbh = get_dbh();
header($p, "Global Admin");
print "<h2>Administrate Tinderbox</h2>\n";
print "<table class=editlist><tr><th>Trees</th></tr>\n";
foreach my $tree (@{$dbh->selectcol_arrayref("SELECT tree_name FROM tbox_tree")}) {
print "<tr><td><a href='admintree.pl?tree=$tree'>$tree</a></td></tr>\n";
}
print "<tr><td><a href='admintree.pl?tree='>Add Tree</a></td></tr>\n";
print "</table>\n";
footer($p);
$dbh->disconnect;

115
webtools/tinderbox3/scripts/adminpatch.pl Executable file
View File

@ -0,0 +1,115 @@
#!/usr/bin/perl -wT -I.
use CGI;
use Tinderbox3::Header;
use Tinderbox3::DB;
use strict;
#
# Init
#
my $p = new CGI;
my $dbh = get_dbh();
my ($patch_id, $message) = update_patch($p, $dbh);
# Get patch from DB
my $patch_info = $dbh->selectrow_arrayref("SELECT tree_name, patch_name, patch_ref, patch, obsolete FROM tbox_patch WHERE patch_id = ?");
if (!$patch_info) {
die "Could not get patch!";
}
my ($tree, $patch_name, $patch_ref, $patch, $obsolete) = @{$patch_info};
my $bug_id;
if ($patch_ref =~ /Bug\s+(.*)/) {
$bug_id = $1;
}
header($p, "Edit Patch $patch_name");
#
# Edit / Add tree form
#
print "<h2>Edit Patch $patch_name</h2>\n";
print "<p><strong><a href='admin.pl'>List Trees</a>";
if ($tree) {
print " | <a href='sheriff.pl?tree=$tree'>Edit Sheriff / Tree Status Info</a> | <a href='admintree.pl?tree=$tree'>Edit Tree</a>\n";
}
print "</strong></p>\n";
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><input type=text name=_patch_name value='$patch_name'></td></tr>
<tr><th>Bug #:</th><td><input type=text name=_patch_ref value='$bug_id'></td></tr>
</table>
<input type=submit>
</form>
EOM
footer($p);
$dbh->disconnect;
#
# Update / insert the patch
#
sub update_patch {
my ($p, $dbh) = @_;
my $tree = $p->param('tree') || "";
my $action = $p->param('action') || "";
if ($action eq 'upload_patch') {
my $tree = $p->param('tree') || "";
my $patch_name = $p->param('_patch_name') || "";
my $bug_id = $p->param('_bug_id') || "";
if (!$patch_name) { die "Must specify a non-blank patch name!"; }
my $patch_fh = $p->upload('_patch');
if (!$patch_fh) { die "No patch file uploaded!"; }
my $patch = "";
while (<$patch_fh>) {
$patch .= $_;
}
my $rows = $dbh->do("INSERT INTO tbox_patch (tree_name, patch_name, patch_ref, patch_ref_url, patch) VALUES (?, ?, ?, ?, ?)", undef, $tree, $patch_name, "Bug $bug_id", "http://bugzilla.mozilla.org/show_bug.cgi?id=$bug_id", $patch);
# Update or insert the tree
if ($tree) {
my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, password = ?, field_short_names = ?, field_processors = ? WHERE tree_name = ?", undef, $newtree, $password, $field_short_names, $field_processors, $tree);
if (!$rows) {
die "No tree named $tree!";
}
} else {
my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, password, field_short_names, field_processors) VALUES (?, ?, ?, ?)", undef, $newtree, $password, $field_short_names, $field_processors);
if (!$rows) {
die "Passing strange. Insert failed.";
}
$tree = $newtree;
}
$dbh->commit;
} elsif ($action eq 'delete_patch') {
my $patch_id = $p->param('_patch_id') || "";
if (!$patch_id) { die "Need patch id!" }
my $rows = $dbh->do("DELETE FROM tbox_patch WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id);
if (!$rows) {
die "Delete failed. No such tree / patch.";
}
$dbh->commit;
} elsif ($action eq 'obsolete_patch') {
my $patch_id = $p->param('_patch_id') || "";
if (!$patch_id) { die "Need patch id!" }
my $rows = $dbh->do("UPDATE tbox_patch SET obsolete = 'Y' WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id);
if (!$rows) {
die "Update failed. No such tree / patch.";
}
$dbh->commit;
}
return $tree;
}

142
webtools/tinderbox3/scripts/admintree.pl Executable file
View File

@ -0,0 +1,142 @@
#!/usr/bin/perl -wT -I.
use CGI;
use Tinderbox3::Header;
use Tinderbox3::Actions;
use Tinderbox3::DB;
use strict;
#
# Init
#
my $p = new CGI;
my $dbh = get_dbh();
my $tree = update_tree($p, $dbh);
my $tree_str = "Edit $tree" || "Add Tree";
header($p, $tree_str);
process_actions($p, $dbh);
#
# Get the tree info to fill in the fields
#
my $tree_info;
if (!$tree) {
# XXX Pull these out into defaults elsewhere
$tree_info = [ '',
'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',
'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,binary_url=URL,warnings=Warn',
];
} else {
$tree_info = $dbh->selectrow_arrayref("SELECT password, field_short_names, field_processors FROM tbox_tree WHERE tree_name = ?", undef, $tree);
}
#
# Edit / Add tree form
#
print "<h2>$tree_str</h2>\n";
print "<p><strong><a href='admin.pl'>List Trees</a>";
if ($tree) {
print " | <a href='sheriff.pl?tree=$tree'>Edit Sheriff / Tree Status Info</a>\n";
}
print "</strong></p>\n";
print <<EOM;
<form name=editform method=get action='admintree.pl'>
<input type=hidden name=action value='edit_tree'>
<input type=hidden name=tree value='$tree'>
<table>
<tr><th>Tree Name (this is the name used to identify the tree):</th><td><input type=text name=_tree_name value='$tree'></td></tr>
<tr><th>Password:</th><td><input type=text name=_password value='$tree_info->[0]'></td></tr>
<tr><th>Status Short Names (bloat=Bl,pageload=Tp)</th><td><input type=text name=_field_short_names size=80 value='$tree_info->[1]'></td></tr>
<tr><th>Status Handlers (bloat=Graph,binary_url=URL)</th><td><input type=text name=_field_processors size=80 value='$tree_info->[2]'></td></tr>
</table>
<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 FROM tbox_patch WHERE tree_name = ?');
$sth->execute($tree);
while (my $patch_info = $sth->fetchrow_arrayref) {
print "<tr><td><a href='adminpatch.pl?patch_id=$patch_info->[0]'>$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=delete_patch&_patch_id=$patch_info->[0]'>Obsolete</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 = ?');
$sth->execute($tree);
while (my $machine_info = $sth->fetchrow_arrayref) {
print "<tr><td><a href='adminmachine.pl?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'>Upload Machine</a></td></tr>\n";
print "</table>\n";
}
footer($p);
$dbh->disconnect;
#
# Update / Insert the tree and perform other DB operations
#
sub update_tree {
my ($p, $dbh) = @_;
my $tree = $p->param('tree') || "";
my $action = $p->param('action') || "";
if ($action eq 'edit_tree') {
my $newtree = $p->param('_tree_name') || "";
my $password = $p->param('_password') || "";
my $field_short_names = $p->param('_field_short_names') || "";
my $field_processors = $p->param('_field_processors') || "";
if (!$newtree) { die "Must specify a non-blank tree!"; }
# Update or insert the tree
if ($tree) {
my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, password = ?, field_short_names = ?, field_processors = ? WHERE tree_name = ?", undef, $newtree, $password, $field_short_names, $field_processors, $tree);
if (!$rows) {
die "No tree named $tree!";
}
} else {
my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, password, field_short_names, field_processors) VALUES (?, ?, ?, ?)", undef, $newtree, $password, $field_short_names, $field_processors);
if (!$rows) {
die "Passing strange. Insert failed.";
}
$tree = $newtree;
}
$dbh->commit;
} elsif ($action eq 'delete_patch') {
my $patch_id = $p->param('_patch_id') || "";
if (!$patch_id) { die "Need patch id!" }
my $rows = $dbh->do("DELETE FROM tbox_patch WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id);
if (!$rows) {
die "Delete failed. No such tree / patch.";
}
$dbh->commit;
} elsif ($action eq 'obsolete_patch') {
my $patch_id = $p->param('_patch_id') || "";
if (!$patch_id) { die "Need patch id!" }
my $rows = $dbh->do("UPDATE tbox_patch SET obsolete = 'Y' WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id);
if (!$rows) {
die "Update failed. No such tree / patch.";
}
$dbh->commit;
}
return $tree;
}

15
webtools/tinderbox3/server/Tinderbox3/DB.pm Normal file
View File

@ -0,0 +1,15 @@
package Tinderbox3::DB;
use strict;
use DBI;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(get_dbh);
sub get_dbh {
my $dbh = DBI->connect("dbi:Pg:dbname=tbox", "jkeiser", "scuttlebutt", { RaiseError => 1, AutoCommit => 0 });
return $dbh;
}
1

31
webtools/tinderbox3/server/Tinderbox3/Header.pm Normal file
View File

@ -0,0 +1,31 @@
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, $title) = @_;
print $p->header;
print <<EOM;
<html>
<head>
<title>Tinderbox - $title</title>
<link rel="stylesheet" type="text/css" href="/~jkeiser/tbox3.css">
</head>
<body>
EOM
}
sub footer {
print <<EOM;
</body>
</html>
EOM
}
1

23
webtools/tinderbox3/server/admin.pl Executable file
View File

@ -0,0 +1,23 @@
#!/usr/bin/perl -wT -I.
use strict;
use CGI;
use Tinderbox3::Header;
use Tinderbox3::DB;
my $p = new CGI;
my $dbh = get_dbh();
header($p, "Global Admin");
print "<h2>Administrate Tinderbox</h2>\n";
print "<table class=editlist><tr><th>Trees</th></tr>\n";
foreach my $tree (@{$dbh->selectcol_arrayref("SELECT tree_name FROM tbox_tree")}) {
print "<tr><td><a href='admintree.pl?tree=$tree'>$tree</a></td></tr>\n";
}
print "<tr><td><a href='admintree.pl?tree='>Add Tree</a></td></tr>\n";
print "</table>\n";
footer($p);
$dbh->disconnect;

115
webtools/tinderbox3/server/adminpatch.pl Executable file
View File

@ -0,0 +1,115 @@
#!/usr/bin/perl -wT -I.
use CGI;
use Tinderbox3::Header;
use Tinderbox3::DB;
use strict;
#
# Init
#
my $p = new CGI;
my $dbh = get_dbh();
my ($patch_id, $message) = update_patch($p, $dbh);
# Get patch from DB
my $patch_info = $dbh->selectrow_arrayref("SELECT tree_name, patch_name, patch_ref, patch, obsolete FROM tbox_patch WHERE patch_id = ?");
if (!$patch_info) {
die "Could not get patch!";
}
my ($tree, $patch_name, $patch_ref, $patch, $obsolete) = @{$patch_info};
my $bug_id;
if ($patch_ref =~ /Bug\s+(.*)/) {
$bug_id = $1;
}
header($p, "Edit Patch $patch_name");
#
# Edit / Add tree form
#
print "<h2>Edit Patch $patch_name</h2>\n";
print "<p><strong><a href='admin.pl'>List Trees</a>";
if ($tree) {
print " | <a href='sheriff.pl?tree=$tree'>Edit Sheriff / Tree Status Info</a> | <a href='admintree.pl?tree=$tree'>Edit Tree</a>\n";
}
print "</strong></p>\n";
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><input type=text name=_patch_name value='$patch_name'></td></tr>
<tr><th>Bug #:</th><td><input type=text name=_patch_ref value='$bug_id'></td></tr>
</table>
<input type=submit>
</form>
EOM
footer($p);
$dbh->disconnect;
#
# Update / insert the patch
#
sub update_patch {
my ($p, $dbh) = @_;
my $tree = $p->param('tree') || "";
my $action = $p->param('action') || "";
if ($action eq 'upload_patch') {
my $tree = $p->param('tree') || "";
my $patch_name = $p->param('_patch_name') || "";
my $bug_id = $p->param('_bug_id') || "";
if (!$patch_name) { die "Must specify a non-blank patch name!"; }
my $patch_fh = $p->upload('_patch');
if (!$patch_fh) { die "No patch file uploaded!"; }
my $patch = "";
while (<$patch_fh>) {
$patch .= $_;
}
my $rows = $dbh->do("INSERT INTO tbox_patch (tree_name, patch_name, patch_ref, patch_ref_url, patch) VALUES (?, ?, ?, ?, ?)", undef, $tree, $patch_name, "Bug $bug_id", "http://bugzilla.mozilla.org/show_bug.cgi?id=$bug_id", $patch);
# Update or insert the tree
if ($tree) {
my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, password = ?, field_short_names = ?, field_processors = ? WHERE tree_name = ?", undef, $newtree, $password, $field_short_names, $field_processors, $tree);
if (!$rows) {
die "No tree named $tree!";
}
} else {
my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, password, field_short_names, field_processors) VALUES (?, ?, ?, ?)", undef, $newtree, $password, $field_short_names, $field_processors);
if (!$rows) {
die "Passing strange. Insert failed.";
}
$tree = $newtree;
}
$dbh->commit;
} elsif ($action eq 'delete_patch') {
my $patch_id = $p->param('_patch_id') || "";
if (!$patch_id) { die "Need patch id!" }
my $rows = $dbh->do("DELETE FROM tbox_patch WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id);
if (!$rows) {
die "Delete failed. No such tree / patch.";
}
$dbh->commit;
} elsif ($action eq 'obsolete_patch') {
my $patch_id = $p->param('_patch_id') || "";
if (!$patch_id) { die "Need patch id!" }
my $rows = $dbh->do("UPDATE tbox_patch SET obsolete = 'Y' WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id);
if (!$rows) {
die "Update failed. No such tree / patch.";
}
$dbh->commit;
}
return $tree;
}

142
webtools/tinderbox3/server/admintree.pl Executable file
View File

@ -0,0 +1,142 @@
#!/usr/bin/perl -wT -I.
use CGI;
use Tinderbox3::Header;
use Tinderbox3::Actions;
use Tinderbox3::DB;
use strict;
#
# Init
#
my $p = new CGI;
my $dbh = get_dbh();
my $tree = update_tree($p, $dbh);
my $tree_str = "Edit $tree" || "Add Tree";
header($p, $tree_str);
process_actions($p, $dbh);
#
# Get the tree info to fill in the fields
#
my $tree_info;
if (!$tree) {
# XXX Pull these out into defaults elsewhere
$tree_info = [ '',
'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',
'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,binary_url=URL,warnings=Warn',
];
} else {
$tree_info = $dbh->selectrow_arrayref("SELECT password, field_short_names, field_processors FROM tbox_tree WHERE tree_name = ?", undef, $tree);
}
#
# Edit / Add tree form
#
print "<h2>$tree_str</h2>\n";
print "<p><strong><a href='admin.pl'>List Trees</a>";
if ($tree) {
print " | <a href='sheriff.pl?tree=$tree'>Edit Sheriff / Tree Status Info</a>\n";
}
print "</strong></p>\n";
print <<EOM;
<form name=editform method=get action='admintree.pl'>
<input type=hidden name=action value='edit_tree'>
<input type=hidden name=tree value='$tree'>
<table>
<tr><th>Tree Name (this is the name used to identify the tree):</th><td><input type=text name=_tree_name value='$tree'></td></tr>
<tr><th>Password:</th><td><input type=text name=_password value='$tree_info->[0]'></td></tr>
<tr><th>Status Short Names (bloat=Bl,pageload=Tp)</th><td><input type=text name=_field_short_names size=80 value='$tree_info->[1]'></td></tr>
<tr><th>Status Handlers (bloat=Graph,binary_url=URL)</th><td><input type=text name=_field_processors size=80 value='$tree_info->[2]'></td></tr>
</table>
<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 FROM tbox_patch WHERE tree_name = ?');
$sth->execute($tree);
while (my $patch_info = $sth->fetchrow_arrayref) {
print "<tr><td><a href='adminpatch.pl?patch_id=$patch_info->[0]'>$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=delete_patch&_patch_id=$patch_info->[0]'>Obsolete</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 = ?');
$sth->execute($tree);
while (my $machine_info = $sth->fetchrow_arrayref) {
print "<tr><td><a href='adminmachine.pl?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'>Upload Machine</a></td></tr>\n";
print "</table>\n";
}
footer($p);
$dbh->disconnect;
#
# Update / Insert the tree and perform other DB operations
#
sub update_tree {
my ($p, $dbh) = @_;
my $tree = $p->param('tree') || "";
my $action = $p->param('action') || "";
if ($action eq 'edit_tree') {
my $newtree = $p->param('_tree_name') || "";
my $password = $p->param('_password') || "";
my $field_short_names = $p->param('_field_short_names') || "";
my $field_processors = $p->param('_field_processors') || "";
if (!$newtree) { die "Must specify a non-blank tree!"; }
# Update or insert the tree
if ($tree) {
my $rows = $dbh->do("UPDATE tbox_tree SET tree_name = ?, password = ?, field_short_names = ?, field_processors = ? WHERE tree_name = ?", undef, $newtree, $password, $field_short_names, $field_processors, $tree);
if (!$rows) {
die "No tree named $tree!";
}
} else {
my $rows = $dbh->do("INSERT INTO tbox_tree (tree_name, password, field_short_names, field_processors) VALUES (?, ?, ?, ?)", undef, $newtree, $password, $field_short_names, $field_processors);
if (!$rows) {
die "Passing strange. Insert failed.";
}
$tree = $newtree;
}
$dbh->commit;
} elsif ($action eq 'delete_patch') {
my $patch_id = $p->param('_patch_id') || "";
if (!$patch_id) { die "Need patch id!" }
my $rows = $dbh->do("DELETE FROM tbox_patch WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id);
if (!$rows) {
die "Delete failed. No such tree / patch.";
}
$dbh->commit;
} elsif ($action eq 'obsolete_patch') {
my $patch_id = $p->param('_patch_id') || "";
if (!$patch_id) { die "Need patch id!" }
my $rows = $dbh->do("UPDATE tbox_patch SET obsolete = 'Y' WHERE tree_name = ? AND patch_id = ?", undef, $tree, $patch_id);
if (!$rows) {
die "Update failed. No such tree / patch.";
}
$dbh->commit;
}
return $tree;
}

71
webtools/tinderbox3/sql/create_schema_postgres.sql Normal file
View File

@ -0,0 +1,71 @@
--
-- Represents a tree--a set of machines
--
CREATE TABLE tbox_tree (
tree_name VARCHAR(200) UNIQUE,
password TEXT,
-- The short names for particular fields that will show up on the main page
field_short_names TEXT,
-- Name the processors that will show the fields (comma separated name=value pairs)
field_processors TEXT
);
--
-- A patch (associated with a tree)
--
CREATE TABLE tbox_patch (
patch_id SERIAL,
tree_name VARCHAR(200),
patch_name VARCHAR(200),
patch_ref TEXT,
patch_ref_url TEXT,
patch TEXT,
-- obsolete: no Tinderboxes will pick up this patch
obsolete BOOLEAN
);
--
-- A tinderbox machine
--
CREATE TABLE tbox_machine (
machine_id SERIAL,
tree_name VARCHAR(200),
machine_name VARCHAR(200),
description TEXT
);
--
-- A particular build on a machine
--
CREATE TABLE tbox_build (
machine_id INTEGER,
build_time TIMESTAMP,
status_time TIMESTAMP,
status VARCHAR(200),
log TEXT
);
--
-- Fields (like Tp and friends) associated with a build
--
CREATE TABLE tbox_build_field (
name VARCHAR(200),
value VARCHAR(200)
);
--
-- Tells what patches were on a particular build
--
CREATE TABLE tbox_build_patch (
machine_id INTEGER,
build_time TIMESTAMP,
patch_id INTEGER
);
-- TODO:
-- comments
-- build commands

189
webtools/tinderbox3/sql/setup-mysql.pl Executable file
View File

@ -0,0 +1,189 @@
#!perl -I..
use strict;
use Getopt::Long;
use DBI;
#
# Get arguments
#
my %args;
$args{prefix} = 'ul_';
$args{drop} = 1;
$args{create} = 1;
$args{defaults} = 1;
GetOptions(\%args, 'host|h:s', 'port|p:s', 'username|u:s', 'password|p:s',
'prefix|P:s',
'drop!', 'defaults!', 'create!',
'help|h|?');
my $dbname = shift @ARGV;
#
# Get help
#
if($args{help} || !$dbname || @ARGV) {
print <<EOM;
setup-mysql.pl [OPTIONS] dbname
OPTIONS
--help, -h, -?: Show this message.
--host: The server postgres is running on (default: this machine)
--port: The port postgres is running on (default: normal MySQL port)
--username, -u: The postgres username to use (default: current user)
--password, -p: The postgres password to use
--prefix, -P: The prefix to add to all tablenames (default: ul_)
--nodrop: Don't perform dropping of tables (default: drop)
--nocreate: Don't perform creation of tables (default: create)
--nodefaults: Don't populate the system parameters with defaults (default: populate)
If you don't know what dbname to use and you normally connect using "psql", use
your unix username as the dbname.
NOTE: population will not work unless UserLogin is installed.
EOM
exit(1);
}
#
# Set up defaults, initialize
#
my $create_file = "create_schema_mysql.sql";
generate_create_schema_file("create_schema_postgres.sql", $create_file);
my $connect_string = "dbi:mysql:$dbname";
$connect_string .= ";host=$args{host}" if $args{host};
$connect_string .= ";port=$args{port}" if $args{port};
my $dbh = DBI->connect($connect_string, $args{username}, $args{password}, { RaiseError => 0, AutoCommit => 1 });
my ($tables, $sequences) = read_tables_sequences($create_file, $args{prefix});
#
# Drop tables
#
if($args{drop}) {
drop_schema($dbh, $tables, $sequences);
}
#
# Create tables
#
if($args{create}) {
execute_sql_file($dbname, \%args, $create_file);
}
#
# Populate data
#
if($args{defaults}) {
populate_data($dbname, \%args);
}
$dbh->disconnect;
sub generate_create_schema_file {
my ($old_create_schema, $new_create_schema) = @_;
open IN, $old_create_schema;
open OUT, ">$new_create_schema";
while (<IN>) {
s/\bserial\b/int4 not null auto_increment primary key/;
s/\bunique\b//;
if (/(create\s*table\s*)(\w+)/i) {
my $new_table_name = lc($2);
s/(create\s*table\s*)(\w+)/\1$new_table_name/i;
}
print OUT;
}
close OUT;
close IN;
}
#
# Actually drop tables and sequences
#
sub drop_schema {
my ($dbh, $tables, $sequences) = @_;
foreach my $table (@{$tables}) {
print "Dropping $table";
if($sequences->{$table}) {
print " (seq: " . join(", ", @{$sequences->{$table}}) . ")";
}
print " ... \n";
my $sth;
foreach my $seq (@{$sequences->{$table}}) {
$sth = $dbh->prepare("drop sequence $seq");
# We don't care if there's an error here
$sth->execute;
}
$sth = $dbh->prepare("drop table $table");
# We don't care if there's an error here
$sth->execute;
}
}
#
# Read the list of tables and sequences from the create schema file
#
sub read_tables_sequences {
my ($create_file, $prefix) = @_;
my @tables;
my %sequences;
my $recent_table;
#
# Grab the list of tables and sequences
#
open IN, $create_file;
while(<IN>) {
if(/^\s*create\s*table\s*(\S+)/i) {
$recent_table = $1;
if($recent_table =~ /^ul_(.+)/i) {
$recent_table = "$prefix$1";
}
unshift @tables, $recent_table;
}
}
close IN;
return (\@tables, \%sequences);
}
#
# Populate the initial data
#
sub populate_data {
my ($dbname, $args) = @_;
require UserLogin::mysql;
my $sys = new UserLogin::mysql(%{$args}, db => $dbname);
require UserLoginInit;
UserLoginInit::initial_populate($sys, $args{prefix});
}
#
# Execute an SQL file in mysql
#
sub execute_sql_file {
# XXX This doesn't respect the password argument
my ($dbname, $args, $sql_file) = @_;
# Switch the prefix to the new prefix
open OLDFILE, $sql_file;
open NEWFILE, ">$sql_file.new";
while(<OLDFILE>) {
s/UL_/$args{prefix}/g;
print NEWFILE $_;
}
close NEWFILE;
close OLDFILE;
my @exec_params = ('mysql');
push @exec_params, ("-h", $args{host}) if $args{host};
push @exec_params, ("-P", $args{port}) if $args{port};
push @exec_params, ("-u", $args{username}) if $args{username};
push @exec_params, ("-p", $args{password}) if $args{password};
push @exec_params, ("-e", "\\. $sql_file.new", $dbname);
print "Executing " . join(' ', @exec_params) . " ...\n";
system(@exec_params);
unlink("$sql_file.new");
}

201
webtools/tinderbox3/sql/setup-postgres.pl Executable file
View File

@ -0,0 +1,201 @@
#!/usr/bin/perl -I.
use strict;
use Getopt::Long;
use DBI;
#
# Get arguments
#
my %args;
$args{prefix} = 'ul_';
$args{drop} = 1;
$args{create} = 1;
$args{defaults} = 1;
GetOptions(\%args, 'host|h:s', 'port|p:s', 'username|u:s', 'password|p:s',
'drop!', 'defaults!', 'create!', 'grant|g:s@',
'help|h|?');
my $dbname = shift @ARGV;
#
# Get help
#
if($args{help} || !$dbname || @ARGV) {
print <<EOM;
setup-postgres.pl [OPTIONS] dbname
OPTIONS
--help, -h, -?: Show this message.
--host: The server postgres is running on (default: this machine)
--port: The port postgres is running on (default: normal Postgres port)
--username, -u: The postgres username to use (default: current user)
--password, -p: The postgres password to use
--nodrop: Don't perform dropping of tables (default: drop)
--nocreate: Don't perform creation of tables (default: create)
--nodefaults: Don't populate the system parameters with defaults (default: populate)
--grant, -g: A list of users to grant permissions on the tables. Use multiple -g
options to grant permission to multiple users. (default: none)
If you don't know what dbname to use and you normally connect using "psql", use
your unix username as the dbname.
NOTE: population will not work unless UserLogin is installed.
EOM
exit(1);
}
#
# Set up defaults, initialize
#
my $create_file = "create_schema_postgres.sql";
my $connect_string = "dbi:Pg:dbname=$dbname";
$connect_string .= ";host=$args{host}" if $args{host};
$connect_string .= ";port=$args{port}" if $args{port};
my $dbh = DBI->connect($connect_string, $args{username}, $args{password}, { RaiseError => 0, AutoCommit => 1 });
my ($tables, $sequences) = read_tables_sequences($create_file);
#
# Drop tables
#
if($args{drop}) {
drop_schema($dbh, $tables, $sequences);
}
#
# Create tables
#
if($args{create}) {
execute_sql_file($dbname, \%args, $create_file);
}
#
# Grant permissions
#
if($args{grant}) {
grant_permissions($dbh, $tables, $sequences, @{$args{grant}});
}
#
# Populate data
#
if($args{defaults}) {
populate_data($dbname, \%args);
}
$dbh->disconnect;
#
# Actually drop tables and sequences
#
sub drop_schema {
my ($dbh, $tables, $sequences) = @_;
foreach my $table (@{$tables}) {
print "Dropping $table";
if($sequences->{$table}) {
print " (seq: " . join(", ", @{$sequences->{$table}}) . ")";
}
print " ... \n";
my $sth;
foreach my $seq (@{$sequences->{$table}}) {
$sth = $dbh->prepare("drop sequence $seq");
# We don't care if there's an error here
$sth->execute;
}
$sth = $dbh->prepare("drop table $table");
# We don't care if there's an error here
$sth->execute;
}
}
#
# Read the list of tables and sequences from the create schema file
#
sub read_tables_sequences {
my ($create_file) = @_;
my @tables;
my %sequences;
my $recent_table;
#
# Grab the list of tables and sequences
#
open IN, $create_file;
while(<IN>) {
if(/^\s*create\s*table\s*(\S+)/i) {
$recent_table = $1;
if($recent_table =~ /^ul_(.+)/i) {
$recent_table = $1;
}
unshift @tables, $recent_table;
} elsif(/^\s*(\S+)\s*serial/i) {
my $seq;
if(length($recent_table) + length($1) > 26) {
if(length($recent_table) <= 13) {
$seq = $recent_table . "_" . substr($1, 0, 26 - length($recent_table)) . "_seq";
} elsif(length($1) <= 13) {
$seq = substr($recent_table, 0, 26 - length($1)) . "_" . $1 . "_seq";
} else {
$seq = substr($recent_table, 0, 13) . "_" . substr($1, 0, 13) . "_seq";
}
} else {
$seq = $recent_table . "_" . $1 . "_seq";
}
push @{$sequences{$recent_table}}, lc($seq);
}
}
close IN;
return (\@tables, \%sequences);
}
#
# Grant permissions to the tables to everyone who needs them
#
sub grant_permissions {
my ($dbh, $tables, $sequences, @grants) = @_;
foreach my $grant (@grants) {
print "Granting permissions to $grant ...\n";
foreach my $table (@{$tables}) {
my $sth = $dbh->prepare("GRANT INSERT,UPDATE,DELETE,SELECT ON $table TO $grant");
# Don't worry if there's an error
$sth->execute;
foreach my $sequence (@{$sequences->{$table}}) {
my $sth2 = $dbh->prepare("GRANT INSERT,UPDATE,DELETE,SELECT ON $sequence TO $grant");
# Don't worry if there's an error
$sth2->execute;
}
}
}
}
#
# Populate the initial data
#
sub populate_data {
my ($dbname, $args) = @_;
}
#
# Execute an SQL file in psql
#
#
# Execute an SQL file in mysql
#
sub execute_sql_file {
# XXX This doesn't respect the password argument
my ($dbname, $args, $sql_file) = @_;
my @exec_params = ('psql');
push @exec_params, ("-h", $args{host}) if $args{host};
push @exec_params, ("-p", $args{port}) if $args{port};
push @exec_params, ("-U", $args{username}) if $args{username};
push @exec_params, ("-f", "$sql_file", $dbname);
print "Executing " . join(' ', @exec_params) . " ...\n";
system(@exec_params);
}