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 } 0 } dict set cases localurl { . 1 ./index 1 https://o-p-e-n-a-c-s.org/ 0 } - dict set cases html { "'" 1 "

" 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