# -*- 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 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 "Bug List: ([expr $cur + 1] of [llength $bugs])" puts "First" puts "Last" if { $cur > 0 } { puts "Prev" } else { puts "Prev" } if { $cur < [expr [ llength $bugs ] - 1] } { set next_bug [lindex $bugs [expr $cur + 1]] puts "Next" } else { puts "Next" } } puts "     Query page" } 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 "