OpenACS
The Kernel Tcl API library.
2017-08-06
@@ -18,7 +18,7 @@
GPL version 2
3
-
+
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 -r1.61.2.9 -r1.61.2.10
--- openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl 27 Nov 2020 09:27:43 -0000 1.61.2.9
+++ openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl 22 Apr 2021 18:47:25 -0000 1.61.2.10
@@ -2187,6 +2187,25 @@
return 0
}
+ad_page_contract_filter printable { name value } {
+
+ Checks whether the value contains only characters with a printable
+ representation. This represents character class of the Tcl
+ character class "print", which consists of the characters with a
+ visible representation and space. This filter is useful for
+ e.g. avoiding invalid byte sequences for the database.
+
+ @author Gustaf Neumann
+ @creation-date 22 April 2021
+} {
+
+ if {![regexp {[^[:print:]]} $value]} {
+ return 1
+ }
+ ad_complain [_ acs-tcl.lt_name_contains_invalid]
+ return 0
+}
+
ad_page_contract_filter path { name value } {
Checks whether the value is a Tcl word, or contains a few
rather safe other characters ("-", "/", ".") used
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 -r1.71.2.37 -r1.71.2.38
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 28 Feb 2021 16:45:02 -0000 1.71.2.37
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 22 Apr 2021 18:47:25 -0000 1.71.2.38
@@ -449,19 +449,20 @@
-cats {api smoke} \
-procs {
ad_page_contract_filter_invoke
- ad_page_contract_filter_proc_integer
- ad_page_contract_filter_proc_naturalnum
- ad_page_contract_filter_proc_float
- ad_page_contract_filter_proc_negative_float
ad_page_contract_filter_proc_boolean
- ad_page_contract_filter_proc_word
- ad_page_contract_filter_proc_token
- ad_page_contract_filter_proc_sql_identifier
ad_page_contract_filter_proc_email
- ad_page_contract_filter_proc_localurl
+ ad_page_contract_filter_proc_float
ad_page_contract_filter_proc_html
+ ad_page_contract_filter_proc_integer
+ ad_page_contract_filter_proc_localurl
+ ad_page_contract_filter_proc_naturalnum
+ ad_page_contract_filter_proc_negative_float
ad_page_contract_filter_proc_nohtml
-
+ ad_page_contract_filter_proc_printable
+ ad_page_contract_filter_proc_sql_identifier
+ ad_page_contract_filter_proc_token
+ ad_page_contract_filter_proc_word
+
ad_complain
ad_page_contract_filter_proc
ad_page_contract_set_validation_passed
@@ -487,15 +488,28 @@
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 nohtml { "a" 1 "
" 0 }
+ dict set cases printable { "a" 1 "a b" 1 "a\x00b" 0 "name\xc0\x80.jpg" 0}
+
foreach filter [dict keys $cases] {
foreach { value result } [dict get $cases $filter] {
+ if {[regexp {[^[:print:]]} $value]} {
+ #
+ # Use ns_urlencode to avoid error messages, when
+ # invalid strings are added to the DB. We should
+ # probably export NaviServer's
+ # DStringAppendPrintable for such cases.
+ #
+ set print_value [ns_urlencode $value]
+ } else {
+ set print_value $value
+ }
if { $result } {
- aa_true "'[ns_quotehtml $value]' is $filter" \
+ aa_true "'[ns_quotehtml $print_value]' is $filter" \
[ad_page_contract_filter_invoke $filter dummy value]
} else {
- aa_false "'[ns_quotehtml $value]' is NOT $filter" \
+ aa_false "'[ns_quotehtml $print_value]' is NOT $filter" \
[ad_page_contract_filter_invoke $filter dummy value]
}
}