diff options
author | terry%netscape.com <> | 1998-09-16 22:08:06 +0000 |
---|---|---|
committer | terry%netscape.com <> | 1998-09-16 22:08:06 +0000 |
commit | 2e4e8698f87145469e45afe37bc30307dafc2cf0 (patch) | |
tree | e53e9e16a469232763dfa677037231771e21f651 /CGI.tcl | |
parent | 0a37fa4964a6f1be24841c30ea8b7956c0e43fcf (diff) | |
download | bugs-2e4e8698f87145469e45afe37bc30307dafc2cf0.tar bugs-2e4e8698f87145469e45afe37bc30307dafc2cf0.tar.gz bugs-2e4e8698f87145469e45afe37bc30307dafc2cf0.tar.bz2 bugs-2e4e8698f87145469e45afe37bc30307dafc2cf0.tar.xz bugs-2e4e8698f87145469e45afe37bc30307dafc2cf0.zip |
Get rid of .tcl files; we're a perl app now.
Diffstat (limited to 'CGI.tcl')
-rwxr-xr-x | CGI.tcl | 349 |
1 files changed, 0 insertions, 349 deletions
diff --git a/CGI.tcl b/CGI.tcl deleted file mode 100755 index b2c839865..000000000 --- a/CGI.tcl +++ /dev/null @@ -1,349 +0,0 @@ -# -*- Mode: tcl; 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> - -source "globals.tcl" - -proc url_decode {buf} { - regsub -all {\\(.)} $buf {\1} buf ; regsub -all {\\} $buf {\\\\} buf ; - regsub -all { } $buf {\ } buf ; regsub -all {\+} $buf {\ } buf ; - regsub -all {\$} $buf {\$} buf ; regsub -all \n $buf {\n} buf ; - regsub -all {;} $buf {\;} buf ; regsub -all {\[} $buf {\[} buf ; - regsub -all \" $buf \\\" buf ; regsub ^\{ $buf \\\{ buf ; - regsub -all -nocase {%([a-fA-F0-9][a-fA-F0-9])} $buf {[format %c 0x\1]} buf - eval return \"$buf\" -} - -proc url_quote {var} { - regsub -all { } "$var" {%20} var - regsub -all {=} "$var" {%3d} var - regsub -all "\n" "$var" {%0a} var - return $var -} - -proc lookup { a key } { - global $a - set ref [format %s(%s) $a $key] - if { [ info exists $ref] } { - eval return \$$ref - } else { - return "" - } -} - -proc ProcessFormFields {buffer} { - global FORM MFORM - catch {unset FORM} - catch {unset MFORM} - set remaining $buffer - while {![cequal $remaining ""]} { - if {![regexp {^([^&]*)&(.*)$} $remaining foo item remaining]} { - set item $remaining - set remaining "" - } - if {![regexp {^([^=]*)=(.*)$} $item foo name value]} { - set name $item - set value "" - } - set value [url_decode $value] - if {![cequal $value ""]} { - append FORM($name) $value - lappend MFORM($name) $value - } else { - set isnull($name) 1 - } - } - if {[info exists isnull]} { - foreach name [array names isnull] { - if {![info exists FORM($name)]} { - set FORM($name) "" - set MFORM($name) "" - } - } - } -} - -proc FormData { field } { - global FORM - return $FORM($field) -} - -if { [info exists env(REQUEST_METHOD) ] } { - if { $env(REQUEST_METHOD) == "GET" } { - set buffer [lookup env QUERY_STRING] - } else { set buffer [ read stdin $env(CONTENT_LENGTH) ] } - ProcessFormFields $buffer -} - -proc html_quote { var } { - regsub -all {&} "$var" {\&} var - regsub -all {<} "$var" {\<} var - regsub -all {>} "$var" {\>} var - return $var -} -proc value_quote { var } { - regsub -all {&} "$var" {\&} var - regsub -all {"} "$var" {\"} var - regsub -all {<} "$var" {\<} var - regsub -all {>} "$var" {\>} var - return $var -} - -proc value_unquote { var } { - regsub -all {"} $var "\"" var - regsub -all {<} $var "<" var - regsub -all {>} $var ">" var - regsub -all {&} $var {\&} var - return $var -} - -foreach pair [ split [lookup env HTTP_COOKIE] ";" ] { - set pair [string trim $pair] - set eq [string first = $pair ] - if {$eq == -1} { - set COOKIE($pair) "" - } else { - set COOKIE([string range $pair 0 [expr $eq - 1]]) [string range $pair [expr $eq + 1] end] - } -} - -proc navigation_header {} { - global COOKIE FORM next_bug - set buglist [lookup COOKIE BUGLIST] - if { $buglist != "" } { - set bugs [split $buglist :] - set cur [ lsearch -exact $bugs $FORM(id) ] - puts "<B>Bug List:</B> ([expr $cur + 1] of [llength $bugs])" - puts "<A HREF=\"show_bug.cgi?id=[lindex $bugs 0]\">First</A>" - puts "<A HREF=\"show_bug.cgi?id=[lindex $bugs [expr [ llength $bugs ] - 1]]\">Last</A>" - if { $cur > 0 } { - puts "<A HREF=\"show_bug.cgi?id=[lindex $bugs [expr $cur - 1]]\">Prev</A>" - } else { - puts "<I><FONT COLOR=\#777777>Prev</FONT></I>" - } - if { $cur < [expr [ llength $bugs ] - 1] } { - set next_bug [lindex $bugs [expr $cur + 1]] - puts "<A HREF=\"show_bug.cgi?id=$next_bug\">Next</A>" - } else { - puts "<I><FONT COLOR=\#777777>Next</FONT></I>" - } - } - puts " <A HREF=\"query.cgi\">Query page</A>" - puts " <A HREF=\"enter_bug.cgi\">Enter new bug</A>" -} - -proc make_options { src default {isregexp 0} } { - set last "" ; set popup "" ; set found 0 - foreach item $src { - if {$item == "-blank-" || $item != $last} { - if { $item == "-blank-" } { set item "" } - set last $item - if {$isregexp ? [regexp $default $item] : [cequal $default $item]} { - append popup "<OPTION SELECTED VALUE=\"$item\">$item" - set found 1 - } else { - append popup "<OPTION VALUE=\"$item\">$item" - } - } - } - if {!$found && $default != ""} { - append popup "<OPTION SELECTED>$default" - } - return $popup -} - - - -proc PasswordForLogin {login} { - SendSQL "select cryptpassword from profiles where login_name = '[SqlQuote $login]'" - return [FetchSQLData] -} - - - -proc confirm_login {{nexturl ""}} { -# puts "Content-type: text/plain\n" - global FORM COOKIE argv0 env - ConnectToDatabase - if { [info exists FORM(Bugzilla_login)] && - [info exists FORM(Bugzilla_password)] } { - if {![regexp {^[^@, ]*@[^@, ]*\.[^@, ]*$} $FORM(Bugzilla_login)]} { - puts "Content-type: text/html\n" - puts "<H1>Invalid e-mail address entered.</H1>" - puts "The e-mail address you entered" - puts "(<b>$FORM(Bugzilla_login)</b>) didn't match our minimal" - puts "syntax checking for a legal email address. A legal address" - puts "must contain exactly one '@', and at least one '.' after" - puts "the @, and may not contain any commas or spaces." - puts "<p>Please click <b>back</b> and try again." - exit - } - set realcryptpwd [PasswordForLogin $FORM(Bugzilla_login)] - set enteredpwd $FORM(Bugzilla_password); - SendSQL "select encrypt('[SqlQuote $enteredpwd]','[crange $realcryptpwd 0 1]')"; - set enteredcryptpwd [lindex [FetchSQLData] 0] - - - if {[info exists FORM(PleaseMailAPassword)]} { - if {[cequal $realcryptpwd ""]} { - set realpwd [InsertNewUser $FORM(Bugzilla_login)] - } else { - SendSQL "select password from profiles where login_name = '[SqlQuote $FORM(Bugzilla_login)]'" - set realpwd [lindex [FetchSQLData] 0] - } - set 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.) -" - - set msg [format $template $FORM(Bugzilla_login) \ - $FORM(Bugzilla_login) $realpwd] - - exec /usr/lib/sendmail -t << $msg - puts "Content-type: text/html\n" - puts "<H1>Password has been emailed.</H1>" - puts "The password for the e-mail address" - puts "$FORM(Bugzilla_login) has been e-mailed to that address." - puts "<p>When the e-mail arrives, you can click <b>Back</b>" - puts "and enter your password in the form there." - exit - } - - if {[cequal $realcryptpwd ""] || ![cequal $enteredcryptpwd $realcryptpwd]} { - puts "Content-type: text/html\n" - puts "<H1>Login failed.</H1>" - puts "The username or password you entered is not valid. Please" - puts "click <b>back</b> and try again." - exit - } - set COOKIE(Bugzilla_login) $FORM(Bugzilla_login) - SendSQL "insert into logincookies (userid,cryptpassword,hostname) values ([DBNameToIdAndCheck $FORM(Bugzilla_login)], '[SqlQuote $realcryptpwd]', '[SqlQuote $env(REMOTE_HOST)]')" - SendSQL "select LAST_INSERT_ID()" - set logincookie [FetchSQLData] - - - - - set COOKIE(Bugzilla_logincookie) $logincookie - puts "Set-Cookie: Bugzilla_login=$COOKIE(Bugzilla_login) ; path=/; expires=Sun, 30-Jun-2029 00:00:00 GMT" - puts "Set-Cookie: Bugzilla_logincookie=$COOKIE(Bugzilla_logincookie) ; path=/; expires=Sun, 30-Jun-2029 00:00:00 GMT" - - # 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. - puts "Set-Cookie: Bugzilla_password= ; path=/; expires=Sun, 30-Jun-80 00:00:00 GMT" - - } - - - set loginok 0 - - if { [info exists COOKIE(Bugzilla_login)] && [info exists 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" - set loginok [FetchSQLData] - } - - if {$loginok != "1"} { - puts "Content-type: text/html\n" - puts "<H1>Please log in.</H1>" - puts "I need a legitimate e-mail address and password to continue." - if {[cequal $nexturl ""]} { - regexp {[^/]*$} $argv0 nexturl - } - set method POST - if {[info exists env(REQUEST_METHOD)]} { - set method $env(REQUEST_METHOD) - } - puts " -<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 i [array names FORM] { - if {[regexp {^Bugzilla_} $i]} { - continue - } - puts "<input type=hidden name=$i value=\"[value_quote $FORM($i)]\">" - } - puts " -<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>" - - # 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)" -} - - -proc PutHeader {title h1 {h2 ""}} { - puts "<HTML><HEAD><TITLE>$title</TITLE></HEAD>"; - puts "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\""; - puts "LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">"; - - puts [Param bannerhtml] - - puts "<TABLE BORDER=0 CELLPADDING=12 CELLSPACING=0 WIDTH=\"100%\">"; - puts " <TR>\n"; - puts " <TD>\n"; - puts " <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=2>\n"; - puts " <TR><TD VALIGN=TOP ALIGN=CENTER NOWRAP>\n"; - puts " <FONT SIZE=\"+3\"><B><NOBR>$h1</NOBR></B></FONT>\n"; - puts " </TD></TR><TR><TD VALIGN=TOP ALIGN=CENTER>\n"; - puts " <B>$h2</B>\n"; - puts " </TD></TR>\n"; - puts " </TABLE>\n"; - puts " </TD>\n"; - puts " <TD>\n"; - - puts [Param blurbhtml] - - puts "</TD></TR></TABLE>\n"; - -} |