diff options
| -rw-r--r-- | CGI.pl | 467 | ||||
| -rw-r--r-- | CHANGES | 20 | ||||
| -rw-r--r-- | README | 176 | ||||
| -rw-r--r-- | bug_form.pl | 239 | ||||
| -rwxr-xr-x | buglist.cgi | 764 | ||||
| -rwxr-xr-x | changepassword.cgi | 63 | ||||
| -rwxr-xr-x | colchange.cgi | 99 | ||||
| -rw-r--r-- | defparams.pl | 234 | ||||
| -rw-r--r-- | defparams.tcl | 21 | ||||
| -rwxr-xr-x | doeditparams.cgi | 67 | ||||
| -rwxr-xr-x | editparams.cgi | 117 | ||||
| -rwxr-xr-x | enter_bug.cgi | 210 | ||||
| -rw-r--r-- | globals.pl | 495 | ||||
| -rw-r--r-- | globals.tcl | 1 | ||||
| -rwxr-xr-x | long_list.cgi | 78 | ||||
| -rwxr-xr-x | new_comment.cgi | 2 | ||||
| -rw-r--r-- | newquip.html | 2 | ||||
| -rwxr-xr-x | post_bug.cgi | 148 | ||||
| -rwxr-xr-x | process_bug.cgi | 442 | ||||
| -rwxr-xr-x | processmail | 350 | ||||
| -rwxr-xr-x | query.cgi | 158 | ||||
| -rwxr-xr-x | relogin.cgi | 32 | ||||
| -rwxr-xr-x | sanitycheck.cgi | 115 | ||||
| -rwxr-xr-x | show_activity.cgi | 69 | ||||
| -rwxr-xr-x | show_bug.cgi | 43 | ||||
| -rwxr-xr-x | whineatnews.pl | 66 |
26 files changed, 3003 insertions, 1475 deletions
@@ -0,0 +1,467 @@ +# -*- 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/\&/\&/g; + $var =~ s/</\</g; + $var =~ s/>/\>/g; + return $var; +} + +sub value_quote { + my ($var) = (@_); + $var =~ s/\&/\&/g; + $var =~ s/</\</g; + $var =~ s/>/\>/g; + $var =~ s/"/\"/g; + return $var; +} + +sub value_unquote { + my ($var) = (@_); + $var =~ s/\"/\"/g; + $var =~ s/\</</g; + $var =~ s/\>/>/g; + $var =~ s/\&/\&/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 " <A HREF=query.cgi>Query page</A>\n"; + print " <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; @@ -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 @@ -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; - } - - - diff --git a/bug_form.pl b/bug_form.pl new file mode 100644 index 000000000..ed6aead8a --- /dev/null +++ b/bug_form.pl @@ -0,0 +1,239 @@ +# -*- 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 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%> </td> +<td align=right>Opened: $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"; diff --git a/buglist.cgi b/buglist.cgi index 8350526a3..e93fc3d8d 100755 --- a/buglist.cgi +++ b/buglist.cgi @@ -1,5 +1,5 @@ -#! /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." +Click the <B>Back</B> button and type in a valid name for this query."; } - exit - } - 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 - } -} - -proc qadd { item } { - global query - append query "$item" +<A HREF=query.cgi>Go back to the query page, using the new default.</A>"; + exit; + }; } -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 +sub DefCol { + my ($name, $k, $t, $s, $q) = (@_); + + $::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 " - } - } else { - foreach v $MFORM($field) { - if {[cequal $v "(empty)"]} { - qadd "\t\t${or}bugs.$field is null\n" + 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 { - if {[cequal $v "---"]} { - qadd "\t\t${or}bugs.$field = ''\n" - } else { - qadd "\t\t${or}bugs.$field = '$v'\n" + my $ref = $::MFORM{$field}; + foreach my $v (@$ref) { + if ($v eq "(empty)") { + $query .= "\t\t${or}bugs.$field is null\n"; + } else { + if ($v eq "---") { + $query .= "\t\t${or}bugs.$field = ''\n"; + } else { + $query .= "\t\t${or}bugs.$field = " . SqlQuote($v) . + "\n"; + } + } + $or = "or "; } } - set or "or " - } + $query .= "\t)\n"; } - qadd "\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) " - } - } - - 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' " - } else { - qadd "and instr($f, '$s') " - } - } - } - - +Click the <B>Back</B> button and try again."; + exit; + } + $query .= "and to_days(now()) - to_days(bugs.delta_ts) <= $c "; + } } - -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" +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 { + $query .= "and instr($f, $s) "; + } } } - if {[cequal [cindex $FORM(order) 0] "\{"]} { - # I don't know why this happens, but... - set FORM(order) [lindex $FORM(order) 0] +} + + +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"; } - qadd $FORM(order) + $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; -if {[info exists FORM(order)]} { - regsub -all { } ", $FORM(order)" "%20" oldorder +my $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} { - # Too big tables take too much browser memory... - pnl "</TABLE>$tablestart" - } - if {[info exists buglist]} { - append buglist ":$bug_id" +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"; + } + 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 - } - 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 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 ] - - orasql $dml_cur "select login_name - from profiles - where userid = $value" - - set cur_resultset [orafetch $dml_cur] - - if {$cur_resultset != ""} { - set value $cur_resultset - set nowrap {nowrap} - } else { - set value "" - } - - oraclose $dml_cur - - } - - 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 + $value = "<nobr>$value</nobr>"; } - pnl "\n" + pnl "<td $nowrap>$value"; } + if ($dotweak) { + my $value = shift @row; + $prodhash{$value} = 1; + $value = shift @row; + $statushash{$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 $buglist = join(":", @bugarray); + + +print "\n"; +print "--ThisRandomString\n"; + + +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>" - -switch $count { - 0 { - puts "Zarro Boogs found." - } - 1 { - puts "One bug found." - } - default { - puts "$count bugs found." +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"; +} + +# 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)] +</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]}}; } - 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] + + 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); - set product_popup [make_options $legal_product $dontchange] - - puts " + 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 + $resolution_popup</SELECT><br>"; + $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 (!defined $statushash{'NEW'} && + !defined $statushash{'ASSIGNED'} && + !defined $statushash{'REOPENED'}) { + print " +<INPUT TYPE=radio NAME=knob VALUE=reopen> Reopen bugs<br>"; + $knum++; } - if {[llength [array names statusarray]] == 1} { - if {[info exists statusarray(RESOLVED)]} { - puts " + 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"; diff --git a/changepassword.cgi b/changepassword.cgi index 9e031bb16..8a8e5623d 100755 --- a/changepassword.cgi +++ b/changepassword.cgi @@ -1,5 +1,5 @@ -#! /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"; diff --git a/colchange.cgi b/colchange.cgi index 0b137f8eb..bd3b23d6f 100755 --- a/colchange.cgi +++ b/colchange.cgi @@ -1,5 +1,5 @@ -#! /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"; diff --git a/defparams.pl b/defparams.pl new file mode 100644 index 000000000..df5d88a85 --- /dev/null +++ b/defparams.pl @@ -0,0 +1,234 @@ +# -*- 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; diff --git a/defparams.tcl b/defparams.tcl index a008dc07f..b9a3a5a82 100644 --- a/defparams.tcl +++ b/defparams.tcl @@ -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 diff --git a/doeditparams.cgi b/doeditparams.cgi index b214ff750..e43fd73ce 100755 --- a/doeditparams.cgi +++ b/doeditparams.cgi @@ -1,5 +1,5 @@ -#! /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"; diff --git a/editparams.cgi b/editparams.cgi index a95fe8d92..c1c885b63 100755 --- a/editparams.cgi +++ b/editparams.cgi @@ -1,5 +1,5 @@ -#! /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" - -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." - -puts "<form method=post action=doeditparams.cgi><table>" - -set rowbreak "<tr><td colspan=2><hr></td></tr>" -puts $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 "" +PutHeader("Edit parameters"); + +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"; + +print "<form method=post action=doeditparams.cgi><table>\n"; + +my $rowbreak = "<tr><td colspan=2><hr></td></tr>"; +print $rowbreak; + +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" + $on = ""; + $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>" - } + 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"; diff --git a/enter_bug.cgi b/enter_bug.cgi index 3bd675c50..c21962400 100755 --- a/enter_bug.cgi +++ b/enter_bug.cgi @@ -1,5 +1,5 @@ -#! /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; + + +if (!defined $::FORM{'product'}) { + GetVersionTable(); + my @prodlist = keys %::versions; + if ($#prodlist != 0) { + print "Content-type: text/html\n\n"; + PutHeader("Enter Bug"); - 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>" + 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"; +sub formvalue { + my ($name, $default) = (@_); + if (exists $::FORM{$name}) { + return $::FORM{$name}; + } + if (defined $default) { + return $default; + } + return ""; +} -proc pickplatform {} { - global env FORM - if {[formvalue rep_platform] != ""} { - return [formvalue rep_platform] +sub pickplatform { + my $value = formvalue("rep_platform"); + if ($value ne "") { + return $value; } - 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"} + 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> <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>"; diff --git a/globals.pl b/globals.pl new file mode 100644 index 000000000..1a6990ac5 --- /dev/null +++ b/globals.pl @@ -0,0 +1,495 @@ +# -*- 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; diff --git a/globals.tcl b/globals.tcl index 2327f2114..f28ea431a 100644 --- a/globals.tcl +++ b/globals.tcl @@ -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" diff --git a/long_list.cgi b/long_list.cgi index 9555a2808..1fb019496 100755 --- a/long_list.cgi +++ b/long_list.cgi @@ -1,5 +1,5 @@ -#! /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 :</B> [html_quote [lindex $result 13]]" - puts "<TR><TD><B>Description :</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 :</B> " . html_quote($shortdesc) . "\n"; + print "<TR><TD><B>Description :</B>\n</TABLE>\n"; + print "<PRE>" . html_quote(GetLongDescription($bug)) . "</PRE>\n"; + print "<HR>\n"; + } } diff --git a/new_comment.cgi b/new_comment.cgi index b57caff46..d578aa877 100755 --- a/new_comment.cgi +++ b/new_comment.cgi @@ -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); diff --git a/newquip.html b/newquip.html index dbb2fb1cf..783290a44 100644 --- a/newquip.html +++ b/newquip.html @@ -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>. diff --git a/post_bug.cgi b/post_bug.cgi index 94878d3bb..3ea3b070f 100755 --- a/post_bug.cgi +++ b/post_bug.cgi @@ -1,5 +1,5 @@ -#! /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>" - - set url "enter_bug.cgi?$buffer" +# Shut up misguided -w warnings about "used only once". For some reason, +# "use vars" chokes on me when I try it here. - 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 -} +# use vars qw($::buffer); +my $zz = $::buffer; +$zz = $zz . $zz; -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; diff --git a/process_bug.cgi b/process_bug.cgi index 6fc7c01bb..d6af0fca2 100755 --- a/process_bug.cgi +++ b/process_bug.cgi @@ -1,5 +1,5 @@ -#! /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)]\">" +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"; } } - 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 + 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 + 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)} { - puts "Nice try. But it doesn't really make sense to mark a bug as" - puts "a duplicate of itself, does it?" - 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. ***" - 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 - } + 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>" - - 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 - } +# print "<PRE>$query</PRE>\n"; + + 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"; } diff --git a/processmail b/processmail index a40723a0b..7cf4caac1 100755 --- a/processmail +++ b/processmail @@ -1,5 +1,5 @@ -#! /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"; } - 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]] + $::lockcount++; } +sub Unlock { + $::lockcount--; + if ($::lockcount <= 0) { + flock(LOCKFID,8); # '8' is magic 'unlock' const. + close LOCKFID; + } +} -proc DescCC {cclist} { - if {[lempty $cclist]} return "" - return "Cc: [join $cclist ", "]\n" +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; } -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"; - - SendSQL $query - - set ret [FetchSQLData] + +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"; + } + close FID1; + close FID2; + return ($d1 ne $d2); +} + + +sub DescCC { + my ($cclist) = (@_); + if (scalar(@$cclist) <= 0) { + return ""; + } + return "Cc: " . join(", ", $cclist) . "\n"; +} + + +sub GetBugText { + my ($id) = (@_); + undef %::bug; - if {$ret == ""} { - return "" + 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"); + + my $query = "select " . join(", ", @collist) . + " from bugs where bug_id = $id"; + + SendSQL($query); + + my @row; + if (!(@row = FetchSQLData())) { + return ""; } - 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 + foreach my $field (@collist) { + $::bug{$field} = shift @row; + if (!defined $::bug{$field}) { + $::bug{$field} = ""; + } } - 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 - - - -set template "From: bugzilla-daemon -To: %s -Cc: %s -Subject: \[Bug %s\] %s - %s +ConnectToDatabase(); -[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" +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 + unlink($diffs); + Log($logstr); } - frename $new $old - catch {chmod 0666 $old} - if {$regenerate} { - puts -nonewline "$i " + rename($new, $old) || die "Can't rename $new to $old"; + chmod 0666, $old; + if ($regenerate) { + print "$i "; } } -exit +exit; @@ -1,5 +1,5 @@ -#! /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 { + $value = ""; + } + if (defined $default{$name}) { + if ($default{$name} ne "") { + $default{$name} .= "|$value"; + $type{$name} = 1; } else { - set default($name) $value + $default{$name} = $value; } } } + + + +my $namelist = ""; -foreach i [lsort [array names COOKIE]] { - switch -glob $i { - QUERY_* { - if {$COOKIE($i) != ""} { - set name [crange $i 6 end] - append namelist "<OPTION>$name" - } +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" -GetVersionTable -set who [GeneratePeopleInput assigned_to $default(assigned_to)] -set reporter [GeneratePeopleInput reporter $default(reporter)] -set qa_assigned_to_who [GeneratePeopleInput qa_assigned_to ""] +print "Set-Cookie: BUGLIST= +Content-type: text/html\n\n"; + +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"); + +push @::legal_resolution, "---"; # Oy, what a hack. -puts " +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" -} diff --git a/relogin.cgi b/relogin.cgi index 4bc1a394c..5ef523945 100755 --- a/relogin.cgi +++ b/relogin.cgi @@ -1,5 +1,5 @@ -#! /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>" diff --git a/sanitycheck.cgi b/sanitycheck.cgi index 3d8a82a83..814a1f031 100755 --- a/sanitycheck.cgi +++ b/sanitycheck.cgi @@ -1,5 +1,5 @@ -#! /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"; + +Status("Checking profile ids..."); -puts "OK, now running sanity checks.<P>" +SendSQL("select userid,login_name from profiles"); -Status "Checking profile ids..." +my @row; -SendSQL "select userid,login_name from profiles" +my %profid; -while {[MoreSQLData]} { - lassign [FetchSQLData] id email - if {[regexp {^[^@, ]*@[^@, ]*\.[^@, ]*$} $email]} { - set profid($id) 1 +while (@row = FetchSQLData()) { + my ($id, $email) = (@row); + if ($email =~ /^[^@, ]*@[^@, ]*\.[^@, ]*$/) { + $profid{$id} = 1; } else { - if {$id != ""} { - Alert "Bad profile id $id <$email>." - } + Alert "Bad profile id $id <$email>." } } -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)); } } diff --git a/show_activity.cgi b/show_activity.cgi index 835b740b6..70f4c253f 100755 --- a/show_activity.cgi +++ b/show_activity.cgi @@ -1,5 +1,5 @@ -#! /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"; diff --git a/show_bug.cgi b/show_bug.cgi index 5228ed394..98829e356 100755 --- a/show_bug.cgi +++ b/show_bug.cgi @@ -1,5 +1,5 @@ -#! /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"; diff --git a/whineatnews.pl b/whineatnews.pl new file mode 100755 index 000000000..1f3d19cf6 --- /dev/null +++ b/whineatnews.pl @@ -0,0 +1,66 @@ +#!/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"; +} |