ad_sanitize_filename (public)

 ad_sanitize_filename [ -no_resolve ] \
    [ -existing_names existing_names ] [ -collapse_spaces ] \
    [ -replace_with replace_with ] [ -tolower ] str

Defined in packages/acs-tcl/tcl/utilities-procs.tcl

Sanitize the provided filename for modern Windows, OS X, and Unix filesystems (NTFS, ext, etc.). FAT 8.3 filenames are not supported. The generated strings should be safe against https://github.com/minimaxir/big-list-of-naughty-strings

Switches:

-no_resolve (optional, boolean)

-existing_names (optional)

-collapse_spaces (optional, boolean)

-replace_with (optional, defaults to "-")

-tolower (optional, boolean)

Parameters:

str (required)

Author:

Gustaf Neumann

Partial Call Graph (max 5 caller/called nodes):

Testcases:

ad__sanitize_filename, fs_add_file_to_folder

Source code:

    #
    # Trim trailing periods and spaces (for Windows)
    #
    set str [string trim $str { .}]

    #
    # Remove Control characters (0x00–0x1f and 0x80–0x9f)
    # and reserved characters (/, ?, <, >, \, :, *, |, ; and ")
    regsub -all -- {[\u0000-\u001f|/|?|<|>|\\:*|\"|;]+} $str "" str

    # allow a custom replacement char, that must be safe.
    regsub -all -- {[\u0000-\u001f|/|?|<|>|\\:*|\"|;|\.]+} $replace_with "" replace_with
    if {$replace_with eq ""} {error "-replace_with must be a safe filesystem character"}

    #
    # Remove Unix reserved filenames (. and ..)
    # reserved names in windows
    set l [string length $str]
    if {($l <  3 && $str in {"." ".."}) ||
        ($l == 3 && $str in {CON PRN AUX NUL}) ||
        ($l == 4 && $str in {
            COM1 COM2 COM3 COM4 COM5 COM6 COM7 COM8 COM9
            LPT1 LPT2 LPT3 LPT4 LPT5 LPT6 LPT7 LPT8 LPT9
        })
    } {
        set str ""
    } elseif {$l > 255} {
        #
        # Truncate the name to 255 characters
        #
        set str [string range $str 0 254]
    }

    #
    # The transformations above are necessary. The following
    # transformation are optional.
    #
    if {$collapse_spaces_p} {
        #
        # replace all consecutive spaces by a single char
        #
        regsub -all -- {[ ]+} $str $replace_with str
    }
    if {$tolower_p} {
        #
        # replace all consecutive spaces by a single "-"
        #
        set str [string tolower $str]
    }

    # check if the resulting name is already present
    if {$str in $existing_names} {

        if { $no_resolve_p } {
            # name is already present in the existing_names list and we
            # are asked to not automatically resolve the collision
            error "The name $str is already present"
        } else {
            # name is already present in the existing_names list -
            # compute an unoccupied replacement using a pattern like
            # this: if foo is taken, try foo-2, then foo-3 etc.

            # Holes will not be re-occupied. E.g. if there's foo-2 and
            # foo-4, a foo-5 will be created instead of foo-3. This
            # way confusion through replacement of deleted content
            # with new stuff is avoided.

            set str_length [string length "${str}${replace_with}"]
            set number 2

            foreach name $existing_names {

                if {[string range $name 0 $str_length-1] eq "${str}${replace_with}"} {
                    set n [string range $name $str_length end]
                    if {[string is integer -strict $n] && $n >= $number} {
                        set number [incr n]
                    }
                }
            }

            set str "$str$replace_with$number"
        }
    }

    return $str

XQL Not present:

PostgreSQL, Oracle

Generic XQL file:

packages/acs-tcl/tcl/utilities-procs.xql