Skip to content

html escape error report values #804

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
daniel-qcode merged 1 commit into from
Mar 19, 2026
Merged

html escape error report values #804

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
138 changes: 69 additions & 69 deletions tcl/error.tcl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -179,7 +179,7 @@ proc qc::error_handler {{error_message "NULL"} args} {
}

proc qc::error_report {{error_message "NULL"} {error_info "NULL"} {error_code "NULL"}} {
#| Return html error report. If there was a http connection when error occurred report any
#| Return html error report. If there was a http connection when error occurred report any
#| relevant information about http request.
# Pass in error message, info and code if available
# Otherwise will take a copy of the global error* variables for backward compatiblity
Expand All @@ -190,41 +190,41 @@ proc qc::error_report {{error_message "NULL"} {error_info "NULL"} {error_code "N
}
}
if { [ns_conn isconnected] } {
sset html {
<html>
<h2>Software Bug</h2>
An error has occurred while processing your request.
<p>
<b>hostname:</b>[ns_info hostname]<br>
<b>url:</b>[html_escape [qc::conn_path]]<br>
<b>request:</b>[html_escape [ns_conn request]]<br>
<b>remoteip:</b>[qc::conn_remote_ip]<br>
<b>time:</b>[qc::format_timestamp now]<br>
<b>errorMessage:</b> [html_escape $error_message]<br>
<b>errorInfo:</b> <pre>[html_escape $error_info]</pre><br>
<b>errorCode:</b> $error_code
<p>
<h3>Form Variables:</h3>
[qc::error_report_form_vars]
<h3>Cookies</h3>
[qc::error_report_cookies]
sset html {
<html>
<h2>Software Bug</h2>
An error has occurred while processing your request.
<p>
<b>hostname:</b>[html_escape [ns_info hostname]]<br>
<b>url:</b>[html_escape [qc::conn_path]]<br>
<b>request:</b>[html_escape [ns_conn request]]<br>
<b>remoteip:</b>[html_escape [qc::conn_remote_ip]]<br>
<b>time:</b>[html_escape [qc::format_timestamp now]]<br>
<b>errorMessage:</b> [html_escape $error_message]<br>
<b>errorInfo:</b> <pre>[html_escape $error_info]</pre><br>
<b>errorCode:</b> [html_escape $error_code]
<p>
<h3>Form Variables:</h3>
[qc::error_report_form_vars]
<h3>Cookies</h3>
[qc::error_report_cookies]
<h3>HTTP Headers</h3>
[qc::error_report_headers]
</html>
}
</html>
}
} else {
sset html {
<html>
<h2>Software Bug</h2>
<p>
<b>hostname:</b>[ns_info hostname]<br>
<b>time:</b>[qc::format_timestamp now]<br>
<b>errorMessage:</b> [html_escape $error_message] <br>
<b>errorInfo:</b> <pre>[html_escape $error_info]</pre><br>
<b>errorCode:</b> $error_code
<p>
</html>
}
sset html {
<html>
<h2>Software Bug</h2>
<p>
<b>hostname:</b>[html_escape [ns_info hostname]]<br>
<b>time:</b>[html_escape [qc::format_timestamp now]]<br>
<b>errorMessage:</b> [html_escape $error_message] <br>
<b>errorInfo:</b> <pre>[html_escape $error_info]</pre><br>
<b>errorCode:</b> [html_escape $error_code]
<p>
</html>
}
}
return $html
}
Expand All @@ -236,11 +236,11 @@ proc qc::error_report_no_conn { message info code } {
<html>
<h2>Software Bug</h2>
<p>
<b>hostname:</b>[ns_info hostname]<br>
<b>time:</b>[qc::format_timestamp now]<br>
<b>errorMessage:</b> $message <br>
<b>hostname:</b>[html_escape [ns_info hostname]]<br>
<b>time:</b>[html_escape [qc::format_timestamp now]]<br>
<b>errorMessage:</b> [html_escape $message] <br>
<b>errorInfo:</b> <pre>[html_escape $info]</pre><br>
<b>errorCode:</b> $code
<b>errorCode:</b> [html_escape $code]
<p>
</html>
}
Expand All @@ -249,47 +249,47 @@ proc qc::error_report_no_conn { message info code } {

proc qc::error_report_form_vars {} {
#| Return preformated html indicating values of all form variables when error occurred.

set set_id [ns_getform]
if { [string equal $set_id ""] } {
set size 0
set size 0
} else {
set size [ns_set size $set_id]
}
set size [ns_set size $set_id]
}
set report {}
set i 0
while {$i<$size} {
set name [ns_set key $set_id $i]
# mask anything that looks like a card number.
set value [ns_set value $set_id $i]
append report "<b>$name</b>\n"
# Truncate value if too long
if { [string bytelength $value] > 1024 } {
append report "<pre>[string range $value 0 1023]....</pre>"
} else {
append report <pre>$value</pre>
}
append report \n
set name [ns_set key $set_id $i]
# mask anything that looks like a card number.
set value [ns_set value $set_id $i]
append report "<b>[html_escape $name]</b>\n"
# Truncate value if too long
if { [string bytelength $value] > 1024 } {
append report "<pre>[html_escape [string range $value 0 1023]]....</pre>"
} else {
append report <pre>[html_escape $value]</pre>
}
append report \n
incr i
}
return $report
}

