-
-- " - 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.