diff options
Diffstat (limited to 'dev-tcltk/tcllib/files/tcllib-1.16-XSS-vuln.patch')
| -rw-r--r-- | dev-tcltk/tcllib/files/tcllib-1.16-XSS-vuln.patch | 572 |
1 files changed, 0 insertions, 572 deletions
diff --git a/dev-tcltk/tcllib/files/tcllib-1.16-XSS-vuln.patch b/dev-tcltk/tcllib/files/tcllib-1.16-XSS-vuln.patch deleted file mode 100644 index 4a08e31e330b..000000000000 --- a/dev-tcltk/tcllib/files/tcllib-1.16-XSS-vuln.patch +++ /dev/null @@ -1,572 +0,0 @@ - modules/html/html.man | 76 +++++++++++++++- - modules/html/html.tcl | 55 +++++++++--- - modules/html/html.test | 224 +++++++++++++++++++++++++++++++++++----------- - modules/html/pkgIndex.tcl | 2 +- - 4 files changed, 287 insertions(+), 70 deletions(-) - -diff --git a/modules/html/html.man b/modules/html/html.man -index 705a8a2..f18cf4b 100644 ---- a/modules/html/html.man -+++ b/modules/html/html.man -@@ -1,5 +1,6 @@ - [comment {-*- tcl -*- doctools manpage}] --[manpage_begin html n 1.4] -+[vset HTML_VERSION 1.4.4] -+[manpage_begin html n [vset HTML_VERSION]] - [see_also htmlparse] - [see_also ncgi] - [keywords checkbox] -@@ -12,7 +13,7 @@ - [titledesc {Procedures to generate HTML structures}] - [category {CGI programming}] - [require Tcl 8.2] --[require html [opt 1.4]] -+[require html [opt [vset HTML_VERSION]]] - [description] - [para] - -@@ -62,7 +63,7 @@ the elements. - - [call [cmd ::html::checkValue] [arg name] [opt [arg value]]] - --Generate the "name=[arg name] value=[arg value] for a [term checkbox] form -+Generate the "name=[arg name] value=[arg value]" for a [term checkbox] form - element. If the CGI variable [arg name] has the value [arg value], - then SELECTED is added to the return value. [arg value] defaults to - "1". -@@ -245,6 +246,51 @@ value list that is used for the name= and value= parameters for the - [term meta] tag. The [term meta] tag is included in the result of - [cmd ::html::head]. - -+[call [cmd ::html::css] [arg href]] -+ -+[emph {Side effect only}]. Call this before [cmd ::html::head] to -+define a [term link] tag for a linked CSS document. The [arg href] -+value is a HTTP URL to a CSS document. The [term link] tag is included -+in the result of [cmd ::html::head]. -+ -+[para] -+ -+Multiple calls of this command are allowed, enabling the use of -+multiple CSS document references. In other words, the arguments -+of multiple calls are accumulated, and do not overwrite each other. -+ -+[call [cmd ::html::css-clear]] -+ -+[emph {Side effect only}]. Call this before [cmd ::html::head] to -+clear all links to CSS documents. -+[para] -+ -+Multiple calls of this command are allowed, doing nothing after the -+first of a sequence with no intervening [cmd ::html::css]. -+ -+[call [cmd ::html::js] [arg href]] -+ -+[emph {Side effect only}]. Call this before [cmd ::html::head] to -+define a [term script] tag for a linked JavaScript document. The -+[arg href] is a HTTP URL to a JavaScript document. The [term script] -+tag is included in the result of [cmd ::html::head]. -+ -+[para] -+ -+Multiple calls of this command are allowed, enabling the use of -+multiple JavaScript document references. In other words, the arguments -+of multiple calls are accumulated, and do not overwrite each other. -+ -+ -+[call [cmd ::html::js-clear]] -+ -+[emph {Side effect only}]. Call this before [cmd ::html::head] to -+clear all links to JavaScript documents. -+[para] -+ -+Multiple calls of this command are allowed, doing nothing after the -+first of a sequence with no intervening [cmd ::html::js]. -+ - [call [cmd ::html::minorList] [arg list] [opt [arg ordered]]] - - Generate an ordered or unordered list of links. The [arg list] is a -@@ -306,7 +352,7 @@ is a Tcl-style label, value list. - - [call [cmd ::html::radioValue] [arg {name value}]] - --Generate the "name=[arg name] value=[arg value] for a [term radio] form -+Generate the "name=[arg name] value=[arg value]" for a [term radio] form - element. If the CGI variable [arg name] has the value [arg value], - then SELECTED is added to the return value. - -@@ -401,6 +447,28 @@ structure. Rather than evaluating the body, it returns the subst'ed - [arg body]. Each iteration of the loop causes another string to be - concatenated to the result value. - -+[call [cmd ::html::doctype] [arg id]] -+ -+This procedure can be used to build the standard DOCTYPE -+declaration string. It will return the standard declaration -+string for the id, or throw an error if the id is not known. -+The following id's are defined: -+ -+[list_begin enumerated] -+[enum] HTML32 -+[enum] HTML40 -+[enum] HTML40T -+[enum] HTML40F -+[enum] HTML401 -+[enum] HTML401T -+[enum] HTML401F -+[enum] XHTML10S -+[enum] XHTML10T -+[enum] XHTML10F -+[enum] XHTML11 -+[enum] XHTMLB -+[list_end] -+ - [list_end] - - [vset CATEGORY html] -diff --git a/modules/html/html.tcl b/modules/html/html.tcl -index 77e517e..3c0c443 100644 ---- a/modules/html/html.tcl -+++ b/modules/html/html.tcl -@@ -15,7 +15,7 @@ - - package require Tcl 8.2 - package require ncgi --package provide html 1.4 -+package provide html 1.4.4 - - namespace eval ::html { - -@@ -510,7 +510,7 @@ proc ::html::refresh {content {url {}}} { - ::if {[string length $url]} { - append html "; url=$url" - } -- append html "\">\n" -+ append html "\">" - lappend page(meta) $html - return "" - } -@@ -912,7 +912,7 @@ proc ::html::selectPlain {name param choices {current {}}} { - # The html fragment - - proc ::html::textarea {name {param {}} {current {}}} { -- ::set value [ncgi::value $name $current] -+ ::set value [quoteFormValue [ncgi::value $name $current]] - return "<[string trimright \ - "textarea name=\"$name\"\ - [tagParam textarea $param]"]>$value</textarea>\n" -@@ -1405,7 +1405,7 @@ proc ::html::html_entities {s} { - # The text with <br> in place of line-endings. - - proc ::html::nl2br {s} { -- return [string map [list \n\r <br> \n <br> \r <br>] $s] -+ return [string map [list \n\r <br> \r\n <br> \n <br> \r <br>] $s] - } - - # ::html::doctype -@@ -1419,9 +1419,10 @@ proc ::html::nl2br {s} { - - proc ::html::doctype {arg} { - variable doctypes -- set code [string toupper $arg] -- if {![info exists doctypes($code)]} { -- return -code error "Unknown doctype \"$arg\"" -+ ::set code [string toupper $arg] -+ ::if {![info exists doctypes($code)]} { -+ return -code error -errorcode {HTML DOCTYPE BAD} \ -+ "Unknown doctype \"$arg\"" - } - return $doctypes($code) - } -@@ -1451,12 +1452,26 @@ namespace eval ::html { - # href The location of the css file to include the filename and path - # - # Results: --# HTML for the section -+# None. - - proc ::html::css {href} { - variable page -- set page(css) \ -- "<link rel=\"stylesheet\" type=\"text/css\" href=\"[quoteFormValue $href]\">\n" -+ lappend page(css) "<link rel=\"stylesheet\" type=\"text/css\" href=\"[quoteFormValue $href]\">" -+ return -+} -+ -+# ::html::css-clear -+# Drop all text/css references. -+# -+# Arguments: -+# None. -+# -+# Results: -+# None. -+ -+proc ::html::css-clear {} { -+ variable page -+ catch { unset page(css) } - return - } - -@@ -1467,11 +1482,25 @@ proc ::html::css {href} { - # href The location of the javascript file to include the filename and path - # - # Results: --# HTML for the section -+# None. - - proc ::html::js {href} { - variable page -- set page(js) \ -- "<script language=\"javascript\" type=\"text/javascript\" src=\"[quoteFormValue $href]\"></script>\n" -+ lappend page(js) "<script language=\"javascript\" type=\"text/javascript\" src=\"[quoteFormValue $href]\"></script>" -+ return -+} -+ -+# ::html::js-clear -+# Drop all text/javascript references. -+# -+# Arguments: -+# None. -+# -+# Results: -+# None. -+ -+proc ::html::js-clear {} { -+ variable page -+ catch { unset page(js) } - return - } -diff --git a/modules/html/html.test b/modules/html/html.test -index 7a03c54..6646fb6 100644 ---- a/modules/html/html.test -+++ b/modules/html/html.test -@@ -17,8 +17,8 @@ source [file join \ - [file dirname [file dirname [file join [pwd] [info script]]]] \ - devtools testutilities.tcl] - --testsNeedTcl 8.2 --testsNeedTcltest 1.0 -+testsNeedTcl 8.4 -+testsNeedTcltest 2.0 - - testing { - useLocal html.tcl html -@@ -26,45 +26,46 @@ testing { - - # ------------------------------------------------------------------------- - --test html-1.1 {html::init} { -+test html-1.1 {html::init} -body { - html::init -- list [array exists html::defaults] \ -- [array size html::defaults] \ -- [info exists html::page] --} {1 0 0} -+ list \ -+ [array exists html::defaults] \ -+ [array size html::defaults] \ -+ [info exists html::page] -+} -result {1 0 0} - --test html-1.2 {html::init} { -+test html-1.2 {html::init} -body { - html::init { - font.face arial - body.bgcolor white - body.text black - } - lsort [array names html::defaults] --} {body.bgcolor body.text font.face} -+} -result {body.bgcolor body.text font.face} - --test html-1.3 {html::init} { -- catch {html::init wrong num args} --} 1 -+test html-1.3 {html::init, too many args} -body { -+ html::init wrong num args -+} -returnCodes error -result {wrong # args: should be "html::init ?nvlist?"} - --test html-1.4 {html::init} { -- catch {html::init {wrong num args}} --} 1 -+test html-1.4 {html::init, bad arg, odd-length list} -body { -+ html::init {wrong num args} -+} -returnCodes error -result {list must have an even number of elements} - --test html-2.1 {html::head} { -- catch {html::head} --} 1 -+test html-2.1 {html::head, not enough args} -body { -+ html::head -+} -returnCodes error -result {wrong # args: should be "html::head title"} - --test html-2.2 {html::head} { -+test html-2.2 {html::head} -body { - html::head "The Title" --} "<html><head>\n\t<title>The Title</title>\n</head>\n" -+} -result "<html><head>\n\t<title>The Title</title>\n</head>\n" - --test html-2.3 {html::head} { -+test html-2.3 {html::head} -body { - html::description "The Description" - html::keywords key word - html::author "Cathy Coder" - html::meta metakey metavalue - html::head "The Title" --} {<html><head> -+} -result {<html><head> - <title>The Title</title> - <!-- Cathy Coder --> - <meta name="description" content="The Description"> -@@ -73,24 +74,24 @@ test html-2.3 {html::head} { - </head> - } - --test html-3.1 {html::title} { -- catch html::title --} 1 -+test html-3.1 {html::title, not enough args} -body { -+ html::title -+} -returnCodes error -result {wrong # args: should be "html::title title"} - --test html-3.2 {html::title} { -+test html-3.2 {html::title} -body { - html::title "blah blah" --} "<title>blah blah</title>\n" -+} -result "<title>blah blah</title>\n" - --test html-4.1 {html::getTitle} { -+test html-4.1 {html::getTitle} -body { - html::init - html::getTitle --} "" -+} -result "" - --test html-4.2 {html::getTitle} { -+test html-4.2 {html::getTitle} -body { - html::init - html::title "blah blah" - html::getTitle --} {blah blah} -+} -result {blah blah} - - test html-5.1 {html::meta} { - html::init -@@ -453,6 +454,18 @@ test html-23.2 {html::textarea} { - } {<textarea name="info" cols="50" rows="8">The textarea value.</textarea> - } - -+test html-23.3 {html::textarea, dangerous input} { -+ html::init { -+ textarea.cols 50 -+ textarea.rows 8 -+ } -+ ncgi::reset info=[ncgi::encode "</textarea><script>alert(1)</script>"] -+ ncgi::parse -+ html::textarea info -+} {<textarea name="info" cols="50" rows="8"></textarea><script>alert(1)</script></textarea> -+} -+ -+ - test html-24.1 {html::submit} { - catch {html::submit} - } {1} -@@ -516,7 +529,6 @@ test html-26.4 {html::refresh} { - } {<html><head> - <title>title</title> - <meta http-equiv="Refresh" content="4"> -- - </head> - } - test html-26.5 {html::refresh} { -@@ -526,7 +538,6 @@ test html-26.5 {html::refresh} { - } {<html><head> - <title>title</title> - <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> -- - </head> - } - -@@ -794,6 +805,7 @@ test html-32.1 {single argument} { - set result [html::eval {set x [format 22]}] - list $result $x - } {{} 22} -+ - test html-32.2 {multiple arguments} { - set a {$b} - set b xyzzy -@@ -801,38 +813,146 @@ test html-32.2 {multiple arguments} { - set result [html::eval {set x [eval format $a]}] - list $result $x - } {{} xyzzy} -+ - test html-32.3 {single argument} { - set x [list] - set y 1 - set result [html::eval lappend x a b c d {$y} e f g] - list $result $x - } {{} {a b c d 1 e f g}} --test html-32.4 {error: not enough arguments} {catch html::eval} 1 --test html-32.5 {error: not enough arguments} { -- catch html::eval msg -- set msg --} {wrong # args: should be "uplevel ?level? command ?arg ...?"} --test html-32.6 {error in eval'ed command} { -- catch {html::eval {error "test error"}} --} 1 --test html-32.7 {error in eval'ed command} { -- catch {html::eval {error "test error"}} msg -- set msg --} {test error} - -+test html-32.4 {error: not enough arguments} -body { -+ html::eval -+} -returnCodes error -result {wrong # args: should be "uplevel ?level? command ?arg ...?"} - --test html-33.0 {html::font} { -+test html-32.6 {error in eval'ed command} -body { -+ html::eval {error "test error"} -+} -returnCodes error -result {test error} -+ -+test html-33.0 {html::font} -body { - html::font --} {} -+} -result {} - --test html-33.1 {html::font} { -+test html-33.1 {html::font} -body { - html::font size=18 --} {<font size=18>} -+} -result {<font size=18>} - -- --test html-34.0 {html::nl2br} { -+test html-34.0 {html::nl2br} -body { - html::nl2br "a\n\rb\nc\rd" --} {a<br>b<br>c<br>d} -+} -result {a<br>b<br>c<br>d} - -+test html-34.1 {html::nl2br, ticket 1742078} -body { -+ html::nl2br "a\r\nb" -+} -result {a<br>b} - -+# ------------------------------------------------------------------------- -+ -+test html-tkt3439702-35.0 {html::css, not enough arguments} -body { -+ html::css -+} -returnCodes error -result {wrong # args: should be "html::css href"} -+ -+test html-tkt3439702-35.1 {html::css, too many arguments} -body { -+ html::css REF X -+} -returnCodes error -result {wrong # args: should be "html::css href"} -+ -+test html-tkt3439702-35.2 {html::css, single ref} -setup { -+ html::css-clear -+} -body { -+ html::css "http://test.css" -+ string trim [html::head T] -+} -cleanup { -+ html::css-clear -+} -result "<html><head>\n\t<title>T</title>\n\t<meta http-equiv=\"Refresh\" content=\"9; url=http://www.scriptics.com\">\n\t<link rel=\"stylesheet\" type=\"text/css\" href=\"http://test.css\">\n</head>" -+ -+test html-tkt3439702-35.3 {html::css, multiple ref} -setup { -+ html::css-clear -+} -body { -+ html::css "http://test1.css" -+ html::css "http://test2.css" -+ string trim [html::head T] -+} -cleanup { -+ html::css-clear -+} -result {<html><head> -+ <title>T</title> -+ <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> -+ <link rel="stylesheet" type="text/css" href="http://test1.css"> -+ <link rel="stylesheet" type="text/css" href="http://test2.css"> -+</head>} -+ -+# ------------------------------------------------------------------------- -+ -+test html-tkt3439702-36.0 {html::js, not enough arguments} -body { -+ html::js -+} -returnCodes error -result {wrong # args: should be "html::js href"} -+ -+test html-tkt3439702-36.1 {html::js, too many arguments} -body { -+ html::js REF X -+} -returnCodes error -result {wrong # args: should be "html::js href"} -+ -+test html-tkt3439702-36.2 {html::js, single ref} -setup { -+ html::js-clear -+} -body { -+ html::js "http://test.js" -+ string trim [html::head T] -+} -cleanup { -+ html::js-clear -+} -result {<html><head> -+ <title>T</title> -+ <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> -+ <script language="javascript" type="text/javascript" src="http://test.js"></script> -+</head>} -+ -+test html-tkt3439702-36.3 {html::js, multiple ref} -setup { -+ html::js-clear -+} -body { -+ html::js "http://test1.js" -+ html::js "http://test2.js" -+ string trim [html::head T] -+} -cleanup { -+ html::js-clear -+} -result {<html><head> -+ <title>T</title> -+ <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> -+ <script language="javascript" type="text/javascript" src="http://test1.js"></script> -+ <script language="javascript" type="text/javascript" src="http://test2.js"></script> -+</head>} -+ -+test html-tkt3439702-37.0 {html::js, html::css, mixed} -setup { -+ html::css-clear -+ html::js-clear -+} -body { -+ html::css "http://test.css" -+ html::js "http://test.js" -+ string trim [html::head T] -+} -cleanup { -+ html::js-clear -+ html::css-clear -+} -result {<html><head> -+ <title>T</title> -+ <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> -+ <link rel="stylesheet" type="text/css" href="http://test.css"> -+ <script language="javascript" type="text/javascript" src="http://test.js"></script> -+</head>} -+ -+# ------------------------------------------------------------------------- -+# TODO: html::css-clear, html::js-clear -+ -+ -+test html-tktafe4366e2e-38.0 {html::doctype, not enough args} -body { -+ html::doctype -+} -returnCodes error -result {wrong # args: should be "html::doctype arg"} -+ -+test html-tktafe4366e2e-38.1 {html::doctype, too many args} -body { -+ html::doctype HTML401T X -+} -returnCodes error -result {wrong # args: should be "html::doctype arg"} -+ -+test html-tktafe4366e2e-38.2 {html::doctype, unknown type} -body { -+ html::doctype HTML401TXXX -+} -returnCodes error -result {Unknown doctype "HTML401TXXX"} -+ -+test html-tktafe4366e2e-38.3 {html::doctype} -body { -+ html::doctype HTML401T -+} -result {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">} -+ -+# ------------------------------------------------------------------------- - testsuiteCleanup -diff --git a/modules/html/pkgIndex.tcl b/modules/html/pkgIndex.tcl -index 88a71b2..9d91097 100644 ---- a/modules/html/pkgIndex.tcl -+++ b/modules/html/pkgIndex.tcl -@@ -1,2 +1,2 @@ - if {![package vsatisfies [package provide Tcl] 8.2]} {return} --package ifneeded html 1.4 [list source [file join $dir html.tcl]] -+package ifneeded html 1.4.4 [list source [file join $dir html.tcl]] |