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.189.2.59 -r1.189.2.60
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl	24 Jul 2020 12:10:18 -0000	1.189.2.59
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl	24 Jul 2020 12:19:55 -0000	1.189.2.60
@@ -193,189 +193,6 @@
     ns_log Notice $message
 }
 
-ad_proc -deprecated check_for_form_variable_naughtiness {
-    name
-    value
-} {
-    stuff to process the data that comes
-    back from the users
-
-    if the form looked like
-    <input type=text name=yow> and <input type=text name=bar>
-    then after you run this function you'll have Tcl vars
-    $foo and $bar set to whatever the user typed in the form
-
-    this uses the initially nauseating but ultimately delicious
-    Tcl system function "uplevel" that lets a subroutine bash
-    the environment and local vars of its caller.  It ain't Common Lisp...
-
-    This is an ad-hoc check to make sure users aren't trying to pass in
-    "naughty" form variables in an effort to hack the database by passing
-    in SQL. It is called in all instances where a Tcl variable
-    is set from a form variable.
-
-    Checks the given variable for against known form variable exploits.
-    If it finds anything objectionable, it throws an error.
-} {
-    # security patch contributed by michael@cleverly.com
-    if { [string match "QQ*" $name] } {
-        error "Form variables should never begin with QQ!"
-    }
-
-    # contributed by michael@cleverly.com
-    if { "Vform_counter_i" eq $name } {
-        error "Vform_counter_i not an allowed form variable"
-    }
-
-    # The statements below make ACS more secure, because it prevents
-    # overwrite of variables from something like set_the_usual_form_variables
-    # and it will be better if it was in the system. Yet, it is commented
-    # out because it will cause an unstable release. To add this security
-    # feature, we will need to go through all the code in the ACS and make
-    # sure that the code doesn't try to overwrite intentionally and also
-    # check to make sure that when Tcl files are sourced from another proc,
-    # the appropriate variables are unset.  If you want to install this
-    # security feature, then you can look in the release notes for more info.
-    #
-    # security patch contributed by michael@cleverly.com,
-    # fixed by iwashima@arsdigita.com
-    #
-    # upvar 1 $name name_before
-    # if { [info exists name_before] } {
-    # The variable was set before the proc was called, and the
-    # form attempts to overwrite it
-    # error "Setting the variables from the form attempted to overwrite existing variable $name"
-    # }
-
-    # no naughtiness with uploaded files (discovered by ben@mit.edu)
-    # patch by richardl@arsdigita.com, with no thanks to
-    # jsc@arsdigita.com.
-    if { [string match "*tmpfile" $name] } {
-        set tmp_filename [ns_queryget $name]
-
-        # ensure no .. in the path
-        ns_normalizepath $tmp_filename
-
-        set passed_check_p 0
-
-        # check to make sure path is to an authorized directory
-        set tmpdir_list [ad_parameter_all_values_as_list -package_id [ad_conn subsite_id] TmpDir]
-        if { $tmpdir_list eq "" } {
-            set tmpdir_list [list [ns_config ns/parameters tmpdir] "/var/tmp" "/tmp"]
-        }
-
-        foreach tmpdir $tmpdir_list {
-            if { [string match "$tmpdir*" $tmp_filename] } {
-                set passed_check_p 1
-                break
-            }
-        }
-
-        if { !$passed_check_p } {
-            error "You specified a path to a file that is not allowed on the system!"
-        }
-
-    }
-
-    # integrates with the ad_set_typed_form_variable_filter system
-    # written by dvr@arsdigita.com
-
-    # see if this is one of the typed variables
-    global ad_typed_form_variables
-
-    if { [info exists ad_typed_form_variables] } {
-
-        foreach typed_var_spec $ad_typed_form_variables {
-            set typed_var_name [lindex $typed_var_spec 0]
-
-            if { ![string match $typed_var_name $name] } {
-                # no match. Go to the next variable in the list
-                continue
-            }
-
-            # the variable matched the pattern
-            set typed_var_type [lindex $typed_var_spec 1]
-
-            if { "" eq $typed_var_type } {
-                # if they don't specify a type, the default is 'integer'
-                set typed_var_type integer
-            }
-
-            set variable_safe_p [ad_var_type_check_${typed_var_type}_p $value]
-
-            if { !$variable_safe_p } {
-                ns_returnerror 500 "variable $name failed '$typed_var_type' type check"
-                ns_log Error "check_for_form_variable_naughtiness: [ad_conn url] called with \$$name = $value"
-                error "variable $name failed '$typed_var_type' type check"
-                ad_script_abort
-            }
-
-            # we've found the first element in the list that matches,
-            # and we don't want to check against any others
-            break
-        }
-    }
-}
-
-
-
-ad_proc -deprecated DoubleApos {string} {
-
-    When the value "O'Malley" is inserted int an SQL database, the
-    single quote can cause troubles in SQL, one has to insert
-    'O''Malley' instead.
-
-    Deprecated: in general, one should be using bind variables rather than
-    calling DoubleApos.
-
-    @see ns_dbquotevalue
-    @see bind variables
-
-    @return string with single quotes converted to a pair of single quotes
-} {
-    set result [ns_dbquotevalue $string]
-    # remove the leading quote if necessary
-    if {[string range $result 0 0] eq '} {
-        set result [string range $result 1 end-1]
-    }
-    return $result
-}
-
-
-
-# debugging kludges
-
-ad_proc -deprecated NsSettoTclString {set_id} {
-    returns a plain text version of the passed ns_set id
-
-    @see util::ns_set_to_tcl_string
-
-    DEPRECATED: does not comply with OpenACS naming convention
-} {
-    return [util::ns_set_to_tcl_string $set_id]
-}
-
-ad_proc -public util::ns_set_to_tcl_string {set_id} {
-    returns a plain text version of the passed ns_set id
-} {
-    set result ""
-    for {set i 0} {$i<[ns_set size $set_id]} {incr i} {
-        append result "[ns_set key $set_id $i] : [ns_set value $set_id $i]\n"
-    }
-    return $result
-}
-
-ad_proc -deprecated get_referrer args {
-    @return referrer from the request headers.
-    @param relative return the refer without protocol and host
-
-    DEPRECATED: does not comply with OpenACS naming convention.
-
-    @see util::get_referrer
-} {
-    return [util::get_referrer {*}$args]
-}
-
 ad_proc -public util::get_referrer {
     -relative:boolean
 } {
@@ -416,20 +233,6 @@
     }
 }
 
