Skip to content

bugzilla
bugzilla
Commit 4727e6c0 authored by terry%netscape.com's avatar terry%netscape.com
Browse files
Options

Everything has been ported to now run under Perl.

parent d8a4482d
Show whitespace changes
Inline Side-by-side
Showing with 2987 additions and 1459 deletions
CGI.pl 0 → 100644
View file @ 4727e6c0
# -*- 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>
# Contains some global routines used throughout the CGI scripts of Bugzilla.
use diagnostics;
use strict;
use CGI::Carp qw(fatalsToBrowser);
require 'globals.pl';
sub GeneratePersonInput {
my ($field, $required, $def_value, $extraJavaScript) = (@_);
if (!defined $extraJavaScript) {
$extraJavaScript = "";
}
if ($extraJavaScript ne "") {
$extraJavaScript = "onChange=\" $extraJavaScript \"";
}
return "<INPUT NAME=\"$field\" SIZE=32 $extraJavaScript VALUE=\"$def_value\">";
}
sub GeneratePeopleInput {
my ($field, $def_value) = (@_);
return "<INPUT NAME=\"$field\" SIZE=45 VALUE=\"$def_value\">";
}
# Implementations of several of the below were blatently stolen from CGI.pm,
# by Lincoln D. Stein.
# Get rid of all the %xx encoding and the like from the given URL.
sub url_decode {
my ($todecode) = (@_);
$todecode =~ tr/+/ /; # pluses become spaces
$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
return $todecode;
}
# Quotify a string, suitable for putting into a URL.
sub url_quote {
my($toencode) = (@_);
$toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
return $toencode;
}
sub ProcessFormFields {
my ($buffer) = (@_);
undef %::FORM;
undef %::MFORM;
my %isnull;
my $remaining = $buffer;
while ($remaining ne "") {
my $item;
if ($remaining =~ /^([^&]*)&(.*)$/) {
$item = $1;
$remaining = $2;
} else {
$item = $remaining;
$remaining = "";
}
my $name;
my $value;
if ($item =~ /^([^=]*)=(.*)$/) {
$name = $1;
$value = url_decode($2);
} else {
$name = $item;
$value = "";
}
if ($value ne "") {
if (defined $::FORM{$name}) {
$::FORM{$name} .= $value;
my $ref = $::MFORM{$name};
push @$ref, $value;
} else {
$::FORM{$name} = $value;
$::MFORM{$name} = [$value];
}
} else {
$isnull{$name} = 1;
}
}
if (defined %isnull) {
foreach my $name (keys(%isnull)) {
if (!defined $::FORM{$name}) {
$::FORM{$name} = "";
$::MFORM{$name} = [];
}
}
}
}
sub FormData {
my ($field) = (@_);
return $::FORM{$field};
}
sub html_quote {
my ($var) = (@_);
$var =~ s/\&/\&amp;/g;
$var =~ s/</\&lt;/g;
$var =~ s/>/\&gt;/g;
return $var;
}
sub value_quote {
my ($var) = (@_);
$var =~ s/\&/\&amp;/g;
$var =~ s/</\&lt;/g;
$var =~ s/>/\&gt;/g;
$var =~ s/"/\&quot;/g;
return $var;
}
sub value_unquote {
my ($var) = (@_);
$var =~ s/\&quot/\"/g;
$var =~ s/\&lt/</g;
$var =~ s/\&gt/>/g;
$var =~ s/\&amp/\&/g;
return $var;
}
sub navigation_header {
if (defined $::COOKIE{"BUGLIST"} && $::COOKIE{"BUGLIST"} ne "") {
my @bugs = split(/:/, $::COOKIE{"BUGLIST"});
my $cur = lsearch(\@bugs, $::FORM{"id"});
print "<B>Bug List:</B> (@{[$cur + 1]} of @{[$#bugs + 1]})\n";
print "<A HREF=\"show_bug.cgi?id=$bugs[0]\">First</A>\n";
print "<A HREF=\"show_bug.cgi?id=$bugs[$#bugs]\">Last</A>\n";
if ($cur > 0) {
print "<A HREF=\"show_bug.cgi?id=$bugs[$cur - 1]\">Prev</A>\n";
} else {
print "<I><FONT COLOR=\#777777>Prev</FONT></I>\n";
}
if ($cur < $#bugs) {
$::next_bug = $bugs[$cur + 1];
print "<A HREF=\"show_bug.cgi?id=$::next_bug\">Next</A>\n";
} else {
print "<I><FONT COLOR=\#777777>Next</FONT></I>\n";
}
}
print "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<A HREF=query.cgi>Query page</A>\n";
print "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<A HREF=enter_bug.cgi>Enter new bug</A>\n"
}
sub make_options {
my ($src,$default,$isregexp) = (@_);
my $last = "";
my $popup = "";
my $found = 0;
foreach my $item (@$src) {
if ($item eq "-blank-" || $item ne $last) {
if ($item eq "-blank-") {
$item = "";
}
$last = $item;
if ($isregexp ? $item =~ $default : $default eq $item) {
$popup .= "<OPTION SELECTED VALUE=\"$item\">$item";
$found = 1;
} else {
$popup .= "<OPTION VALUE=\"$item\">$item";
}
}
}
if (!$found && $default ne "") {
$popup .= "<OPTION SELECTED>$default";
}
return $popup;
}
sub make_popup {
my ($name,$src,$default,$listtype,$onchange) = (@_);
my $popup = "<SELECT NAME=$name";
if ($listtype > 0) {
$popup .= " SIZE=5";
if ($listtype == 2) {
$popup .= " MULTIPLE";
}
}
if (defined $onchange && $onchange ne "") {
$popup .= " onchange=$onchange";
}
$popup .= ">" . make_options($src, $default,
($listtype == 2 && $default ne ""));
$popup .= "</SELECT>";
return $popup;
}
sub PasswordForLogin {
my ($login) = (@_);
SendSQL("select cryptpassword from profiles where login_name = " .
SqlQuote($login));
return FetchOneColumn();
}
sub confirm_login {
my ($nexturl) = (@_);
# Uncommenting the next line can help debugging...
# print "Content-type: text/plain\n\n";
ConnectToDatabase();
if (defined $::FORM{"Bugzilla_login"} &&
defined $::FORM{"Bugzilla_password"}) {
my $enteredlogin = $::FORM{"Bugzilla_login"};
my $enteredpwd = $::FORM{"Bugzilla_password"};
if ($enteredlogin !~ /^[^@, ]*@[^@, ]*\.[^@, ]*$/) {
print "Content-type: text/html\n\n";
print "<H1>Invalid e-mail address entered.</H1>\n";
print "The e-mail address you entered\n";
print "(<b>$enteredlogin</b>) didn't match our minimal\n";
print "syntax checking for a legal email address. A legal\n";
print "address must contain exactly one '\@', and at least one\n";
print "'.' after the \@, and may not contain any commas or.\n";
print "spaces.\n";
print "<p>Please click <b>back</b> and try again.\n";
exit;
}
my $realcryptpwd = PasswordForLogin($::FORM{"Bugzilla_login"});
my $enteredcryptpwd = crypt($enteredpwd, substr($realcryptpwd, 0, 2));
if (defined $::FORM{"PleaseMailAPassword"}) {
my $realpwd;
if ($realcryptpwd eq "") {
$realpwd = InsertNewUser($enteredlogin);
} else {
SendSQL("select password from profiles where login_name = " .
SqlQuote($enteredlogin));
$realpwd = FetchOneColumn();
}
my $template = "From: bugzilla-daemon
To: %s
Subject: Your bugzilla password.
To use the wonders of bugzilla, you can use the following:
E-mail address: %s
Password: %s
To change your password, go to:
[Param urlbase]changepassword.cgi
(Your bugzilla and CVS password, if any, are not currently synchronized.
Top hackers are working around the clock to fix this, as you read this.)
";
my $msg = sprintf($template, $enteredlogin, $enteredlogin,
$realpwd);
open SENDMAIL, "|/usr/lib/sendmail -t";
print SENDMAIL $msg;
close SENDMAIL;
print "Content-type: text/html\n\n";
print "<H1>Password has been emailed.</H1>\n";
print "The password for the e-mail address\n";
print "$enteredlogin has been e-mailed to that address.\n";
print "<p>When the e-mail arrives, you can click <b>Back</b>\n";
print "and enter your password in the form there.\n";
exit;
}
if ($realcryptpwd eq "" || $enteredcryptpwd ne $realcryptpwd) {
print "Content-type: text/html\n\n";
print "<H1>Login failed.</H1>\n";
print "The username or password you entered is not valid.\n";
print "Please click <b>Back</b> and try again.\n";
exit;
}
$::COOKIE{"Bugzilla_login"} = $enteredlogin;
SendSQL("insert into logincookies (userid,cryptpassword,hostname) values (@{[DBNameToIdAndCheck($enteredlogin)]}, @{[SqlQuote($realcryptpwd)]}, @{[SqlQuote($ENV{'REMOTE_HOST'})]})");
SendSQL("select LAST_INSERT_ID()");
my $logincookie = FetchOneColumn();
$::COOKIE{"Bugzilla_logincookie"} = $logincookie;
print "Set-Cookie: Bugzilla_login=$enteredlogin ; path=/; expires=Sun, 30-Jun-2029 00:00:00 GMT\n";
print "Set-Cookie: Bugzilla_logincookie=$logincookie ; path=/; expires=Sun, 30-Jun-2029 00:00:00 GMT\n";
# This next one just cleans out any old bugzilla passwords that may
# be sitting around in the cookie files, from the bad old days when
# we actually stored the password there.
print "Set-Cookie: Bugzilla_password= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT\n";
}
my $loginok = 0;
if (defined $::COOKIE{"Bugzilla_login"} &&
defined $::COOKIE{"Bugzilla_logincookie"}) {
SendSQL("select profiles.login_name = " .
SqlQuote($::COOKIE{"Bugzilla_login"}) .
" and profiles.cryptpassword = logincookies.cryptpassword " .
"and logincookies.hostname = " .
SqlQuote($ENV{"REMOTE_HOST"}) .
" from profiles,logincookies where logincookies.cookie = " .
$::COOKIE{"Bugzilla_logincookie"} .
" and profiles.userid = logincookies.userid");
$loginok = FetchOneColumn();
}
if ($loginok ne "1") {
print "Content-type: text/html\n\n";
print "<H1>Please log in.</H1>\n";
print "I need a legitimate e-mail address and password to continue.\n";
if (!defined $nexturl || $nexturl eq "") {
# Sets nexturl to be argv0, stripping everything up to and
# including the last slash.
$0 =~ m:[^/]*$:;
$nexturl = $&;
}
my $method = "POST";
if (defined $ENV{"REQUEST_METHOD"}) {
$method = $ENV{"REQUEST_METHOD"};
}
print "
<FORM action=$nexturl method=$method>
<table>
<tr>
<td align=right><b>E-mail address:</b></td>
<td><input size=35 name=Bugzilla_login></td>
</tr>
<tr>
<td align=right><b>Password:</b></td>
<td><input type=password size=35 name=Bugzilla_password></td>
</tr>
</table>
";
foreach my $i (keys %::FORM) {
if ($i =~ /^Bugzilla_/) {
next;
}
print "<input type=hidden name=$i value=\"@{[value_quote($::FORM{$i})]}\">\n";
}
print "
<input type=submit value=Login name=GoAheadAndLogIn><hr>
If you don't have a password, or have forgotten it, then please fill in the
e-mail address above and click
here:<input type=submit value=\"E-mail me a password\"
name=PleaseMailAPassword>
</form>\n";
# This seems like as good as time as any to get rid of old
# crufty junk in the logincookies table. Get rid of any entry
# that hasn't been used in a month.
SendSQL("delete from logincookies where to_days(now()) - to_days(lastused) > 30");
exit;
}
# Update the timestamp on our logincookie, so it'll keep on working.
SendSQL("update logincookies set lastused = null where cookie = $::COOKIE{'Bugzilla_logincookie'}");
}
sub PutHeader {
my ($title, $h1, $h2) = (@_);
if (!defined $h1) {
$h1 = $title;
}
if (!defined $h2) {
$h2 = "";
}
print "<HTML><HEAD><TITLE>$title</TITLE></HEAD>\n";
print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"\n";
print "LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
print Param("bannerhtml");
print "<TABLE BORDER=0 CELLPADDING=12 CELLSPACING=0 WIDTH=\"100%\">\n";
print " <TR>\n";
print " <TD>\n";
print " <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=2>\n";
print " <TR><TD VALIGN=TOP ALIGN=CENTER NOWRAP>\n";
print " <FONT SIZE=\"+3\"><B><NOBR>$h1</NOBR></B></FONT>\n";
print " </TD></TR><TR><TD VALIGN=TOP ALIGN=CENTER>\n";
print " <B>$h2</B>\n";
print " </TD></TR>\n";
print " </TABLE>\n";
print " </TD>\n";
print " <TD>\n";
print Param("blurbhtml");
print "</TD></TR></TABLE>\n";
}
############# Live code below here (that is, not subroutine defs) #############
$| = 1;
# Uncommenting this next line can help debugging.
# print "Content-type: text/html\n\nHello mom\n";
# foreach my $k (sort(keys %ENV)) {
# print "$k $ENV{$k}<br>\n";
# }
if (defined $ENV{"REQUEST_METHOD"}) {
if ($ENV{"REQUEST_METHOD"} eq "GET") {
if (defined $ENV{"QUERY_STRING"}) {
$::buffer = $ENV{"QUERY_STRING"};
} else {
$::buffer = "";
}
} else {
read STDIN, $::buffer, $ENV{"CONTENT_LENGTH"} || die "Couldn't get form data";
}
ProcessFormFields $::buffer;
}
if (defined $ENV{"HTTP_COOKIE"}) {
foreach my $pair (split(/;/, $ENV{"HTTP_COOKIE"})) {
$pair = trim($pair);
if ($pair =~ /^([^=]*)=(.*)$/) {
$::COOKIE{$1} = $2;
} else {
$::COOKIE{$pair} = "";
}
}
}
1;
CHANGES
View file @ 4727e6c0
......@@ -10,6 +10,26 @@ query the CVS tree. For example,
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
crypt'd version of the password in the database, and check against
that. (This is silly, because we're also keeping the plaintext
......
README
View file @ 4727e6c0
......@@ -24,10 +24,12 @@ this document!)
First, you need some other things:
1) MySQL database server.
2) Tcl 7.6
3) TclX 7.6
4) mysqltcl program (hmm.. This was tricky.. Read on)
5) Some kind of HTTP server so you could use CGI scripts
2) Perl5.004 or greater, including MySQL support and the Date::Format
package from CPAN.
3) 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
......@@ -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
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.5 HTTP server
1.2 HTTP server
You have a freedom of choice here - Apache, Netscape or any other
server on UNIX would do. The only thing - to make configuration easier
......@@ -120,8 +87,8 @@ like to customize some things.
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
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
params file, and change the line that says "set param(maintainer)" to
the creation of the "data/params" file in your installation dir. Edit the
data/params file, and change the line that sets "$::param{'maintainer'}" to
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
edit the parameters. (If you have cookies turned off, you'll have to
......@@ -134,131 +101,8 @@ Tweak the parameters to taste. Be careful.
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
hasn't been touched for several days. For more info, see the
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;
}
bug_form.pl 0 → 100644
View file @ 4727e6c0
# -*- 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";
buglist.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,77 +19,91 @@
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
puts "Content-type: multipart/x-mixed-replace;boundary=ThisRandomString"
puts ""
puts "--ThisRandomString"
use diagnostics;
use strict;
print "Content-type: multipart/x-mixed-replace;boundary=ThisRandomString\n";
print "\n";
print "--ThisRandomString\n";
# The below "if catch" stuff, if uncommented, will trap any error, and
# mail the error messages to terry. What a hideous, horrible
# debugging hack.
# if {[catch {
require "CGI.pl";
# Shut up misguided -w warnings about "used only once":
source "CGI.tcl"
use vars @::legal_platform,
@::versions,
@::legal_product,
@::legal_component,
%::MFORM,
@::components,
@::legal_severity,
@::legal_priority,
@::default_column_list,
@::legal_resolution_no_dup;
ConnectToDatabase
if {![info exists FORM(cmdtype)]} {
ConnectToDatabase();
if (!defined $::FORM{'cmdtype'}) {
# This can happen if there's an old bookmark to a query...
set FORM(cmdtype) doit
$::FORM{'cmdtype'} = 'doit';
}
switch $FORM(cmdtype) {
runnamed {
set buffer $COOKIE(QUERY_$FORM(namedcmd))
ProcessFormFields $buffer
}
editnamed {
puts "Content-type: text/html
Refresh: 0; URL=query.cgi?$COOKIE(QUERY_$FORM(namedcmd))
CMD: for ($::FORM{'cmdtype'}) {
/^runnamed$/ && do {
$::buffer = $::COOKIE{"QUERY_" . $::FORM{"namedcmd"}};
ProcessFormFields $::buffer;
last CMD;
};
/^editnamed$/ && do {
my $url = "query.cgi?" . $::COOKIE{"QUERY_" . $::FORM{"namedcmd"}};
print "Content-type: text/html
Refresh: 0; URL=$url
<TITLE>What a hack.</TITLE>
Loading your query named <B>$FORM(namedcmd)</B>..."
exit
}
forgetnamed {
puts "Set-Cookie: QUERY_$FORM(namedcmd)= ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT
Loading your query named <B>$::FORM{'namedcmd'}</B>...";
exit;
};
/^forgetnamed$/ && do {
print "Set-Cookie: QUERY_" . $::FORM{'namedcmd'} . "= ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT
Content-type: text/html
<HTML>
<TITLE>Forget what?</TITLE>
OK, the <B>$FORM(namedcmd)</B> query is gone.
OK, the <B>$::FORM{'namedcmd'}</B> query is gone.
<P>
<A HREF=query.cgi>Go back to the query page.</A>"
exit
}
asnamed {
if {[regexp {^[a-zA-Z0-9_ ]+$} $FORM(newqueryname)]} {
puts "Set-Cookie: QUERY_$FORM(newqueryname)=$buffer ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT
<A HREF=query.cgi>Go back to the query page.</A>";
exit;
};
/^asnamed$/ && do {
if ($::FORM{'newqueryname'} =~ /^[a-zA-Z0-9_ ]+$/) {
print "Set-Cookie: QUERY_" . $::FORM{'newqueryname'} . "=$::buffer ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT
Content-type: text/html
<HTML>
<TITLE>OK, done.</TITLE>
OK, you now have a new query named <B>$FORM(newqueryname)</B>.
OK, you now have a new query named <B>$::FORM{'newqueryname'}</B>.
<P>
<A HREF=query.cgi>Go back to the query page.</A>"
<A HREF=query.cgi>Go back to the query page.</A>";
} else {
puts "Content-type: text/html
print "Content-type: text/html
<HTML>
<TITLE>Picky, picky.</TITLE>
Query names can only have letters, digits, spaces, or underbars. You entered
\"<B>$FORM(newqueryname)</B>\", which doesn't cut it.
\"<B>$::FORM{'newqueryname'}</B>\", which doesn't cut it.
<P>
Click the <B>Back</B> button and type in a valid name for this query."
}
exit
Click the <B>Back</B> button and type in a valid name for this query.";
}
asdefault {
puts "Set-Cookie: DEFAULTQUERY=$buffer ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT
exit;
};
/^asdefault$/ && do {
print "Set-Cookie: DEFAULTQUERY=$::buffer ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT
Content-type: text/html
<HTML>
......@@ -98,78 +112,82 @@ OK, you now have a new default query.
<P>
<A HREF=query.cgi>Go back to the query page, using the new default.</A>"
exit
}
<A HREF=query.cgi>Go back to the query page, using the new default.</A>";
exit;
};
}
proc qadd { item } {
global query
append query "$item"
}
sub DefCol {
my ($name, $k, $t, $s, $q) = (@_);
proc DefCol {name k t {s ""} {q 0}} {
global key title sortkey needquote
set key($name) $k
set title($name) $t
if {![cequal $s ""]} {
set sortkey($name) $s
$::key{$name} = $k;
$::title{$name} = $t;
if (defined $s && $s ne "") {
$::sortkey{$name} = $s;
}
set needquote($name) $q
if (!defined $q || $q eq "") {
$q = 0;
}
$::needquote{$name} = $q;
}
DefCol opendate "date_format(bugs.creation_ts,'Y-m-d')" Opened bugs.creation_ts
DefCol changeddate "date_format(bugs.delta_ts,'Y-m-d')" Changed bugs.delta_ts
DefCol severity "substring(bugs.bug_severity, 1, 3)" Sev bugs.bug_severity
DefCol priority "substring(bugs.priority, 1, 3)" Pri bugs.priority
DefCol platform "substring(bugs.rep_platform, 1, 3)" Plt bugs.rep_platform
DefCol owner "assign.login_name" Owner assign.login_name
DefCol reporter "report.login_name" Reporter report.login_name
DefCol status "substring(bugs.bug_status,1,4)" State bugs.bug_status
DefCol resolution "substring(bugs.resolution,1,4)" Res bugs.resolution
DefCol summary "substring(bugs.short_desc, 1, 60)" Summary {} 1
DefCol summaryfull "bugs.short_desc" Summary {} 1
DefCol component "substring(bugs.component, 1, 8)" Comp bugs.component
DefCol product "substring(bugs.product, 1, 8)" Product bugs.product
DefCol version "substring(bugs.version, 1, 5)" Vers bugs.version
DefCol os "substring(bugs.op_sys, 1, 4)" OS bugs.op_sys
if {[info exists COOKIE(COLUMNLIST)]} {
set collist $COOKIE(COLUMNLIST)
DefCol("opendate", "date_format(bugs.creation_ts,'Y-m-d')", "Opened",
"bugs.creation_ts");
DefCol("changeddate", "date_format(bugs.delta_ts,'Y-m-d')", "Changed",
"bugs.delta_ts");
DefCol("severity", "substring(bugs.bug_severity, 1, 3)", "Sev",
"bugs.bug_severity");
DefCol("priority", "substring(bugs.priority, 1, 3)", "Pri", "bugs.priority");
DefCol("platform", "substring(bugs.rep_platform, 1, 3)", "Plt",
"bugs.rep_platform");
DefCol("owner", "assign.login_name", "Owner", "assign.login_name");
DefCol("reporter", "report.login_name", "Reporter", "report.login_name");
DefCol("status", "substring(bugs.bug_status,1,4)", "State", "bugs.bug_status");
DefCol("resolution", "substring(bugs.resolution,1,4)", "Result",
"bugs.resolution");
DefCol("summary", "substring(bugs.short_desc, 1, 60)", "Summary", "", 1);
DefCol("summaryfull", "bugs.short_desc", "Summary", "", 1);
DefCol("component", "substring(bugs.component, 1, 8)", "Comp",
"bugs.component");
DefCol("product", "substring(bugs.product, 1, 8)", "Product", "bugs.product");
DefCol("version", "substring(bugs.version, 1, 5)", "Vers", "bugs.version");
DefCol("os", "substring(bugs.op_sys, 1, 4)", "OS", "bugs.op_sys");
my @collist;
if (defined $::COOKIE{'COLUMNLIST'}) {
@collist = split(/ /, $::COOKIE{'COLUMNLIST'});
} else {
set collist $default_column_list
@collist = @::default_column_list;
}
set dotweak [info exists FORM(tweak)]
my $dotweak = defined $::FORM{'tweak'};
if {$dotweak} {
confirm_login
if ($dotweak) {
confirm_login();
}
puts "Content-type: text/html\n"
print "Content-type: text/html\n\n";
set query "
select
bugs.bug_id"
my $query = "select bugs.bug_id";
foreach c $collist {
if {[info exists needquote($c)] } {
append query ",
\t$key($c)"
foreach my $c (@collist) {
if (exists $::needquote{$c}) {
$query .= ",
\t$::key{$c}";
}
}
if {$dotweak} {
append query ",
if ($dotweak) {
$query .= ",
bugs.product,
bugs.bug_status"
bugs.bug_status";
}
append query "
$query .= "
from bugs,
profiles assign,
profiles report,
......@@ -178,271 +196,263 @@ where bugs.assigned_to = assign.userid
and bugs.reporter = report.userid
and bugs.product = projector.program
and bugs.version = projector.value
"
";
if {[info exists FORM(sql)]} {
append query "and (\n[join [url_decode $FORM(sql)] { }]\n)"
if (defined $::FORM{'sql'}) {
$query .= "and (\n$::FORM('sql')\n)"
} else {
set legal_fields { bug_id product version rep_platform op_sys bug_status
resolution priority bug_severity assigned_to reporter
bug_file_loc component}
foreach field [array names FORM] {
if { [ lsearch $legal_fields $field ] != -1 && ![cequal $FORM($field) ""]} {
qadd "\tand (\n"
set or ""
if { $field == "assigned_to" || $field == "reporter"} {
foreach p [split $FORM($field) ","] {
qadd "\t\t${or}bugs.$field = [DBNameToIdAndCheck $p]\n"
set or "or "
my @legal_fields = ("bug_id", "product", "version", "rep_platform", "op_sys",
"bug_status", "resolution", "priority", "bug_severity",
"assigned_to", "reporter", "bug_file_loc", "component");
foreach my $field (keys %::FORM) {
my $or = "";
if (lsearch(\@legal_fields, $field) != -1 && $::FORM{$field} ne "") {
$query .= "\tand (\n";
if ($field eq "assigned_to" || $field eq "reporter") {
foreach my $p (split(/,/, $::FORM{$field})) {
my $whoid = DBNameToIdAndCheck($p);
$query .= "\t\t${or}bugs.$field = $whoid\n";
$or = "or ";
}
} else {
foreach v $MFORM($field) {
if {[cequal $v "(empty)"]} {
qadd "\t\t${or}bugs.$field is null\n"
my $ref = $::MFORM{$field};
foreach my $v (@$ref) {
if ($v eq "(empty)") {
$query .= "\t\t${or}bugs.$field is null\n";
} else {
if {[cequal $v "---"]} {
qadd "\t\t${or}bugs.$field = ''\n"
if ($v eq "---") {
$query .= "\t\t${or}bugs.$field = ''\n";
} else {
qadd "\t\t${or}bugs.$field = '$v'\n"
$query .= "\t\t${or}bugs.$field = " . SqlQuote($v) .
"\n";
}
}
set or "or "
$or = "or ";
}
}
qadd "\t)\n"
$query .= "\t)\n";
}
}
}
if {[lookup FORM changedin] != ""} {
set c [string trim $FORM(changedin)]
if {$c != ""} {
if {![regexp {^[0-9]*$} $c]} {
puts "
if (defined $::FORM{'changedin'}) {
my $c = trim($::FORM{'changedin'});
if ($c ne "") {
if ($c !~ /^[0-9]*$/) {
print "
The 'changed in last ___ days' field must be a simple number. You entered
\"$c\", which doesn't cut it.
<P>
Click the <B>Back</B> button and try again."
exit
}
qadd "and to_days(now()) - to_days(bugs.delta_ts) <= $FORM(changedin) "
Click the <B>Back</B> button and try again.";
exit;
}
$query .= "and to_days(now()) - to_days(bugs.delta_ts) <= $c ";
}
}
foreach f {short_desc long_desc} {
set s [SqlQuote [string trim [lookup FORM $f]]]
if {$s != ""} {
if {[lookup FORM [set f]_type] == "regexp"} {
qadd "and $f regexp '$s' "
foreach my $f ("short_desc", "long_desc") {
if (defined $::FORM{$f}) {
my $s = SqlQuote(trim($::FORM{$f}));
if ($s ne "") {
if ($::FORM{$f . "_type"} eq "regexp") {
$query .= "and $f regexp $s ";
} else {
qadd "and instr($f, '$s') "
$query .= "and instr($f, $s) ";
}
}
}
}
if {[info exists FORM(order)]} {
qadd "order by "
switch -glob $FORM(order) {
*.* {}
*Number* {
set FORM(order) bugs.bug_id
}
*Import* {
set FORM(order) bugs.priority
}
*Assign* {
set FORM(order) "assign.login_name, bugs.bug_status, priority, bugs.bug_id"
}
default {
set FORM(order) "bugs.bug_status, priorities.rank, assign.login_name, bugs.bug_id"
}
}
if {[cequal [cindex $FORM(order) 0] "\{"]} {
# I don't know why this happens, but...
set FORM(order) [lindex $FORM(order) 0]
}
qadd $FORM(order)
if (defined $::FORM{'order'} && $::FORM{'order'} ne "") {
$query .= "order by ";
ORDER: for ($::FORM{'order'}) {
/\./ && do {
# This (hopefully) already has fieldnames in it, so we're done.
last ORDER;
};
/Number/ && do {
$::FORM{'order'} = "bugs.bug_id";
last ORDER;
};
/Import/ && do {
$::FORM{'order'} = "bugs.priority";
last ORDER;
};
/Assign/ && do {
$::FORM{'order'} = "assign.login_name, bugs.bug_status, priority, bugs.bug_id";
last ORDER;
};
# DEFAULT
$::FORM{'order'} = "bugs.bug_status, priorities.rank, assign.login_name, bugs.bug_id";
}
$query .= $::FORM{'order'};
}
puts "Please stand by ... <p>"
if {[info exists FORM(debug)]} {
puts "<pre>$query</pre>"
print "Please stand by ... <p>\n";
if (defined $::FORM{'debug'}) {
print "<pre>$query</pre>\n";
}
flush stdout
SendSQL $query
set count 0
set bugl ""
proc pnl { str } {
global bugl
append bugl "$str"
SendSQL($query);
my $count = 0;
$::bugl = "";
sub pnl {
my ($str) = (@_);
$::bugl .= $str;
}
regsub -all {[&?]order=[^&]*} $buffer {} fields
regsub -all {[&?]cmdtype=[^&]*} $fields {} fields
my $fields = $::buffer;
$fields =~ s/[&?]order=[^&]*//g;
$fields =~ s/[&?]cmdtype=[^&]*//g;
my $oldorder;
if {[info exists FORM(order)]} {
regsub -all { } ", $FORM(order)" "%20" oldorder
if (defined $::FORM{'order'}) {
$oldorder = url_quote(", $::FORM{'order'}");
} else {
set oldorder ""
$oldorder = "";
}
if {$dotweak} {
pnl "<FORM NAME=changeform METHOD=POST ACTION=\"process_bug.cgi\">"
if ($dotweak) {
pnl "<FORM NAME=changeform METHOD=POST ACTION=\"process_bug.cgi\">";
}
set tablestart "<TABLE CELLSPACING=0 CELLPADDING=2>
my $tablestart = "<TABLE CELLSPACING=0 CELLPADDING=2>
<TR ALIGN=LEFT><TH>
<A HREF=\"buglist.cgi?[set fields]&order=bugs.bug_id\">ID</A>"
<A HREF=\"buglist.cgi?$fields&order=bugs.bug_id\">ID</A>";
foreach c $collist {
if { [info exists needquote($c)] } {
if {$needquote($c)} {
append tablestart "<TH WIDTH=100% valigh=left>"
foreach my $c (@collist) {
if (exists $::needquote{$c}) {
if ($::needquote{$c}) {
$tablestart .= "<TH WIDTH=100% valigh=left>";
} else {
append tablestart "<TH valign=left>"
$tablestart .= "<TH valign=left>";
}
if {[info exists sortkey($c)]} {
append tablestart "<A HREF=\"buglist.cgi?[set fields]&order=$sortkey($c)$oldorder\">$title($c)</A>"
if (defined $::sortkey{$c}) {
$tablestart .= "<A HREF=\"buglist.cgi?$fields&order=$::sortkey{$c}$oldorder\">$::title{$c}</A>";
} else {
append tablestart $title($c)
$tablestart .= $::title{$c};
}
}
}
append tablestart "\n"
$tablestart .= "\n";
set dotweak [info exists FORM(tweak)]
set p_true 1
my @row;
my %seen;
my @bugarray;
my %prodhash;
my %statushash;
while { $p_true } {
set result [FetchSQLData]
set p_true [MoreSQLData]
if { $result != "" } {
set bug_id [lvarpop result]
if {![info exists seen($bug_id)]} {
set seen($bug_id) 1
incr count
if {($count % 200) == 0} {
while (@row = FetchSQLData()) {
my $bug_id = shift @row;
if (!defined $seen{$bug_id}) {
$seen{$bug_id} = 1;
$count++;
if ($count % 200 == 0) {
# Too big tables take too much browser memory...
pnl "</TABLE>$tablestart"
pnl "</TABLE>$tablestart";
}
if {[info exists buglist]} {
append buglist ":$bug_id"
push @bugarray, $bug_id;
pnl "<TR VALIGN=TOP ALIGN=LEFT><TD>";
if ($dotweak) {
pnl "<input type=checkbox name=id_$bug_id>";
}
pnl "<A HREF=\"show_bug.cgi?id=$bug_id\">";
pnl "$bug_id</A> ";
foreach my $c (@collist) {
my $value = shift @row;
my $nowrap = "";
if (exists $::needquote{$c} && $::needquote{$c}) {
$value = html_quote($value);
} else {
set buglist $bug_id
$value = "<nobr>$value</nobr>";
}
pnl "<TR VALIGN=TOP ALIGN=LEFT><TD>"
if {$dotweak} {
pnl "<input type=checkbox name=id_$bug_id>"
pnl "<td $nowrap>$value";
}
pnl "<A HREF=\"show_bug.cgi?id=$bug_id\">"
pnl "$bug_id</A> "
foreach c $collist {
set value [lvarpop result]
set nowrap {}
#-- This cursor is used to pick the login_name to be
# displayed on the query list as the field value may or
# maynot have vales associated to it
if { $c == "qa_assigned_to"} {
set dml_cur [ oraopen $lhandle ]
if ($dotweak) {
my $value = shift @row;
$prodhash{$value} = 1;
$value = shift @row;
$statushash{$value} = 1;
}
pnl "\n";
}
}
orasql $dml_cur "select login_name
from profiles
where userid = $value"
set cur_resultset [orafetch $dml_cur]
my $buglist = join(":", @bugarray);
if {$cur_resultset != ""} {
set value $cur_resultset
set nowrap {nowrap}
} else {
set value ""
}
oraclose $dml_cur
print "\n";
print "--ThisRandomString\n";
}
if { [info exists needquote($c)] && $needquote($c)} {
set value [html_quote $value]
} else {
set value "<nobr>$value</nobr>"
}
pnl "<td $nowrap>$value"
}
if {$dotweak} {
set value [lvarpop result]
set prodarray($value) 1
set value [lvarpop result]
set statusarray($value) 1
}
pnl "\n"
}
}
}
puts ""
puts "--ThisRandomString"
set toolong 0
puts "Content-type: text/html"
if { [info exists buglist] } {
if {[clength $buglist] < 4000} {
puts "Set-Cookie: BUGLIST=$buglist"
} else {
puts "Set-Cookie: BUGLIST="
set toolong 1
}
my $toolong = 0;
print "Content-type: text/html\n";
if (length($buglist) < 4000) {
print "Set-Cookie: BUGLIST=$buglist\n";
} else {
print "Set-Cookie: BUGLIST=\n";
$toolong = 1;
}
puts ""
set env(TZ) PST8PDT
PutHeader "Bug List" "Bug List"
print "\n";
PutHeader("Bug List");
puts -nonewline "
print "
<CENTER>
<B>[fmtclock [getclock ]]</B>"
if {[info exists FORM(debug)]} { puts "<PRE>$query</PRE>" }
<B>" . time2str("%a %b %e %T %Z %Y", time()) . "</B>";
if {$toolong} {
puts "<h2>This list is too long for bugzilla's little mind; the"
puts "Next/Prev/First/Last buttons won't appear.</h2>"
if (defined $::FORM{'debug'}) {
print "<PRE>$query</PRE>\n";
}
set cdata [ split [read_file -nonewline "comments"] "\n" ]
random seed
puts {<HR><I><A HREF="newquip.html">}
puts [lindex $cdata [random [llength $cdata]]]</I></A></CENTER>
puts "<HR SIZE=10>$tablestart"
puts $bugl
puts "</TABLE>"
if ($toolong) {
print "<h2>This list is too long for bugzilla's little mind; the\n";
print "Next/Prev/First/Last buttons won't appear.</h2>\n";
}
switch $count {
0 {
puts "Zarro Boogs found."
}
1 {
puts "One bug found."
}
default {
puts "$count bugs found."
# This is stupid. We really really need to move the quip list into the DB!
my $quip;
if (open (COMMENTS, "<data/comments")) {
my @cdata;
while (<COMMENTS>) {
push @cdata, $_;
}
close COMMENTS;
$quip = $cdata[int(rand($#cdata + 1))];
} else {
$quip = "Bugzilla would like to put a random quip here, but nobody has entered any.";
}
print "<HR><I><A HREF=newquip.html>$quip\n";
print "</I></A></CENTER>\n";
print "<HR SIZE=10>$tablestart\n";
print $::bugl;
print "</TABLE>\n";
if ($count == 0) {
print "Zarro Boogs found.\n";
} elsif ($count == 1) {
print "One bug found.\n";
} else {
print "$count bugs found.\n";
}
if {$dotweak} {
GetVersionTable
puts "
if ($dotweak) {
GetVersionTable();
print "
<SCRIPT>
numelements = document.changeform.elements.length;
function SetCheckboxes(value) {
......@@ -452,35 +462,26 @@ function SetCheckboxes(value) {
}
}
document.write(\" <input type=button value=\\\"Uncheck All\\\" onclick=\\\"SetCheckboxes(false);\\\"> <input type=button value=\\\"Check All\\\" onclick=\\\"SetCheckboxes(true);\\\">\");
</SCRIPT>"
set resolution_popup [make_options $legal_resolution_no_dup FIXED]
GetVersionTable
set prod_list [array names prodarray]
set list $prod_list
set legal_target_versions $versions([lvarpop list])
foreach p $list {
set legal_target_versions [intersect $legal_target_versions \
$versions($p)]
}
set version_popup [make_options \
[concat "-blank-" $legal_target_versions] \
$dontchange]
set platform_popup [make_options $legal_platform $dontchange]
set priority_popup [make_options $legal_priority $dontchange]
set sev_popup [make_options $legal_severity $dontchange]
if {[llength $prod_list] == 1} {
set prod_list [lindex $prod_list 0 ]
set legal_component [linsert $components($prod_list) 0 { }]
} else {
set legal_component { }
}
set component_popup [make_options $legal_component $dontchange]
set product_popup [make_options $legal_product $dontchange]
puts "
</SCRIPT>";
my $resolution_popup = make_options(\@::legal_resolution_no_dup, "FIXED");
my @prod_list = keys %prodhash;
my @list = @prod_list;
my @legal_versions;
my @legal_component;
if ($#prod_list == 1) {
@legal_versions = @{$::versions{$prod_list[0]}};
@legal_component = @{$::components{$prod_list[0]}};
}
my $version_popup = make_options(\@legal_versions, $::dontchange);
my $platform_popup = make_options(\@::legal_platform, $::dontchange);
my $priority_popup = make_options(\@::legal_priority, $::dontchange);
my $sev_popup = make_options(\@::legal_severity, $::dontchange);
my $component_popup = make_options(\@::legal_component, $::dontchange);
my $product_popup = make_options(\@::legal_product, $::dontchange);
print "
<hr>
<TABLE>
<TR>
......@@ -506,67 +507,68 @@ document.write(\" <input type=button value=\\\"Uncheck All\\\" onclick=\\\"SetCh
<B>Additional Comments:</B>
<BR>
<TEXTAREA WRAP=HARD NAME=comment ROWS=5 COLS=80></TEXTAREA><BR>"
<TEXTAREA WRAP=HARD NAME=comment ROWS=5 COLS=80></TEXTAREA><BR>";
# knum is which knob number we're generating, in javascript terms.
set knum 0
puts "
my $knum = 0;
print "
<INPUT TYPE=radio NAME=knob VALUE=none CHECKED>
Do nothing else<br>"
incr knum
puts "
Do nothing else<br>";
$knum++;
print "
<INPUT TYPE=radio NAME=knob VALUE=accept>
Accept bugs (change status to <b>ASSIGNED</b>)<br>"
incr knum
if {![info exists statusarray(CLOSED)] && \
![info exists statusarray(VERIFIED)] && \
![info exists statusarray(RESOLVED)]} {
puts "
Accept bugs (change status to <b>ASSIGNED</b>)<br>";
$knum++;
if (!defined $statushash{'CLOSED'} &&
!defined $statushash{'VERIFIED'} &&
!defined $statushash{'RESOLVED'}) {
print "
<INPUT TYPE=radio NAME=knob VALUE=clearresolution>
Clear the resolution<br>"
incr knum
puts "
Clear the resolution<br>";
$knum++;
print "
<INPUT TYPE=radio NAME=knob VALUE=resolve>
Resolve bugs, changing <A HREF=\"bug_status.html\">resolution</A> to
<SELECT NAME=resolution
ONCHANGE=\"document.changeform.knob\[$knum\].checked=true\">
$resolution_popup</SELECT><br>"
incr knum
}
if {![info exists statusarray(NEW)] && \
![info exists statusarray(ASSIGNED)] && \
![info exists statusarray(REOPENED)]} {
puts "
<INPUT TYPE=radio NAME=knob VALUE=reopen> Reopen bugs<br>"
incr knum
}
if {[llength [array names statusarray]] == 1} {
if {[info exists statusarray(RESOLVED)]} {
puts "
$resolution_popup</SELECT><br>";
$knum++;
}
if (!defined $statushash{'NEW'} &&
!defined $statushash{'ASSIGNED'} &&
!defined $statushash{'REOPENED'}) {
print "
<INPUT TYPE=radio NAME=knob VALUE=reopen> Reopen bugs<br>";
$knum++;
}
my @statuskeys = keys %statushash;
if ($#statuskeys == 1) {
if (defined $statushash{'RESOLVED'}) {
print "
<INPUT TYPE=radio NAME=knob VALUE=verify>
Mark bugs as <b>VERIFIED</b><br>"
incr knum
Mark bugs as <b>VERIFIED</b><br>";
$knum++;
}
if {[info exists statusarray(VERIFIED)]} {
puts "
if (defined $statushash{'VERIFIED'}) {
print "
<INPUT TYPE=radio NAME=knob VALUE=close>
Mark bugs as <b>CLOSED</b><br>"
incr knum
Mark bugs as <b>CLOSED</b><br>";
$knum++;
}
}
puts "
print "
<INPUT TYPE=radio NAME=knob VALUE=reassign>
<A HREF=\"bug_status.html#assigned_to\">Reassign</A> bugs to
<INPUT NAME=assigned_to SIZE=32
ONCHANGE=\"document.changeform.knob\[$knum\].checked=true\"
VALUE=\"$COOKIE(Bugzilla_login)\"><br>"
incr knum
puts "<INPUT TYPE=radio NAME=knob VALUE=reassignbycomponent>
Reassign bugs to owner of selected component<br>"
incr knum
VALUE=\"$::COOKIE{'Bugzilla_login'}\"><br>";
$knum++;
print "<INPUT TYPE=radio NAME=knob VALUE=reassignbycomponent>
Reassign bugs to owner of selected component<br>";
$knum++;
puts "
print "
<p>
<font size=-1>
To make changes to a bunch of bugs at once:
......@@ -577,35 +579,19 @@ To make changes to a bunch of bugs at once:
<li> Click the below \"Commit\" button.
</ol></font>
<INPUT TYPE=SUBMIT VALUE=Commit>
</FORM><hr>"
</FORM><hr>\n";
}
if {$count > 0} {
puts "<FORM METHOD=POST ACTION=\"long_list.cgi\">
if ($count > 0) {
print "<FORM METHOD=POST ACTION=\"long_list.cgi\">
<INPUT TYPE=HIDDEN NAME=buglist VALUE=$buglist>
<INPUT TYPE=SUBMIT VALUE=\"Long Format\">
<A HREF=\"query.cgi\">Query Page</A>
<A HREF=\"colchange.cgi?$buffer\">Change columns</A>
</FORM>"
if {!$dotweak && $count > 1} {
puts "<A HREF=\"buglist.cgi?[set fields]&tweak=1\">Make changes to several of these bugs at once.</A>"
<A HREF=\"colchange.cgi?$::buffer\">Change columns</A>
</FORM>";
if (!$dotweak && $count > 1) {
print "<A HREF=\"buglist.cgi?$fields&tweak=1\">Make changes to several of these bugs at once.</A>\n";
}
}
puts "--ThisRandomString--"
flush stdout
#
# Below is second part of hideous "if catch" stuff from above.
#
#
#
# }]} {
# exec /usr/lib/sendmail -t << "To: terry@mozilla.org
#
#
# $query
#
# $errorInfo
# "
# }
print "\n--ThisRandomString--\n";
changepassword.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -18,61 +18,74 @@
# Netscape Communications Corporation. All Rights Reserved.
#
# 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)]} {
puts "Content-type: text/html
confirm_login();
if (! defined $::FORM{'pwd1'}) {
print "Content-type: text/html
<H1>Change your password</H1>
<form method=post>
<table>
<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>
</tr>
<tr>
<td align=right>Re-enter your new password:</td>
<td><input type=password name=pwd2></td>
</table>
<input type=submit value=Submit>"
exit
<input type=submit value=Submit>\n";
exit;
}
if {![cequal $FORM(pwd1) $FORM(pwd2)]} {
puts "Content-type: text/html
if ($::FORM{'pwd1'} ne $::FORM{'pwd2'}) {
print "Content-type: text/html
<H1>Try again.</H1>
The two passwords you entered did not match. Please click <b>Back</b> and try again."
exit
The two passwords you entered did not match. Please click <b>Back</b> and try again.\n";
exit;
}
set pwd $FORM(pwd1)
my $pwd = $::FORM{'pwd1'};
if {![regexp {^[a-zA-Z0-9-_]*$} $pwd] || [clength $pwd] < 3 || [clength $pwd] > 15} {
puts "Content-type: text/html
if ($pwd !~ /^[a-zA-Z0-9-_]*$/ || length($pwd) < 3 || length($pwd) > 15) {
print "Content-type: text/html
<H1>Sorry; we're picky.</H1>
Please choose a password that is between 3 and 15 characters long, and that
contains only numbers, letters, hyphens, or underlines.
<p>
Please click <b>Back</b> and try again."
exit
Please click <b>Back</b> and try again.\n";
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')"
set encrypted [lindex [FetchSQLData] 0]
SendSQL("update profiles set password='$pwd',cryptpassword='$encrypted' where login_name=" .
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.
<p>
<a href=query.cgi>Back to query page.</a>"
<a href=query.cgi>Back to query page.</a>\n";
colchange.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,70 +19,79 @@
#
# 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
# they get displayed in.
set masterlist {opendate changeddate severity priority platform owner reporter status
resolution component product version project os summary summaryfull }
my @masterlist = ("opendate", "changeddate", "severity", "priority",
"platform", "owner", "reporter", "status", "resolution",
"component", "product", "version", "project", "os",
"summary", "summaryfull");
if {[info exists FORM(rememberedquery)]} {
if {[info exists FORM(resetit)]} {
set collist $default_column_list
my @collist;
if (defined $::FORM{'rememberedquery'}) {
if (defined $::FORM{'resetit'}) {
@collist = @::default_column_list;
} else {
set collist {}
foreach i $masterlist {
if {[info exists FORM(column_$i)]} {
lappend collist $i
foreach my $i (@masterlist) {
if (defined $::FORM{"column_$i"}) {
push @collist, $i;
}
}
}
puts "Set-Cookie: COLUMNLIST=$collist ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT"
puts "Refresh: 0; URL=buglist.cgi?$FORM(rememberedquery)"
puts ""
puts "<TITLE>What a hack.</TITLE>"
puts "Resubmitting your query with new columns..."
exit
my $list = join(" ", @collist);
print "Set-Cookie: COLUMNLIST=$list ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT\n";
print "Refresh: 0; URL=buglist.cgi?$::FORM{'rememberedquery'}\n";
print "\n";
print "<TITLE>What a hack.</TITLE>\n";
print "Resubmitting your query with new columns...\n";
exit;
}
if {[info exists COOKIE(COLUMNLIST)]} {
set collist $COOKIE(COLUMNLIST)
if (defined $::COOKIE{'COLUMNLIST'}) {
@collist = split(/ /, $::COOKIE{'COLUMNLIST'});
} 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)"
set desc(summaryfull) "Full Summary"
$desc{'summary'} = "Summary (first 60 characters)";
$desc{'summaryfull'} = "Full Summary";
puts ""
puts "Check which columns you wish to appear on the list, and then click on"
puts "submit."
puts "<p>"
puts "<FORM ACTION=colchange.cgi>"
puts "<INPUT TYPE=HIDDEN NAME=rememberedquery VALUE=$buffer>"
print "\n";
print "Check which columns you wish to appear on the list, and then click\n";
print "on submit.\n";
print "<p>\n";
print "<FORM ACTION=colchange.cgi>\n";
print "<INPUT TYPE=HIDDEN NAME=rememberedquery VALUE=$::buffer>\n";
foreach i $masterlist {
if {[lsearch $collist $i] >= 0} {
set c CHECKED
foreach my $i (@masterlist) {
my $c;
if (lsearch(\@collist, $i) >= 0) {
$c = 'CHECKED';
} 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>"
puts "<INPUT TYPE=\"submit\" VALUE=\"Submit\">"
puts "</FORM>"
puts "<FORM ACTION=colchange.cgi>"
puts "<INPUT TYPE=HIDDEN NAME=rememberedquery VALUE=$buffer>"
puts "<INPUT TYPE=HIDDEN NAME=resetit VALUE=1>"
puts "<INPUT TYPE=\"submit\" VALUE=\"Reset to Bugzilla default\">"
puts "</FORM>"
print "<P>\n";
print "<INPUT TYPE=\"submit\" VALUE=\"Submit\">\n";
print "</FORM>\n";
print "<FORM ACTION=colchange.cgi>\n";
print "<INPUT TYPE=HIDDEN NAME=rememberedquery VALUE=$::buffer>\n";
print "<INPUT TYPE=HIDDEN NAME=resetit VALUE=1>\n";
print "<INPUT TYPE=\"submit\" VALUE=\"Reset to Bugzilla default\">\n";
print "</FORM>\n";
defparams.pl 0 → 100644
View file @ 4727e6c0
# -*- 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;
defparams.tcl
View file @ 4727e6c0
......@@ -71,6 +71,10 @@ set param_list {}
#
# 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.
......@@ -90,6 +94,22 @@ proc check_urlbase {url} {
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>
<TR><TD><A HREF="http://www.mozilla.org/"><IMG
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!
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
doeditparams.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,44 +19,57 @@
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
source "defparams.tcl"
use diagnostics;
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>"
puts "And so, you aren't allowed to edit the parameters of it."
exit
confirm_login();
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 {
if {[info exists FORM(reset-$i)]} {
set FORM($i) $param_default($i)
foreach my $i (@::param_list) {
# print "Processing $i...<BR>\n";
if (exists $::FORM{"reset-$i"}) {
$::FORM{$i} = $::param_default{$i};
}
if {![cequal $FORM($i) [Param $i]]} {
if {![cequal $param_checker($i) ""]} {
set ok [$param_checker($i) $FORM($i)]
if {![cequal $ok ""]} {
puts "New value for $i is invalid: $ok<p>"
puts "Please hit <b>Back</b> and try again."
exit
$::FORM{$i} =~ s/\r\n/\n/; # Get rid of windows-style line endings.
if ($::FORM{$i} ne Param($i)) {
if (defined $::param_checker{$i}) {
my $ref = $::param_checker{$i};
my $ok = &$ref($::FORM{$i});
if ($ok ne "") {
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>"
set param($i) $FORM($i)
print "Changed $i.<br>\n";
$::param{$i} = $::FORM{$i}
}
}
WriteParams
WriteParams();
puts "OK, done.<p>"
puts "<a href=editparams.cgi>Edit the params some more.</a><p>"
puts "<a href=query.cgi>Go back to the query page.</a>"
print "OK, done.<p>\n";
print "<a href=editparams.cgi>Edit the params some more.</a><p>\n";
print "<a href=query.cgi>Go back to the query page.</a>\n";
editparams.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -20,66 +20,81 @@
# Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
source "defparams.tcl"
use diagnostics;
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)]} {
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."
exit
confirm_login();
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 "Edit parameters" "Edit parameters"
PutHeader("Edit parameters");
puts "This lets you edit the basic operating parameters of bugzilla. Be careful!"
puts "<p>"
puts "Any item you check Reset on will get reset to its default value."
print "This lets you edit the basic operating parameters of bugzilla.\n";
print "Be careful!\n";
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>"
puts "<tr><td valign=top><input type=checkbox name=reset-$i>Reset</td><td>"
set value [Param $i]
switch $param_type($i) {
t {
puts "<input size=80 name=$i value=\"[value_quote $value]\">"
}
l {
puts "<textarea wrap=hard name=$i rows=10 cols=80>[value_quote $value]</textarea>"
}
b {
if {$value} {
set on "checked"
set off ""
foreach my $i (@::param_list) {
print "<tr><th align=right valign=top>$i:</th><td>$::param_desc{$i}</td></tr>\n";
print "<tr><td valign=top><input type=checkbox name=reset-$i>Reset</td><td>\n";
my $value = Param($i);
SWITCH: for ($::param_type{$i}) {
/^t$/ && do {
print "<input size=80 name=$i value=\"" .
value_quote($value) . '">\n';
last SWITCH;
};
/^l$/ && do {
print "<textarea wrap=hard name=$i rows=10 cols=80>" .
value_quote($value) . "</textarea>\n";
last SWITCH;
};
/^b$/ && do {
my $on;
my $off;
if ($value) {
$on = "checked";
$off = "";
} else {
set on ""
set off "checked"
}
puts "<input type=radio name=$i value=1 $on>On "
puts "<input type=radio name=$i value=0 $off>Off"
}
default {
puts "<font color=red><blink>Unknown param type $param_type($i)!!!</blink></font>"
$on = "";
$off = "checked";
}
print "<input type=radio name=$i value=1 $on>On\n";
print "<input type=radio name=$i value=0 $off>Off\n";
last SWITCH;
};
# DEFAULT
print "<font color=red><blink>Unknown param type $::param_type{$i}!!!</blink></font>\n";
}
puts "</td></tr>"
puts $rowbreak
print "</td></tr>\n";
print $rowbreak;
}
puts "</table>"
print "</table>\n";
puts "<input type=reset value=\"Reset form\"><br>"
puts "<input type=submit value=\"Submit changes\">"
print "<input type=reset value=\"Reset form\"><br>\n";
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";
enter_bug.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,135 +19,149 @@
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
use diagnostics;
use strict;
source CGI.tcl
require "CGI.pl";
if {![info exists FORM(product)]} {
GetVersionTable
if {[array size versions] != 1} {
puts "Content-type: text/html\n"
PutHeader "Enter Bug" "Enter Bug"
# Shut up misguided -w warnings about "used only once":
use vars @::legal_platform,
@::buffer,
@::legal_severity,
@::legal_opsys,
@::legal_priority;
puts "<H2>First, you must pick a product on which to enter a bug.</H2>"
foreach p [lsort [array names versions]] {
puts "<a href=\"enter_bug.cgi?product=[url_quote $p]\"&$buffer>$p</a><br>"
if (!defined $::FORM{'product'}) {
GetVersionTable();
my @prodlist = keys %::versions;
if ($#prodlist != 0) {
print "Content-type: text/html\n\n";
PutHeader("Enter Bug");
print "<H2>First, you must pick a product on which to enter\n";
print "a bug.</H2>\n";
foreach my $p (sort (@prodlist)) {
print "<a href=\"enter_bug.cgi?product=" . url_quote($p) . "\"&$::buffer>$p</a><br>\n";
}
exit
exit;
}
set FORM(product) [array names versions]
$::FORM{'product'} = $prodlist[0];
}
set product $FORM(product)
confirm_login
my $product = $::FORM{'product'};
puts "Content-type: text/html\n"
confirm_login();
print "Content-type: text/html\n\n";
proc pickplatform {} {
global env FORM
if {[formvalue rep_platform] != ""} {
return [formvalue rep_platform]
sub formvalue {
my ($name, $default) = (@_);
if (exists $::FORM{$name}) {
return $::FORM{$name};
}
switch -regexp $env(HTTP_USER_AGENT) {
{Mozilla.*\(X11} {return "X-Windows"}
{Mozilla.*\(Windows} {return "PC"}
{Mozilla.*\(Macintosh} {return "Macintosh"}
{Mozilla.*\(Win} {return "PC"}
default {return "PC"}
if (defined $default) {
return $default;
}
return "";
}
sub pickplatform {
my $value = formvalue("rep_platform");
if ($value ne "") {
return $value;
}
for ($ENV{'HTTP_USER_AGENT'}) {
/Mozilla.*\(X11/ && do {return "X-Windows";};
/Mozilla.*\(Windows/ && do {return "PC";};
/Mozilla.*\(Macintosh/ && do {return "Macintosh";};
/Mozilla.*\(Win/ && do {return "PC";};
# default
return "PC";
}
}
proc pickversion {} {
global env versions product FORM
set version [formvalue version]
if {$version == ""} {
regexp {Mozilla[ /]([^ ]*) } $env(HTTP_USER_AGENT) foo version
switch -regexp $env(HTTP_USER_AGENT) {
{4\.09} { set version "4.5" }
sub pickversion {
my $version = formvalue('version');
if ($version eq "") {
if ($ENV{'HTTP_USER_AGENT'} =~ m@Mozilla[ /]([^ ]*)@) {
$version = $1;
}
}
if {[lsearch -exact $versions($product) $version] >= 0} {
return $version
if (lsearch($::versions{$product}, $version) >= 0) {
return $version;
} else {
if {[info exists COOKIE(VERSION-$product)]} {
if {[lsearch -exact $versions($product) $COOKIE(VERSION-$Product)] >= 0} {
return $COOKIE(VERSION-$Product)
if (defined $::COOKIE{"VERSION-$product"}) {
if (lsearch($::versions{$product},
$::COOKIE{"VERSION-$product"}) >= 0) {
return $::COOKIE{"VERSION-$product"};
}
}
}
return [lindex $versions($product) 0]
return $::versions{$product}->[0];
}
proc pickcomponent {} {
global components product FORM
set result [formvalue component]
if {![cequal $result ""] && \
[lsearch -exact $components($product) $result] < 0} {
set result ""
sub pickcomponent {
my $result =formvalue('component');
if ($result ne "" && lsearch($::components{$product}, $result) < 0) {
$result = "";
}
return $result
return $result;
}
proc pickos {} {
global env FORM
if {[formvalue op_sys] != ""} {
return [formvalue op_sys]
sub pickos {
if (formvalue('op_sys') ne "") {
return formvalue('op_sys');
}
switch -regexp $env(HTTP_USER_AGENT) {
{Mozilla.*\(.*;.*; IRIX.*\)} {return "IRIX"}
{Mozilla.*\(.*;.*; 32bit.*\)} {return "Windows 95"}
{Mozilla.*\(.*;.*; 16bit.*\)} {return "Windows 3.1"}
{Mozilla.*\(.*;.*; 68K.*\)} {return "System 7.5"}
{Mozilla.*\(.*;.*; PPC.*\)} {return "System 7.5"}
{Mozilla.*\(.*;.*; OSF.*\)} {return "OSF/1"}
{Mozilla.*\(.*;.*; Linux.*\)} {return "Linux"}
{Mozilla.*\(.*;.*; SunOS 5.*\)} {return "Solaris"}
{Mozilla.*\(.*;.*; SunOS.*\)} {return "SunOS"}
{Mozilla.*\(.*;.*; SunOS.*\)} {return "SunOS"}
{Mozilla.*\(Win16.*\)} {return "Windows 3.1"}
{Mozilla.*\(Win95.*\)} {return "Windows 95"}
{Mozilla.*\(WinNT.*\)} {return "Windows NT"}
default {return "other"}
for ($ENV{'HTTP_USER_AGENT'}) {
/Mozilla.*\(.*;.*; IRIX.*\)/ && do {return "IRIX";};
/Mozilla.*\(.*;.*; 32bit.*\)/ && do {return "Windows 95";};
/Mozilla.*\(.*;.*; 16bit.*\)/ && do {return "Windows 3.1";};
/Mozilla.*\(.*;.*; 68K.*\)/ && do {return "System 7.5";};
/Mozilla.*\(.*;.*; PPC.*\)/ && do {return "System 7.5";};
/Mozilla.*\(.*;.*; OSF.*\)/ && do {return "OSF/1";};
/Mozilla.*\(.*;.*; Linux.*\)/ && do {return "Linux";};
/Mozilla.*\(.*;.*; SunOS 5.*\)/ && do {return "Solaris";};
/Mozilla.*\(.*;.*; SunOS.*\)/ && do {return "SunOS";};
/Mozilla.*\(.*;.*; SunOS.*\)/ && do {return "SunOS";};
/Mozilla.*\(Win16.*\)/ && do {return "Windows 3.1";};
/Mozilla.*\(Win95.*\)/ && do {return "Windows 95";};
/Mozilla.*\(WinNT.*\)/ && do {return "Windows NT";};
# default
return "other";
}
}
proc formvalue {name {default ""}} {
global FORM
if {[info exists FORM($name)]} {
return [FormData $name]
}
return $default
}
GetVersionTable
GetVersionTable();
set assign_element [GeneratePersonInput assigned_to 1 [formvalue assigned_to]]
set cc_element [GeneratePeopleInput cc [formvalue cc ""]]
my $assign_element = GeneratePersonInput('assigned_to', 1,
formvalue('assigned_to'));
my $cc_element = GeneratePeopleInput('cc', formvalue('cc'));
set priority_popup [make_popup priority $legal_priority [formvalue priority "P2"] 0]
set sev_popup [make_popup bug_severity $legal_severity [formvalue bug_severity "normal"] 0]
set platform_popup [make_popup rep_platform $legal_platform [pickplatform] 0]
set opsys_popup [make_popup op_sys $legal_opsys [pickos] 0]
my $priority_popup = make_popup('priority', \@::legal_priority,
formvalue('priority', 'P2'), 0);
my $sev_popup = make_popup('bug_severity', \@::legal_severity,
formvalue('bug_severity', 'normal'), 0);
my $platform_popup = make_popup('rep_platform', \@::legal_platform,
pickplatform(), 0);
my $opsys_popup = make_popup('op_sys', \@::legal_opsys, pickos(), 0);
set component_popup [make_popup component $components($product) \
[formvalue component] 1]
my $component_popup = make_popup('component', $::components{$product},
formvalue('component'), 1);
PutHeader "Enter Bug" "Enter Bug"
PutHeader ("Enter Bug");
puts "
print "
<FORM NAME=enterForm METHOD=POST ACTION=\"post_bug.cgi\">
<INPUT TYPE=HIDDEN NAME=bug_status VALUE=NEW>
<INPUT TYPE=HIDDEN NAME=reporter VALUE=$COOKIE(Bugzilla_login)>
<INPUT TYPE=HIDDEN NAME=reporter VALUE=$::COOKIE{'Bugzilla_login'}>
<INPUT TYPE=HIDDEN NAME=product VALUE=$product>
<TABLE CELLSPACING=2 CELLPADDING=0 BORDER=0>
<TR>
......@@ -156,7 +170,7 @@ puts "
</TR>
<TR>
<td ALIGN=right valign=top><B>Version:</B></td>
<td>[Version_element [pickversion] $product]</td>
<td>" . Version_element(pickversion(), $product) . "</td>
<td align=right valign=top><b>Component:</b></td>
<td>$component_popup</td>
</TR>
......@@ -193,17 +207,23 @@ puts "
<TR>
<TD ALIGN=RIGHT><B>URL:</B>
<TD COLSPAN=5>
<INPUT NAME=bug_file_loc SIZE=60 value=\"[value_quote [formvalue bug_file_loc]]\"></TD>
<INPUT NAME=bug_file_loc SIZE=60 value=\"" .
value_quote(formvalue('bug_file_loc')) .
"\"></TD>
</TR>
<TR>
<TD ALIGN=RIGHT><B>Summary:</B>
<TD COLSPAN=5>
<INPUT NAME=short_desc SIZE=60 value=\"[value_quote [formvalue short_desc]]\"></TD>
<INPUT NAME=short_desc SIZE=60 value=\"" .
value_quote(formvalue('short_desc')) .
"\"></TD>
</TR>
<tr><td>&nbsp<td> <td> <td> <td> <td> </tr>
<tr>
<td aligh=right valign=top><B>Description:</b>
<td colspan=5><TEXTAREA WRAP=HARD NAME=comment ROWS=10 COLS=80>[value_quote [formvalue comment]]</TEXTAREA><BR></td>
<td colspan=5><TEXTAREA WRAP=HARD NAME=comment ROWS=10 COLS=80>" .
value_quote(formvalue('comment')) .
"</TEXTAREA><BR></td>
</tr>
<tr>
<td></td>
......@@ -219,9 +239,7 @@ puts "
<INPUT TYPE=hidden name=form_name VALUE=enter_bug>
</FORM>
Some fields initialized from your user-agent, <b>$env(HTTP_USER_AGENT)</b>.
If you think it got it wrong, please tell $maintainer what it should have been.
</BODY></HTML>"
Some fields initialized from your user-agent, <b>$ENV{'HTTP_USER_AGENT'}</b>.
If you think it got it wrong, please tell " . Param('maintainer') . " what it should have been.
flush stdout
</BODY></HTML>";
globals.pl 0 → 100644
View file @ 4727e6c0
# -*- 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>
# Contains some global variables and routines used throughout bugzilla.
use diagnostics;
use strict;
use Mysql;
use Date::Format; # For time2str().
$::dontchange = "--do_not_change--";
$::chooseone = "--Choose_one:--";
sub ConnectToDatabase {
if (!defined $::db) {
$::db = Mysql->Connect("localhost", "bugs", "bugs", "")
|| die "Can't connect to database server.";
}
}
sub SendSQL {
my ($str) = (@_);
$::currentquery = $::db->query($str)
|| die "$str: $::db_errstr";
}
sub MoreSQLData {
if (defined @::fetchahead) {
return 1;
}
if (@::fetchahead = $::currentquery->fetchrow()) {
return 1;
}
return 0;
}
sub FetchSQLData {
if (defined @::fetchahead) {
my @result = @::fetchahead;
undef @::fetchahead;
return @result;
}
return $::currentquery->fetchrow();
}
sub FetchOneColumn {
my @row = FetchSQLData();
return $row[0];
}
@::legal_opsys = ("Windows 3.1", "Windows 95", "Windows NT", "System 7",
"System 7.5", "7.1.6", "AIX", "BSDI", "HP-UX", "IRIX",
"Linux", "OSF/1", "Solaris", "SunOS", "other");
@::default_column_list = ("severity", "priority", "platform", "owner",
"status", "resolution", "summary");
sub AppendComment {
my ($bugid,$who,$comment) = (@_);
$comment =~ s/\r\n/\n/; # Get rid of windows-style line endings.
if ($comment =~ /^\s*$/) { # Nothin' but whitespace.
return;
}
SendSQL("select long_desc from bugs where bug_id = $bugid");
my $desc = FetchOneColumn();
my $now = time2str("%D %H:%M", time());
$desc .= "\n\n------- Additional Comments From $who $now -------\n";
$desc .= $comment;
SendSQL("update bugs set long_desc=" . SqlQuote($desc) .
" where bug_id=$bugid");
}
sub lsearch {
my ($list,$item) = (@_);
my $count = 0;
foreach my $i (@$list) {
if ($i eq $item) {
return $count;
}
$count++;
}
return -1;
}
sub Product_element {
my ($prod,$onchange) = (@_);
return make_popup("product", keys %::versions, $prod, 1, $onchange);
}
sub Component_element {
my ($comp,$prod,$onchange) = (@_);
my $componentlist;
if (! defined $::components{$prod}) {
$componentlist = [];
} else {
$componentlist = $::components{$prod};
}
my $defcomponent;
if ($comp ne "" && lsearch($componentlist, $comp) >= 0) {
$defcomponent = $comp;
} else {
$defcomponent = $componentlist->[0];
}
return make_popup("component", $componentlist, $defcomponent, 1, "");
}
sub Version_element {
my ($vers, $prod, $onchange) = (@_);
my $versionlist;
if (!defined $::versions{$prod}) {
$versionlist = [];
} else {
$versionlist = $::versions{$prod};
}
my $defversion = $versionlist->[0];
if (lsearch($versionlist,$vers) >= 0) {
$defversion = $vers;
}
return make_popup("version", $versionlist, $defversion, 1, $onchange);
}
# Generate a string which, when later interpreted by the Perl compiler, will
# be the same as the given string.
sub PerlQuote {
my ($str) = (@_);
return SqlQuote($str);
# The below was my first attempt, but I think just using SqlQuote makes more
# sense...
# $result = "'";
# $length = length($str);
# for (my $i=0 ; $i<$length ; $i++) {
# my $c = substr($str, $i, 1);
# if ($c eq "'" || $c eq '\\') {
# $result .= '\\';
# }
# $result .= $c;
# }
# $result .= "'";
# return $result;
}
# Given the name of a global variable, generate Perl code that, if later
# executed, would restore the variable to its current value.
sub GenerateCode {
my ($name) = (@_);
my $result = $name . " = ";
if ($name =~ /^\$/) {
my $value = eval($name);
if (ref($value) eq "ARRAY") {
$result .= "[" . GenerateArrayCode($value) . "]";
} else {
$result .= PerlQuote(eval($name));
}
} elsif ($name =~ /^@/) {
my @value = eval($name);
$result .= "(" . GenerateArrayCode(\@value) . ")";
} elsif ($name =~ '%') {
$result = "";
foreach my $k (sort { uc($a) cmp uc($b)} eval("keys $name")) {
$result .= GenerateCode("\$" . substr($name, 1) .
"{'" . $k . "'}");
}
return $result;
} else {
die "Can't do $name -- unacceptable variable type.";
}
$result .= ";\n";
return $result;
}
sub GenerateArrayCode {
my ($ref) = (@_);
my @list;
foreach my $i (@$ref) {
push @list, PerlQuote($i);
}
return join(',', @list);
}
sub GenerateVersionTable {
ConnectToDatabase();
SendSQL("select value, program from versions order by value");
my @line;
my %varray;
my %carray;
while (@line = FetchSQLData()) {
my ($v,$p1) = (@line);
if (!defined $::versions{$p1}) {
$::versions{$p1} = [];
}
push @{$::versions{$p1}}, $v;
$varray{$v} = 1;
}
SendSQL("select value, program from components");
while (@line = FetchSQLData()) {
my ($c,$p) = (@line);
if (!defined $::components{$p}) {
$::components{$p} = [];
}
my $ref = $::components{$p};
push @$ref, $c;
$carray{$c} = 1;
}
my $cols = LearnAboutColumns("bugs");
@::log_columns = @{$cols->{"-list-"}};
foreach my $i ("bug_id", "creation_ts", "delta_ts", "long_desc") {
my $w = lsearch(\@::log_columns, $i);
if ($w >= 0) {
splice(@::log_columns, $w, 1);
}
}
@::legal_priority = SplitEnumType($cols->{"priority,type"});
@::legal_severity = SplitEnumType($cols->{"bug_severity,type"});
@::legal_platform = SplitEnumType($cols->{"rep_platform,type"});
@::legal_bug_status = SplitEnumType($cols->{"bug_status,type"});
@::legal_resolution = SplitEnumType($cols->{"resolution,type"});
@::legal_resolution_no_dup = @::legal_resolution;
my $w = lsearch(\@::legal_resolution_no_dup, "DUPLICATE");
if ($w >= 0) {
splice(@::legal_resolution_no_dup, $w, 1);
}
my @list = sort { uc($a) cmp uc($b)} keys(%::versions);
@::legal_product = @list;
mkdir("data", 0777);
chmod 0777, "data";
my $tmpname = "data/versioncache.$$";
open(FID, ">$tmpname") || die "Can't create $tmpname";
print FID GenerateCode('@::log_columns');
print FID GenerateCode('%::versions');
foreach my $i (@list) {
if (!defined $::components{$i}) {
$::components{$i} = "";
}
}
@::legal_versions = sort {uc($a) cmp uc($b)} keys(%varray);
print FID GenerateCode('@::legal_versions');
print FID GenerateCode('%::components');
@::legal_components = sort {uc($a) cmp uc($b)} keys(%carray);
print FID GenerateCode('@::legal_components');
foreach my $i('product', 'priority', 'severity', 'platform',
'bug_status', 'resolution', 'resolution_no_dup') {
print FID GenerateCode('@::legal_' . $i);
}
print FID "1;\n";
close FID;
rename $tmpname, "data/versioncache" || die "Can't rename $tmpname to versioncache";
chmod 0666, "data/versioncache";
}
# Returns the modification time of a file.
sub ModTime {
my ($filename) = (@_);
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($filename);
return $mtime;
}
# This proc must be called before using legal_product or the versions array.
sub GetVersionTable {
my $mtime = ModTime("data/versioncache");
if (!defined $mtime || $mtime eq "") {
$mtime = 0;
}
if (time() - $mtime > 3600) {
GenerateVersionTable();
}
require 'data/versioncache';
if (!defined %::versions) {
GenerateVersionTable();
do 'data/versioncache';
if (!defined %::versions) {
die "Can't generate version info; tell terry.";
}
}
}
sub InsertNewUser {
my ($username) = (@_);
my $password = "";
for (my $i=0 ; $i<8 ; $i++) {
$password .= substr("abcdefghijklmnopqrstuvwxyz", int(rand(26)), 1);
}
SendSQL("insert into profiles (login_name, password, cryptpassword) values (@{[SqlQuote($username)]}, '$password', encrypt('$password')");
return $password;
}
sub DBID_to_name {
my ($id) = (@_);
if (!defined $::cachedNameArray{$id}) {
SendSQL("select login_name from profiles where userid = $id");
my $r = FetchOneColumn();
if ($r eq "") {
$r = "__UNKNOWN__";
}
$::cachedNameArray{$id} = $r;
}
return $::cachedNameArray{$id};
}
sub DBname_to_id {
my ($name) = (@_);
SendSQL("select userid from profiles where login_name = @{[SqlQuote($name)]}");
my $r = FetchOneColumn();
if ($r eq "") {
return 0;
}
return $r;
}
sub DBNameToIdAndCheck {
my ($name, $forceok) = (@_);
my $result = DBname_to_id($name);
if ($result > 0) {
return $result;
}
if ($forceok) {
InsertNewUser($name);
$result = DBname_to_id($name);
if ($result > 0) {
return $result;
}
print "Yikes; couldn't create user $name. Please report problem to " .
Param("maintainer") ."\n";
} else {
print "The name <TT>$name</TT> is not a valid username. Please hit\n";
print "the <B>Back</B> button and try again.\n";
}
exit(0);
}
sub GetLongDescription {
my ($id) = (@_);
SendSQL("select long_desc from bugs where bug_id = $id");
return FetchOneColumn();
}
sub ShowCcList {
my ($num) = (@_);
my @ccids;
my @row;
SendSQL("select who from cc where bug_id = $num");
while (@row = FetchSQLData()) {
push(@ccids, $row[0]);
}
my @result = ();
foreach my $i (@ccids) {
push @result, DBID_to_name($i);
}
return join(',', @result);
}
# Fills in a hashtable with info about the columns for the given table in the
# database. The hashtable has the following entries:
# -list- the list of column names
# <name>,type the type for the given name
sub LearnAboutColumns {
my ($table) = (@_);
my %a;
SendSQL("show columns from $table");
my @list = ();
my @row;
while (@row = FetchSQLData()) {
my ($name,$type) = (@row);
$a{"$name,type"} = $type;
push @list, $name;
}
$a{"-list-"} = \@list;
return \%a;
}
# If the above returned a enum type, take that type and parse it into the
# list of values. Assumes that enums don't ever contain an apostrophe!
sub SplitEnumType {
my ($str) = (@_);
my @result = ();
if ($str =~ /^enum\((.*)\)$/) {
my $guts = $1 . ",";
while ($guts =~ /^\'([^\']*)\',(.*)$/) {
push @result, $1;
$guts = $2;
}
}
return @result;
}
# This routine is largely copied from Mysql.pm.
sub SqlQuote {
my ($str) = (@_);
$str =~ s/([\\\'])/\\$1/g;
$str =~ s/\0/\\0/g;
return "'$str'";
}
sub Param {
my ($value) = (@_);
if (defined $::param{$value}) {
return $::param{$value};
}
# Um, maybe we haven't sourced in the params at all yet.
if (stat("data/params")) {
require "data/params";
}
if (defined $::param{$value}) {
return $::param{$value};
}
# Well, that didn't help. Maybe it's a new param, and the user
# hasn't defined anything for it. Try and load a default value
# for it.
require "defparams.pl";
WriteParams();
if (defined $::param{$value}) {
return $::param{$value};
}
# We're pimped.
die "Can't find param named $value";
}
sub PerformSubsts {
my ($str, $substs) = (@_);
$str =~ s/%([a-z]*)%/(defined $substs->{$1} ? $substs->{$1} : Param($1))/eg;
return $str;
}
# Trim whitespace from front and back.
sub trim {
($_) = (@_);
s/^\s*//g;
s/\s*$//g;
return $_;
}
1;
globals.tcl
View file @ 4727e6c0
......@@ -110,7 +110,6 @@ proc SortIgnoringCase {a b} {
proc make_popup { name src default listtype {onchange {}}} {
set last ""
set popup "<SELECT NAME=$name"
if {$listtype > 0} {
append popup " SIZE=5"
......
long_list.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -20,11 +20,18 @@
# Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
puts "Content-type: text/html\n"
puts "<TITLE>Full Text Bug Listing</TITLE>"
use diagnostics;
use strict;
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
bugs.bug_id,
bugs.product,
......@@ -42,34 +49,39 @@ select
bugs.short_desc
from bugs,profiles assign,profiles report
where assign.userid = bugs.assigned_to and report.userid = bugs.reporter and
}
";
ConnectToDatabase
ConnectToDatabase();
foreach bug [split $FORM(buglist) :] {
SendSQL "$generic_query bugs.bug_id = $bug\n"
foreach my $bug (split(/:/, $::FORM{'buglist'})) {
SendSQL("$generic_query bugs.bug_id = $bug");
if { [ MoreSQLData ] } {
set result [ FetchSQLData ]
puts "<IMG SRC=\"1x1.gif\" WIDTH=1 HEIGHT=80 ALIGN=LEFT>"
puts "<TABLE WIDTH=100%>"
puts "<TD COLSPAN=4><TR><DIV ALIGN=CENTER><B><FONT =\"+3\">[html_quote [lindex $result 15]]</B></FONT></DIV>"
puts "<TR><TD><B>Bug#:</B> <A HREF=\"show_bug.cgi?id=[lindex $result 0]\">[lindex $result 0]</A>"
puts "<TD><B>Product:</B> [lindex $result 1]"
puts "<TD><B>Version:</B> [lindex $result 2]"
puts "<TD><B>Platform:</B> [lindex $result 3]"
puts "<TR><TD><B>OS/Version:</B> [lindex $result 4]"
puts "<TD><B>Status:</B> [lindex $result 5]"
puts "<TD><B>Severity:</B> [lindex $result 6]"
puts "<TD><B>Priority:</B> [lindex $result 7]"
puts "<TR><TD><B>Resolution:</B> [lindex $result 8]</TD>"
puts "<TD><B>Assigned To:</B> [lindex $result 9]"
puts "<TD><B>Reported By:</B> [lindex $result 10]"
puts "<TR><TD><B>Component:</B> [lindex $result 11]"
puts "<TR><TD COLSPAN=6><B>URL:</B> [html_quote [lindex $result 12]]"
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]]"
puts "<TR><TD><B>Description&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;:</B>\n</TABLE>"
puts "<PRE>[html_quote [GetLongDescription $bug]]</PRE>"
puts "<HR>"
my @row;
if (@row = FetchSQLData()) {
my ($id, $product, $version, $platform, $opsys, $status, $severity,
$priority, $resolution, $assigned, $reporter, $component, $url,
$shortdesc) = (@row);
print "<IMG SRC=\"1x1.gif\" WIDTH=1 HEIGHT=80 ALIGN=LEFT>\n";
print "<TABLE WIDTH=100%>\n";
print "<TD COLSPAN=4><TR><DIV ALIGN=CENTER><B><FONT =\"+3\">" .
html_quote($shortdesc) .
"</B></FONT></DIV>\n";
print "<TR><TD><B>Bug#:</B> <A HREF=\"show_bug.cgi?id=$id\">$id</A>\n";
print "<TD><B>Product:</B> $product\n";
print "<TD><B>Version:</B> $version\n";
print "<TD><B>Platform:</B> $platform\n";
print "<TR><TD><B>OS/Version:</B> $opsys\n";
print "<TD><B>Status:</B> $status\n";
print "<TD><B>Severity:</B> $severity\n";
print "<TD><B>Priority:</B> $priority\n";
print "<TR><TD><B>Resolution:</B> $resolution</TD>\n";
print "<TD><B>Assigned To:</B> $assigned\n";
print "<TD><B>Reported By:</B> $reporter\n";
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";
}
}
new_comment.cgi
View file @ 4727e6c0
......@@ -31,7 +31,7 @@ foreach $pair (@pairs)
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
open(COMMENTS, ">>comments");
open(COMMENTS, ">>data/comments");
$c=$FORM{"comment"};
print COMMENTS $FORM{"comment"} . "\n";
close(COMMENTS);
......
newquip.html
View file @ 4727e6c0
......@@ -31,4 +31,4 @@ funny or boring and bonk on the button.
<INPUT TYPE="submit" VALUE="Add This Quip"></FORM>
</HR>
For the impatient, you can
<A HREF="comments">view the whole quip list</A>.
<A HREF="data/comments">view the whole quip list</A>.
post_bug.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -20,118 +20,104 @@
# Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
confirm_login
use diagnostics;
use strict;
puts "Set-Cookie: PLATFORM=$FORM(product) ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT"
puts "Set-Cookie: VERSION-$FORM(product)=$FORM(version) ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT"
puts "Content-type: text/html\n"
require "CGI.pl";
if {[info exists FORM(maketemplate)]} {
puts "<TITLE>Bookmarks are your friend.</TITLE>"
puts "<H1>Template constructed.</H1>"
# Shut up misguided -w warnings about "used only once". For some reason,
# "use vars" chokes on me when I try it here.
set url "enter_bug.cgi?$buffer"
# use vars qw($::buffer);
my $zz = $::buffer;
$zz = $zz . $zz;
puts "If you put a bookmark <a href=\"$url\">to this link</a>, it will"
puts "bring up the submit-a-new-bug page with the fields initialized"
puts "as you've requested."
exit
}
PutHeader "Posting Bug -- Please wait" "Posting Bug" "One moment please..."
confirm_login();
flush stdout
umask 0
ConnectToDatabase
print "Set-Cookie: PLATFORM=$::FORM{'product'} ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT\n";
print "Set-Cookie: VERSION-$::FORM{'product'}=$::FORM{'version'} ; path=/ ; expires=Sun, 30-Jun-2029 00:00:00 GMT\n";
print "Content-type: text/html\n\n";
if {![info exists FORM(component)] || [cequal $FORM(component) ""]} {
puts "You must choose a component that corresponds to this bug. If"
puts "necessary, just guess. But please hit the <B>Back</B> button and"
puts "choose a component."
exit 0
}
if (defined $::FORM{'maketemplate'}) {
print "<TITLE>Bookmarks are your friend.</TITLE>\n";
print "<H1>Template constructed.</H1>\n";
my $url = "enter_bug.cgi?$::buffer";
set forceAssignedOK 0
if {[cequal "" $FORM(assigned_to)]} {
SendSQL "select initialowner from components
where program='[SqlQuote $FORM(product)]'
and value='[SqlQuote $FORM(component)]'"
set FORM(assigned_to) [lindex [FetchSQLData] 0]
set forceAssignedOK 1
print "If you put a bookmark <a href=\"$url\">to this link</a>, it will\n";
print "bring up the submit-a-new-bug page with the fields initialized\n";
print "as you've requested.\n";
exit;
}
set FORM(assigned_to) [DBNameToIdAndCheck $FORM(assigned_to) $forceAssignedOK]
set FORM(reporter) [DBNameToIdAndCheck $FORM(reporter)]
PutHeader("Posting Bug -- Please wait", "Posting Bug", "One moment please...");
umask 0;
ConnectToDatabase();
set bug_fields { reporter product version rep_platform bug_severity \
priority op_sys assigned_to bug_status bug_file_loc \
short_desc component }
set query "insert into bugs (\n"
if (!defined $::FORM{'component'} || $::FORM{'component'} eq "") {
print "You must choose a component that corresponds to this bug. If\n";
print "necessary, just guess. But please hit the <B>Back</B> button\n";
print "and choose a component.\n";
exit 0
}
foreach field $bug_fields {
append query "$field,\n"
my $forceAssignedOK = 0;
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 {
if {$field == "qa_assigned_to"} {
my @bug_fields = ("reporter", "product", "version", "rep_platform",
"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 {
regsub -all "'" [FormData $field] "''" value
append query "'$value',\n"
}
foreach my $field (@bug_fields) {
$query .= SqlQuote($::FORM{$field}) . ",\n";
}
append query "now(), "
append query "'[SqlQuote [FormData comment]]' )\n"
$query .= "now(), " . SqlQuote($::FORM{'comment'}) . " )\n";
set ccids(zz) 1
unset ccids(zz)
my %ccids;
if {[info exists FORM(cc)]} {
foreach person [split $FORM(cc) " ,"] {
if {![cequal $person ""]} {
set ccids([DBNameToIdAndCheck $person]) 1
if (defined $::FORM{'cc'}) {
foreach my $person (split(/[ ,]/, $::FORM{'cc'})) {
if ($person ne "") {
$ccids{DBNameToIdAndCheck($person)} = 1;
}
}
}
# puts "<PRE>$query</PRE>"
# print "<PRE>$query</PRE>\n";
SendSQL $query
while {[MoreSQLData]} { set ret [FetchSQLData] }
SendSQL($query);
SendSQL "select LAST_INSERT_ID()"
set id [FetchSQLData]
SendSQL("select LAST_INSERT_ID()");
my $id = FetchOneColumn();
foreach person [array names ccids] {
SendSQL "insert into cc (bug_id, who) values ($id, $person)"
while { [ MoreSQLData ] } { FetchSQLData }
foreach my $person (keys %ccids) {
SendSQL("insert into cc (bug_id, who) values ($id, $person)");
}
# Now make sure changes are written before we run processmail...
Disconnect
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
print "<H2>Changes Submitted</H2>\n";
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";
exec ./processmail $id < /dev/null > /dev/null 2> /dev/null &
exit
system("./processmail $id < /dev/null > /dev/null 2> /dev/null &");
exit;
process_bug.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,293 +19,293 @@
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
confirm_login
puts "Content-type: text/html\n"
GetVersionTable
if {![cequal $FORM(product) $dontchange]} {
set prod [FormData product]
set vok [expr [lsearch -exact $versions($prod) \
[FormData version]] >= 0]
set cok [expr [lsearch -exact $components($prod) \
[FormData component]] >= 0]
if {!$vok || !$cok} {
puts "<H1>Changing product means changing version and component.</H1>"
puts "You have chosen a new product, and now the version and/or"
puts "component fields are not correct. (Or, possibly, the bug did"
puts "not have a valid component or version field in the first place.)"
puts "Anyway, please set the version and component now.<p>"
puts "<form>"
puts "<table>"
puts "<tr>"
puts "<td align=right><b>Product:</b></td>"
puts "<td>$prod</td>"
puts "</tr><tr>"
puts "<td align=right><b>Version:</b></td>"
puts "<td>[Version_element [FormData version] $prod]</td>"
puts "</tr><tr>"
puts "<td align=right><b>Component:</b></td>"
puts "<td>[Component_element [FormData component] $prod]</td>"
puts "</tr>"
puts "</table>"
foreach i [array names FORM] {
if {[lsearch -exact {version component} $i] < 0} {
puts "<input type=hidden name=$i value=\"[value_quote $FORM($i)]\">"
}
}
puts "<input type=submit value=Commit>"
puts "</form>"
puts "</hr>"
puts "<a href=query.cgi>Cancel all this and go back to the query page.</a>"
exit
use diagnostics;
use strict;
require "CGI.pl";
# Shut up misguided -w warnings about "used only once":
use vars %::versions,
%::components,
%::COOKIE;
confirm_login();
print "Content-type: text/html\n\n";
GetVersionTable();
if ($::FORM{'product'} ne $::dontchange) {
my $prod = $::FORM{'product'};
my $vok = lsearch($::versions{$prod}, $::FORM{'version'}) >= 0;
my $cok = lsearch($::components{$prod}, $::FORM{'component'}) >= 0;
if (!$vok || !$cok) {
print "<H1>Changing product means changing version and component.</H1>\n";
print "You have chosen a new product, and now the version and/or\n";
print "component fields are not correct. (Or, possibly, the bug did\n";
print "not have a valid component or version field in the first place.)\n";
print "Anyway, please set the version and component now.<p>\n";
print "<form>\n";
print "<table>\n";
print "<tr>\n";
print "<td align=right><b>Product:</b></td>\n";
print "<td>$prod</td>\n";
print "</tr><tr>\n";
print "<td align=right><b>Version:</b></td>\n";
print "<td>" . Version_element($::FORM{'version'}, $prod) . "</td>\n";
print "</tr><tr>\n";
print "<td align=right><b>Component:</b></td>\n";
print "<td>" . Component_element($::FORM{'component'}, $prod) . "</td>\n";
print "</tr>\n";
print "</table>\n";
foreach my $i (keys %::FORM) {
if ($i ne 'version' && $i ne 'component') {
print "<input type=hidden name=$i value=\"" .
value_quote($::FORM{$i}) . "\">\n";
}
}
print "<input type=submit value=Commit>\n";
print "</form>\n";
print "</hr>\n";
print "<a href=query.cgi>Cancel all this and go back to the query page.</a>\n";
exit;
}
}
if {[info exists FORM(id)]} {
set idlist $FORM(id)
my @idlist;
if (defined $::FORM{'id'}) {
push @idlist, $::FORM{'id'};
} else {
set idlist {}
foreach i [array names FORM] {
if {[string match "id_*" $i]} {
lappend idlist [crange $i 3 end]
foreach my $i (keys %::FORM) {
if ($i =~ /^id_/) {
push @idlist, substr($i, 3);
}
}
}
if {![info exists FORM(who)]} {
set FORM(who) $COOKIE(Bugzilla_login)
if (!defined $::FORM{'who'}) {
$::FORM{'who'} = $::COOKIE{'Bugzilla_login'};
}
puts "<TITLE>Update Bug $idlist</TITLE>"
if {[info exists FORM(id)]} {
navigation_header
print "<TITLE>Update Bug " . join(" ", @idlist) . "</TITLE>\n";
if (defined $::FORM{'id'}) {
navigation_header();
}
puts "<HR>"
set query "update bugs\nset"
set comma ""
umask 0
proc DoComma {} {
global query comma
append query "$comma\n "
set comma ","
print "<HR>\n";
$::query = "update bugs\nset";
$::comma = "";
umask(0);
sub DoComma {
$::query .= "$::comma\n ";
$::comma = ",";
}
proc ChangeStatus {str} {
global dontchange query
if {![cequal $str $dontchange]} {
DoComma
append query "bug_status = '$str'"
sub ChangeStatus {
my ($str) = (@_);
if ($str ne $::dontchange) {
DoComma();
$::query .= "bug_status = '$str'";
}
}
proc ChangeResolution {str} {
global dontchange query
if {![cequal $str $dontchange]} {
DoComma
append query "resolution = '$str'"
sub ChangeResolution {
my ($str) = (@_);
if ($str ne $::dontchange) {
DoComma();
$::query .= "resolution = '$str'";
}
}
foreach field {rep_platform priority bug_severity url summary \
component bug_file_loc short_desc \
product version component} {
if {[info exists FORM($field)]} {
if {![cequal $FORM($field) $dontchange]} {
DoComma
regsub -all "'" [FormData $field] "''" value
append query "$field = '$value'"
foreach my $field ("rep_platform", "priority", "bug_severity", "url",
"summary", "component", "bug_file_loc", "short_desc",
"product", "version", "component") {
if (defined $::FORM{$field}) {
if ($::FORM{$field} ne $::dontchange) {
DoComma();
$::query .= "$field = " . SqlQuote($::FORM{$field});
}
}
}
ConnectToDatabase
switch -exact $FORM(knob) {
none {}
accept {
ChangeStatus ASSIGNED
}
clearresolution {
ChangeResolution {}
}
resolve {
ChangeStatus RESOLVED
ChangeResolution $FORM(resolution)
}
reassign {
ChangeStatus NEW
DoComma
set newid [DBNameToIdAndCheck $FORM(assigned_to)]
append query "assigned_to = $newid"
}
reassignbycomponent {
if {[cequal $FORM(component) $dontchange]} {
puts "You must specify a component whose owner should get assigned"
puts "these bugs."
ConnectToDatabase();
SWITCH: for ($::FORM{'knob'}) {
/^none$/ && do {
last SWITCH;
};
/^accept$/ && do {
ChangeStatus('ASSIGNED');
last SWITCH;
};
/^clearresolution$/ && do {
ChangeResolution('');
last SWITCH;
};
/^resolve$/ && do {
ChangeStatus('RESOLVED');
ChangeResolution($::FORM{'resolution'});
last SWITCH;
};
/^reassign$/ && do {
ChangeStatus('NEW');
DoComma();
my $newid = DBNameToIdAndCheck($::FORM{'assigned_to'});
$::query .= "assigned_to = $newid";
last SWITCH;
};
/^reassignbycomponent$/ && do {
if ($::FORM{'component'} eq $::dontchange) {
print "You must specify a component whose owner should get\n";
print "assigned these bugs.\n";
exit 0
}
ChangeStatus NEW
DoComma
SendSQL "select initialowner from components
where program='[SqlQuote $FORM(product)]'
and value='[SqlQuote $FORM(component)]'"
set newname [lindex [FetchSQLData] 0]
set newid [DBNameToIdAndCheck $newname 1]
append query "assigned_to = $newid"
}
reopen {
ChangeStatus REOPENED
}
verify {
ChangeStatus VERIFIED
}
close {
ChangeStatus CLOSED
}
duplicate {
ChangeStatus RESOLVED
ChangeResolution DUPLICATE
set num $FORM(dup_id)
if {[catch {incr num}]} {
puts "You must specify a bug number of which this bug is a"
puts "duplicate. The bug has not been changed."
exit
}
if {$FORM(dup_id) == $FORM(id)} {
puts "Nice try. But it doesn't really make sense to mark a bug as"
puts "a duplicate of itself, does it?"
exit
}
AppendComment $FORM(dup_id) $FORM(who) "*** Bug $FORM(id) has been marked as a duplicate of this bug. ***"
append FORM(comment) "\n\n*** This bug has been marked as a duplicate of $FORM(dup_id) ***"
exec ./processmail $FORM(dup_id) < /dev/null > /dev/null 2> /dev/null &
}
default {
puts "Unknown action $FORM(knob)!"
exit
}
ChangeStatus('NEW');
SendSQL("select initialowner from components where program=" .
SqlQuote($::FORM{'product'}) . " and value=" .
SqlQuote($::FORM{'component'}));
my $newname = FetchOneColumn();
my $newid = DBNameToIdAndCheck($newname, 1);
DoComma();
$::query .= "assigned_to = $newid";
last SWITCH;
};
/^reopen$/ && do {
ChangeStatus('REOPENED');
last SWITCH;
};
/^verify$/ && do {
ChangeStatus('VERIFIED');
last SWITCH;
};
/^close$/ && do {
ChangeStatus('CLOSED');
last SWITCH;
};
/^duplicate$/ && do {
ChangeStatus('RESOLVED');
ChangeResolution('DUPLICATE');
my $num = trim($::FORM{'dup_id'});
if ($num !~ /^[0-9]*$/) {
print "You must specify a bug number of which this bug is a\n";
print "duplicate. The bug has not been changed.\n";
exit;
}
if ($::FORM{'dup_id'} == $::FORM{'id'}) {
print "Nice try. But it doesn't really make sense to mark a\n";
print "bug as a duplicate of itself, does it?\n";
exit;
}
AppendComment($::FORM{'dup_id'}, $::FORM{'who'}, "*** Bug $::FORM{'id'} has been marked as a duplicate of this bug. ***");
$::FORM{'comment'} .= "\n\n*** This bug has been marked as a duplicate of $::FORM{'dup_id'} ***";
system("./processmail $::FORM{'dup_id'} < /dev/null > /dev/null 2> /dev/null &");
last SWITCH;
};
# default
print "Unknown action $::FORM{'knob'}!\n";
exit;
}
if {[lempty $idlist]} {
puts "You apparently didn't choose any bugs to modify."
puts "<p>Click <b>Back</b> and try again."
exit
if ($#idlist < 0) {
print "You apparently didn't choose any bugs to modify.\n";
print "<p>Click <b>Back</b> and try again.\n";
exit;
}
if {[cequal $comma ""]} {
set comment {}
if {[info exists FORM(comment)]} {
set comment $FORM(comment)
}
if {[cequal $comment ""]} {
puts "Um, you apparently did not change anything on the selected bugs."
puts "<p>Click <b>Back</b> and try again."
if ($::comma eq "") {
if (!defined $::FORM{'comment'} || $::FORM{'comment'} =~ /^\s*$/) {
print "Um, you apparently did not change anything on the selected\n";
print "bugs. <p>Click <b>Back</b> and try again.\n";
exit
}
}
set basequery $query
my $basequery = $::query;
proc SnapShotBug {id} {
global log_columns
SendSQL "select [join $log_columns ","] from bugs where bug_id = $id"
return [FetchSQLData]
sub SnapShotBug {
my ($id) = (@_);
SendSQL("select " . join(',', @::log_columns) .
" from bugs where bug_id = $id");
return FetchSQLData();
}
foreach id $idlist {
SendSQL "lock tables bugs write, bugs_activity write, cc write, profiles write"
set oldvalues [SnapShotBug $id]
foreach my $id (@idlist) {
SendSQL("lock tables bugs write, bugs_activity write, cc write, profiles write");
my @oldvalues = SnapShotBug($id);
set query "$basequery\nwhere bug_id = $id"
my $query = "$basequery\nwhere bug_id = $id";
# puts "<PRE>$query</PRE>"
# print "<PRE>$query</PRE>\n";
if {![cequal $comma ""]} {
if { [SendSQL $query] != 0 } {
puts "<H1>Error -- Changes not applied</H1>"
puts "OK, the database rejected the changes for some reason"
puts "which bugzilla can't deal with. The error string returned"
puts "was:<PRE>$oramsg(errortxt)</PRE>"
puts "Here is the query which caused the error:"
puts "<PRE>$query</PRE>"
}
while {[MoreSQLData]} {
FetchSQLData
}
if ($::comma ne "") {
SendSQL($query);
}
if {[info exists FORM(comment)]} {
AppendComment $id $FORM(who) [FormData comment]
if (defined $::FORM{'comment'}) {
AppendComment($id, $::FORM{'who'}, $::FORM{'comment'});
}
if {[info exists FORM(cc)] && [ShowCcList $id] != [lookup FORM cc]} {
set ccids(zz) 1
unset ccids(zz)
foreach person [split $FORM(cc) " ,"] {
if {![cequal $person ""]} {
set cid [DBNameToIdAndCheck $person]
set ccids($cid) 1
if (defined $::FORM{'cc'} && ShowCcList($id) ne $::FORM{'cc'}) {
my %ccids;
foreach my $person (split(/[ ,]/, $::FORM{'cc'})) {
if ($person ne "") {
my $cid = DBNameToIdAndCheck($person);
$ccids{$cid} = 1;
}
}
SendSQL "delete from cc where bug_id = $id"
while {[MoreSQLData]} { FetchSQLData }
foreach ccid [array names ccids] {
SendSQL "insert into cc (bug_id, who) values ($id, $ccid)"
while { [ MoreSQLData ] } { FetchSQLData }
SendSQL("delete from cc where bug_id = $id");
foreach my $ccid (keys %ccids) {
SendSQL("insert into cc (bug_id, who) values ($id, $ccid)");
}
}
# oracommit $lhandle
set newvalues [SnapShotBug $id]
foreach col $log_columns {
set old [lvarpop oldvalues]
set new [lvarpop newvalues]
if {![cequal $old $new]} {
if {![info exists whoid]} {
set whoid [DBNameToIdAndCheck $FORM(who)]
SendSQL "select delta_ts from bugs where bug_id = $id"
set timestamp [lindex [FetchSQLData] 0]
my @newvalues = SnapShotBug($id);
my $whoid;
my $timestamp;
foreach my $col (@::log_columns) {
my $old = shift @oldvalues;
my $new = shift @newvalues;
if ($old ne $new) {
if (!defined $whoid) {
$whoid = DBNameToIdAndCheck($::FORM{'who'});
SendSQL("select delta_ts from bugs where bug_id = $id");
$timestamp = FetchOneColumn();
}
if {[cequal $col assigned_to]} {
set old [DBID_to_name $old]
set new [DBID_to_name $new]
if ($col eq 'assigned_to') {
$old = DBID_to_name($old);
$new = DBID_to_name($new);
}
set q "insert into bugs_activity (bug_id,who,when,field,oldvalue,newvalue) values ($id,$whoid,$timestamp,'[SqlQuote $col]','[SqlQuote $old]','[SqlQuote $new]')"
$col = SqlQuote($col);
$old = SqlQuote($old);
$new = SqlQuote($new);
my $q = "insert into bugs_activity (bug_id,who,when,field,oldvalue,newvalue) values ($id,$whoid,$timestamp,$col,$old,$new)";
# puts "<pre>$q</pre>"
SendSQL $q
SendSQL($q);
}
}
puts "<TABLE BORDER=1><TD><H1>Changes Submitted</H1>"
puts "<TD><A HREF=\"show_bug.cgi?id=$id\">Back To BUG# $id</A></TABLE>"
flush stdout
print "<TABLE BORDER=1><TD><H1>Changes Submitted</H1>\n";
print "<TD><A HREF=\"show_bug.cgi?id=$id\">Back To BUG# $id</A></TABLE>\n";
SendSQL "unlock tables"
SendSQL("unlock tables");
exec ./processmail $id < /dev/null > /dev/null 2> /dev/null &
system("./processmail $id < /dev/null > /dev/null 2> /dev/null &");
}
if {[info exists next_bug]} {
set FORM(id) $next_bug
puts "<HR>"
if (defined $::next_bug) {
$::FORM{'id'} = $::next_bug;
print "<HR>\n";
navigation_header
source "bug_form.tcl"
navigation_header();
do "bug_form.tcl";
} else {
puts "<BR><A HREF=\"query.cgi\">Back To Query Page</A>"
print "<BR><A HREF=\"query.cgi\">Back To Query Page</A>\n";
}
processmail
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -22,202 +22,256 @@
# To recreate the shadow database, run "processmail regenerate" .
use diagnostics;
use strict;
source "globals.tcl"
require "globals.pl";
umask 0
$| = 1;
proc Different {file1 file2} {
if {[file size $file1] != [file size $file2]} {
return 1
umask(0);
$::lockcount = 0;
sub Lock {
if ($::lockcount <= 0) {
$::lockcount = 0;
if (!open(LOCKFID, ">>data/maillock")) {
mkdir "data", 0777;
chmod 0777, "data";
open(LOCKFID, ">>data/maillock") || die "Can't open lockfile.";
}
my $val = flock(LOCKFID,2);
if (!$val) { # '2' is magic 'exclusive lock' const.
print "Lock failed: $val\n";
}
chmod 0666, "data/maillock";
}
$::lockcount++;
}
sub Unlock {
$::lockcount--;
if ($::lockcount <= 0) {
flock(LOCKFID,8); # '8' is magic 'unlock' const.
close LOCKFID;
}
}
sub FileSize {
my ($filename) = (@_);
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($filename);
if (defined $size) {
return $size;
}
return -1;
}
sub Different {
my ($file1, $file2) = (@_);
my $size1 = FileSize($file1);
my $size2 = FileSize($file2);
if ($size1 != $size2) {
return 1;
}
open(FID1, "<$file1") || die "Can't open $file1";
open(FID2, "<$file2") || die "Can't open $file2";
my $d1;
my $d2;
if (read(FID1, $d1, $size1) ne $size1) {
die "Can't read $size1 bytes from $file1";
}
if (read(FID2, $d2, $size2) ne $size2) {
die "Can't read $size2 bytes from $file2";
}
set f1 [open $file1 "r"]
set f2 [open $file2 "r"]
set d1 [read $f1]
set d2 [read $f2]
close $f1
close $f2
return [expr ![cequal $d1 $d2]]
close FID1;
close FID2;
return ($d1 ne $d2);
}
proc DescCC {cclist} {
if {[lempty $cclist]} return ""
return "Cc: [join $cclist ", "]\n"
sub DescCC {
my ($cclist) = (@_);
if (scalar(@$cclist) <= 0) {
return "";
}
return "Cc: " . join(", ", $cclist) . "\n";
}
proc GetBugText {id} {
global bug
catch {unset bug}
set query "
select
bug_id,
product,
version,
rep_platform,
op_sys,
bug_status,
resolution,
priority,
bug_severity,
area,
assigned_to,
reporter,
bug_file_loc,
short_desc,
component
from bugs
where bug_id = $id";
sub GetBugText {
my ($id) = (@_);
undef %::bug;
my @collist = ("bug_id", "product", "version", "rep_platform", "op_sys",
"bug_status", "resolution", "priority", "bug_severity",
"area", "assigned_to", "reporter", "bug_file_loc",
"short_desc", "component");
SendSQL $query
my $query = "select " . join(", ", @collist) .
" from bugs where bug_id = $id";
set ret [FetchSQLData]
SendSQL($query);
if {$ret == ""} {
return ""
my @row;
if (!(@row = FetchSQLData())) {
return "";
}
foreach my $field (@collist) {
$::bug{$field} = shift @row;
if (!defined $::bug{$field}) {
$::bug{$field} = "";
}
set count 0
foreach field { bug_id product version rep_platform op_sys bug_status
resolution priority bug_severity area assigned_to
reporter bug_file_loc short_desc
component } {
set bug($field) [lindex $ret $count]
incr count
}
set bug(assigned_to) [DBID_to_name $bug(assigned_to)]
set bug(reporter) [DBID_to_name $bug(reporter)]
$::bug{'assigned_to'} = DBID_to_name($::bug{'assigned_to'});
$::bug{'reporter'} = DBID_to_name($::bug{'reporter'});
set bug(long_desc) [GetLongDescription $id]
$::bug{'long_desc'} = GetLongDescription($id);
set bug(cclist) [split [ShowCcList $id] ","]
my @cclist;
@cclist = split(/,/, ShowCcList($id));
$::bug{'cclist'} = \@cclist;
return "Bug\#: $id
Product: $bug(product)
Version: $bug(version)
Platform: $bug(rep_platform)
OS/Version: $bug(op_sys)
Status: $bug(bug_status)
Resolution: $bug(resolution)
Severity: $bug(bug_severity)
Priority: $bug(priority)
Component: $bug(component)
Area: $bug(area)
AssignedTo: $bug(assigned_to)
ReportedBy: $bug(reporter)
URL: $bug(bug_file_loc)
[DescCC $bug(cclist)]Summary: $bug(short_desc)
$bug(long_desc)"
Product: $::bug{'product'}
Version: $::bug{'version'}
Platform: $::bug{'rep_platform'}
OS/Version: $::bug{'op_sys'}
Status: $::bug{'bug_status'}
Resolution: $::bug{'resolution'}
Severity: $::bug{'bug_severity'}
Priority: $::bug{'priority'}
Component: $::bug{'component'}
Area: $::bug{'area'}
AssignedTo: $::bug{'assigned_to'}
ReportedBy: $::bug{'reporter'}
URL: $::bug{'bug_file_loc'}
" . DescCC($::bug{'cclist'}) . "Summary: $::bug{'short_desc'}
$::bug{'long_desc'}
";
}
proc fixaddresses {list} {
global nomail
set result {}
foreach i [lrmdups $list] {
if {![info exists nomail($i)]} {
lappend result $i
sub fixaddresses {
my ($list) = (@_);
my @result;
my %seen;
foreach my $i (@$list) {
if (!defined $::nomail{$i} && !defined $seen{$i}) {
push @result, $i;
$seen{$i} = 1;
}
}
return [join $result ", "]
return join(", ", @result);
}
proc Log {str} {
set lockfid [open "maillock" "w"]
flock -write $lockfid
set fid [open "maillog" "a"]
puts $fid "[fmtclock [getclock] "%D %H:%M"] $str"
close $fid
close $lockfid
sub Log {
my ($str) = (@_);
Lock();
open(FID, ">>data/maillog") || die "Can't write to data/maillog";
print FID time2str("%D %H:%M", time()) . ": $str\n";
close FID;
Unlock();
}
ConnectToDatabase
ConnectToDatabase();
set template "From: bugzilla-daemon
To: %s
Cc: %s
Subject: \[Bug %s\] %s - %s
[Param urlbase]show_bug.cgi?id=%s
%s"
set lockfid [open "maillock" "r"]
flock -read $lockfid
Lock();
# foreach i [split [read_file -nonewline "okmail"] "\n"] {
# set okmail($i) 1
# }
foreach i [split [read_file -nonewline "nomail"] "\n"] {
if {[info exists okmail($i)]} {
unset okmail($i)
if (open(FID, "<data/nomail")) {
while (<FID>) {
$::nomail{trim($_)} = 1;
}
set nomail($i) 1
close FID;
}
close $lockfid
my $regenerate = 0;
set regenerate 0
if {[cequal [lindex $argv 0] "regenerate"]} {
set regenerate 1
set argv ""
SendSQL "select bug_id from bugs order by bug_id"
while {[MoreSQLData]} {
lappend argv [lindex [FetchSQLData] 0]
if ($ARGV[0] eq "regenerate") {
$regenerate = 1;
$#ARGV = -1;
SendSQL("select bug_id from bugs order by bug_id");
my @row;
while (@row = FetchSQLData()) {
push @ARGV, $row[0];
}
}
foreach i $argv {
if {[lempty $i]} continue
set old shadow/$i
set new shadow/$i.tmp.[id process]
set diffs shadow/$i.diffs.[id process]
set verb "Changed"
if {![file exists $old]} {
close [open $old "w"]
set verb "New"
}
set text [GetBugText $i]
if {$text == ""} {
error "Couldn't find bug $i."
}
set fid [open $new "w"]
puts $fid $text
close $fid
if {[Different $old $new]} {
catch {exec diff -c $old $new > $diffs}
set tolist [fixaddresses [list $bug(assigned_to) $bug(reporter)]]
set cclist [fixaddresses $bug(cclist)]
set logstr "Bug $i changed"
if {![lempty $tolist] || ![lempty $cclist]} {
set msg [format $template $tolist $cclist $i $verb \
$bug(short_desc) $i [read_file $diffs]]
if {!$regenerate || ![cequal $verb "New"]} {
exec /usr/lib/sendmail -t << $msg
set logstr "$logstr; mail sent to $tolist $cclist"
}
}
unlink $diffs
Log $logstr
}
frename $new $old
catch {chmod 0666 $old}
if {$regenerate} {
puts -nonewline "$i "
foreach my $i (@ARGV) {
my $old = "shadow/$i";
my $new = "shadow/$i.tmp.$$";
my $diffs = "shadow/$i.diffs.$$";
my $verb = "Changed";
if (!stat($old)) {
mkdir "shadow", 0777;
chmod 0777, "shadow";
open(OLD, ">$old") || die "Couldn't create null $old";
close OLD;
$verb = "New";
}
my $text = GetBugText($i);
if ($text eq "") {
die "Couldn't find bug $i.";
}
open(FID, ">$new") || die "Couldn't create $new";
print FID $text;
close FID;
if (Different($old, $new)) {
system("diff -c $old $new > $diffs");
my $tolist = fixaddresses([$::bug{'assigned_to'}, $::bug{'reporter'}]);
my $cclist = fixaddresses($::bug{'cclist'});
my $logstr = "Bug $i changed";
if ($tolist ne "" || $cclist ne "") {
my %substs;
$substs{"to"} = $tolist;
$substs{"cc"} = $cclist;
$substs{"bugid"} = $i;
$substs{"diffs"} = "";
open(DIFFS, "<$diffs") || die "Can't open $diffs";
while (<DIFFS>) {
$substs{"diffs"} .= $_;
}
close DIFFS;
$substs{"neworchanged"} = $verb;
$substs{"summary"} = $::bug{'short_desc'};
my $msg = PerformSubsts(Param("changedmail"), \%substs);
if (!$regenerate) {
open(SENDMAIL, "|/usr/lib/sendmail -t") ||
die "Can't open sendmail";
print SENDMAIL $msg;
close SENDMAIL;
$logstr = "$logstr; mail sent to $tolist $cclist";
}
}
unlink($diffs);
Log($logstr);
}
rename($new, $old) || die "Can't rename $new to $old";
chmod 0666, $old;
if ($regenerate) {
print "$i ";
}
}
exit
exit;
query.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,66 +19,90 @@
#
# 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
# make sure the password is legit.
confirm_login
confirm_login();
}
if {![info exists COOKIE(DEFAULTQUERY)]} {
set COOKIE(DEFAULTQUERY) [Param defaultquery]
if (!defined $::COOKIE{"DEFAULTQUERY"}) {
$::COOKIE{"DEFAULTQUERY"} = Param("defaultquery");
}
if {![info exists buffer] || $buffer == ""} {
set buffer $COOKIE(DEFAULTQUERY)
if (!defined $::buffer || $::buffer eq "") {
$::buffer = $::COOKIE{"DEFAULTQUERY"};
}
foreach name {bug_status resolution assigned_to rep_platform priority \
bug_severity product reporter op_sys component \
version} {
set default($name) ""
set type($name) 0
my %default;
my %type;
foreach my $name ("bug_status", "resolution", "assigned_to", "rep_platform",
"priority", "bug_severity", "product", "reporter", "op_sys",
"component", "version") {
$default{$name} = "";
$type{$name} = 0;
}
foreach item [split $buffer "&"] {
set el [ split $item = ]
set value [url_decode [lindex $el 1]]
set name [lindex $el 0]
if {[info exists default($name)]} {
if {$default($name) != ""} {
append default($name) "|$value"
set type($name) 1
foreach my $item (split(/\&/, $::buffer)) {
my @el = split(/=/, $item);
my $name = $el[0];
my $value;
if ($#el > 0) {
$value = url_decode($el[1]);
} else {
set default($name) $value
$value = "";
}
if (defined $default{$name}) {
if ($default{$name} ne "") {
$default{$name} .= "|$value";
$type{$name} = 1;
} else {
$default{$name} = $value;
}
}
}
foreach i [lsort [array names COOKIE]] {
switch -glob $i {
QUERY_* {
if {$COOKIE($i) != ""} {
set name [crange $i 6 end]
append namelist "<OPTION>$name"
}
my $namelist = "";
foreach my $i (sort (keys %::COOKIE)) {
if ($i =~ /^QUERY_/) {
if ($::COOKIE{$i} ne "") {
my $name = substr($i, 6);
$namelist .= "<OPTION>$name";
}
}
}
puts "Set-Cookie: BUGLIST=
Content-type: text/html\n"
print "Set-Cookie: BUGLIST=
Content-type: text/html\n\n";
GetVersionTable
set who [GeneratePeopleInput assigned_to $default(assigned_to)]
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
......@@ -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.
# set w [lsearch $legal_product $default(product)]
# set w [lsearch $legal_product $default{"product"}]
# 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");
puts "
push @::legal_resolution, "---"; # Oy, what a hack.
print "
<FORM NAME=queryForm METHOD=GET ACTION=\"buglist.cgi\">
<table>
......@@ -107,27 +133,27 @@ puts "
<tr>
<td align=left valign=top>
<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>
</td>
<td align=left valign=top>
<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>
</td>
<td align=left valign=top>
<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>
</td>
<td align=left valign=top>
<SELECT NAME=\"priority\" MULTIPLE SIZE=7>
[make_options $legal_priority $default(priority) $type(priority) ]
@{[make_options(\@::legal_priority, $default{'priority'}, $type{'priority'})]}
</SELECT>
</td>
<td align=left valign=top>
<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>
</tr>
</table>
......@@ -154,19 +180,19 @@ puts "
<td align=left valign=top>
<SELECT NAME=\"product\" MULTIPLE SIZE=5>
[make_options $legal_product $default(product) $type(product)]
@{[make_options(\@::legal_product, $default{'product'}, $type{'product'})]}
</SELECT>
</td>
<td align=left valign=top>
<SELECT NAME=\"version\" MULTIPLE SIZE=5>
[make_options $legal_versions $default(version) $type(version)]
@{[make_options(\@::legal_versions, $default{'version'}, $type{'version'})]}
</SELECT>
</td>
<td align=left valign=top>
<SELECT NAME=\"component\" MULTIPLE SIZE=5>
[make_options $legal_components $default(component) $type(component)]
@{[make_options(\@::legal_components, $default{'component'}, $type{'component'})]}
</SELECT>
</td>
......@@ -193,10 +219,11 @@ puts "
<BR>
<INPUT TYPE=radio NAME=cmdtype VALUE=doit CHECKED> Run this query
<BR>"
<BR>
";
if {[info exists namelist]} {
puts "
if ($namelist ne "") {
print "
<table cellspacing=0 cellpadding=0><tr>
<td><INPUT TYPE=radio NAME=cmdtype VALUE=editnamed> Load the remembered query:</td>
<td rowspan=3><select name=namedcmd>$namelist</select>
......@@ -207,7 +234,7 @@ if {[info exists namelist]} {
</tr></table>"
}
puts "
print "
<INPUT TYPE=radio NAME=cmdtype VALUE=asdefault> Remember this as the default query
<BR>
<INPUT TYPE=radio NAME=cmdtype VALUE=asnamed> Remember this query, and name it:
......@@ -227,19 +254,18 @@ puts "
</CENTER>
</FORM>
"
";
if {[info exists COOKIE(Bugzilla_login)]} {
if {[cequal $COOKIE(Bugzilla_login) [Param maintainer]]} {
puts "<a href=editparams.cgi>Edit Bugzilla operating parameters</a><br>"
if (defined $::COOKIE{"Bugzilla_login"}) {
if ($::COOKIE{"Bugzilla_login"} eq Param("maintainer")) {
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>"
puts "<a href=\"enter_bug.cgi\">Create a new bug.</a><br>"
print "<a href=changepassword.cgi>Change your password.</a><br>\n";
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"
}
relogin.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,13 +19,13 @@
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
source CGI.tcl
use diagnostics;
use strict;
require "CGI.pl";
puts "Set-Cookie: Bugzilla_login= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT
print "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_password= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT
Content-type: text/html
......@@ -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.
<p>
<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.
catch {unset COOKIE(Bugzilla_login)}
catch {unset COOKIE(Bugzilla_password)}
confirm_login
# catch {unset COOKIE(Bugzilla_login)}
# catch {unset COOKIE(Bugzilla_password)}
# confirm_login
puts "Content-type: text/html\n"
puts "<H1>OK, logged in.</H1>"
puts "You are now logged in as <b>$COOKIE(Bugzilla_login)</b>."
puts "<p>"
puts "<a href=query.cgi>Back to the query page.</a>"
# puts "Content-type: text/html\n"
# puts "<H1>OK, logged in.</H1>"
# puts "You are now logged in as <b>$COOKIE(Bugzilla_login)</b>."
# puts "<p>"
# puts "<a href=query.cgi>Back to the query page.</a>"
sanitycheck.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,94 +19,95 @@
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
puts "Content-type: text/html"
puts ""
use diagnostics;
use strict;
ConnectToDatabase
require "CGI.pl";
print "Content-type: text/html\n";
print "\n";
proc Status {str} {
puts "$str <P>"
flush stdout
ConnectToDatabase();
sub Status {
my ($str) = (@_);
print "$str <P>\n";
}
proc Alert {str} {
Status "<font color=red>$str</font>"
sub Alert {
my ($str) = (@_);
Status("<font color=red>$str</font>");
}
proc BugLink {id} {
return "<a href='show_bug.cgi?id=$id'>$id</a>"
sub BugLink {
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";
puts "OK, now running sanity checks.<P>"
Status("Checking profile ids...");
Status "Checking profile ids..."
SendSQL("select userid,login_name from profiles");
SendSQL "select userid,login_name from profiles"
my @row;
while {[MoreSQLData]} {
lassign [FetchSQLData] id email
if {[regexp {^[^@, ]*@[^@, ]*\.[^@, ]*$} $email]} {
set profid($id) 1
my %profid;
while (@row = FetchSQLData()) {
my ($id, $email) = (@row);
if ($email =~ /^[^@, ]*@[^@, ]*\.[^@, ]*$/) {
$profid{$id} = 1;
} else {
if {$id != ""} {
Alert "Bad profile id $id &lt;$email&gt;."
}
}
}
catch {[unset profid(0)]}
undef $profid{0};
Status "Checking reporter/assigned_to ids"
SendSQL "select bug_id,reporter,assigned_to from bugs"
Status("Checking reporter/assigned_to ids");
SendSQL("select bug_id,reporter,assigned_to from bugs");
while {[MoreSQLData]} {
lassign [FetchSQLData] id reporter assigned_to
if {$id == ""} {
continue
}
set bugid($id) 1
if {![info exists profid($reporter)]} {
Alert "Bad reporter $reporter in [BugLink $id]"
my %bugid;
while (@row = FetchSQLData()) {
my($id, $reporter, $assigned_to) = (@row);
$bugid{$id} = 1;
if (!defined $profid{$reporter}) {
Alert("Bad reporter $reporter in " . BugLink($id));
}
if {![info exists profid($assigned_to)]} {
Alert "Bad assigned_to $assigned_to in [BugLink $id]"
if (!defined $profid{$assigned_to}) {
Alert("Bad assigned_to $assigned_to in" . BugLink($id));
}
}
Status "Checking CC table"
Status("Checking CC table");
SendSQL "select bug_id,who from cc";
while {[MoreSQLData]} {
lassign [FetchSQLData] id cc
if {$cc == ""} {
continue
}
if {![info exists profid($cc)]} {
Alert "Bad cc $cc in [BugLink $id]"
SendSQL("select bug_id,who from cc");
while (@row = FetchSQLData()) {
my ($id, $cc) = (@row);
if (!defined $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]} {
lassign [FetchSQLData] id who
if {$who == ""} {
continue
}
if {![info exists bugid($id)]} {
Alert "Bad bugid [BugLink $id]"
while (@row = FetchSQLData()) {
my ($id, $who) = (@row);
if (!defined $bugid{$id}) {
Alert("Bad bugid " . BugLink($id));
}
if {![info exists profid($who)]} {
Alert "Bad who $who in [BugLink $id]"
if (!defined $profid{$who}) {
Alert("Bad who $who in " . BugLink($id));
}
}
show_activity.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,40 +19,45 @@
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
puts "Content-type: text/html\n"
use diagnostics;
use strict;
puts "<HTML>
<H1>Changes made to bug $FORM(id)</H1>
"
set query "
require "CGI.pl";
print "Content-type: text/html\n\n";
PutHeader("Changes made to bug $::FORM{'id'}", "Activity log",
"Bug $::FORM{'id'}");
my $query = "
select bugs_activity.field, bugs_activity.when,
bugs_activity.oldvalue, bugs_activity.newvalue,
profiles.login_name
from bugs_activity,profiles
where bugs_activity.bug_id = $FORM(id)
where bugs_activity.bug_id = $::FORM{'id'}
and profiles.userid = bugs_activity.who
order by bugs_activity.when"
ConnectToDatabase
SendSQL $query
puts "<table border cellpadding=4>"
puts "<tr>"
puts " <th>Who</th><th>What</th><th>Old value</th><th>New value</th><th>When</th>"
puts "</tr>"
while { [MoreSQLData] } {
set value [FetchSQLData]
lassign $value field when old new who
puts "<tr>"
puts "<td>$who</td>"
puts "<td>$field</td>"
puts "<td>[value_quote $old]</td>"
puts "<td>[value_quote $new]</td>"
puts "<td>$when</td>"
puts "</tr>"
order by bugs_activity.when";
ConnectToDatabase();
SendSQL($query);
print "<table border cellpadding=4>\n";
print "<tr>\n";
print " <th>Who</th><th>What</th><th>Old value</th><th>New value</th><th>When</th>\n";
print "</tr>\n";
my @row;
while (@row = FetchSQLData()) {
my ($field,$when,$old,$new,$who) = (@row);
$old = value_quote($old);
$new = value_quote($new);
print "<tr>\n";
print "<td>$who</td>\n";
print "<td>$field</td>\n";
print "<td>$old</td>\n";
print "<td>$new</td>\n";
print "<td>$when</td>\n";
print "</tr>\n";
}
puts "</table>"
puts "<hr><a href=show_bug.cgi?id=$FORM(id)>Back to bug $FORM(id)</a>"
print "</table>\n";
print "<hr><a href=show_bug.cgi?id=$::FORM{'id'}>Back to bug $::FORM{'id'}</a>\n";
show_bug.cgi
View file @ 4727e6c0
#! /usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#!/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
......@@ -19,26 +19,31 @@
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
source "CGI.tcl"
puts "Content-type: text/html"
puts ""
use diagnostics;
use strict;
print "Content-type: text/html\n";
print "\n";
if {[lookup FORM id] == ""} {
puts "<H2>Search By Bug Number</H2>"
puts "<FORM METHOD=GET ACTION=\"show_bug.cgi\">"
puts "You may find a single bug by entering its bug id here: "
puts "<INPUT NAME=id>"
puts "<INPUT TYPE=\"submit\" VALUE=\"Show Me This Bug\">"
puts "</FORM>"
exit 0
require "CGI.pl";
if (!defined $::FORM{'id'}) {
print "<H2>Search By Bug Number</H2>\n";
print "<FORM METHOD=GET ACTION=\"show_bug.cgi\">\n";
print "You may find a single bug by entering its bug id here: \n";
print "<INPUT NAME=id>\n";
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)
navigation_header
print "<HR>\n";
puts "<HR>"
source "bug_form.tcl"
do "bug_form.pl";
whineatnews.pl 0 → 100755
View file @ 4727e6c0
#!/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