proc qc::error_report_locals {} {
#| Return preformated html indicating values of all local variables when error occurred.

set report {}
foreach name [uplevel 1 {info locals}] {
# mask anything that looks like a card number.
set value [upset 1 $name]
append report "<b>$name</b>\n"
# Truncate value if too long
if { [string bytelength $value] > 1024 } {
append report "<pre>[string range $value 0 1023]....</pre>"
} else {
append report <pre>$value</pre>
}
append report \n
# mask anything that looks like a card number.
set value [upset 1 $name]
append report "<b>[html_escape $name]</b>\n"
# Truncate value if too long
if { [string bytelength $value] > 1024 } {
append report "<pre>[html_escape [string range $value 0 1023]]....</pre>"
} else {
append report <pre>[html_escape $value]</pre>
}
append report \n
}
return $report
}
Expand All @@ -299,11 +299,11 @@ proc qc::error_report_cookies {} {
set cookies [ns_set iget $headers Cookie]
set report {}
foreach pair [split $cookies ;] {
lassign [split $pair =] name value
set name [qc::url_decode $name]
set value [string trimright $value "; "]
set value [qc::url_decode $value]
append report "<b>$name</b> $value <br>"
lassign [split $pair =] name value
set name [qc::url_decode $name]
set value [string trimright $value "; "]
set value [qc::url_decode $value]
append report "<b>[html_escape $name]</b> [html_escape $value] <br>"
}
return $report
}
Expand All @@ -312,7 +312,7 @@ proc qc::error_report_headers {} {
set headers [ns_conn headers]
set report {}
foreach {name value} [ns_set array $headers] {
append report "[h b $name]: [h span $value]<br>"
append report "[h b [html_escape $name]]: [h span [html_escape $value]]<br>"
}
return $report
}
192 changes: 192 additions & 0 deletions test/error.test
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,192 @@
package require tcltest
package require mock_ns
namespace import ::tcltest::test ::tcltest::cleanupTests ::tcltest::testConstraint mock_ns::*

# Load all .tcl files
package require fileutil
set files [lsort [fileutil::findByPattern "~/qcode-tcl/tcl" "*.tcl"]]
foreach file $files {
source $file
}
namespace import ::qc::*

set setup {
}

set cleanup {
mock_ns::_reset
}

# Standard case
test qc::error_report-1 \
{ns isconnected = 0} \
-setup $setup \
-cleanup $cleanup \
-body {
ns_conn _set isconnected 0
return [qc::error_report "Test error message" "Test error info" "TEST_ERROR_CODE"]
} \
-match glob \
-result {*<h2>Software Bug</h2>*}

test qc::error_report-2 \
{ns isconnected = 1} \
-setup $setup \
-cleanup $cleanup \
-body {
ns_conn _set protocol https
ns_conn _set isconnected 1
ns_conn _set version 1.1
ns_conn _set location https://test.co.uk/tcl/test.json
ns_conn _set port 443
ns_conn _set url "/tcl/test.json"
ns_conn _set method GET
ns_conn _set headers [ns_set create headers \
Cookie "" \
]
ns_conn _set outputheaders [ns_set create headers]
ns_conn _set peeraddr 1.1.1.1
ns_conn _set form [ns_set create form \
var1 "value1" \
var2 [string repeat "value2" 500] \
]
return [qc::error_report "Test error message" "Test error info" "TEST_ERROR_CODE"]
} \
-match glob \
-result {*<h2>Software Bug</h2>*}

