Index: openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl,v diff -u -N -r1.61.2.39 -r1.61.2.40 --- openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl 13 Feb 2024 16:48:52 -0000 1.61.2.39 +++ openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl 15 Feb 2024 12:27:30 -0000 1.61.2.40 @@ -1968,11 +1968,39 @@ return 1 } +ad_page_contract_filter dbtext { name value } { + Ensure that the value can be used in an SQL query. + + Note that this is not the same as quoting or otherwise ensuring + the safety of the statement itself. What we enforce here is that + the value will be accepted by the db interface without + complaining. The actual definition may change or be database + specific in the future. +} { + # + # Reject the NUL character + # + if {[regexp \u00 $value]} { + ad_complain [_ acs-tcl.lt_name_contains_invalid] + return 0 + } + + return 1 +} + ad_page_contract_filter html { name value } { Checks whether the value contains naughty HTML @author Lars Pind (lars@pinds.com) @creation-date 25 July 2000 } { + # + # Reject the NUL character + # + if {[regexp \u00 $value]} { + ad_complain [_ acs-tcl.lt_name_contains_invalid] + return 0 + } + set naughty_prompt [ad_html_security_check $value] if { $naughty_prompt ne "" } { ad_complain $naughty_prompt Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v diff -u -N -r1.71.2.57 -r1.71.2.58 --- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 30 Jan 2024 16:56:51 -0000 1.71.2.57 +++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 15 Feb 2024 12:27:30 -0000 1.71.2.58 @@ -469,6 +469,7 @@ ad_page_contract_filter_proc_nohtml ad_page_contract_filter_proc_object_id ad_page_contract_filter_proc_object_type + ad_page_contract_filter_proc_dbtext ad_page_contract_filter_proc_oneof ad_page_contract_filter_proc_path ad_page_contract_filter_proc_phone @@ -509,18 +510,41 @@ dict set cases word {red 1 " " 0 "hello_world" 1 {$a} 0 a1 1
0 "a.b" 0 "-flag" 0 "1,2" 0 "r: -1" 0} dict set cases token {red 1 " " 1 "hello_world" 1 {$a} 0 a1 1
0 "a.b" 1 "-flag" 1 "1,2" 1 "r: -1" 1} - dict set cases safetclchars {red 1 " " 1 "hello world" 1 {$a} 0 a1 1
1 "a.b" 1 "-flag" 1 "1,2" 1 "r: -1" 1 {a[b]c} 0 x\\y 0} + dict set cases safetclchars {red 1 " " 1 "hello world" 1 {$a} 0 a1 1
1 "a.b" 1 "-flag" 1 "1,2" 1 "r: -1" 1 {a[b]c} 0 x\\y 0} dict set cases sql_identifier {red 1 " " 0 "hello_world" 1 {$a} 0 a1 1
0 "a.b" 0 "-flag" 0 "1,2" 0 "r: -1" 0}
dict set cases email { {philip@mit.edu} 1 {Philip Greenspun " 1 }
- dict set cases nohtml { "a" 1 " " 0 }
- dict set cases allhtml { "a" 1 " " 1 "" 1}
+ set nul_char \u00
+ set string_with_nul "I have '$nul_char' inside"
- dict set cases printable { "a" 1 "a b" 1 "a\x00b" 0 "name\xc0\x80.jpg" 0}
+ dict set cases html [list \
+ "a" 1 \
+ "'" 1 \
+ " " 1 \
+ "" 0 \
+ $string_with_nul 0]
+ dict set cases nohtml [list \
+ "a" 1 \
+ "'" 1 \
+ " " 0 \
+ "" 0 \
+ $string_with_nul 1]
+ dict set cases allhtml [list \
+ "a" 1 \
+ "'" 1 \
+ " " 1 \
+ "" 1 \
+ $string_with_nul 1]
+ dict set cases printable [list \
+ "a" 1 \
+ "a b" 1 \
+ "a\x00b" 0 \
+ "name\xc0\x80.jpg" 0 \
+ $string_with_nul 0]
+
dict set cases date {
{day 1 month 1 year 2010} 1
{day 60 month 1 year 2010} 0
@@ -579,6 +603,18 @@
"abcd(800) 888-8888" 0
}
+ set nul_char \u00
+ set string_with_nul "I have '$nul_char' inside"
+ dict set cases dbtext [list \
+ 9999999999999999999999 1 \
+ "I am text" 1 \
+ "I am HTML" 1 \
+ "select min(object_id) from acs_objects where object_type = 'user'" 1 \
+ $string_with_nul 0 \
+ "I also have '\u00\u00'" 0 \
+ ]
+
+
foreach filter [dict keys $cases] {
foreach { value result } [dict get $cases $filter] {
if {[regexp {[^[:print:]]} $value]} {
Index: openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl,v
diff -u -N -r1.93.2.67 -r1.93.2.68
--- openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl 29 Nov 2023 08:16:36 -0000 1.93.2.67
+++ openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl 15 Feb 2024 12:27:30 -0000 1.93.2.68
@@ -134,6 +134,24 @@
error "value '$value' of parameter $name is invalid"
}
}
+ :method type=dbtext {name value arg} {
+ #
+ # Ensure that the value can be used in an SQL query.
+ #
+ # Note that this is not the same as quoting or otherwise
+ # ensuring the safety of the statement itself. What we enforce
+ # here is that the value will be accepted by the db interface
+ # without complaining. The actual definition may change or be
+ # database specific in the future.
+ #
+
+ #
+ # Reject the NUL character
+ #
+ if {[regexp \u00 $value]} {
+ error "value '$value' of parameter $name contains the NUL character"
+ }
+ }
:method type=signed {name input} {
#
# Check, if a value is a signed value, signed by