Index: openacs-4/packages/acs-tcl/acs-tcl.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/acs-tcl.info,v
diff -u -r1.96 -r1.97
--- openacs-4/packages/acs-tcl/acs-tcl.info 3 Sep 2024 15:37:34 -0000 1.96
+++ openacs-4/packages/acs-tcl/acs-tcl.info 16 Oct 2024 09:21:21 -0000 1.97
@@ -9,7 +9,7 @@
f
t
-
+
OpenACS
The Kernel Tcl API library.
2024-09-02
@@ -18,7 +18,7 @@
GPL version 2
3
-
+
Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v
diff -u -r1.191 -r1.192
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 11 Sep 2024 06:15:48 -0000 1.191
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 16 Oct 2024 09:21:21 -0000 1.192
@@ -849,11 +849,29 @@
# Prepend with the base URL
if { [info exists base] && $base ne "" } {
- set base [string trimright $base "?"]
- if { [string first ? $base] > -1 } {
+ set parsedURL [ns_parseurl $base]
+ if {[dict exists $parsedURL query]} {
# The base already has query vars; assume that the
# path up to this point is already correctly encoded.
- set export_string $base[expr {$export_string ne "" ? "&$export_string" : ""}]
+ set newQuery [::util::skip_suspicious_query_vars [dict get $parsedURL query]]
+ append newQuery [expr {$export_string ne "" ? "&$export_string" : ""}]
+ set URL {}
+ if {[dict exists $parsedURL host]} {
+ set URL \
+ [util::join_location \
+ {*}[expr {[dict exists $parsedURL proto] ? [list -proto [dict get $parsedURL proto]] : {}}] \
+ {*}[expr {[dict exists $parsedURL host] ? [list -hostname [dict get $parsedURL host]] : {}}] \
+ {*}[expr {[dict exists $parsedURL port] ? [list -port [dict get $parsedURL port]] : {}}] \
+ ]
+ }
+ append URL /
+ if {[dict exists $parsedURL path] && [dict get $parsedURL path] ne ""} {
+ append URL [dict get $parsedURL path]/
+ }
+ if {[dict exists $parsedURL tail] && [dict get $parsedURL tail] ne ""} {
+ append URL [dict get $parsedURL tail]
+ }
+ set export_string $URL?$newQuery
} else {
# The base has no query vars: encode URL part if not
# explicitly said otherwise. Include also as exception
@@ -873,7 +891,41 @@
return $export_string
}
+ad_proc ::util::suspicious_query_variable {{-proc {}} key {value ""}} {
+ Guess if a query variable was encoded twice
+ @return boolean result
+} {
+ set result 0
+ if {[string match "*amp;*" $key]} {
+ ns_log notice $proc \
+ "ignore suspect query variable with key <$key> value <$value>\n" \
+ [util::request_info]
+ set result 1
+ }
+ return $result
+}
+ad_proc -private ::util::skip_suspicious_query_vars {query} {
+
+ Skip in a URL query suspicious looking variables (probably double
+ encoded)
+
+ @return encoded HTTP query
+} {
+ set pairs {}
+ if {$query ne ""} {
+ set encodeCmd {ns_urlencode --}
+ foreach {key value} [ns_set array [ns_parsequery $query]] {
+ if {[::util::suspicious_query_variable -proc suspicious_query_variable $key $value]} {
+ continue
+ }
+ lappend pairs [{*}$encodeCmd $key]=[{*}$encodeCmd $value]
+ }
+ }
+ return [join $pairs &]
+}
+
+
ad_proc -private export_vars_sign {
{-params ""}
value
Index: openacs-4/packages/acs-templating/acs-templating.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/acs-templating.info,v
diff -u -r1.68 -r1.69
--- openacs-4/packages/acs-templating/acs-templating.info 3 Sep 2024 15:37:34 -0000 1.68
+++ openacs-4/packages/acs-templating/acs-templating.info 16 Oct 2024 09:21:21 -0000 1.69
@@ -9,7 +9,7 @@
f
t
-
+
OpenACS
Templating library.
2024-09-02
@@ -27,8 +27,8 @@
GPL version 2
3
-
-
+
+
Index: openacs-4/packages/acs-templating/tcl/dimensional-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/dimensional-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-templating/tcl/dimensional-procs.tcl 11 Sep 2024 06:15:48 -0000 1.5
+++ openacs-4/packages/acs-templating/tcl/dimensional-procs.tcl 16 Oct 2024 09:21:22 -0000 1.6
@@ -56,6 +56,13 @@
if {$options_set eq ""} {
set options_set [ns_getform]
+
+ # Process the set from the end to avoid shifted indices
+ for { set i [expr {[ns_set size $options_set]-1}]} { $i > -1 } { incr i -1 } {
+ if {[::util::suspicious_query_variable -proc ad_dimensional [ns_set key $options_set $i]]} {
+ ns_set delete $options_set $i
+ }
+ }
}
if {$url eq ""} {
Index: openacs-4/packages/xotcl-core/xotcl-core.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/xotcl-core.info,v
diff -u -r1.107 -r1.108
--- openacs-4/packages/xotcl-core/xotcl-core.info 3 Sep 2024 15:37:54 -0000 1.107
+++ openacs-4/packages/xotcl-core/xotcl-core.info 16 Oct 2024 09:21:22 -0000 1.108
@@ -10,7 +10,7 @@
t
xotcl
-
+
Gustaf Neumann
XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes)
2024-09-02
@@ -42,13 +42,13 @@
BSD-Style
2
-
+
-
+
Index: openacs-4/packages/xotcl-core/tcl/context-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/context-procs.tcl,v
diff -u -r1.78 -r1.79
--- openacs-4/packages/xotcl-core/tcl/context-procs.tcl 8 Oct 2024 15:09:25 -0000 1.78
+++ openacs-4/packages/xotcl-core/tcl/context-procs.tcl 16 Oct 2024 09:21:22 -0000 1.79
@@ -720,17 +720,20 @@
ad_proc -private ::xo::update_query_variable {old_query var value} {
- Replace in a URL-query old occurrences of var with new value.
+ Replace in a URL-query old occurrences of var with new value.
- @return pairs in a form suitable for export_vars
- } {
+ @return pairs in a form suitable for export_vars
+ } {
set query [list [list $var $value]]
foreach {key value} [ns_set array [ns_parsequery $old_query]] {
- if {$key eq $var} continue
+ if {$key eq $var
+ || [::util::suspicious_query_variable -proc xo::update_query $key $value]} {
+ continue
+ }
lappend query [list $key $value]
}
return $query
- }
+ }
ad_proc -private ::xo::update_query {old_query var value} {
@@ -745,7 +748,10 @@
if {$old_query ne ""} {
foreach {key value} [ns_set array [ns_parsequery $old_query]] {
- if {$key eq $var} continue
+ if {$key eq $var
+ || [::util::suspicious_query_variable -proc xo::update_query $key $value]} {
+ continue
+ }
append query &[{*}$encodeCmd $key]=[{*}$encodeCmd $value]
}
}
Index: openacs-4/packages/xotcl-core/www/show-object.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/show-object.tcl,v
diff -u -r1.30 -r1.31
--- openacs-4/packages/xotcl-core/www/show-object.tcl 8 Oct 2024 15:09:25 -0000 1.30
+++ openacs-4/packages/xotcl-core/www/show-object.tcl 16 Oct 2024 09:21:22 -0000 1.31
@@ -23,6 +23,16 @@
output:onevalue
}
+#ns_log notice "SHOW OBJECT object=$object show_methods=$show_methods show_source=$show_source show_variables=$show_variables"
+set keys [ns_set keys [ns_parsequery [ns_conn query]]]
+#ns_log notice "... keys $keys"
+if {[::util::suspicious_query_variable -proc xo::update_query $keys]} {
+if {[string match "*amp;*" $keys]} {
+ ad_return_complaint 1 "invalid query parameters: $keys"
+ ns_log notice "... aborting show-object due to suspicious query variables [list $keys]"
+ ad_script_abort
+}
+
set context [list "XOTcl Object"]
set output ""