test qc::error_report-3 \
{fallback to global args} \
-setup $setup \
-cleanup $cleanup \
-body {
ns_conn _set isconnected 0
set ::errorMessage "Test error message"
set ::errorInfo "Test error info"
set ::errorCode "TEST_ERROR_CODE"
return [qc::error_report]
} \
-match glob \
-result {*<h2>Software Bug</h2>*}

test qc::error_report_no_conn-1 \
{} \
-setup $setup \
-cleanup $cleanup \
-body {
return [qc::error_report_no_conn "Test error message" "Test error info" "TEST_ERROR_CODE"]
} \
-match glob \
-result {*<h2>Software Bug</h2>*}

test qc::error_report_form_vars-2 \
{form vars exist} \
-setup $setup \
-cleanup $cleanup \
-body {
ns_conn _set protocol https
ns_conn _set isconnected 1
ns_conn _set version 1.1
ns_conn _set location https://test.co.uk/tcl/test.json
ns_conn _set port 443
ns_conn _set url "/tcl/test.json"
ns_conn _set method GET
ns_conn _set headers [ns_set create headers \
Cookie "" \
]
ns_conn _set outputheaders [ns_set create headers]
ns_conn _set peeraddr 1.1.1.1
ns_conn _set form [ns_set create form \
var1 "value1" \
var2 [string repeat "value2" 500] \
]
return [qc::error_report_form_vars]
} \
-match glob \
-result {*<b>var1</b>*}

test qc::error_report_form_vars-2 \
{no form vars} \
-setup $setup \
-cleanup $cleanup \
-body {
ns_conn _set protocol https
ns_conn _set isconnected 1
ns_conn _set version 1.1
ns_conn _set location https://test.co.uk/tcl/test.json
ns_conn _set port 443
ns_conn _set url "/tcl/test.json"
ns_conn _set method GET
ns_conn _set headers [ns_set create headers \
Cookie "" \
]
ns_conn _set outputheaders [ns_set create headers]
ns_conn _set peeraddr 1.1.1.1
ns_conn _set form [ns_set create form]
return [qc::error_report_form_vars]
} \
-match glob \
-result {}

test qc::error_report_locals-1 \
{} \
-setup $setup \
-cleanup $cleanup \
-body {
proc test_proc {} {
set var1 "value1"
set var2 [string repeat "value2" 500]
return [qc::error_report_locals]
}
return [test_proc]
} \
-match glob \
-result {*<b>var1</b>*}

test qc::error_report_cookies-1 \
{} \
-setup $setup \
-cleanup $cleanup \
-body {
ns_conn _set protocol https
ns_conn _set isconnected 1
ns_conn _set version 1.1
ns_conn _set location https://test.co.uk/tcl/test.json
ns_conn _set port 443
ns_conn _set url "/tcl/test.json"
ns_conn _set method GET
ns_conn _set headers [ns_set create headers \
Cookie "cookie1=value1;" \
]
ns_conn _set outputheaders [ns_set create headers]
ns_conn _set peeraddr 1.1.1.1
ns_conn _set form [ns_set create form]
return [qc::error_report_cookies]
} \
-match glob \
-result {*<b>cookie1</b>*}

test qc::error_report_headers-1 \
{} \
-setup $setup \
-cleanup $cleanup \
-body {
ns_conn _set protocol https
ns_conn _set isconnected 1
ns_conn _set version 1.1
ns_conn _set location https://test.co.uk/tcl/test.json
ns_conn _set port 443
ns_conn _set url "/tcl/test.json"
ns_conn _set method GET
ns_conn _set headers [ns_set create headers \
Cookie "cookie1=value1;" \
]
ns_conn _set outputheaders [ns_set create headers]
ns_conn _set peeraddr 1.1.1.1
ns_conn _set form [ns_set create form]
return [qc::error_report_headers]
} \
-match glob \
-result {*<b>Cookie</b>*}

cleanupTests
Loading