Index: openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl,v diff -u -N -r1.24.2.4 -r1.24.2.5 --- openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl 21 Apr 2017 14:53:08 -0000 1.24.2.4 +++ openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl 8 Jun 2017 16:42:26 -0000 1.24.2.5 @@ -853,8 +853,10 @@ } set existing_filenames [db_list get_parent_existing_filenames {}] - set filename [util_text_to_url \ - -text ${title} -existing_urls "$existing_filenames" -replacement "_"] + set filename [ad_sanitize_filename \ + -existing_names $existing_filenames \ + -collapse_spaces \ + -replace_with "_" $title] set revision_id [cr_import_content \ -storage_type "file" -title $title \ 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 -N -r1.140.2.77 -r1.140.2.78 --- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 23 May 2017 20:51:41 -0000 1.140.2.77 +++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 8 Jun 2017 16:42:26 -0000 1.140.2.78 @@ -3282,6 +3282,120 @@ return $out } +# apisano 2017-06-08: this should someday replace proc +# util_text_to_url, but it is unclear to me whether we want two +# different semantics to sanitize URLs and filesystem names or +# not. For the time being I have replaced util_text_to_url in every +# place where this was used to sanitize filenames. +ad_proc ad_sanitize_filename { + -no_resolve:boolean + {-existing_names ""} + -collapse_spaces:boolean + {-replace_with "-"} + -tolower:boolean + str +} { + Sanitize the provided filename for modern Windows, OS X, and Unix + file systems (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 + + + @author Gustaf Neumann +} { + # + # 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"} + + # dots other than in file extension are dangerous. Put inside two + # '#' character will be seen as message keys and file-storage is + # currently set to interpret them. + set str_ext [file extension $str] + set str_noext [string range $str 0 end-[string length $str_ext]] + regsub -all {\.} $str_noext $replace_with str_noext + set str ${str_noext}${str_ext} + + # + # 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 number 2 + + foreach name $existing_names { + + if { [regexp "${str}${replace_with}(\\d+)\$" $name match n] } { + # matches the foo-123 pattern + if { $n >= $number } { set number [expr {$n + 1}] } + } + } + + set str "$str$replace_with$number" + } + } + + return $str +} + ad_proc -public util_text_to_url { {-existing_urls {}} {-no_resolve:boolean} Index: openacs-4/packages/file-storage/lib/folder-links.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/lib/folder-links.tcl,v diff -u -N -r1.4.2.4 -r1.4.2.5 --- openacs-4/packages/file-storage/lib/folder-links.tcl 4 Jul 2016 10:13:43 -0000 1.4.2.4 +++ openacs-4/packages/file-storage/lib/folder-links.tcl 8 Jun 2017 16:42:26 -0000 1.4.2.5 @@ -73,7 +73,6 @@ } - set file_upload_name [fs::remove_special_file_system_characters -string $file_upload_name] set name [lang::util::localize $name] if {![info exists download_base_url] } { Index: openacs-4/packages/file-storage/tcl/file-storage-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/file-storage-procs.tcl,v diff -u -N -r1.69.2.5 -r1.69.2.6 --- openacs-4/packages/file-storage/tcl/file-storage-procs.tcl 24 May 2017 18:49:21 -0000 1.69.2.5 +++ openacs-4/packages/file-storage/tcl/file-storage-procs.tcl 8 Jun 2017 16:42:26 -0000 1.69.2.6 @@ -372,10 +372,13 @@ get the name of a file storage object and make it safe for writing to the file system } { - return [remove_special_file_system_characters -string [get_object_name -object_id $object_id]] + return [ad_sanitize_filename \ + -collapse_spaces \ + -tolower \ + [get_object_name -object_id $object_id]] } -ad_proc -public fs::remove_special_file_system_characters { +ad_proc -deprecated -public fs::remove_special_file_system_characters { {-string:required} } { remove unsafe file system characters. useful if you want to use $string @@ -546,18 +549,25 @@ if {$folder_name eq ""} { set folder_name [get_object_name -object_id $folder_id] } - set folder_name [remove_special_file_system_characters -string $folder_name] + set folder_name [ad_sanitize_filename \ + -collapse_spaces \ + -tolower \ + $folder_name] set dir "[file join ${path} "${folder_name}"]" # set dir "[file join ${path} "download"]" file mkdir $dir foreach object [get_folder_contents -folder_id $folder_id -user_id $user_id] { + set file_name [ad_sanitize_filename \ + -collapse_spaces \ + -tolower \ + [ns_set get $object name]] publish_object_to_file_system \ -object_id [ns_set get $object object_id] \ -path $dir \ - -file_name [remove_special_file_system_characters -string [ns_set get $object name]] \ - -user_id $user_id + -file_name $file_name \ + -user_id $user_id } return $dir @@ -582,7 +592,10 @@ set file_name $name } set file_name "${file_name}.url" - set file_name [remove_special_file_system_characters -string $file_name] + set file_name [ad_sanitize_filename \ + -collapse_spaces \ + -tolower \ + $file_name] set fp [open [file join $path $file_name] w] puts $fp {[InternetShortcut]} @@ -635,7 +648,10 @@ set file_name $file_upload_name } - set file_name [remove_special_file_system_characters -string $file_name] + set file_name [ad_sanitize_filename \ + -collapse_spaces \ + -tolower \ + $file_name] switch $storage_type { lob { Index: openacs-4/packages/file-storage/www/folder-chunk.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/www/folder-chunk.tcl,v diff -u -N -r1.49.2.9 -r1.49.2.10 --- openacs-4/packages/file-storage/www/folder-chunk.tcl 3 May 2017 18:18:15 -0000 1.49.2.9 +++ openacs-4/packages/file-storage/www/folder-chunk.tcl 8 Jun 2017 16:42:26 -0000 1.49.2.10 @@ -300,8 +300,6 @@ } - set file_upload_name [fs::remove_special_file_system_characters -string $file_upload_name] - if { $content_size ne "" } { incr content_size_total $content_size } Index: openacs-4/packages/file-storage/www/folder-create.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/www/folder-create.tcl,v diff -u -N -r1.10.2.4 -r1.10.2.5 --- openacs-4/packages/file-storage/www/folder-create.tcl 30 May 2017 11:58:46 -0000 1.10.2.4 +++ openacs-4/packages/file-storage/www/folder-create.tcl 8 Jun 2017 16:42:26 -0000 1.10.2.5 @@ -96,7 +96,10 @@ # strip out spaces from the name # use - instead of _ which can get URLencoded - set name [string tolower [util_text_to_url -text $folder_name]] + set name [ad_sanitize_filename \ + -collapse_spaces \ + -tolower \ + $folder_name] # check folder name does not exist already if {[content::item::get_id_by_name \