-ad_proc -deprecated remove_nulls_from_ns_set {
-    old_set_id
-} {
-    Creates and returns a new ns_set without any null value fields
-
-    DEPRECATED: does not comply with OpenACS naming convention.
-
-    @see util_remove_nulls_from_ns_set
-
-    @return new ns_set
-} {
-    return [util_remove_nulls_from_ns_set $old_set_id]
-}
-
 ad_proc -public util_remove_nulls_from_ns_set {
     old_set_id
 } {
@@ -450,75 +253,6 @@
     return $new_set_id
 }
 
-ad_proc -deprecated merge_form_with_query {
-    {-bind {}}
-    form statement_name sql_qry
-} {
-    Merges a form with a query string.
-
-    DEPRECATED: this proc does not comply with OpenACS naming
-    convention. Furthermore, ns_formvalueput supports a limited number
-    of HTML variants and input tag types and is subject to various
-    other limitations. For a modern implementation addressing the
-    use-case of this proc one should probably use tools such as tDOM.
-
-    @see tDOM
-    @see https://panoptic.com/wiki/aolserver/Ns_formvalueput
-
-    @param form the form to be stuffed.
-    @param statement_name An identifier for the sql_qry to be executed.
-    @param sql_qry The sql that must be executed.
-    @param bind A ns_set stuffed with bind variables for the sql_qry.
-} {
-    set set_id [ns_set create]
-
-    ns_log debug "merge_form_with_query: statement_name = $statement_name"
-    ns_log debug "merge_form_with_query: sql_qry = $sql_qry"
-    ns_log debug "merge_form_with_query: set_id = $set_id"
-
-    db_0or1row $statement_name $sql_qry -bind $bind -column_set set_id
-
-    if { $set_id ne "" } {
-
-        for {set i 0} {$i < [ns_set size $set_id]} {incr i} {
-            set form [ns_formvalueput $form [ns_set key $set_id $i] [ns_set value $set_id $i]]
-        }
-
-    }
-    return $form
-}
-
-
-
-
-ad_proc -deprecated util_PrettyTclBoolean {
-    zero_or_one
-} {
-    Turns a 1 (or anything else that makes a Tcl IF happy) into Yes; anything else into No
-
-    DEPRECATED: this proc is not localized, does not comply with
-    OpenACS naming convention and can be replaced by simple oneliner
-    idioms based e.g. on expr command
-
-    @see plain tcl idioms involving message keys
-} {
-    if {$zero_or_one} {
-        return "Yes"
-    } else {
-        return "No"
-    }
-}
-
-ad_proc -deprecated randomInit {seed} {
-    seed the random number generator.
-
-    DEPRECATED: this proc does not respect OpenACS naming convention
-
-    @see util::random_init
-} {
-    return [util::random_init $seed]
-}
-
 ad_proc -public util::random_init {seed} {
     Seed the random number generator.
 } {
@@ -528,16 +262,6 @@
     nsv_set rand seed $seed
 }
 
