Commit 4727e6c0 authored by terry%netscape.com's avatar terry%netscape.com

Everything has been ported to now run under Perl.

parent d8a4482d
This diff is collapsed. Click to expand it.
...@@ -10,6 +10,26 @@ query the CVS tree. For example, ...@@ -10,6 +10,26 @@ query the CVS tree. For example,
will tell you what has been changed in the last week. will tell you what has been changed in the last week.
9/15/98 Everything has been ported to Perl. NO MORE TCL. This
transition should be relatively painless, except for the "params"
file. This is the file that contains parameters you've set up on the
editparams.cgi page. Before changing to Perl, this was a tcl-syntax
file, stored in the same directory as the code; after the change to
Perl, it becomes a perl-syntax file, stored in a subdirectory named
"data".
So, if updating from an older version of Bugzilla, you will need to
edit data/param, change the email address listed for
$::param{'maintainer'}, and then go revisit the editparams.cgi page
and reset all the parameters to your taste. Fortunately, your old
params file will still be around, and so you ought to be able to
cut&paste important bits from there.
9/2/98 Changed the way password validation works. We now keep a 9/2/98 Changed the way password validation works. We now keep a
crypt'd version of the password in the database, and check against crypt'd version of the password in the database, and check against
that. (This is silly, because we're also keeping the plaintext that. (This is silly, because we're also keeping the plaintext
......
...@@ -24,10 +24,12 @@ this document!) ...@@ -24,10 +24,12 @@ this document!)
First, you need some other things: First, you need some other things:
1) MySQL database server. 1) MySQL database server.
2) Tcl 7.6 2) Perl5.004 or greater, including MySQL support and the Date::Format
3) TclX 7.6 package from CPAN.
4) mysqltcl program (hmm.. This was tricky.. Read on) 3) Some kind of HTTP server so you could use CGI scripts
5) Some kind of HTTP server so you could use CGI scripts
Earlier versions of Bugzilla required TCL. THIS IS NO LONGER TRUE.
All dependencies on TCL have been removed.
1.1 Getting and setting up MySQL database 1.1 Getting and setting up MySQL database
...@@ -43,43 +45,8 @@ writable by all users on your machine and change access level ...@@ -43,43 +45,8 @@ writable by all users on your machine and change access level
later. This would save you a lot of time trying to guess whether it's later. This would save you a lot of time trying to guess whether it's
permissions or a mistake in the script that make things fail. permissions or a mistake in the script that make things fail.
1.2-3 Getting and building Tcl & TclX 7.6
Tcl homepage is at http://www.scriptics.com. You may get sources
for UNIX from ftp://ftp.scriptics.com/pub/tcl/tcl7_6/tcl7.6p2.tar.gz.
TclX is an extension for Tcl that adds a lot of useful functions that
are heavily used in the Bugzilla tool.
TclX page is http://www.neosoft.com/tclx. Download sources from
ftp://ftp.neosoft.com/pub/tcl/TclX/tclX7.6.0.tar.gz. Watch out for the
case of the letters in URL. These guys are going to bring some fun
into your life by spelling their program name in various ways.
Now you've probably got both Tcl and TclX 7.6. You may try to use
version 8.X but I'm not sure about results. Unfortunately I'm not an
expert in "Tcl&Co.".
Build and install Tcl first. Then build and install TclX. This
should go without serious problems
1.4 mysqltcl - the tricky part
Grab msqltcl 1.50 (yes, "msqltcl" without 'y'. That's not a typo) from
MySQL site's contributed software area (http://www.tcx.se/Contrib/) or
from mSQL site (www.hughes.com.au). I've used version 1.50 and it
works for me, though you may try more recent version at your own
risk. You're risking anyway.
Then grab mysqltcl.c-patch from MySQL's contrib area and apply this
patch to msqltcl.c file from msqltcl-1.50 distribution.
Try to make msqltcl binary which is in fact mYsqltcl already. Very
likely that you will not be able to compile it without modifications.
You can use the patch in APPENDIX 1 to see what changes I had to make
to compile mysqltcl. Your mileage may vary.
1.2 HTTP server
1.5 HTTP server
You have a freedom of choice here - Apache, Netscape or any other You have a freedom of choice here - Apache, Netscape or any other
server on UNIX would do. The only thing - to make configuration easier server on UNIX would do. The only thing - to make configuration easier
...@@ -120,8 +87,8 @@ like to customize some things. ...@@ -120,8 +87,8 @@ like to customize some things.
Create yourself an account. (Try to enter a new bug, and it will Create yourself an account. (Try to enter a new bug, and it will
prompt you for your login. Give it your email address, and have it prompt you for your login. Give it your email address, and have it
mail you your password.) Go visit the query page; that ought to force mail you your password.) Go visit the query page; that ought to force
the creation of the "params" file in your installation dir. Edit the the creation of the "data/params" file in your installation dir. Edit the
params file, and change the line that says "set param(maintainer)" to data/params file, and change the line that sets "$::param{'maintainer'}" to
have your email address as the maintainer. Go visit the query page have your email address as the maintainer. Go visit the query page
again; there should now be a link at the bottom that invites you to again; there should now be a link at the bottom that invites you to
edit the parameters. (If you have cookies turned off, you'll have to edit the parameters. (If you have cookies turned off, you'll have to
...@@ -134,131 +101,8 @@ Tweak the parameters to taste. Be careful. ...@@ -134,131 +101,8 @@ Tweak the parameters to taste. Be careful.
It's a good idea to set up a daily cronjob that does It's a good idea to set up a daily cronjob that does
cd <your-installation-dir> ; ./whineatnews.tcl cd <your-installation-dir> ; ./whineatnews.pl
This causes email that gets sent to anyone who has a NEW bug that This causes email that gets sent to anyone who has a NEW bug that
hasn't been touched for several days. For more info, see the hasn't been touched for several days. For more info, see the
whinedays and whinemail parameters. whinedays and whinemail parameters.
*******************************************************
APPENDIXES
*******************************************************
APPENDIX 1. Patch to build mysqltcl.
--------------------------------------
diff -u -r msqltcl-1.50/Makefile mysqltcl-1.50/Makefile
--- msqltcl-1.50/Makefile Tue Jun 6 07:25:39 1995
+++ mysqltcl-1.50/Makefile Tue Jun 23 18:20:07 1998
@@ -38,11 +38,11 @@
#
#----- Tcl/Tk libraries & such
# Path for Tcl include files.
-TCLINCL = -I/usr/local/include
+TCLINCL = -I../include
# Path for Tk include files, if different from the above.
TKINCL =
# Libraries required to link plain Tcl.
-TCLLIBS = -L/usr/local/lib -ltcl -lm
+TCLLIBS = -L../lib -ltclx7.6.0 -ltcl7.6 -lm -lnsl -lsocket
# Libraries required to link plain Tk.
TKLIBS = -L/usr/local/lib -ltk -ltcl -lX11 -lm
@@ -66,11 +66,11 @@
#
#----- Tcl/Tk libraries & such
# Path for Tcl include files.
-NEWTCLINCL = -I/usr/local/new/include
+NEWTCLINCL = -I../include
# Path for Tk include files, if different from the above.
NEWTKINCL =
# Libraries required to link plain Tcl.
-NEWTCLLIBS = -L/usr/local/new/lib -ltcl -lm
+NEWTCLLIBS = -L../lib -ltclx7.6.0 -ltcl7.6 -lm -lnsl -lsocket
# Libraries required to link plain Tk.
NEWTKLIBS = -L/usr/local/new/lib -ltk -ltcl -lX11 -lm
@@ -82,7 +82,7 @@
# Path for TclX/TkX include files, if different from plain Tcl.
NEWTCLXINCL =
# Extra libraries required to link TclX.
-NEWTCLXLIBS = -L/usr/local/new/lib -ltclx
+NEWTCLXLIBS = -L../mysql/lib -ltclx
# Extra libraries required to link TkX.
NEWTKXLIBS = -L/usr/local/new/lib -ltkx -ltclx
# TclX/TkX 'AppInit' files (base names).
@@ -94,16 +94,16 @@
#
#----- mSQL libraries & such
# Path for mSQL include files.
-MSQLINCL = -I/usr/local2/src/Minerva/include
+MSQLINCL = -I../mysql/include
# Libraries required to link an mSQL application.
-MSQLLIB = -L/usr/local2/src/Minerva/lib -lmsql
+MSQLLIB = -L../mysql/lib -lmysqlclient
#===== END OF CONFIGURATION DEFINITIONS =====
INCL = -I. ${MSQLINCL} ${TCLINCL} ${TKINCL}
CFLAGS = ${OPTIM} -c
LDFLAGS = ${OPTIM}
-PROGS = msqltcl msqlwish
+PROGS = msqltcl # msqlwish
TCLLINK = ${MSQLLIB} ${TCLLIBS}
TKLINK = ${MSQLLIB} ${TKLIBS}
diff -u -r msqltcl-1.50/new-tclAppInit.c mysqltcl-1.50/new-tclAppInit.c
--- msqltcl-1.50/new-tclAppInit.c Tue Jun 6 07:25:38 1995
+++ mysqltcl-1.50/new-tclAppInit.c Tue Jun 23 18:28:14 1998
@@ -14,7 +14,7 @@
static char sccsid[] = "@(#) tclAppInit.c 1.11 94/12/17 16:14:03";
#endif /* not lint */
-#include "tcl.h"
+#include "tclExtend.h"
/*
* The following variable is a special hack that is needed in order for
@@ -48,7 +48,7 @@
int argc; /* Number of command-line arguments. */
char **argv; /* Values of command-line arguments. */
{
- Tcl_Main(argc, argv);
+ TclX_Main(argc, argv, Tcl_AppInit);
return 0; /* Needed only to prevent compiler warning. */
}
@@ -79,6 +79,10 @@
return TCL_ERROR;
}
+ if (Tclx_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
/*
* Call the init procedures for included packages. Each call should
* look like this:
@@ -90,7 +94,7 @@
* where "Mod" is the name of the module.
*/
- if (Msqltcl_Init(interp) == TCL_ERROR) {
+ if (Mysqltcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -106,6 +110,6 @@
* then no user-specific startup file will be run under any conditions.
*/
- tcl_RcFileName = "~/.tclshrc";
+/* tcl_RcFileName = "~/.tclshrc"; */
return TCL_OK;
}
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
use diagnostics;
use strict;
my $query = "
select
bug_id,
product,
version,
rep_platform,
op_sys,
bug_status,
resolution,
priority,
bug_severity,
component,
assigned_to,
reporter,
bug_file_loc,
short_desc,
date_format(creation_ts,'Y-m-d')
from bugs
where bug_id = $::FORM{'id'}";
SendSQL($query);
my %bug;
my @row;
if (@row = FetchSQLData()) {
my $count = 0;
foreach my $field ("bug_id", "product", "version", "rep_platform",
"op_sys", "bug_status", "resolution", "priority",
"bug_severity", "component", "assigned_to", "reporter",
"bug_file_loc", "short_desc", "creation_ts") {
$bug{$field} = shift @row;
if (!defined $bug{$field}) {
$bug{$field} = "";
}
$count++;
}
} else {
my $maintainer = Param("maintainer");
print "<TITLE>Bug Splat Error</TITLE>\n";
print "<H1>Query Error</H1>Somehow something went wrong. Possibly if\n";
print "you mail this page to $maintainer, he will be able to fix\n";
print "things.<HR>\n";
print "Bug $::FORM{'id'} not found<H2>Query Text</H2><PRE>$query<PRE>\n";
exit 0
}
$bug{'assigned_to'} = DBID_to_name($bug{'assigned_to'});
$bug{'reporter'} = DBID_to_name($bug{'reporter'});
$bug{'long_desc'} = GetLongDescription($::FORM{'id'});
GetVersionTable();
#
# These should be read from the database ...
#
my $resolution_popup = make_options(\@::legal_resolution_no_dup,
$bug{'resolution'});
my $platform_popup = make_options(\@::legal_platform, $bug{'rep_platform'});
my $priority_popup = make_options(\@::legal_priority, $bug{'priority'});
my $sev_popup = make_options(\@::legal_severity, $bug{'bug_severity'});
my $component_popup = make_options($::components{$bug{'product'}},
$bug{'component'});
my $cc_element = '<INPUT NAME=cc SIZE=30 VALUE="' .
ShowCcList($::FORM{'id'}) . '">';
my $URL = $bug{'bug_file_loc'};
if (defined $URL && $URL ne "none" && $URL ne "NULL" && $URL ne "") {
$URL = "<B><A HREF=\"$URL\">URL:</A></B>";
} else {
$URL = "<B>URL:</B>";
}
print "
<HEAD><TITLE>Bug $::FORM{'id'} -- " . html_quote($bug{'short_desc'}) .
"</TITLE></HEAD><BODY>
<FORM NAME=changeform METHOD=POST ACTION=\"process_bug.cgi\">
<INPUT TYPE=HIDDEN NAME=\"id\" VALUE=$::FORM{'id'}>
<INPUT TYPE=HIDDEN NAME=\"was_assigned_to\" VALUE=\"$bug{'assigned_to'}\">
<TABLE CELLSPACING=0 CELLPADDING=0 BORDER=0><TR>
<TD ALIGN=RIGHT><B>Bug#:</B></TD><TD>$bug{'bug_id'}</TD>
<TD ALIGN=RIGHT><B><A HREF=\"bug_status.html#rep_platform\">Platform:</A></B></TD>
<TD><SELECT NAME=rep_platform>$platform_popup</SELECT></TD>
<TD ALIGN=RIGHT><B>Version:</B></TD>
<TD><SELECT NAME=version>" .
make_options($::versions{$bug{'product'}}, $bug{'version'}) .
"</SELECT></TD>
</TR><TR>
<TD ALIGN=RIGHT><B>Product:</B></TD>
<TD><SELECT NAME=product>" .
make_options(\@::legal_product, $bug{'product'}) .
"</SELECT></TD>
<TD ALIGN=RIGHT><B>OS:</B></TD><TD>$bug{'op_sys'}</TD>
<TD ALIGN=RIGHT><B>Reporter:</B></TD><TD>$bug{'reporter'}</TD>
</TR><TR>
<TD ALIGN=RIGHT><B><A HREF=\"bug_status.html\">Status:</A></B></TD>
<TD>$bug{'bug_status'}</TD>
<TD ALIGN=RIGHT><B><A HREF=\"bug_status.html#priority\">Priority:</A></B></TD>
<TD><SELECT NAME=priority>$priority_popup</SELECT></TD>
<TD ALIGN=RIGHT><B>Cc:</B></TD>
<TD> $cc_element </TD>
</TR><TR>
<TD ALIGN=RIGHT><B><A HREF=\"bug_status.html\">Resolution:</A></B></TD>
<TD>$bug{'resolution'}</TD>
<TD ALIGN=RIGHT><B><A HREF=\"bug_status.html#severity\">Severity:</A></B></TD>
<TD><SELECT NAME=bug_severity>$sev_popup</SELECT></TD>
<TD ALIGN=RIGHT><B>Component:</B></TD>
<TD><SELECT NAME=component>$component_popup</SELECT></TD>
</TR><TR>
<TD ALIGN=RIGHT><B><A HREF=\"bug_status.html#assigned_to\">Assigned&nbsp;To:
</A></B></TD>
<TD>$bug{'assigned_to'}</TD>
</TR><TR>
<TD ALIGN=\"RIGHT\">$URL
<TD COLSPAN=6>
<INPUT NAME=bug_file_loc VALUE=\"$bug{'bug_file_loc'}\" SIZE=60></TD>
</TR><TR>
<TD ALIGN=\"RIGHT\"><B>Summary:</B>
<TD COLSPAN=6>
<INPUT NAME=short_desc VALUE=\"" .
value_quote($bug{'short_desc'}) .
"\" SIZE=60></TD>
</TR>
</TABLE>
<br>
<B>Additional Comments:</B>
<BR>
<TEXTAREA WRAP=HARD NAME=comment ROWS=5 COLS=80></TEXTAREA><BR>
<br>
<INPUT TYPE=radio NAME=knob VALUE=none CHECKED>
Leave as <b>$bug{'bug_status'} $bug{'resolution'}</b><br>";
# knum is which knob number we're generating, in javascript terms.
my $knum = 1;
my $status = $bug{'bug_status'};
if ($status eq "NEW" || $status eq "ASSIGNED" || $status eq "REOPENED") {
if ($status ne "ASSIGNED") {
print "<INPUT TYPE=radio NAME=knob VALUE=accept>";
print "Accept bug (change status to <b>ASSIGNED</b>)<br>";
$knum++;
}
if ($bug{'resolution'} ne "") {
print "<INPUT TYPE=radio NAME=knob VALUE=clearresolution>\n";
print "Clear the resolution (remove the current resolution of\n";
print "<b>$bug{'resolution'}</b>)<br>\n";
$knum++;
}
print "<INPUT TYPE=radio NAME=knob VALUE=resolve>
Resolve bug, changing <A HREF=\"bug_status.html\">resolution</A> to
<SELECT NAME=resolution
ONCHANGE=\"document.changeform.knob\[$knum\].checked=true\">
$resolution_popup</SELECT><br>\n";
$knum++;
print "<INPUT TYPE=radio NAME=knob VALUE=duplicate>
Resolve bug, mark it as duplicate of bug #
<INPUT NAME=dup_id SIZE=6 ONCHANGE=\"document.changeform.knob\[$knum\].checked=true\"><br>\n";
$knum++;
my $assign_element = "<INPUT NAME=assigned_to SIZE=32 ONCHANGE=\"document.changeform.knob\[$knum\].checked=true\" VALUE=$bug{'assigned_to'}>";
print "<INPUT TYPE=radio NAME=knob VALUE=reassign>
<A HREF=\"bug_status.html#assigned_to\">Reassign</A> bug to
$assign_element
<br>\n";
$knum++;
print "<INPUT TYPE=radio NAME=knob VALUE=reassignbycomponent>
Reassign bug to owner of selected component<br>\n";
$knum++;
} else {
print "<INPUT TYPE=radio NAME=knob VALUE=reopen> Reopen bug<br>\n";
$knum++;
if ($status eq "RESOLVED") {
print "<INPUT TYPE=radio NAME=knob VALUE=verify>
Mark bug as <b>VERIFIED</b><br>\n";
$knum++;
}
if ($status ne "CLOSED") {
print "<INPUT TYPE=radio NAME=knob VALUE=close>
Mark bug as <b>CLOSED</b><br>\n";
$knum++;
}
}
print "
<INPUT TYPE=\"submit\" VALUE=\"Commit\">
<INPUT TYPE=\"reset\" VALUE=\"Reset\">
<INPUT TYPE=hidden name=form_name VALUE=process_bug>
<BR>
<FONT size=\"+1\"><B>
<A HREF=\"show_activity.cgi?id=$::FORM{'id'}\">View Bug Activity</A>
<A HREF=\"long_list.cgi?buglist=$::FORM{'id'}\">Format For Printing</A>
</B></FONT><BR>
</FORM>
<table><tr><td align=left><B>Description:</B></td><td width=100%>&nbsp;</td>
<td align=right>Opened:&nbsp;$bug{'creation_ts'}</td></tr></table>
<HR>
<PRE>
" . html_quote($bug{'long_desc'}) . "
</PRE>
<HR>\n";
# To add back option of editing the long description, insert after the above
# long_list.cgi line:
# <A HREF=\"edit_desc.cgi?id=$::FORM{'id'}\">Edit Long Description</A>
navigation_header();
print "</BODY>\n";
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -18,61 +18,74 @@ ...@@ -18,61 +18,74 @@
# Netscape Communications Corporation. All Rights Reserved. # Netscape Communications Corporation. All Rights Reserved.
# #
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
confirm_login #! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
require "CGI.pl";
if {![info exists FORM(pwd1)]} { confirm_login();
puts "Content-type: text/html
if (! defined $::FORM{'pwd1'}) {
print "Content-type: text/html
<H1>Change your password</H1> <H1>Change your password</H1>
<form method=post> <form method=post>
<table> <table>
<tr> <tr>
<td align=right>Please enter the new password for <b>$COOKIE(Bugzilla_login)</b>:</td> <td align=right>Please enter the new password for <b>$::COOKIE{'Bugzilla_login'}</b>:</td>
<td><input type=password name=pwd1></td> <td><input type=password name=pwd1></td>
</tr> </tr>
<tr> <tr>
<td align=right>Re-enter your new password:</td> <td align=right>Re-enter your new password:</td>
<td><input type=password name=pwd2></td> <td><input type=password name=pwd2></td>
</table> </table>
<input type=submit value=Submit>" <input type=submit value=Submit>\n";
exit exit;
} }
if {![cequal $FORM(pwd1) $FORM(pwd2)]} { if ($::FORM{'pwd1'} ne $::FORM{'pwd2'}) {
puts "Content-type: text/html print "Content-type: text/html
<H1>Try again.</H1> <H1>Try again.</H1>
The two passwords you entered did not match. Please click <b>Back</b> and try again." The two passwords you entered did not match. Please click <b>Back</b> and try again.\n";
exit exit;
} }
set pwd $FORM(pwd1) my $pwd = $::FORM{'pwd1'};
if {![regexp {^[a-zA-Z0-9-_]*$} $pwd] || [clength $pwd] < 3 || [clength $pwd] > 15} { if ($pwd !~ /^[a-zA-Z0-9-_]*$/ || length($pwd) < 3 || length($pwd) > 15) {
puts "Content-type: text/html print "Content-type: text/html
<H1>Sorry; we're picky.</H1> <H1>Sorry; we're picky.</H1>
Please choose a password that is between 3 and 15 characters long, and that Please choose a password that is between 3 and 15 characters long, and that
contains only numbers, letters, hyphens, or underlines. contains only numbers, letters, hyphens, or underlines.
<p> <p>
Please click <b>Back</b> and try again." Please click <b>Back</b> and try again.\n";
exit exit;
} }
puts "Content-type: text/html\n" print "Content-type: text/html\n\n";
# Generate a random salt.
sub x {
my $sc="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789./";
return substr($sc, int (rand () * 100000) % (length ($sc) + 1), 1);
}
my $salt = x() . x();
my $encrypted = crypt($pwd, $salt);
SendSQL "select encrypt('$pwd')" SendSQL("update profiles set password='$pwd',cryptpassword='$encrypted' where login_name=" .
set encrypted [lindex [FetchSQLData] 0] SqlQuote($::COOKIE{'Bugzilla_login'}));
SendSQL "update profiles set password='$pwd',cryptpassword='$encrypted' where login_name='[SqlQuote $COOKIE(Bugzilla_login)]'" SendSQL("update logincookies set cryptpassword = '$encrypted' where cookie = $::COOKIE{'Bugzilla_logincookie'}");
SendSQL "update logincookies set cryptpassword = '$encrypted' where cookie = $COOKIE(Bugzilla_logincookie)"
puts "<H1>OK, done.</H1> print "<H1>OK, done.</H1>
Your new password has been set. Your new password has been set.
<p> <p>
<a href=query.cgi>Back to query page.</a>" <a href=query.cgi>Back to query page.</a>\n";
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -19,70 +19,79 @@ ...@@ -19,70 +19,79 @@
# #
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" use diagnostics;
use strict;
puts "Content-type: text/html" require "CGI.pl";
print "Content-type: text/html\n";
# The master list not only says what fields are possible, but what order # The master list not only says what fields are possible, but what order
# they get displayed in. # they get displayed in.
set masterlist {opendate changeddate severity priority platform owner reporter status my @masterlist = ("opendate", "changeddate", "severity", "priority",
resolution component product version project os summary summaryfull } "platform", "owner", "reporter", "status", "resolution",
"component", "product", "version", "project", "os",
"summary", "summaryfull");
if {[info exists FORM(rememberedquery)]} { my @collist;
if {[info exists FORM(resetit)]} { if (defined $::FORM{'rememberedquery'}) {
set collist $default_column_list if (defined $::FORM{'resetit'}) {
@collist = @::default_column_list;
} else { } else {
set collist {} foreach my $i (@masterlist) {
foreach i $masterlist { if (defined $::FORM{"column_$i"}) {
if {[info exists FORM(column_$i)]} { push @collist, $i;
lappend collist $i
} }
} }
} }
puts "Set-Cookie: COLUMNLIST=$collist ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT" my $list = join(" ", @collist);
puts "Refresh: 0; URL=buglist.cgi?$FORM(rememberedquery)" print "Set-Cookie: COLUMNLIST=$list ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT\n";
puts "" print "Refresh: 0; URL=buglist.cgi?$::FORM{'rememberedquery'}\n";
puts "<TITLE>What a hack.</TITLE>" print "\n";
puts "Resubmitting your query with new columns..." print "<TITLE>What a hack.</TITLE>\n";
exit print "Resubmitting your query with new columns...\n";
exit;
} }
if {[info exists COOKIE(COLUMNLIST)]} { if (defined $::COOKIE{'COLUMNLIST'}) {
set collist $COOKIE(COLUMNLIST) @collist = split(/ /, $::COOKIE{'COLUMNLIST'});
} else { } else {
set collist $default_column_list @collist = @::default_column_list;
} }
foreach i $masterlist {
set desc($i) $i my %desc;
foreach my $i (@masterlist) {
$desc{$i} = $i;
} }
set desc(summary) "Summary (first 60 characters)" $desc{'summary'} = "Summary (first 60 characters)";
set desc(summaryfull) "Full Summary" $desc{'summaryfull'} = "Full Summary";
puts "" print "\n";
puts "Check which columns you wish to appear on the list, and then click on" print "Check which columns you wish to appear on the list, and then click\n";
puts "submit." print "on submit.\n";
puts "<p>" print "<p>\n";
puts "<FORM ACTION=colchange.cgi>" print "<FORM ACTION=colchange.cgi>\n";
puts "<INPUT TYPE=HIDDEN NAME=rememberedquery VALUE=$buffer>" print "<INPUT TYPE=HIDDEN NAME=rememberedquery VALUE=$::buffer>\n";
foreach i $masterlist { foreach my $i (@masterlist) {
if {[lsearch $collist $i] >= 0} { my $c;
set c CHECKED if (lsearch(\@collist, $i) >= 0) {
$c = 'CHECKED';
} else { } else {
set c "" $c = '';
} }
puts "<INPUT TYPE=checkbox NAME=column_$i $c>$desc($i)<br>" print "<INPUT TYPE=checkbox NAME=column_$i $c>$desc{$i}<br>\n";
} }
puts "<P>" print "<P>\n";
puts "<INPUT TYPE=\"submit\" VALUE=\"Submit\">" print "<INPUT TYPE=\"submit\" VALUE=\"Submit\">\n";
puts "</FORM>" print "</FORM>\n";
puts "<FORM ACTION=colchange.cgi>" print "<FORM ACTION=colchange.cgi>\n";
puts "<INPUT TYPE=HIDDEN NAME=rememberedquery VALUE=$buffer>" print "<INPUT TYPE=HIDDEN NAME=rememberedquery VALUE=$::buffer>\n";
puts "<INPUT TYPE=HIDDEN NAME=resetit VALUE=1>" print "<INPUT TYPE=HIDDEN NAME=resetit VALUE=1>\n";
puts "<INPUT TYPE=\"submit\" VALUE=\"Reset to Bugzilla default\">" print "<INPUT TYPE=\"submit\" VALUE=\"Reset to Bugzilla default\">\n";
puts "</FORM>" print "</FORM>\n";
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
# This file defines all the parameters that we have a GUI to edit within
# Bugzilla.
use diagnostics;
use strict;
sub WriteParams {
foreach my $i (@::param_list) {
if (!defined $::param{$i}) {
$::param{$i} = $::param_default{$i};
}
}
mkdir("data", 0777);
chmod 0777, "data";
my $tmpname = "data/params.$$";
open(FID, ">$tmpname") || die "Can't create $tmpname";
print FID GenerateCode('%::param');
print FID "1;\n";
close FID;
rename $tmpname, "data/params" || die "Can't rename $tmpname to data/params";
chmod 0666, "data/params";
}
sub DefParam {
my ($id, $desc, $type, $default, $checker) = (@_);
push @::param_list, $id;
$::param_desc{$id} = $desc;
$::param_type{$id} = $type;
$::param_default{$id} = $default;
if (defined $checker) {
$::param_checker{$id} = $checker;
}
}
sub check_numeric {
my ($value) = (@_);
if ($value !~ /^[0-9]+$/) {
return "must be a numeric value";
}
return "";
}
@::param_list = ();
# OK, here are the definitions themselves.
#
# The type of parameters (the third parameter to DefParam) can be one
# of the following:
#
# t -- A short text entry field (suitable for a single line)
# l -- A long text field (suitable for many lines)
# b -- A boolean value (either 1 or 0)
# defenum -- This param defines an enum that defines a column in one of
# the database tables. The name of the parameter is of the form
# "tablename.columnname".
# This very first one is silly. At some point, "superuserness" should be an
# attribute of the person's profile entry, and not a single name like this.
#
# When first installing bugzilla, you need to either change this line to be
# you, or (better) edit the initial "params" file and change the entry for
# param(maintainer).
DefParam("maintainer",
"The email address of the person who maintains this installation of Bugzilla.",
"t",
'terry@mozilla.org');
DefParam("urlbase",
"The URL that is the common initial leading part of all Bugzilla URLs.",
"t",
"http://cvs-mirror.mozilla.org/webtools/bugzilla/",
\&check_urlbase);
sub check_urlbase {
my ($url) = (@_);
if ($url !~ m:^http.*/$:) {
return "must be a legal URL, that starts with http and ends with a slash.";
}
return "";
}
DefParam("usedespot",
"If this is on, then we are using the Despot system to control our database of users. Bugzilla won't ever write into the user database, it will let the Despot code maintain that. And Bugzilla will send the user over to Despot URLs if they need to change their password. Also, in that case, Bugzilla will treat the passwords stored in the database as being crypt'd, not plaintext.",
"b",
0);
DefParam("despotbaseurl",
"The base URL for despot. Used only if <b>usedespot</b> is turned on, above.",
"t",
"http://cvs-mirror.mozilla.org/webtools/despot/despot.cgi",
\&check_despotbaseurl);
sub check_despotbaseurl {
my ($url) = (@_);
if ($url !~ /^http.*cgi$/) {
return "must be a legal URL, that starts with http and ends with .cgi";
}
return "";
}
DefParam("bannerhtml",
"The html that gets emitted at the head of every Bugzilla page.",
"l",
q{<TABLE BGCOLOR="#000000" WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0>
<TR><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>});
DefParam("blurbhtml",
"A blurb that appears as part of the header of every Bugzilla page. This is a place to put brief warnings, pointers to one or two related pages, etc.",
"l",
"This is <B>Bugzilla</B>: the Mozilla bug system. For more
information about what Bugzilla is and what it can do, see
<A HREF=http://www.mozilla.org/>mozilla.org</A>'s
<A HREF=http://www.mozilla.org/bugs/><B>bug pages</B></A>.");
DefParam("changedmail",
q{The email that gets sent to people when a bug changes. Within this
text, %to% gets replaced by the assigned-to and reported-by people,
separated by a comma (with duplication removed, if they're the same
person). %cc% gets replaced by the list of people on the CC list,
separated by commas. %bugid% gets replaced by the bug number.
%diffs% gets replaced by the diff text from the old version to the new
version of this bug. %neworchanged% is either "New" or "Changed",
depending on whether this mail is reporting a new bug or changes made
to an existing one. %summary% gets replaced by the summary of this
bug. %<i>anythingelse</i>% gets replaced by the definition of that
parameter (as defined on this page).},
"l",
"From: bugzilla-daemon
To: %to%
Cc: %cc%
Subject: [Bug %bugid%] %neworchanged% - %summary%
%urlbase%show_bug.cgi?id=%bugid%
%diffs%");
DefParam("whinedays",
"The number of days that we'll let a bug sit untouched in a NEW state before our cronjob will whine at the owner.",
"t",
7,
\&check_numeric);
DefParam("whinemail",
"The email that gets sent to anyone who has a NEW bug that hasn't been touched for more than <b>whinedays</b>. Within this text, %email% gets replaced by the offender's email address. %<i>anythingelse</i>% gets replaced by the definition of that parameter (as defined on this page).<p> It is a good idea to make sure this message has a valid From: address, so that if the mail bounces, a real person can know that there are bugs assigned to an invalid address.",
"l",
q{From: %maintainer%
To: %email%
Subject: Your Bugzilla buglist needs attention.
[This e-mail has been automatically generated.]
You have one or more bugs assigned to you in the Bugzilla
bugsystem (%urlbase%) that require
attention.
All of these bugs are in the NEW state, and have not been touched
in %whinedays% days or more. You need to take a look at them, and
decide on an initial action.
Generally, this means one of three things:
(1) You decide this bug is really quick to deal with (like, it's INVALID),
and so you get rid of it immediately.
(2) You decide the bug doesn't belong to you, and you reassign it to someone
else. (Hint: if you don't know who to reassign it to, make sure that
the Component field seems reasonable, and then use the "Reassign bug to
owner of selected component" option.)
(3) You decide the bug belongs to you, but you can't solve it this moment.
Just use the "Accept bug" command.
To get a list of all NEW bugs, you can use this URL (bookmark it if you like!):
%urlbase%buglist.cgi?bug_status=NEW&assigned_to=%email%
Or, you can use the general query page, at
%urlbase%query.cgi.
Appended below are the individual URLs to get to all of your NEW bugs that
haven't been touched for a week or more.
You will get this message once a day until you've dealt with these bugs!
});
DefParam("defaultquery",
"This is the default query that initially comes up when you submit a bug. It's in URL parameter format, which makes it hard to read. Sorry!",
"t",
"bug_status=NEW&bug_status=ASSIGNED&bug_status=REOPENED&product=Mozilla&order=%22Importance%22");
1;
...@@ -71,6 +71,10 @@ set param_list {} ...@@ -71,6 +71,10 @@ set param_list {}
# #
# t -- A short text entry field (suitable for a single line) # t -- A short text entry field (suitable for a single line)
# l -- A long text field (suitable for many lines) # l -- A long text field (suitable for many lines)
# b -- A boolean value (either 1 or 0)
# defenum -- This param defines an enum that defines a column in one of
# the database tables. The name of the parameter is of the form
# "tablename.columnname".
# This very first one is silly. At some point, "superuserness" should be an # This very first one is silly. At some point, "superuserness" should be an
# attribute of the person's profile entry, and not a single name like this. # attribute of the person's profile entry, and not a single name like this.
...@@ -90,6 +94,22 @@ proc check_urlbase {url} { ...@@ -90,6 +94,22 @@ proc check_urlbase {url} {
return "" return ""
} }
DefParam usedespot {If this is on, then we are using the Despot system to control our database of users. Bugzilla won't ever write into the user database, it will let the Despot code maintain that. And Bugzilla will send the user over to Despot URLs if they need to change their password. Also, in that case, Bugzilla will treat the passwords stored in the database as being crypt'd, not plaintext.} b 0
DefParam despotbaseurl {The base URL for despot. Used only if <b>usedespot</b> is turned on, above.} t {http://cvs-mirror.mozilla.org/webtools/despot/despot.cgi} check_despotbaseurl
proc check_despotbaseurl {url} {
if {![regexp {^http.*cgi$} $url]} {
return "must be a legal URL, that starts with http and ends with .cgi"
}
return ""
}
DefParam bannerhtml {The html that gets emitted at the head of every Bugzilla page.} l {<TABLE BGCOLOR="#000000" WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0> DefParam bannerhtml {The html that gets emitted at the head of every Bugzilla page.} l {<TABLE BGCOLOR="#000000" WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0>
<TR><TD><A HREF="http://www.mozilla.org/"><IMG <TR><TD><A HREF="http://www.mozilla.org/"><IMG
SRC="http://www.mozilla.org/images/mozilla-banner.gif" ALT="" SRC="http://www.mozilla.org/images/mozilla-banner.gif" ALT=""
...@@ -148,3 +168,4 @@ You will get this message once a day until you've dealt with these bugs! ...@@ -148,3 +168,4 @@ You will get this message once a day until you've dealt with these bugs!
DefParam defaultquery {This is the default query that initially comes up when you submit a bug. It's in URL parameter format, which makes it hard to read. Sorry!} t "bug_status=NEW&bug_status=ASSIGNED&bug_status=REOPENED&product=Mozilla&order=%22Importance%22" DefParam defaultquery {This is the default query that initially comes up when you submit a bug. It's in URL parameter format, which makes it hard to read. Sorry!} t "bug_status=NEW&bug_status=ASSIGNED&bug_status=REOPENED&product=Mozilla&order=%22Importance%22"
DefParam bugs.bug_status {The different statuses that a bug
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -19,44 +19,57 @@ ...@@ -19,44 +19,57 @@
# #
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" use diagnostics;
source "defparams.tcl" use strict;
confirm_login require "CGI.pl";
require "defparams.pl";
puts "Content-type: text/html\n" # Shut up misguided -w warnings about "used only once":
use vars %::param,
%::param_default,
@::param_list,
%::COOKIE;
if {![cequal [Param "maintainer"] $COOKIE(Bugzilla_login)]} {
puts "<H1>Sorry, you aren't the maintainer of this system.</H1>" confirm_login();
puts "And so, you aren't allowed to edit the parameters of it."
exit print "Content-type: text/html\n\n";
if (Param("maintainer") ne $::COOKIE{'Bugzilla_login'}) {
print "<H1>Sorry, you aren't the maintainer of this system.</H1>\n";
print "And so, you aren't allowed to edit the parameters of it.\n";
exit;
} }
PutHeader "Saving new parameters" "Saving new parameters" PutHeader("Saving new parameters");
foreach i $param_list { foreach my $i (@::param_list) {
if {[info exists FORM(reset-$i)]} { # print "Processing $i...<BR>\n";
set FORM($i) $param_default($i) if (exists $::FORM{"reset-$i"}) {
$::FORM{$i} = $::param_default{$i};
} }
if {![cequal $FORM($i) [Param $i]]} { $::FORM{$i} =~ s/\r\n/\n/; # Get rid of windows-style line endings.
if {![cequal $param_checker($i) ""]} { if ($::FORM{$i} ne Param($i)) {
set ok [$param_checker($i) $FORM($i)] if (defined $::param_checker{$i}) {
if {![cequal $ok ""]} { my $ref = $::param_checker{$i};
puts "New value for $i is invalid: $ok<p>" my $ok = &$ref($::FORM{$i});
puts "Please hit <b>Back</b> and try again." if ($ok ne "") {
exit print "New value for $i is invalid: $ok<p>\n";
print "Please hit <b>Back</b> and try again.\n";
exit;
} }
} }
puts "Changed $i.<br>" print "Changed $i.<br>\n";
set param($i) $FORM($i) $::param{$i} = $::FORM{$i}
} }
} }
WriteParams WriteParams();
puts "OK, done.<p>" print "OK, done.<p>\n";
puts "<a href=editparams.cgi>Edit the params some more.</a><p>" print "<a href=editparams.cgi>Edit the params some more.</a><p>\n";
puts "<a href=query.cgi>Go back to the query page.</a>" print "<a href=query.cgi>Go back to the query page.</a>\n";
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -20,66 +20,81 @@ ...@@ -20,66 +20,81 @@
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" use diagnostics;
source "defparams.tcl" use strict;
confirm_login require "CGI.pl";
require "defparams.pl";
puts "Content-type: text/html\n" # Shut up misguided -w warnings about "used only once":
use vars @::param_desc,
@::param_list,
%::COOKIE;
if {![cequal [Param "maintainer"] $COOKIE(Bugzilla_login)]} { confirm_login();
puts "<H1>Sorry, you aren't the maintainer of this system.</H1>"
puts "And so, you aren't allowed to edit the parameters of it." print "Content-type: text/html\n\n";
exit
if (Param("maintainer") ne $::COOKIE{Bugzilla_login}) {
print "<H1>Sorry, you aren't the maintainer of this system.</H1>\n";
print "And so, you aren't allowed to edit the parameters of it.\n";
exit;
} }
PutHeader "Edit parameters" "Edit parameters" PutHeader("Edit parameters");
puts "This lets you edit the basic operating parameters of bugzilla. Be careful!" print "This lets you edit the basic operating parameters of bugzilla.\n";
puts "<p>" print "Be careful!\n";
puts "Any item you check Reset on will get reset to its default value." print "<p>\n";
print "Any item you check Reset on will get reset to its default value.\n";
puts "<form method=post action=doeditparams.cgi><table>"
print "<form method=post action=doeditparams.cgi><table>\n";
set rowbreak "<tr><td colspan=2><hr></td></tr>"
puts $rowbreak my $rowbreak = "<tr><td colspan=2><hr></td></tr>";
print $rowbreak;
foreach i $param_list {
puts "<tr><th align=right valign=top>$i:</th><td>$param_desc($i)</td></tr>" foreach my $i (@::param_list) {
puts "<tr><td valign=top><input type=checkbox name=reset-$i>Reset</td><td>" print "<tr><th align=right valign=top>$i:</th><td>$::param_desc{$i}</td></tr>\n";
set value [Param $i] print "<tr><td valign=top><input type=checkbox name=reset-$i>Reset</td><td>\n";
switch $param_type($i) { my $value = Param($i);
t { SWITCH: for ($::param_type{$i}) {
puts "<input size=80 name=$i value=\"[value_quote $value]\">" /^t$/ && do {
} print "<input size=80 name=$i value=\"" .
l { value_quote($value) . '">\n';
puts "<textarea wrap=hard name=$i rows=10 cols=80>[value_quote $value]</textarea>" last SWITCH;
} };
b { /^l$/ && do {
if {$value} { print "<textarea wrap=hard name=$i rows=10 cols=80>" .
set on "checked" value_quote($value) . "</textarea>\n";
set off "" last SWITCH;
};
/^b$/ && do {
my $on;
my $off;
if ($value) {
$on = "checked";
$off = "";
} else { } else {
set on "" $on = "";
set off "checked" $off = "checked";
} }
puts "<input type=radio name=$i value=1 $on>On " print "<input type=radio name=$i value=1 $on>On\n";
puts "<input type=radio name=$i value=0 $off>Off" print "<input type=radio name=$i value=0 $off>Off\n";
} last SWITCH;
default { };
puts "<font color=red><blink>Unknown param type $param_type($i)!!!</blink></font>" # DEFAULT
} print "<font color=red><blink>Unknown param type $::param_type{$i}!!!</blink></font>\n";
} }
puts "</td></tr>" print "</td></tr>\n";
puts $rowbreak print $rowbreak;
} }
puts "</table>" print "</table>\n";
puts "<input type=reset value=\"Reset form\"><br>" print "<input type=reset value=\"Reset form\"><br>\n";
puts "<input type=submit value=\"Submit changes\">" print "<input type=submit value=\"Submit changes\">\n";
puts "</form>" print "</form>\n";
puts "<p><a href=query.cgi>Skip all this, and go back to the query page</a>" print "<p><a href=query.cgi>Skip all this, and go back to the query page</a>\n";
This diff is collapsed. Click to expand it.
...@@ -110,7 +110,6 @@ proc SortIgnoringCase {a b} { ...@@ -110,7 +110,6 @@ proc SortIgnoringCase {a b} {
proc make_popup { name src default listtype {onchange {}}} { proc make_popup { name src default listtype {onchange {}}} {
set last ""
set popup "<SELECT NAME=$name" set popup "<SELECT NAME=$name"
if {$listtype > 0} { if {$listtype > 0} {
append popup " SIZE=5" append popup " SIZE=5"
......
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -20,11 +20,18 @@ ...@@ -20,11 +20,18 @@
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" use diagnostics;
puts "Content-type: text/html\n" use strict;
puts "<TITLE>Full Text Bug Listing</TITLE>"
set generic_query { require "CGI.pl";
# Shut up misguided -w warnings about "used only once":
use vars %::FORM;
print "Content-type: text/html\n\n";
print "<TITLE>Full Text Bug Listing</TITLE>\n";
my $generic_query = "
select select
bugs.bug_id, bugs.bug_id,
bugs.product, bugs.product,
...@@ -42,34 +49,39 @@ select ...@@ -42,34 +49,39 @@ select
bugs.short_desc bugs.short_desc
from bugs,profiles assign,profiles report from bugs,profiles assign,profiles report
where assign.userid = bugs.assigned_to and report.userid = bugs.reporter and where assign.userid = bugs.assigned_to and report.userid = bugs.reporter and
} ";
ConnectToDatabase ConnectToDatabase();
foreach bug [split $FORM(buglist) :] { foreach my $bug (split(/:/, $::FORM{'buglist'})) {
SendSQL "$generic_query bugs.bug_id = $bug\n" SendSQL("$generic_query bugs.bug_id = $bug");
if { [ MoreSQLData ] } { my @row;
set result [ FetchSQLData ] if (@row = FetchSQLData()) {
puts "<IMG SRC=\"1x1.gif\" WIDTH=1 HEIGHT=80 ALIGN=LEFT>" my ($id, $product, $version, $platform, $opsys, $status, $severity,
puts "<TABLE WIDTH=100%>" $priority, $resolution, $assigned, $reporter, $component, $url,
puts "<TD COLSPAN=4><TR><DIV ALIGN=CENTER><B><FONT =\"+3\">[html_quote [lindex $result 15]]</B></FONT></DIV>" $shortdesc) = (@row);
puts "<TR><TD><B>Bug#:</B> <A HREF=\"show_bug.cgi?id=[lindex $result 0]\">[lindex $result 0]</A>" print "<IMG SRC=\"1x1.gif\" WIDTH=1 HEIGHT=80 ALIGN=LEFT>\n";
puts "<TD><B>Product:</B> [lindex $result 1]" print "<TABLE WIDTH=100%>\n";
puts "<TD><B>Version:</B> [lindex $result 2]" print "<TD COLSPAN=4><TR><DIV ALIGN=CENTER><B><FONT =\"+3\">" .
puts "<TD><B>Platform:</B> [lindex $result 3]" html_quote($shortdesc) .
puts "<TR><TD><B>OS/Version:</B> [lindex $result 4]" "</B></FONT></DIV>\n";
puts "<TD><B>Status:</B> [lindex $result 5]" print "<TR><TD><B>Bug#:</B> <A HREF=\"show_bug.cgi?id=$id\">$id</A>\n";
puts "<TD><B>Severity:</B> [lindex $result 6]" print "<TD><B>Product:</B> $product\n";
puts "<TD><B>Priority:</B> [lindex $result 7]" print "<TD><B>Version:</B> $version\n";
puts "<TR><TD><B>Resolution:</B> [lindex $result 8]</TD>" print "<TD><B>Platform:</B> $platform\n";
puts "<TD><B>Assigned To:</B> [lindex $result 9]" print "<TR><TD><B>OS/Version:</B> $opsys\n";
puts "<TD><B>Reported By:</B> [lindex $result 10]" print "<TD><B>Status:</B> $status\n";
puts "<TR><TD><B>Component:</B> [lindex $result 11]" print "<TD><B>Severity:</B> $severity\n";
puts "<TR><TD COLSPAN=6><B>URL:</B> [html_quote [lindex $result 12]]" print "<TD><B>Priority:</B> $priority\n";
puts "<TR><TD COLSPAN=6><B>Summary&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;:</B> [html_quote [lindex $result 13]]" print "<TR><TD><B>Resolution:</B> $resolution</TD>\n";
puts "<TR><TD><B>Description&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;:</B>\n</TABLE>" print "<TD><B>Assigned To:</B> $assigned\n";
puts "<PRE>[html_quote [GetLongDescription $bug]]</PRE>" print "<TD><B>Reported By:</B> $reporter\n";
puts "<HR>" print "<TR><TD><B>Component:</B> $component\n";
} print "<TR><TD COLSPAN=6><B>URL:</B> " . html_quote($url) . "\n";
print "<TR><TD COLSPAN=6><B>Summary&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;:</B> " . html_quote($shortdesc) . "\n";
print "<TR><TD><B>Description&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;:</B>\n</TABLE>\n";
print "<PRE>" . html_quote(GetLongDescription($bug)) . "</PRE>\n";
print "<HR>\n";
}
} }
...@@ -31,7 +31,7 @@ foreach $pair (@pairs) ...@@ -31,7 +31,7 @@ foreach $pair (@pairs)
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value; $FORM{$name} = $value;
} }
open(COMMENTS, ">>comments"); open(COMMENTS, ">>data/comments");
$c=$FORM{"comment"}; $c=$FORM{"comment"};
print COMMENTS $FORM{"comment"} . "\n"; print COMMENTS $FORM{"comment"} . "\n";
close(COMMENTS); close(COMMENTS);
......
...@@ -31,4 +31,4 @@ funny or boring and bonk on the button. ...@@ -31,4 +31,4 @@ funny or boring and bonk on the button.
<INPUT TYPE="submit" VALUE="Add This Quip"></FORM> <INPUT TYPE="submit" VALUE="Add This Quip"></FORM>
</HR> </HR>
For the impatient, you can For the impatient, you can
<A HREF="comments">view the whole quip list</A>. <A HREF="data/comments">view the whole quip list</A>.
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -20,118 +20,104 @@ ...@@ -20,118 +20,104 @@
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" use diagnostics;
confirm_login use strict;
puts "Set-Cookie: PLATFORM=$FORM(product) ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT" require "CGI.pl";
puts "Set-Cookie: VERSION-$FORM(product)=$FORM(version) ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT"
puts "Content-type: text/html\n"
if {[info exists FORM(maketemplate)]} { # Shut up misguided -w warnings about "used only once". For some reason,
puts "<TITLE>Bookmarks are your friend.</TITLE>" # "use vars" chokes on me when I try it here.
puts "<H1>Template constructed.</H1>"
set url "enter_bug.cgi?$buffer"
puts "If you put a bookmark <a href=\"$url\">to this link</a>, it will" # use vars qw($::buffer);
puts "bring up the submit-a-new-bug page with the fields initialized" my $zz = $::buffer;
puts "as you've requested." $zz = $zz . $zz;
exit
}
PutHeader "Posting Bug -- Please wait" "Posting Bug" "One moment please..." confirm_login();
flush stdout print "Set-Cookie: PLATFORM=$::FORM{'product'} ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT\n";
umask 0 print "Set-Cookie: VERSION-$::FORM{'product'}=$::FORM{'version'} ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT\n";
ConnectToDatabase print "Content-type: text/html\n\n";
if {![info exists FORM(component)] || [cequal $FORM(component) ""]} { if (defined $::FORM{'maketemplate'}) {
puts "You must choose a component that corresponds to this bug. If" print "<TITLE>Bookmarks are your friend.</TITLE>\n";
puts "necessary, just guess. But please hit the <B>Back</B> button and" print "<H1>Template constructed.</H1>\n";
puts "choose a component."
exit 0
}
my $url = "enter_bug.cgi?$::buffer";
set forceAssignedOK 0 print "If you put a bookmark <a href=\"$url\">to this link</a>, it will\n";
if {[cequal "" $FORM(assigned_to)]} { print "bring up the submit-a-new-bug page with the fields initialized\n";
SendSQL "select initialowner from components print "as you've requested.\n";
where program='[SqlQuote $FORM(product)]' exit;
and value='[SqlQuote $FORM(component)]'"
set FORM(assigned_to) [lindex [FetchSQLData] 0]
set forceAssignedOK 1
} }
set FORM(assigned_to) [DBNameToIdAndCheck $FORM(assigned_to) $forceAssignedOK] PutHeader("Posting Bug -- Please wait", "Posting Bug", "One moment please...");
set FORM(reporter) [DBNameToIdAndCheck $FORM(reporter)]
umask 0;
ConnectToDatabase();
set bug_fields { reporter product version rep_platform bug_severity \ if (!defined $::FORM{'component'} || $::FORM{'component'} eq "") {
priority op_sys assigned_to bug_status bug_file_loc \ print "You must choose a component that corresponds to this bug. If\n";
short_desc component } print "necessary, just guess. But please hit the <B>Back</B> button\n";
set query "insert into bugs (\n" print "and choose a component.\n";
exit 0
}
foreach field $bug_fields { my $forceAssignedOK = 0;
append query "$field,\n" if ($::FORM{'assigned_to'} eq "") {
SendSQL("select initialowner from components where program=" .
SqlQuote($::FORM{'product'}) .
" and value=" . SqlQuote($::FORM{'component'}));
$::FORM{'assigned_to'} = FetchOneColumn();
$forceAssignedOK = 1;
} }
append query "creation_ts, long_desc )\nvalues (\n" $::FORM{'assigned_to'} = DBNameToIdAndCheck($::FORM{'assigned_to'}, $forceAssignedOK);
$::FORM{'reporter'} = DBNameToIdAndCheck($::FORM{'reporter'});
foreach field $bug_fields { my @bug_fields = ("reporter", "product", "version", "rep_platform",
if {$field == "qa_assigned_to"} { "bug_severity", "priority", "op_sys", "assigned_to",
"bug_status", "bug_file_loc", "short_desc", "component");
my $query = "insert into bugs (\n" . join(",\n", @bug_fields) . ",
creation_ts, long_desc )
values (
";
set valin [DBname_to_id $FORM($field)]
if {$valin == "__UNKNOWN__"} {
append query "null,\n"
} else {
append query "$valin,\n"
}
} else { foreach my $field (@bug_fields) {
regsub -all "'" [FormData $field] "''" value $query .= SqlQuote($::FORM{$field}) . ",\n";
append query "'$value',\n"
}
} }
append query "now(), " $query .= "now(), " . SqlQuote($::FORM{'comment'}) . " )\n";
append query "'[SqlQuote [FormData comment]]' )\n"
set ccids(zz) 1 my %ccids;
unset ccids(zz)
if {[info exists FORM(cc)]} { if (defined $::FORM{'cc'}) {
foreach person [split $FORM(cc) " ,"] { foreach my $person (split(/[ ,]/, $::FORM{'cc'})) {
if {![cequal $person ""]} { if ($person ne "") {
set ccids([DBNameToIdAndCheck $person]) 1 $ccids{DBNameToIdAndCheck($person)} = 1;
} }
} }
} }
# puts "<PRE>$query</PRE>" # print "<PRE>$query</PRE>\n";
SendSQL $query SendSQL($query);
while {[MoreSQLData]} { set ret [FetchSQLData] }
SendSQL "select LAST_INSERT_ID()" SendSQL("select LAST_INSERT_ID()");
set id [FetchSQLData] my $id = FetchOneColumn();
foreach person [array names ccids] { foreach my $person (keys %ccids) {
SendSQL "insert into cc (bug_id, who) values ($id, $person)" SendSQL("insert into cc (bug_id, who) values ($id, $person)");
while { [ MoreSQLData ] } { FetchSQLData }
} }
# Now make sure changes are written before we run processmail... print "<H2>Changes Submitted</H2>\n";
Disconnect print "<A HREF=\"show_bug.cgi?id=$id\">Show BUG# $id</A>\n";
print "<BR><A HREF=\"query.cgi\">Back To Query Page</A>\n";
puts "<H2>Changes Submitted</H2>"
puts "<A HREF=\"show_bug.cgi?id=$id\">Show BUG# $id</A>"
puts "<BR><A HREF=\"query.cgi\">Back To Query Page</A>"
flush stdout
exec ./processmail $id < /dev/null > /dev/null 2> /dev/null & system("./processmail $id < /dev/null > /dev/null 2> /dev/null &");
exit exit;
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -19,66 +19,90 @@ ...@@ -19,66 +19,90 @@
# #
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" # Contains some global routines used throughout the CGI scripts of Bugzilla.
if {[catch { use diagnostics;
use strict;
require "CGI.pl";
# Shut up misguided -w warnings about "used only once":
if {[info exists FORM(GoAheadAndLogIn)]} { use vars @::legal_resolution,
@::legal_product,
@::legal_bug_status,
@::legal_priority,
@::legal_resolution,
@::legal_platform,
@::legal_components,
@::legal_versions,
@::legal_severity,
%::FORM;
if (defined $::FORM{"GoAheadAndLogIn"}) {
# We got here from a login page, probably from relogin.cgi. We better # We got here from a login page, probably from relogin.cgi. We better
# make sure the password is legit. # make sure the password is legit.
confirm_login confirm_login();
} }
if (!defined $::COOKIE{"DEFAULTQUERY"}) {
if {![info exists COOKIE(DEFAULTQUERY)]} { $::COOKIE{"DEFAULTQUERY"} = Param("defaultquery");
set COOKIE(DEFAULTQUERY) [Param defaultquery]
} }
if {![info exists buffer] || $buffer == ""} { if (!defined $::buffer || $::buffer eq "") {
set buffer $COOKIE(DEFAULTQUERY) $::buffer = $::COOKIE{"DEFAULTQUERY"};
} }
foreach name {bug_status resolution assigned_to rep_platform priority \ my %default;
bug_severity product reporter op_sys component \ my %type;
version} {
set default($name) "" foreach my $name ("bug_status", "resolution", "assigned_to", "rep_platform",
set type($name) 0 "priority", "bug_severity", "product", "reporter", "op_sys",
"component", "version") {
$default{$name} = "";
$type{$name} = 0;
} }
foreach item [split $buffer "&"] {
set el [ split $item = ] foreach my $item (split(/\&/, $::buffer)) {
set value [url_decode [lindex $el 1]] my @el = split(/=/, $item);
set name [lindex $el 0] my $name = $el[0];
if {[info exists default($name)]} { my $value;
if {$default($name) != ""} { if ($#el > 0) {
append default($name) "|$value" $value = url_decode($el[1]);
set type($name) 1 } else {
$value = "";
}
if (defined $default{$name}) {
if ($default{$name} ne "") {
$default{$name} .= "|$value";
$type{$name} = 1;
} else { } else {
set default($name) $value $default{$name} = $value;
} }
} }
} }
my $namelist = "";
foreach i [lsort [array names COOKIE]] { foreach my $i (sort (keys %::COOKIE)) {
switch -glob $i { if ($i =~ /^QUERY_/) {
QUERY_* { if ($::COOKIE{$i} ne "") {
if {$COOKIE($i) != ""} { my $name = substr($i, 6);
set name [crange $i 6 end] $namelist .= "<OPTION>$name";
append namelist "<OPTION>$name"
}
} }
} }
} }
puts "Set-Cookie: BUGLIST=
Content-type: text/html\n"
GetVersionTable print "Set-Cookie: BUGLIST=
set who [GeneratePeopleInput assigned_to $default(assigned_to)] Content-type: text/html\n\n";
set reporter [GeneratePeopleInput reporter $default(reporter)]
set qa_assigned_to_who [GeneratePeopleInput qa_assigned_to ""] GetVersionTable();
my $who = GeneratePeopleInput("assigned_to", $default{"assigned_to"});
my $reporter = GeneratePeopleInput("reporter", $default{"reporter"});
# Muck the "legal product" list so that the default one is always first (and # Muck the "legal product" list so that the default one is always first (and
...@@ -86,14 +110,16 @@ set qa_assigned_to_who [GeneratePeopleInput qa_assigned_to ""] ...@@ -86,14 +110,16 @@ set qa_assigned_to_who [GeneratePeopleInput qa_assigned_to ""]
# Commented out, until we actually have enough products for this to matter. # Commented out, until we actually have enough products for this to matter.
# set w [lsearch $legal_product $default(product)] # set w [lsearch $legal_product $default{"product"}]
# if {$w >= 0} { # if {$w >= 0} {
# set legal_product [concat $default(product) [lreplace $legal_product $w $w]] # set legal_product [concat $default{"product"} [lreplace $legal_product $w $w]]
# } # }
PutHeader "Bugzilla Query Page" "Query Page" PutHeader("Bugzilla Query Page", "Query Page");
push @::legal_resolution, "---"; # Oy, what a hack.
puts " print "
<FORM NAME=queryForm METHOD=GET ACTION=\"buglist.cgi\"> <FORM NAME=queryForm METHOD=GET ACTION=\"buglist.cgi\">
<table> <table>
...@@ -107,27 +133,27 @@ puts " ...@@ -107,27 +133,27 @@ puts "
<tr> <tr>
<td align=left valign=top> <td align=left valign=top>
<SELECT NAME=\"bug_status\" MULTIPLE SIZE=7> <SELECT NAME=\"bug_status\" MULTIPLE SIZE=7>
[make_options $legal_bug_status $default(bug_status) $type(bug_status)] @{[make_options(\@::legal_bug_status, $default{'bug_status'}, $type{'bug_status'})]}
</SELECT> </SELECT>
</td> </td>
<td align=left valign=top> <td align=left valign=top>
<SELECT NAME=\"resolution\" MULTIPLE SIZE=7> <SELECT NAME=\"resolution\" MULTIPLE SIZE=7>
[make_options [concat $legal_resolution [list "---"]] $default(resolution) $type(resolution)] @{[make_options(\@::legal_resolution, $default{'resolution'}, $type{'resolution'})]}
</SELECT> </SELECT>
</td> </td>
<td align=left valign=top> <td align=left valign=top>
<SELECT NAME=\"rep_platform\" MULTIPLE SIZE=7> <SELECT NAME=\"rep_platform\" MULTIPLE SIZE=7>
[make_options $legal_platform $default(rep_platform) $type(rep_platform)] @{[make_options(\@::legal_platform, $default{'rep_platform'}, $type{'rep_platform'})]}
</SELECT> </SELECT>
</td> </td>
<td align=left valign=top> <td align=left valign=top>
<SELECT NAME=\"priority\" MULTIPLE SIZE=7> <SELECT NAME=\"priority\" MULTIPLE SIZE=7>
[make_options $legal_priority $default(priority) $type(priority) ] @{[make_options(\@::legal_priority, $default{'priority'}, $type{'priority'})]}
</SELECT> </SELECT>
</td> </td>
<td align=left valign=top> <td align=left valign=top>
<SELECT NAME=\"bug_severity\" MULTIPLE SIZE=7> <SELECT NAME=\"bug_severity\" MULTIPLE SIZE=7>
[make_options $legal_severity $default(bug_severity) $type(bug_severity)] @{[make_options(\@::legal_severity, $default{'bug_severity'}, $type{'bug_severity'})]}
</SELECT> </SELECT>
</tr> </tr>
</table> </table>
...@@ -154,19 +180,19 @@ puts " ...@@ -154,19 +180,19 @@ puts "
<td align=left valign=top> <td align=left valign=top>
<SELECT NAME=\"product\" MULTIPLE SIZE=5> <SELECT NAME=\"product\" MULTIPLE SIZE=5>
[make_options $legal_product $default(product) $type(product)] @{[make_options(\@::legal_product, $default{'product'}, $type{'product'})]}
</SELECT> </SELECT>
</td> </td>
<td align=left valign=top> <td align=left valign=top>
<SELECT NAME=\"version\" MULTIPLE SIZE=5> <SELECT NAME=\"version\" MULTIPLE SIZE=5>
[make_options $legal_versions $default(version) $type(version)] @{[make_options(\@::legal_versions, $default{'version'}, $type{'version'})]}
</SELECT> </SELECT>
</td> </td>
<td align=left valign=top> <td align=left valign=top>
<SELECT NAME=\"component\" MULTIPLE SIZE=5> <SELECT NAME=\"component\" MULTIPLE SIZE=5>
[make_options $legal_components $default(component) $type(component)] @{[make_options(\@::legal_components, $default{'component'}, $type{'component'})]}
</SELECT> </SELECT>
</td> </td>
...@@ -193,10 +219,11 @@ puts " ...@@ -193,10 +219,11 @@ puts "
<BR> <BR>
<INPUT TYPE=radio NAME=cmdtype VALUE=doit CHECKED> Run this query <INPUT TYPE=radio NAME=cmdtype VALUE=doit CHECKED> Run this query
<BR>" <BR>
";
if {[info exists namelist]} { if ($namelist ne "") {
puts " print "
<table cellspacing=0 cellpadding=0><tr> <table cellspacing=0 cellpadding=0><tr>
<td><INPUT TYPE=radio NAME=cmdtype VALUE=editnamed> Load the remembered query:</td> <td><INPUT TYPE=radio NAME=cmdtype VALUE=editnamed> Load the remembered query:</td>
<td rowspan=3><select name=namedcmd>$namelist</select> <td rowspan=3><select name=namedcmd>$namelist</select>
...@@ -207,7 +234,7 @@ if {[info exists namelist]} { ...@@ -207,7 +234,7 @@ if {[info exists namelist]} {
</tr></table>" </tr></table>"
} }
puts " print "
<INPUT TYPE=radio NAME=cmdtype VALUE=asdefault> Remember this as the default query <INPUT TYPE=radio NAME=cmdtype VALUE=asdefault> Remember this as the default query
<BR> <BR>
<INPUT TYPE=radio NAME=cmdtype VALUE=asnamed> Remember this query, and name it: <INPUT TYPE=radio NAME=cmdtype VALUE=asnamed> Remember this query, and name it:
...@@ -227,19 +254,18 @@ puts " ...@@ -227,19 +254,18 @@ puts "
</CENTER> </CENTER>
</FORM> </FORM>
" ";
if {[info exists COOKIE(Bugzilla_login)]} { if (defined $::COOKIE{"Bugzilla_login"}) {
if {[cequal $COOKIE(Bugzilla_login) [Param maintainer]]} { if ($::COOKIE{"Bugzilla_login"} eq Param("maintainer")) {
puts "<a href=editparams.cgi>Edit Bugzilla operating parameters</a><br>" print "<a href=editparams.cgi>Edit Bugzilla operating parameters</a><br>\n";
} }
puts "<a href=relogin.cgi>Log in as someone besides <b>$COOKIE(Bugzilla_login)</b></a><br>" print "<a href=relogin.cgi>Log in as someone besides <b>$::COOKIE{'Bugzilla_login'}</b></a><br>\n";
} }
puts "<a href=changepassword.cgi>Change your password.</a><br>" print "<a href=changepassword.cgi>Change your password.</a><br>\n";
puts "<a href=\"enter_bug.cgi\">Create a new bug.</a><br>" print "<a href=\"enter_bug.cgi\">Create a new bug.</a><br>\n";
}]} {
puts "\n\nQuery Page Error\n$errorInfo"
# exec /usr/lib/sendmail -t << "To: terry\n\n$errorInfo\n"
}
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -19,13 +19,13 @@ ...@@ -19,13 +19,13 @@
# #
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source CGI.tcl use diagnostics;
use strict;
require "CGI.pl";
print "Set-Cookie: Bugzilla_login= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT
puts "Set-Cookie: Bugzilla_login= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT
Set-Cookie: Bugzilla_logincookie= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT Set-Cookie: Bugzilla_logincookie= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT
Set-Cookie: Bugzilla_password= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT Set-Cookie: Bugzilla_password= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT
Content-type: text/html Content-type: text/html
...@@ -35,19 +35,19 @@ The cookie that was remembering your login is now gone. The next time you ...@@ -35,19 +35,19 @@ The cookie that was remembering your login is now gone. The next time you
do an action that requires a login, you will be prompted for it. do an action that requires a login, you will be prompted for it.
<p> <p>
<a href=query.cgi>Back to the query page.</a> <a href=query.cgi>Back to the query page.</a>
" ";
exit exit;
# The below was a different way, that prompted you for a login right then. # The below was a different way, that prompted you for a login right then.
catch {unset COOKIE(Bugzilla_login)} # catch {unset COOKIE(Bugzilla_login)}
catch {unset COOKIE(Bugzilla_password)} # catch {unset COOKIE(Bugzilla_password)}
confirm_login # confirm_login
puts "Content-type: text/html\n" # puts "Content-type: text/html\n"
puts "<H1>OK, logged in.</H1>" # puts "<H1>OK, logged in.</H1>"
puts "You are now logged in as <b>$COOKIE(Bugzilla_login)</b>." # puts "You are now logged in as <b>$COOKIE(Bugzilla_login)</b>."
puts "<p>" # puts "<p>"
puts "<a href=query.cgi>Back to the query page.</a>" # puts "<a href=query.cgi>Back to the query page.</a>"
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -19,94 +19,95 @@ ...@@ -19,94 +19,95 @@
# #
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" use diagnostics;
puts "Content-type: text/html" use strict;
puts ""
ConnectToDatabase require "CGI.pl";
print "Content-type: text/html\n";
print "\n";
proc Status {str} { ConnectToDatabase();
puts "$str <P>"
flush stdout
sub Status {
my ($str) = (@_);
print "$str <P>\n";
} }
proc Alert {str} { sub Alert {
Status "<font color=red>$str</font>" my ($str) = (@_);
Status("<font color=red>$str</font>");
} }
proc BugLink {id} { sub BugLink {
return "<a href='show_bug.cgi?id=$id'>$id</a>" my ($id) = (@_);
return "<a href='show_bug.cgi?id=$id'>$id</a>";
} }
PutHeader "Bugzilla Sanity Check" "Bugzilla Sanity Check" PutHeader("Bugzilla Sanity Check");
print "OK, now running sanity checks.<P>\n";
Status("Checking profile ids...");
puts "OK, now running sanity checks.<P>" SendSQL("select userid,login_name from profiles");
Status "Checking profile ids..." my @row;
SendSQL "select userid,login_name from profiles" my %profid;
while {[MoreSQLData]} { while (@row = FetchSQLData()) {
lassign [FetchSQLData] id email my ($id, $email) = (@row);
if {[regexp {^[^@, ]*@[^@, ]*\.[^@, ]*$} $email]} { if ($email =~ /^[^@, ]*@[^@, ]*\.[^@, ]*$/) {
set profid($id) 1 $profid{$id} = 1;
} else { } else {
if {$id != ""} { Alert "Bad profile id $id &lt;$email&gt;."
Alert "Bad profile id $id &lt;$email&gt;."
}
} }
} }
catch {[unset profid(0)]} undef $profid{0};
Status "Checking reporter/assigned_to ids" Status("Checking reporter/assigned_to ids");
SendSQL "select bug_id,reporter,assigned_to from bugs" SendSQL("select bug_id,reporter,assigned_to from bugs");
while {[MoreSQLData]} { my %bugid;
lassign [FetchSQLData] id reporter assigned_to
if {$id == ""} { while (@row = FetchSQLData()) {
continue my($id, $reporter, $assigned_to) = (@row);
} $bugid{$id} = 1;
set bugid($id) 1 if (!defined $profid{$reporter}) {
if {![info exists profid($reporter)]} { Alert("Bad reporter $reporter in " . BugLink($id));
Alert "Bad reporter $reporter in [BugLink $id]"
} }
if {![info exists profid($assigned_to)]} { if (!defined $profid{$assigned_to}) {
Alert "Bad assigned_to $assigned_to in [BugLink $id]" Alert("Bad assigned_to $assigned_to in" . BugLink($id));
} }
} }
Status "Checking CC table" Status("Checking CC table");
SendSQL "select bug_id,who from cc"; SendSQL("select bug_id,who from cc");
while {[MoreSQLData]} { while (@row = FetchSQLData()) {
lassign [FetchSQLData] id cc my ($id, $cc) = (@row);
if {$cc == ""} { if (!defined $profid{$cc}) {
continue Alert("Bad cc $cc in " . BugLink($id));
}
if {![info exists profid($cc)]} {
Alert "Bad cc $cc in [BugLink $id]"
} }
} }
Status "Checking activity table" Status("Checking activity table");
SendSQL "select bug_id,who from bugs_activity" SendSQL("select bug_id,who from bugs_activity");
while {[MoreSQLData]} { while (@row = FetchSQLData()) {
lassign [FetchSQLData] id who my ($id, $who) = (@row);
if {$who == ""} { if (!defined $bugid{$id}) {
continue Alert("Bad bugid " . BugLink($id));
}
if {![info exists bugid($id)]} {
Alert "Bad bugid [BugLink $id]"
} }
if {![info exists profid($who)]} { if (!defined $profid{$who}) {
Alert "Bad who $who in [BugLink $id]" Alert("Bad who $who in " . BugLink($id));
} }
} }
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -19,40 +19,45 @@ ...@@ -19,40 +19,45 @@
# #
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" use diagnostics;
puts "Content-type: text/html\n" use strict;
puts "<HTML> require "CGI.pl";
<H1>Changes made to bug $FORM(id)</H1>
" print "Content-type: text/html\n\n";
set query "
PutHeader("Changes made to bug $::FORM{'id'}", "Activity log",
"Bug $::FORM{'id'}");
my $query = "
select bugs_activity.field, bugs_activity.when, select bugs_activity.field, bugs_activity.when,
bugs_activity.oldvalue, bugs_activity.newvalue, bugs_activity.oldvalue, bugs_activity.newvalue,
profiles.login_name profiles.login_name
from bugs_activity,profiles from bugs_activity,profiles
where bugs_activity.bug_id = $FORM(id) where bugs_activity.bug_id = $::FORM{'id'}
and profiles.userid = bugs_activity.who and profiles.userid = bugs_activity.who
order by bugs_activity.when" order by bugs_activity.when";
ConnectToDatabase ConnectToDatabase();
SendSQL $query SendSQL($query);
puts "<table border cellpadding=4>" print "<table border cellpadding=4>\n";
puts "<tr>" print "<tr>\n";
puts " <th>Who</th><th>What</th><th>Old value</th><th>New value</th><th>When</th>" print " <th>Who</th><th>What</th><th>Old value</th><th>New value</th><th>When</th>\n";
puts "</tr>" print "</tr>\n";
while { [MoreSQLData] } { my @row;
set value [FetchSQLData] while (@row = FetchSQLData()) {
lassign $value field when old new who my ($field,$when,$old,$new,$who) = (@row);
$old = value_quote($old);
puts "<tr>" $new = value_quote($new);
puts "<td>$who</td>" print "<tr>\n";
puts "<td>$field</td>" print "<td>$who</td>\n";
puts "<td>[value_quote $old]</td>" print "<td>$field</td>\n";
puts "<td>[value_quote $new]</td>" print "<td>$old</td>\n";
puts "<td>$when</td>" print "<td>$new</td>\n";
puts "</tr>" print "<td>$when</td>\n";
print "</tr>\n";
} }
puts "</table>" print "</table>\n";
puts "<hr><a href=show_bug.cgi?id=$FORM(id)>Back to bug $FORM(id)</a>" print "<hr><a href=show_bug.cgi?id=$::FORM{'id'}>Back to bug $::FORM{'id'}</a>\n";
#! /usr/bonsaitools/bin/mysqltcl #!/usr/bonsaitools/bin/perl -w
# -*- Mode: tcl; indent-tabs-mode: nil -*- # -*- Mode: perl; indent-tabs-mode: nil -*-
# #
# The contents of this file are subject to the Mozilla Public License # The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in # Version 1.0 (the "License"); you may not use this file except in
...@@ -19,26 +19,31 @@ ...@@ -19,26 +19,31 @@
# #
# Contributor(s): Terry Weissman <terry@mozilla.org> # Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl" use diagnostics;
puts "Content-type: text/html" use strict;
puts ""
print "Content-type: text/html\n";
print "\n";
if {[lookup FORM id] == ""} { require "CGI.pl";
puts "<H2>Search By Bug Number</H2>"
puts "<FORM METHOD=GET ACTION=\"show_bug.cgi\">" if (!defined $::FORM{'id'}) {
puts "You may find a single bug by entering its bug id here: " print "<H2>Search By Bug Number</H2>\n";
puts "<INPUT NAME=id>" print "<FORM METHOD=GET ACTION=\"show_bug.cgi\">\n";
puts "<INPUT TYPE=\"submit\" VALUE=\"Show Me This Bug\">" print "You may find a single bug by entering its bug id here: \n";
puts "</FORM>" print "<INPUT NAME=id>\n";
exit 0 print "<INPUT TYPE=\"submit\" VALUE=\"Show Me This Bug\">\n";
print "</FORM>\n";
exit;
} }
ConnectToDatabase
GetVersionTable ConnectToDatabase();
GetVersionTable();
PutHeader("Bugzilla bug $::FORM{'id'}", "Bugzilla Bug", $::FORM{'id'});
navigation_header();
PutHeader "Bugzilla bug $FORM(id)" "Bugzilla Bug" $FORM(id) print "<HR>\n";
navigation_header
puts "<HR>" do "bug_form.pl";
source "bug_form.tcl"
#!/usr/bonsaitools/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
# This is a script suitable for running once a day from a cron job. It
# looks at all the bugs, and sends whiny mail to anyone who has a bug
# assigned to them that has status NEW that has not been touched for
# more than 7 days.
use diagnostics;
use strict;
require "globals.pl";
ConnectToDatabase();
SendSQL("select bug_id,login_name from bugs,profiles where " .
"bug_status = 'NEW' and to_days(now()) - to_days(delta_ts) > " .
Param('whinedays') . " and userid=assigned_to order by bug_id");
my %bugs;
my @row;
while (@row = FetchSQLData()) {
my ($id, $email) = (@row);
if (!defined $bugs{$email}) {
$bugs{$email} = [];
}
push @{$bugs{$email}}, $id;
}
my $template = Param('whinemail');
my $urlbase = Param('urlbase');
foreach my $email (sort (keys %bugs)) {
my %substs;
$substs{'email'} = $email;
my $msg = PerformSubsts($template, \%substs);
foreach my $i (@{$bugs{$email}}) {
$msg .= " ${urlbase}show_bug.cgi?id=$i\n"
}
open(SENDMAIL, "|/usr/lib/sendmail -t") || die "Can't open sendmail";
print SENDMAIL $msg;
close SENDMAIL;
print "$email " . join(" ", @{$bugs{$email}}) . "\n";
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment