+ #
+ # Register special rules for form variables.
+ #
+ # Example:
+ #
+ # ad_set_typed_form_variable_filter /my_module/* {a_id number} {b_id word} {*_id integer}
+ #
+ # For all pages under /my_module, set_form_variables would set
+ # $a_id only if it was number, and $b_id only if it was a 'word'
+ # (a string that contains only letters, numbers, dashes, and
+ # underscores), and all other variables that match the pattern
+ # *_id would be set only if they were integers.
+ #
+ # Variables not listed have no restrictions on them.
+ #
+ # By default, the three supported datatypes are 'integer', 'number',
+ # and 'word', although you can add your own type by creating
+ # functions named ad_var_type_check_${type_name}_p which should
+ # return 1 if the value is a valid $type_name, or 0 otherwise.
+ #
+ # There's also a special datatype named 'nocheck', which will
+ # return success regardless of the value. (See the docs for
+ # ad_var_type_check_${type_name}_p to see how this might be
+ # useful.)
+ #
+ # The default data_type is 'integer', which allows you shorten the
+ # command above to:
+ #
+ # ad_set_typed_form_variable_filter /my_module/* a_id {b_id word}
+ #
+
+ ad_page_contract is the preferred mechanism to do automated
+ validation of form variables.
+
+ @see ad_page_contract
+} {
+ ad_register_filter postauth GET $url_pattern ad_set_typed_form_variables $args
+ ad_register_filter postauth POST $url_pattern ad_set_typed_form_variables $args
+}
+
+proc ad_set_typed_form_variables {conn args why} {
+
+ global ad_typed_form_variables
+
+ lappend ad_typed_form_variables {*}[lindex $args 0]
+
+ return filter_ok
+}
+
+ad_proc -deprecated ad_dbclick_check_dml {
+ {-bind ""}
+ statement_name table_name id_column_name generated_id return_url insert_dml
+} {
+ This proc is used for pages using double click protection. table_name
+ is table_name for which we are checking whether the double click
+ occurred. id_column_name is the name of the id table
+ column. generated_id is the generated id, which is supposed to have
+ been generated on the previous page. return_url is url to which this
+ procedure will return redirect in the case of successful insertion in
+ the database. insert_sql is the sql insert statement. if data is ok
+ this procedure will insert data into the database in a double click
+ safe manner and will returnredirect to the page specified by
+ return_url. if database insert fails, this procedure will return a
+ sensible error message to the user.
+} {
+ if { [catch {
+ if { $bind ne "" } {
+ db_dml $statement_name $insert_dml -bind $bind
+ } else {
+ db_dml $statement_name $insert_dml
+ }
+ } errmsg] } {
+ # Oracle choked on the insert
+
+ # detect double click
+ if {
+ [db_0or1row double_click_check "
+
+ select 1 as one
+ from $table_name
+ where $id_column_name = :generated_id
+
+ " -bind [ad_tcl_vars_to_ns_set generated_id]]
+ } {
+ ad_returnredirect $return_url
+ return
+ }
+
+ ns_log Error "[info script] choked. Oracle returned error: $errmsg"
+
+ ad_return_error "Error in insert" "
+ We were unable to do your insert in the database.
+ Here is the error that was returned:
+ +
++ " + return + } + + ad_returnredirect $return_url + # should this be ad_script_abort? Should check how its being used. + return +} + + + +ad_proc -deprecated util_PrettyBoolean {t_or_f { default "default" } } { +} { + if { $t_or_f == "t" || $t_or_f eq "T" } { + return "Yes" + } elseif { $t_or_f == "f" || $t_or_f eq "F" } { + return "No" + } else { + # Note that we can't compare default to the empty string as in + # many cases, we are going want the default to be the empty + # string + if { $default eq "default" } { + return "Unknown (\"$t_or_f\")" + } else { + return $default + } + } +} + +ad_proc -deprecated ad_export_vars { + -form:boolean + {-exclude {}} + {-override {}} + {include {}} +} { + Note This proc is deprecated in favor of ++ $errmsg ++
export_vars. They're very similar, but
+ export_vars have a number of advantages:
+
+ :sign flag)
+ foo(bar) syntax to pull a single value from an array, however, but
+ you can do the same by saying export_vars {{foo.bar $foo(bar)}}.
+
+ + + Helps export variables from one page to the next, + either as URL variables or hidden form variables. + It'll reach into arrays and grab either all values or individual values + out and export them in a way that will be consistent with the + ad_page_contract :array flag. + +
+ + Example: + +
doc_body_append [export_vars { msg_id user(email) { order_by date } }]msg_id and the value email from the array user,
+ and it will export a variable named order_by with the value date.
+
+ + + The args is a list of variable names that you want exported. You can name + +
foo,
+ bar,
+ in which case all the values in that array will get exported, or
+ bar(baz)
+ + + A more involved example: +
set my_vars { msg_id user(email) order_by }
+ doc_body_append [export_vars -override { order_by $new_order_by } $my_vars]+ export_vars is now the preferred interface. +
+
+ Example usage: [export_vars -form -sign {foo bar:multiple baz}]
+
+ @param sign If this flag is set, all the variables output will be
+ signed using ad_sign. These variables should then be
+ verified using the :verify flag to ad_page_contract,
+ which in turn uses ad_verify_signature. This
+ ensures that the value hasn't been tampered with at the user's end.
+
+ @see export_vars
+} {
+ set hidden ""
+ foreach var_spec $args {
+ lassign [split $var_spec ":"] var type
+ upvar 1 $var value
+ if { [info exists value] } {
+ switch -- $type {
+ multiple {
+ foreach item $value {
+ append hidden "\n"
+ }
+ }
+ default {
+ append hidden "\n"
+ }
+ }
+ if { $sign_p } {
+ append hidden "\n"
+ }
+ }
+ }
+ return $hidden
+}
+
+ad_proc -deprecated export_url_vars {
+ -sign:boolean
+ args
+} {
+ export_vars is now the preferred interface.
+
+ Returns a string of key=value pairs suitable for inclusion in a
+ URL; you can pass it any number of variables as arguments. If any are
+ defined in the caller's environment, they are included. See also
+ export_entire_form_as_url_vars.
+
+
+
+ Instead of naming a variable you can also say name=value. Note that the value here is not
+ the name of a variable but the literal value you want to export e.g.,
+ export_url_vars [ns_urlencode foo]=[ns_urlencode $the_value].
+
+
+
+ For normal variables, you can say export_url_vars foo:multiple. In this case,
+ the value of foo will be treated as a Tcl list, and each value will be output separately e.g.,
+ foo=item0&foo=item1&foo=item2...
+
+
+
+ You cannot combine the foo=bar syntax with the foo:multiple syntax. Why? Because there's no way we can distinguish
+ between the :multiple being part of the value of foo or being a flag intended for export_url_vars.
+
+ @param sign If this flag is set, all the variables output will be
+ signed using ad_sign. These variables should then be
+ verified using the :verify flag to ad_page_contract,
+ which in turn uses ad_verify_signature. This
+ ensures that the value hasn't been tampered with at the user's end.
+
+ @see export_vars
+} {
+ set params {}
+ foreach var_spec $args {
+ if { [string first "=" $var_spec] != -1 } {
+ # There shouldn't be more than one equal sign, since the value should already be url-encoded.
+ lassign [split $var_spec "="] var value
+ lappend params "$var=$value"
+ if { $sign_p } {
+ lappend params "[ns_urlencode [ns_urldecode $var]:sig]=[ns_urlencode [ad_sign [ns_urldecode $value]]]"
+ }
+ } else {
+ lassign [split $var_spec ":"] var type
+ upvar 1 $var upvar_value
+ if { [info exists upvar_value] } {
+ switch -- $type {
+ multiple {
+ foreach item $upvar_value {
+ lappend params "[ns_urlencode $var]=[ns_urlencode $item]"
+ }
+ }
+ default {
+ lappend params "[ns_urlencode $var]=[ns_urlencode $upvar_value]"
+ }
+ }
+ if { $sign_p } {
+ lappend params "[ns_urlencode "$var:sig"]=[ns_urlencode [ad_sign $upvar_value]]"
+ }
+ }
+ }
+ }
+
+ return [join $params "&"]
+}
+
+ad_proc -public -deprecated exists_or_null { varname } {
+ Returns the contents of the variable if it exists, otherwise returns empty string
+} {
+ upvar 1 $varname var
+ if {[info exists var]} {
+ return $var
+ }
+ return ""
+}
+
+ad_proc -deprecated -private set_encoding {
+ {-text_translation {auto binary}}
+ content_type
+ channel
+} {
+
The ad_http* and util_http* machineries depend on the + AOLserver/NaviServer socket I/O layer provided by [ns_sockopen]. + This proc allows you to request Tcl encoding filtering for + ns_sockopen channels (i.e., the read and write channels return by + [ns_sockopen]), to be applied right before performing socket I/O + operations (i.e., reads).
+ +The major task is to resolve the corresponding Tcl encoding + (e.g.: ascii) for a given IANA/MIME charset name (or alias; e.g.: + US-ASCII); the main resolution scheme is implemented by + [ns_encodingfortype] which is available bother under AOLserver and + NaviServer (see tcl/charsets.tcl). The mappings between Tcl encoding + names (as shown by [encoding names]) and IANA/MIME charset names + (i.e., names and aliases in the sense of IANA's + charater sets registry) is provided by:
+ +[ns_encodingfortype] introduces several levels of precedence + when resolving the actual IANA/MIME charset and the corresponding + Tcl encoding to use:
+ ++ validate via ad_page_contract + + @see ad_page_contract +} { + if { ![regexp {^[0-9]+$} $string] } { + error "$field_name is not an integer" + } + # trim leading zeros, so as not to confuse Tcl + set string [string trimleft $string "0"] + if { $string eq "" } { + # but not all of the zeros + return "0" + } + return $string +} + +ad_proc -deprecated validate_zip_code {field_name zip_string country_code} { + Given a string, signals an error if it's not a legal zip code +
+ validate via ad_page_contract + + @see ad_page_contract + +} { + if { $country_code eq "" || [string toupper $country_code] eq "US" } { + if { [regexp {^[0-9][0-9][0-9][0-9][0-9](-[0-9][0-9][0-9][0-9])?$} $zip_string] } { + set zip_5 [string range $zip_string 0 4] + if { + ![db_0or1row zip_code_exists { + select 1 + from dual + where exists (select 1 + from zip_codes + where zip_code like :zip_5) + }] + } { + error "The entry for $field_name, \"$zip_string\" is not a recognized zip code" + } + } else { + error "The entry for $field_name, \"$zip_string\" does not look like a zip code" + } + } else { + if { $zip_string ne "" } { + error "Zip code is not needed outside the US" + } + } + return $zip_string +} + +ad_proc -deprecated validate_ad_dateentrywidget {field_name column form {allow_null 0}} { +
+ validate via ad_page_contract + + @see ad_page_contract +} { + set col $column + set day [ns_set get $form "$col.day"] + ns_set update $form "$col.day" [string trimleft $day "0"] + set month [ns_set get $form "$col.month"] + set year [ns_set get $form "$col.year"] + + # check that either all elements are blank + # date value is formated correctly for ns_dbformvalue + if { "$day$month$year" eq "" } { + if { $allow_null == 0 } { + error "$field_name must be supplied" + } else { + return "" + } + } elseif { $year ne "" && [string length $year] != 4 } { + error "The year must contain 4 digits." + } elseif { [catch { ns_dbformvalue $form $column date date } errmsg ] } { + error "The entry for $field_name had a problem: $errmsg." + } + + return $date +} + +ad_proc -deprecated util_ReturnMetaRefresh { + url + { seconds_delay 0 } +} { + Ugly workaround to deal with IE5.0 bug handling + multipart/form-data using + Meta Refresh page instead of a redirect. + +} { + ad_return_top_of_page [subst { +
+ + + + +list into the variable named by
+ the nth element of args.
+
+ One should use the built-in Tcl command "lassign" instread of this proc.
+
+} {
+ for { set i 0 } { $i < [llength $args] } { incr i } {
+ upvar [lindex $args $i] val
+ set val [lindex $list $i]
+ }
+}
+
+# michael@arsdigita.com: A better name for this proc would be
+# "ad_block_sql_fragment_form_data", since "form data" is the
+# official term for query string (URL) variables and form input
+# variables.
+#
+ad_proc -public -deprecated ad_block_sql_urls {
+ conn
+ args
+ why
+} {
+
+ A filter that detect attempts to smuggle in SQL code through form data
+ variables. The use of bind variables and ad_page_contract input
+ validation to prevent SQL smuggling is preferred.
+
+ @see ad_page_contract
+} {
+ set form [ns_getform]
+ if { $form eq "" } { return filter_ok }
+
+ # Check each form data variable to see if it contains malicious
+ # user input that we don't want to interpolate into our SQL
+ # statements.
+ #
+ # We do this by scanning the variable for suspicious phrases; at
+ # this time, the phrases we look for are: UNION, UNION ALL, and
+ # OR.
+ #
+ # If one of these phrases is found, we construct a test SQL query
+ # that incorporates the variable into its WHERE clause and ask
+ # the database to parse it. If the query does parse successfully,
+ # then we know that the suspicious user input would result in a
+ # executing SQL that we didn't write, so we abort processing this
+ # HTTP request.
+ #
+ set n_form_vars [ns_set size $form]
+ for { set i 0 } { $i < $n_form_vars } { incr i } {
+ set key [ns_set key $form $i]
+ set value [ns_set value $form $i]
+
+ # michael@arsdigita.com:
+ #
+ # Removed 4000-character length check, because that allowed
+ # malicious users to smuggle SQL fragments greater than 4000
+ # characters in length.
+ #
+ if {
+ [regexp -nocase {[^a-z_]or[^a-z0-9_]} $value]
+ || [regexp -nocase {union([^a-z0-9_].*all)?[^a-z0-9_].*select} $value]
+ } {
+ # Looks like the user has added "union [all] select" to
+ # the variable, # or is trying to modify the WHERE clause
+ # by adding "or ...".
+ #
+ # Let's see if Oracle would accept this variables as part
+ # of a typical WHERE clause, either as string or integer.
+ #
+ # michael@arsdigita.com: Should we grab a handle once
+ # outside of the loop?
+ #
+ set parse_result_integer [db_string sql_test_1 "select test_sql('select 1 from dual where 1=[DoubleApos $value]') from dual"]
+
+ if { [string first "'" $value] != -1 } {
+ #
+ # The form variable contains at least one single
+ # quote. This can be a problem in the case that
+ # the programmer forgot to QQ the variable before
+ # interpolation into SQL, because the variable
+ # could contain a single quote to terminate the
+ # criterion and then smuggled SQL after that, e.g.:
+ #
+ # set foo "' or 'a' = 'a"
+ #
+ # db_dml "delete from bar where foo = '$foo'"
+ #
+ # which would be processed as:
+ #
+ # delete from bar where foo = '' or 'a' = 'a'
+ #
+ # resulting in the effective truncation of the bar
+ # table.
+ #
+ set parse_result_string [db_string sql_test_2 "select test_sql('select 1 from dual where 1=[DoubleApos "'$value'"]') from dual"]
+ } else {
+ set parse_result_string 1
+ }
+
+ if {
+ $parse_result_integer == 0
+ || $parse_result_integer == -904
+ || $parse_result_integer == -1789
+ || $parse_result_string == 0
+ || $parse_result_string == -904
+ || $parse_result_string == -1789
+ } {
+ # Code -904 means "invalid column", -1789 means
+ # "incorrect number of result columns". We treat this
+ # the same as 0 (no error) because the above statement
+ # just selects from dual and 904 or 1789 only occur
+ # after the parser has validated that the query syntax
+ # is valid.
+
+ ns_log Error "ad_block_sql_urls: Suspicious request from [ad_conn peeraddr]. Parameter $key contains code that looks like part of a valid SQL WHERE clause: [ad_conn url]?[ad_conn query]"
+
+ # michael@arsdigita.com: Maybe we should just return a
+ # 501 error.
+ #
+ ad_return_error "Suspicious Request" "Parameter $key looks like it contains SQL code. For security reasons, the system won't accept your request."
+
+ return filter_return
+ }
+ }
+ }
+
+ return filter_ok
+}
+
+
+# Local variables:
+# mode: tcl
+# tcl-indent-level: 4
+# indent-tabs-mode: nil
+# End:
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.144 -r1.145
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 1 Oct 2017 12:16:05 -0000 1.144
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 21 Dec 2017 20:50:19 -0000 1.145
@@ -300,65 +300,8 @@
# Database-related code
##
-ad_proc -deprecated ad_dbclick_check_dml {
- {-bind ""}
- statement_name table_name id_column_name generated_id return_url insert_dml
-} {
- This proc is used for pages using double click protection. table_name
- is table_name for which we are checking whether the double click
- occurred. id_column_name is the name of the id table
- column. generated_id is the generated id, which is supposed to have
- been generated on the previous page. return_url is url to which this
- procedure will return redirect in the case of successful insertion in
- the database. insert_sql is the sql insert statement. if data is ok
- this procedure will insert data into the database in a double click
- safe manner and will returnredirect to the page specified by
- return_url. if database insert fails, this procedure will return a
- sensible error message to the user.
-} {
- if { [catch {
- if { $bind ne "" } {
- db_dml $statement_name $insert_dml -bind $bind
- } else {
- db_dml $statement_name $insert_dml
- }
- } errmsg] } {
- # Oracle choked on the insert
-
- # detect double click
- if {
- [db_0or1row double_click_check "
-
- select 1 as one
- from $table_name
- where $id_column_name = :generated_id
-
- " -bind [ad_tcl_vars_to_ns_set generated_id]]
- } {
- ad_returnredirect $return_url
- return
- }
-
- ns_log Error "[info script] choked. Oracle returned error: $errmsg"
- ad_return_error "Error in insert" "
- We were unable to do your insert in the database.
- Here is the error that was returned:
- -
-- " - return - } - ad_returnredirect $return_url - # should this be ad_script_abort? Should check how its being used. - return -} - ad_proc -public util_AnsiDatetoPrettyDate { sql_date } { @@ -437,24 +380,6 @@ -ad_proc -deprecated util_PrettyBoolean {t_or_f { default "default" } } { -} { - if { $t_or_f == "t" || $t_or_f eq "T" } { - return "Yes" - } elseif { $t_or_f == "f" || $t_or_f eq "F" } { - return "No" - } else { - # Note that we can't compare default to the empty string as in - # many cases, we are going want the default to be the empty - # string - if { $default eq "default" } { - return "Unknown (\"$t_or_f\")" - } else { - return $default - } - } -} - ad_proc util_PrettyTclBoolean { zero_or_one } { @@ -1008,204 +933,12 @@ } -ad_proc -deprecated ad_export_vars { - -form:boolean - {-exclude {}} - {-override {}} - {include {}} -} { - Note This proc is deprecated in favor of -- $errmsg --
export_vars. They're very similar, but
- export_vars have a number of advantages:
- :sign flag)
- foo(bar) syntax to pull a single value from an array, however, but
- you can do the same by saying export_vars {{foo.bar $foo(bar)}}.
- - Helps export variables from one page to the next, - either as URL variables or hidden form variables. - It'll reach into arrays and grab either all values or individual values - out and export them in a way that will be consistent with the - ad_page_contract :array flag. - -
- Example: -
doc_body_append [export_vars { msg_id user(email) { order_by date } }]msg_id and the value email from the array user,
- and it will export a variable named order_by with the value date.
-
- - - The args is a list of variable names that you want exported. You can name - -
foo,
- bar,
- in which case all the values in that array will get exported, or
- bar(baz)
- - - A more involved example: -
set my_vars { msg_id user(email) order_by }
- doc_body_append [export_vars -override { order_by $new_order_by } $my_vars]- export_vars is now the preferred interface. -
-
- Example usage: [export_vars -form -sign {foo bar:multiple baz}]
-
- @param sign If this flag is set, all the variables output will be
- signed using ad_sign. These variables should then be
- verified using the :verify flag to ad_page_contract,
- which in turn uses ad_verify_signature. This
- ensures that the value hasn't been tampered with at the user's end.
-
- @see export_vars
-} {
- set hidden ""
- foreach var_spec $args {
- lassign [split $var_spec ":"] var type
- upvar 1 $var value
- if { [info exists value] } {
- switch -- $type {
- multiple {
- foreach item $value {
- append hidden "\n"
- }
- }
- default {
- append hidden "\n"
- }
- }
- if { $sign_p } {
- append hidden "\n"
- }
- }
- }
- return $hidden
-}
-
ad_proc -public export_entire_form {} {
Exports everything in ns_getform to the ns_set. This should
@@ -1275,78 +1008,7 @@
}
}
-ad_proc -deprecated export_url_vars {
- -sign:boolean
- args
-} {
- export_vars is now the preferred interface.
- Returns a string of key=value pairs suitable for inclusion in a
- URL; you can pass it any number of variables as arguments. If any are
- defined in the caller's environment, they are included. See also
- export_entire_form_as_url_vars.
-
-
-
- Instead of naming a variable you can also say name=value. Note that the value here is not
- the name of a variable but the literal value you want to export e.g.,
- export_url_vars [ns_urlencode foo]=[ns_urlencode $the_value].
-
-
-
- For normal variables, you can say export_url_vars foo:multiple. In this case,
- the value of foo will be treated as a Tcl list, and each value will be output separately e.g.,
- foo=item0&foo=item1&foo=item2...
-
-
-
- You cannot combine the foo=bar syntax with the foo:multiple syntax. Why? Because there's no way we can distinguish
- between the :multiple being part of the value of foo or being a flag intended for export_url_vars.
-
- @param sign If this flag is set, all the variables output will be
- signed using ad_sign. These variables should then be
- verified using the :verify flag to ad_page_contract,
- which in turn uses ad_verify_signature. This
- ensures that the value hasn't been tampered with at the user's end.
-
- @see export_vars
-} {
- set params {}
- foreach var_spec $args {
- if { [string first "=" $var_spec] != -1 } {
- # There shouldn't be more than one equal sign, since the value should already be url-encoded.
- lassign [split $var_spec "="] var value
- lappend params "$var=$value"
- if { $sign_p } {
- lappend params "[ns_urlencode [ns_urldecode $var]:sig]=[ns_urlencode [ad_sign [ns_urldecode $value]]]"
- }
- } else {
- lassign [split $var_spec ":"] var type
- upvar 1 $var upvar_value
- if { [info exists upvar_value] } {
- switch -- $type {
- multiple {
- foreach item $upvar_value {
- lappend params "[ns_urlencode $var]=[ns_urlencode $item]"
- }
- }
- default {
- lappend params "[ns_urlencode $var]=[ns_urlencode $upvar_value]"
- }
- }
- if { $sign_p } {
- lappend params "[ns_urlencode "$var:sig"]=[ns_urlencode [ad_sign $upvar_value]]"
- }
- }
- }
- }
-
- return [join $params "&"]
-}
-
ad_proc -public export_entire_form_as_url_vars {
{vars_to_passthrough ""}
} {
@@ -1481,15 +1143,6 @@
return [expr { [info exists var] && $var ne "" }]
}
-ad_proc -public -deprecated exists_or_null { varname } {
- Returns the contents of the variable if it exists, otherwise returns empty string
-} {
- upvar 1 $varname var
- if {[info exists var]} {
- return $var
- }
- return ""
-}
ad_proc -public exists_and_equal { varname value } {
Returns 1 if the variable name exists in the caller's envirnoment
@@ -1504,92 +1157,7 @@
return [expr { [info exists var] && $var eq $value } ]
}
-ad_proc -deprecated -private set_encoding {
- {-text_translation {auto binary}}
- content_type
- channel
-} {
-
The ad_http* and util_http* machineries depend on the - AOLserver/NaviServer socket I/O layer provided by [ns_sockopen]. - This proc allows you to request Tcl encoding filtering for - ns_sockopen channels (i.e., the read and write channels return by - [ns_sockopen]), to be applied right before performing socket I/O - operations (i.e., reads).
-The major task is to resolve the corresponding Tcl encoding - (e.g.: ascii) for a given IANA/MIME charset name (or alias; e.g.: - US-ASCII); the main resolution scheme is implemented by - [ns_encodingfortype] which is available bother under AOLserver and - NaviServer (see tcl/charsets.tcl). The mappings between Tcl encoding - names (as shown by [encoding names]) and IANA/MIME charset names - (i.e., names and aliases in the sense of IANA's - charater sets registry) is provided by:
- -[ns_encodingfortype] introduces several levels of precedence - when resolving the actual IANA/MIME charset and the corresponding - Tcl encoding to use:
- -- validate via ad_page_contract - - @see ad_page_contract -} { - if { ![regexp {^[0-9]+$} $string] } { - error "$field_name is not an integer" - } - # trim leading zeros, so as not to confuse Tcl - set string [string trimleft $string "0"] - if { $string eq "" } { - # but not all of the zeros - return "0" - } - return $string -} - -ad_proc -deprecated validate_zip_code {field_name zip_string country_code} { - Given a string, signals an error if it's not a legal zip code -
- validate via ad_page_contract - - @see ad_page_contract - -} { - if { $country_code eq "" || [string toupper $country_code] eq "US" } { - if { [regexp {^[0-9][0-9][0-9][0-9][0-9](-[0-9][0-9][0-9][0-9])?$} $zip_string] } { - set zip_5 [string range $zip_string 0 4] - if { - ![db_0or1row zip_code_exists { - select 1 - from dual - where exists (select 1 - from zip_codes - where zip_code like :zip_5) - }] - } { - error "The entry for $field_name, \"$zip_string\" is not a recognized zip code" - } - } else { - error "The entry for $field_name, \"$zip_string\" does not look like a zip code" - } - } else { - if { $zip_string ne "" } { - error "Zip code is not needed outside the US" - } - } - return $zip_string -} - -ad_proc -deprecated validate_ad_dateentrywidget {field_name column form {allow_null 0}} { -
- validate via ad_page_contract - - @see ad_page_contract -} { - set col $column - set day [ns_set get $form "$col.day"] - ns_set update $form "$col.day" [string trimleft $day "0"] - set month [ns_set get $form "$col.month"] - set year [ns_set get $form "$col.year"] - - # check that either all elements are blank - # date value is formated correctly for ns_dbformvalue - if { "$day$month$year" eq "" } { - if { $allow_null == 0 } { - error "$field_name must be supplied" - } else { - return "" - } - } elseif { $year ne "" && [string length $year] != 4 } { - error "The year must contain 4 digits." - } elseif { [catch { ns_dbformvalue $form $column date date } errmsg ] } { - error "The entry for $field_name had a problem: $errmsg." - } - - return $date -} - ad_proc -private util_WriteWithExtraOutputHeaders { headers_so_far {first_part_of_page ""} @@ -2341,28 +1826,6 @@ } } -ad_proc -deprecated util_ReturnMetaRefresh { - url - { seconds_delay 0 } -} { - Ugly workaround to deal with IE5.0 bug handling - multipart/form-data using - Meta Refresh page instead of a redirect. - -} { - ad_return_top_of_page [subst { -
- - - - -list into the variable named by
- the nth element of args.
-
- One should use the built-in Tcl command "lassign" instread of this proc.
-
-} {
- for { set i 0 } { $i < [llength $args] } { incr i } {
- upvar [lindex $args $i] val
- set val [lindex $list $i]
- }
-}
-
ad_proc util_email_valid_p { query_email } {
Returns 1 if an email address has more or less the correct form.
The regexp was taken from Jeff Friedls book "Mastering Regular Expressions".
@@ -4017,178 +3467,7 @@
#####
-# michael@arsdigita.com: A better name for this proc would be
-# "ad_block_sql_fragment_form_data", since "form data" is the
-# official term for query string (URL) variables and form input
-# variables.
#
-ad_proc -public -deprecated ad_block_sql_urls {
- conn
- args
- why
-} {
-
- A filter that detect attempts to smuggle in SQL code through form data
- variables. The use of bind variables and ad_page_contract input
- validation to prevent SQL smuggling is preferred.
-
- @see ad_page_contract
-} {
- set form [ns_getform]
- if { $form eq "" } { return filter_ok }
-
- # Check each form data variable to see if it contains malicious
- # user input that we don't want to interpolate into our SQL
- # statements.
- #
- # We do this by scanning the variable for suspicious phrases; at
- # this time, the phrases we look for are: UNION, UNION ALL, and
- # OR.
- #
- # If one of these phrases is found, we construct a test SQL query
- # that incorporates the variable into its WHERE clause and ask
- # the database to parse it. If the query does parse successfully,
- # then we know that the suspicious user input would result in a
- # executing SQL that we didn't write, so we abort processing this
- # HTTP request.
- #
- set n_form_vars [ns_set size $form]
- for { set i 0 } { $i < $n_form_vars } { incr i } {
- set key [ns_set key $form $i]
- set value [ns_set value $form $i]
-
- # michael@arsdigita.com:
- #
- # Removed 4000-character length check, because that allowed
- # malicious users to smuggle SQL fragments greater than 4000
- # characters in length.
- #
- if {
- [regexp -nocase {[^a-z_]or[^a-z0-9_]} $value]
- || [regexp -nocase {union([^a-z0-9_].*all)?[^a-z0-9_].*select} $value]
- } {
- # Looks like the user has added "union [all] select" to
- # the variable, # or is trying to modify the WHERE clause
- # by adding "or ...".
- #
- # Let's see if Oracle would accept this variables as part
- # of a typical WHERE clause, either as string or integer.
- #
- # michael@arsdigita.com: Should we grab a handle once
- # outside of the loop?
- #
- set parse_result_integer [db_string sql_test_1 "select test_sql('select 1 from dual where 1=[DoubleApos $value]') from dual"]
-
- if { [string first "'" $value] != -1 } {
- #
- # The form variable contains at least one single
- # quote. This can be a problem in the case that
- # the programmer forgot to QQ the variable before
- # interpolation into SQL, because the variable
- # could contain a single quote to terminate the
- # criterion and then smuggled SQL after that, e.g.:
- #
- # set foo "' or 'a' = 'a"
- #
- # db_dml "delete from bar where foo = '$foo'"
- #
- # which would be processed as:
- #
- # delete from bar where foo = '' or 'a' = 'a'
- #
- # resulting in the effective truncation of the bar
- # table.
- #
- set parse_result_string [db_string sql_test_2 "select test_sql('select 1 from dual where 1=[DoubleApos "'$value'"]') from dual"]
- } else {
- set parse_result_string 1
- }
-
- if {
- $parse_result_integer == 0
- || $parse_result_integer == -904
- || $parse_result_integer == -1789
- || $parse_result_string == 0
- || $parse_result_string == -904
- || $parse_result_string == -1789
- } {
- # Code -904 means "invalid column", -1789 means
- # "incorrect number of result columns". We treat this
- # the same as 0 (no error) because the above statement
- # just selects from dual and 904 or 1789 only occur
- # after the parser has validated that the query syntax
- # is valid.
-
- ns_log Error "ad_block_sql_urls: Suspicious request from [ad_conn peeraddr]. Parameter $key contains code that looks like part of a valid SQL WHERE clause: [ad_conn url]?[ad_conn query]"
-
- # michael@arsdigita.com: Maybe we should just return a
- # 501 error.
- #
- ad_return_error "Suspicious Request" "Parameter $key looks like it contains SQL code. For security reasons, the system won't accept your request."
-
- return filter_return
- }
- }
- }
-
- return filter_ok
-}
-
-ad_proc -public -deprecated ad_set_typed_form_variable_filter {
- url_pattern
- args
-} {
-
- #
- # Register special rules for form variables.
- #
- # Example:
- #
- # ad_set_typed_form_variable_filter /my_module/* {a_id number} {b_id word} {*_id integer}
- #
- # For all pages under /my_module, set_form_variables would set
- # $a_id only if it was number, and $b_id only if it was a 'word'
- # (a string that contains only letters, numbers, dashes, and
- # underscores), and all other variables that match the pattern
- # *_id would be set only if they were integers.
- #
- # Variables not listed have no restrictions on them.
- #
- # By default, the three supported datatypes are 'integer', 'number',
- # and 'word', although you can add your own type by creating
- # functions named ad_var_type_check_${type_name}_p which should
- # return 1 if the value is a valid $type_name, or 0 otherwise.
- #
- # There's also a special datatype named 'nocheck', which will
- # return success regardless of the value. (See the docs for
- # ad_var_type_check_${type_name}_p to see how this might be
- # useful.)
- #
- # The default data_type is 'integer', which allows you shorten the
- # command above to:
- #
- # ad_set_typed_form_variable_filter /my_module/* a_id {b_id word}
- #
-
- ad_page_contract is the preferred mechanism to do automated
- validation of form variables.
-
- @see ad_page_contract
-} {
- ad_register_filter postauth GET $url_pattern ad_set_typed_form_variables $args
- ad_register_filter postauth POST $url_pattern ad_set_typed_form_variables $args
-}
-
-proc ad_set_typed_form_variables {conn args why} {
-
- global ad_typed_form_variables
-
- lappend ad_typed_form_variables {*}[lindex $args 0]
-
- return filter_ok
-}
-
-#
# All the ad_var_type_check* procs get called from
# check_for_form_variable_naughtiness. Read the documentation
# for ad_set_typed_form_variable_filter for more details.