-ad_proc -deprecated random {} {
-    Return a pseudo-random number between 0 and 1.
-
-    DEPRECATED: this proc does not respect OpenACS naming convention
-
-    @see util::random
-} {
-    return [util::random]
-}
-
 ad_proc -public util::random {} {
     Return a pseudo-random number between 0 and 1. The reason to have
     this proc is that seeding can be controlled by the user and the
@@ -549,18 +273,6 @@
     return [expr {[nsv_get rand seed]/double([nsv_get rand im])}]
 }
 
-ad_proc -deprecated randomRange {range} {
-    Returns a pseudo-random number between 0 and range.
-
-    DEPRECATED: this proc does not respect OpenACS naming convention
-
-    @see util::random_range
-
-    @return integer
-} {
-    return [util::random_range $range]
-}
-
 ad_proc -public util::random_range {range} {
     Returns a pseudo-random number between 0 and range.
 
@@ -1231,38 +943,7 @@
     return $url
 }
 
-ad_proc -deprecated with_catch {error_var body on_error} {
-    execute code in body with the catch errorMessage in error_var
-    and if there is a nonzero return code from body
-    execute the on_error block.
 
-    DEPRECATED: does not comply with OpenACS naming convention and can
-    be replaced with better api such as ad_try or native Tcl
-    constructs such as ::try (8.6)
-
-    @see try
-    @see ad_try
-} {
-    upvar 1 $error_var $error_var
-    if { [catch { uplevel $body } $error_var] } {
-        set code [catch {uplevel $on_error} string]
-        # Return out of the caller appropriately.
-        if { $code == 1 } {
-            return -code error -errorinfo $::errorInfo -errorcode $::errorCode $string
-        } elseif { $code == 2 } {
-            return -code return $string
-        } elseif { $code == 3 } {
-            return -code break
-        } elseif { $code == 4 } {
-            return -code continue
-        } elseif { $code > 4 } {
-            return -code $code $string
-        }
-    }
-}
-
-
-
 # putting commas into numbers (thank you, Michael Bryzek)
 
 ad_proc -public util_commify_number { num } {
@@ -1298,41 +979,7 @@
     ns_log Notice $message
 }
 
-ad_proc -deprecated exists_and_not_null { varname } {
-    Returns 1 if the variable name exists in the caller's environment and
-    is not the empty string.
 
-    Note you should enter the variable name, and not the variable value
-    (varname not $varname which will pass variable varnames value into this function).
-
-    DEPRECATED: the value provided by this proc is arguable, as it can
-    be replaced by a plain tcl oneliner.
-
-    @see plain tcl idioms
-} {
-    upvar 1 $varname var
-    return [expr { [info exists var] && $var ne "" }]
-}
-
-
-ad_proc -deprecated exists_and_equal { varname value } {
-    Returns 1 if the variable name exists in the caller's environment
-    and is equal to the given value.
-
-    DEPRECATED: the value provided by this proc is arguable, as it can
-    be replaced by a plain tcl oneliner.
-
-    @see exists_and_not_null
-    @see plain tcl idioms
-
-    @author Peter Marklund
-} {
-    upvar 1 $varname var
-
-    return [expr { [info exists var] && $var eq $value } ]
-}
-
-
 # some procs to make it easier to deal with CSV files (reading and writing)
 # added by philg@mit.edu on October 30, 1999
 
@@ -1529,22 +1176,6 @@
     ns_write $entire_string_to_write
 }
 
-ad_proc -deprecated ReturnHeaders args {
-    We use this when we want to send out just the headers
-    and then do incremental writes with ns_write.  This way the user
-    doesn't have to wait for streamed output (useful when doing
-    bulk uploads, installs, etc.).
-
-    It returns status 200 and all headers including
-    any added to outputheaders.
-
-    DEPRECATED: does not comply with OpenACS naming convention.
-
-    @see util_return_headers
-} {
-    return [util_return_headers {*}$args]
-}
-
 ad_proc -private util_return_headers {
     {content_type text/html}
     {content_length ""}
@@ -1599,13 +1230,6 @@
     return [uplevel $func_and_args]
 }
 
-ad_proc -public -deprecated safe_eval args {
-    Deprecated version of ad_safe_eval
-    @see ad_safe_eval
-} {
-    return [ad_safe_eval {*}$args]
-}
-
 ad_proc -public ad_safe_eval args {
 
     Version of "eval" that checks its arguments for brackets that may be
@@ -2353,18 +1977,6 @@
 }
 
 
