Index: openacs.org-dev/packages/file-storage/tcl/file-storage-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs.org-dev/packages/file-storage/tcl/file-storage-procs.tcl,v diff -u -r1.1.1.2 -r1.1.1.3 --- openacs.org-dev/packages/file-storage/tcl/file-storage-procs.tcl 31 Jul 2002 16:31:15 -0000 1.1.1.2 +++ openacs.org-dev/packages/file-storage/tcl/file-storage-procs.tcl 8 Oct 2002 15:47:11 -0000 1.1.1.3 @@ -3,7 +3,7 @@ @author Kevin Scaldeferri (kevin@arsdigita.com) @creation-date 6 November 2000 - @version $Id$ + @cvs-id $Id$ } ad_proc fs_get_root_folder { @@ -193,30 +193,42 @@ when we encounter something we haven't seen before. } { - set mime_type [ns_guesstype $file_name] - set extension [string trimleft [file extension $file_name] "."] + set file_extension [string trimleft [file extension $file_name] "."] - # don't know how to generate nice names like "JPEG Image" - # have to leave it blank for now + if {[empty_string_p $file_extension]} { + return "*/*" + } - #set pretty_mime_type ??? - - if { [db_string mime_type_exists { - select count(*) + if {![db_0or1row select_mime_type "select mime_type from cr_mime_types - where mime_type = :mime_type - }] == 0 } { + where file_extension = :file_extension"]} { + + # A mime type for this file extension does not exist + # in the database. Check to see AOLServer can + # generate a mime type. + + set mime_type [ns_guesstype $file_name] + + # Note: If AOLServer can't determine a mime type, + # ns_guesstype will return */*. We still record + # a mime type for this file extension. At a later + # date, the mime type for the file extension may be + # updated and, as a result, the files with that + # file extension will be associated with the + # proper mime types. + db_dml new_mime_type { insert into cr_mime_types (mime_type, file_extension) values - (:mime_type, :extension) + (:mime_type, :file_extension) } } - return $mime_type } + + namespace eval fs { ad_proc -public new_root_folder { @@ -307,6 +319,25 @@ return [db_string select_object_name {} -default $object_id] } + ad_proc -public get_file_system_safe_object_name { + {-object_id:required} + } { + 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]] + } + + ad_proc -public remove_special_file_system_characters { + {-string:required} + } { + remove unsafe file system characters. useful if you want to use $string + as the name of an object to write to disk. + } { + regsub -all {[<>:\"|/@#%&+\\]} $string {_} string + return $string + } + ad_proc -public folder_p { {-object_id:required} } { @@ -338,12 +369,15 @@ {-user_id ""} {-n_past_days "99999"} } { + WARNING: This proc is not scalable because it does too many permission checks. + Retrieve the contents of the specified folder in the form of a list of ns_sets, one for each row returned. The keys for each row are as follows: object_id, name, live_revision, type, - last_modified, new_p, content_size, write_p, delete_p, admin_p + last_modified, new_p, content_size, file_upload_name + write_p, delete_p, admin_p, @param folder_id The folder for which to retrieve contents @param user_id The viewer of the contents (to make sure they have @@ -396,9 +430,9 @@ db_1row select_object_info {} - if {[string match folder $type]} { + if {[string equal folder $type]} { set result [publish_folder_to_file_system -folder_id $object_id -path $path -folder_name $name -user_id $user_id] - } elseif {[string match url $type]} { + } elseif {[string equal url $type]} { set result [publish_simple_object_to_file_system -object_id $object_id -path $path -file_name $file_name] } else { set result [publish_versioned_object_to_file_system -object_id $object_id -path $path] @@ -422,15 +456,16 @@ if {[empty_string_p $folder_name]} { set folder_name [get_object_name -object_id $folder_id] } + set folder_name [remove_special_file_system_characters -string $folder_name] - set dir "${path}/${folder_name}" + set dir [file join ${path} ${folder_name}] file mkdir $dir foreach object [get_folder_contents -folder_id $folder_id -user_id $user_id] { publish_object_to_file_system \ -object_id [ns_set get $object object_id] \ -path $dir \ - -file_name [ns_set get $object name] \ + -file_name [remove_special_file_system_characters -string [ns_set get $object name]] \ -user_id $user_id } @@ -474,12 +509,13 @@ if {[empty_string_p $file_name]} { set file_name [ns_set get $object name] } + set file_name [remove_special_file_system_characters -string $file_name] - set fp [open "${path}/${file_name}" w] + set fp [open [file join ${path} ${file_name}] w] puts $fp [ns_set get $object url] close $fp - return "${path}/${file_name}" + return [file join ${path} ${file_name}] } ad_proc -public publish_versioned_object_to_file_system { @@ -499,16 +535,17 @@ if {[empty_string_p $file_name]} { set file_name $title } + set file_name [remove_special_file_system_characters -string $file_name] switch $storage_type { lob { # FIXME: db_blob_get_file is failing when i use bind variables - db_blob_get_file select_object_content {} -file "${path}/${file_name}" + db_blob_get_file select_object_content {} -file [file join ${path} ${file_name}] } text { set content [db_string select_object_content {}] - set fp [open "${path}/${file_name}" w] + set fp [open [file join ${path} ${file_name}] w] puts $fp $content close $fp } @@ -517,7 +554,7 @@ set cr_file_name [db_string select_file_name {}] set ifp [open "${cr_path}${cr_file_name}" r] - set ofp [open "${path}/${file_name}" w] + set ofp [open [file join ${path} ${file_name}] w] ns_cpfp $ifp $ofp @@ -526,7 +563,7 @@ } } - return "${path}/${file_name}" + return [file join ${path} ${file_name}] } ad_proc -public get_archive_command {