Get rid of .tcl files; we're a perl app now.

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" {\&amp;} var
-  regsub -all {<} "$var" {\&lt;} var
-  regsub -all {>} "$var" {\&gt;} var
-  return $var
-}
-proc value_quote { var } {
-  regsub -all {&} "$var" {\&amp;} var
-  regsub -all {"} "$var" {\&quot;} var
-  regsub -all {<} "$var" {\&lt;} var
-  regsub -all {>} "$var" {\&gt;} var
-  return $var
-}
-
-proc value_unquote { var } {
-    regsub -all {&quot;} $var "\"" var
-    regsub -all {&lt;} $var "<" var
-    regsub -all {&gt;} $var ">" var
-    regsub -all {&amp;} $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 "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<A HREF=\"query.cgi\">Query page</A>"
-  puts "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<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";
-
-}