-ad_proc -deprecated -public ad_call_proc_if_exists { proc args } {
-    Calls a procedure with particular arguments, only if the procedure is defined.
-
-    Deprecated: very simple tcl commands idioms can replace this proc
-
-    @see "info commands" based idioms
-} {
-    if { [info commands $proc] ne "" } {
-        $proc {*}$args
-    }
-}
-
 ad_proc -public ad_get_tcl_call_stack {
     {level -2}
 } {
@@ -3033,47 +2645,6 @@
     return [regexp -nocase {^(http|https|ftp)://[^ ].+} [string trim $query_url]]
 }
 
-ad_proc -deprecated value_if_exists { var_name } {
-    If the specified variable exists in the calling environment,
-    returns the value of that variable. Otherwise, returns the
-    empty_string.
-
-    DEPRECATED: this proc does not respect OpenACS naming convention
-    and can be replaced with a plain tcl oneliner.
-
-    @see plain tcl idioms
-} {
-    upvar $var_name $var_name
-    if { [info exists $var_name] } {
-        return [set $var_name]
-    }
-}
-
-ad_proc -deprecated min { args } {
-    Returns the minimum of a list of numbers. Example: <code>min 2 3 1.5</code> returns 1.5.
-
-    DEPRECATED: this proc does not respect OpenACS naming convention.
-    @see util::min
-
-    @author Ken Mayer (kmayer@bitwrangler.com)
-    @creation-date 26 September 2002
-} {
-    return [util::min $args]
-}
-
-
-ad_proc -deprecated max { args } {
-    Returns the maximum of a list of numbers. Example: <code>max 2 3 1.5</code> returns 3.
-
-    DEPRECATED: this proc does not respect OpenACS naming convention.
-    @see util::max
-
-    @author Lars Pind (lars@pinds.com)
-    @creation-date 31 August 2000
-} {
-    return [util::max $args]
-}
-
 ad_proc -public util::min { args } {
     Returns the minimum of a list of numbers. Example: <code>min 2 3 1.5</code> returns 1.5.
 
@@ -3355,87 +2926,6 @@
     return [string range [sec_random_token] 0 $length-1]
 }
 
-ad_proc -deprecated with_finally {
-    -code:required
-    -finally:required
-} {
-    Execute CODE, then execute cleanup code FINALLY.
-    If CODE completes normally, its value is returned after
-    executing FINALLY.
-    If CODE exits non-locally (as with error or return), FINALLY
-    is executed anyway.
-
-    @param code Code to be executed that could throw and error
-    @param finally Cleanup code to be executed even if an error occurs
-
-    DEPRECATED: does not comply with OpenACS naming convention and can
-    be replaced with better api such as ad_try or native Tcl
-    constructs such as ::try (8.6)
-
-    @see try
-    @see ad_try
-} {
-
-    # Execute CODE.
-    set return_code [catch {uplevel $code} string]
-
-    if {[info exists ::errorInfo]} {
-        set s_errorInfo $::errorInfo
-    } else {
-        set s_errorInfo ""
-    }
-    if {[info exists ::errorCode]} {
-        set s_errorCode $::errorCode
-    } else {
-        set s_errorCode ""
-    }
-
-    # As promised, always execute FINALLY.  If FINALLY throws an
-    # error, Tcl will propagate it the usual way.  If FINALLY contains
-    # stuff like break or continue, the result is undefined.
-    uplevel $finally
-
-    switch -- $return_code {
-        0 {
-            # CODE executed without a non-local exit -- return what it
-            # evaluated to.
-            return $string
-        }
-        1 {
-            # Error
-            if {[lindex $s_errorCode 0 0] eq "CHILDSTATUS"} {
-                #
-                # GN: In case the errorCode starts with CHILDSTATUS it
-                # means that an error was raised from an "exec". In
-                # that case the raw error just tells that the "child
-                # process exited abnormally", without given any
-                # details. Therefore, we add the exit code to the
-                # messages.
-                #
-                set extra "child process (pid [lindex $s_errorCode 0 1]) exited with exit-code [lindex $s_errorCode 0 end]"
-                append string " ($extra)"
-                set s_errorInfo $extra\n$s_errorInfo
-            }
-            return -code error -errorinfo $s_errorInfo -errorcode $s_errorCode $string
-        }
-        2 {
-            # Return from the caller.
-            return -code return $string
-        }
-        3 {
-            # break
-            return -code break
-        }
-        4 {
-            # continue
-            return -code continue
-        }
-        default {
-            return -code $return_code $string
-        }
-    }
-}
-
 ad_proc util_background_exec {
     {-pass_vars ""}
     {-name:required}
@@ -3537,142 +3027,6 @@
 }
 
 
-
-#####
-#
-# This is some old security crud from before we had ad_page_contract
-#
-#####
-
-
-#
-# 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.
-
-ad_proc -deprecated ad_var_type_check_integer_p {value} {
-    @return 1 if $value is an integer, 0 otherwise.
-
-    This function is deprecated.
-    Use either template::data::validate::integer
-    or "string is integer -strict" instead.
-
-    @see ::template::data::validate::integer
-} {
-
-    if { [regexp {[^0-9]} $value] } {
-        return 0
-    } else {
-        return 1
-    }
-}
-
-ad_proc -deprecated ad_var_type_check_safefilename_p {value} {
-    @return 0 if the file contains ".."
-} {
-
-    if { [string match "*..*" $value] } {
-        return 0
-    } else {
-        return 1
-    }
-}
-
-ad_proc -deprecated ad_var_type_check_dirname_p {value} {
-    @return 0 if $value contains a / or \, 1 otherwise.
-} {
-
-    if { [regexp {[/\\]} $value] } {
-        return 0
-    } else {
-        return 1
-    }
-}
-
-ad_proc -deprecated ad_var_type_check_number_p {value} {
-    @return 1 if $value is a valid number
-} {
-    if { [catch {expr {1.0 * $value}}] } {
-        return 0
-    } else {
-        return 1
-    }
-}
-
-ad_proc -deprecated ad_var_type_check_word_p {value} {
-    @return 1 if $value contains only letters, numbers, dashes,
-            and underscores, otherwise returns 0.
-} {
-
-    if { [regexp {[^-A-Za-z0-9_]} $value] } {
-        return 0
-    } else {
-        return 1
-    }
-}
-
-ad_proc -deprecated ad_var_type_check_nocheck_p {{value ""}} {
-    @return 1 regardless of the value. This is useful if you want to
-            set a filter over the entire site, then create a few exceptions.
-
-    For example:
-
-      ad_set_typed_form_variable_filter /my-dangerous-page.tcl {user_id nocheck}
-      ad_set_typed_form_variable_filter /*.tcl user_id
-} {
-    return 1
-}
-
-ad_proc -deprecated ad_var_type_check_noquote_p {value} {
-    @return 1 if $value contains any single-quotes
-} {
-
-    if { [string match "*'*" $value] } {
-        return 0
-    } else {
-        return 1
-    }
-}
-
-ad_proc -deprecated ad_var_type_check_integerlist_p {value} {
-    @return 1 if list contains only numbers, spaces, and commas.
-            Example '5, 3, 1'. Note: it doesn't allow negative numbers,
-            because that could let people sneak in numbers that get
-            treated like math expressions like '1, 5-2'
-} {
-
-    if { [regexp {[^ 0-9,]} $value] } {
-        return 0
-    } else {
-        return 1
-    }
-}
-
-ad_proc -deprecated ad_var_type_check_fail_p {value} {
-    A check that always returns 0. Useful if you want to disable all access
-    to a page.
-} {
-    return 0
-}
-
-ad_proc -deprecated ad_var_type_check_third_urlv_integer_p {{args ""}} {
-    Deprecated: too specific to make sense as a public api, can be
-    replaced via a simple tcl oneliner
-
-    @see simple tcl oneliner
-
-    @return 1 if the third path element in the URL is integer.
-} {
-
-    set third_url_element [lindex [ad_conn urlv] 3]
-
-    if { [regexp {[^0-9]} $third_url_element] } {
-        return 0
-    } else {
-        return 1
-    }
-}
-
 ####################
 #
 # Procs in the util namespace
@@ -4491,26 +3845,6 @@
 }
 
 
-ad_proc -public -deprecated util_search_list_of_lists {list_of_lists query_string {sublist_element_pos 0}} {
-    Returns position of sublist that contains QUERY_STRING at SUBLIST_ELEMENT_POS.
-
-    The function can be replaced by "lsearch -index $pos $list_of_lists $query_string"
-    @see lsearch
-} {
-    #set sublist_index 0
-    #foreach sublist $list_of_lists {
-    #    set comparison_element [lindex $sublist $sublist_element_pos]
-    #    if { $query_string eq $comparison_element  } {
-    #        return $sublist_index
-    #    }
-    #    incr sublist_index
-    #}
-    # didn't find it
-    #return -1
-
-    return [lsearch -index $sublist_element_pos $list_of_lists $query_string]
-}
-
 namespace eval util {
 
     ad_proc ::util::inline_svg_from_dot {{-css ""} dot_code} {