Index: openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs-postgresql.xql,v diff -u -r1.1.2.1 -r1.1.2.2 --- openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs-postgresql.xql 25 Dec 2013 16:10:31 -0000 1.1.2.1 +++ openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs-postgresql.xql 31 Dec 2013 16:21:10 -0000 1.1.2.2 @@ -4,18 +4,14 @@ - SELECT distinct crftd.path, crftd.storage_area_key + SELECT distinct crftd.path, crftd.storage_area_key FROM cr_files_to_delete crftd - WHERE not exists (SELECT 1 FROM cr_revisions r - WHERE substring(r.content for 100) = substring(crftd.path for 100)) + WHERE not exists ( + SELECT 1 FROM cr_revisions r + WHERE substring(r.content for 100) = substring(crftd.path for 100) + ) - - - SELECT count(*) FROM cr_revisions WHERE substring(content, 1, 100) = substring(:name, 1, 100); - - - Index: openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs.tcl,v diff -u -r1.7.2.3 -r1.7.2.4 --- openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs.tcl 27 Dec 2013 10:14:54 -0000 1.7.2.3 +++ openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs.tcl 31 Dec 2013 16:21:10 -0000 1.7.2.4 @@ -36,6 +36,11 @@ # now that all scheduled files deleted, clear table db_dml delete_files { *SQL* } } + + # + # cleanup orphaned files (leftovers from aborted transactions) + # + cr_cleanup_orphaned_files } @@ -79,8 +84,13 @@ ad_proc cr_check_orphaned_files {-delete:boolean {-mtime ""}} { Check for orphaned files in the content respository directory, and - delete such files if required. Orphaned files might be created, when - files add added to the content repository, but the transaction is being aborted. + delete such files if required. Orphaned files might be created, + when files are added to the content repository, but the transaction + is being aborted. This function is intended to be used for one-time + maintainenace operations. Starting with 5.8.1, OpenACS contains + support for handling orphaned files much more efficiently via a + transaction log that is checked via cr_cleanup_orphaned_files in + cr_delete_scheduled_files. @param -delete delete the orphaned files @param -mtime same semantics as mtime in the file command @@ -90,21 +100,16 @@ set root_length [string length $cr_root] set result "" - # Check for missing trailing slash on directory. - # Find needs folders to end with slash to search them. - if {[string index $cr_root end] != "/"} { - append cr_root / - } - - # For every file in the content respository directory, check if this - # file is still referenced from the content-revisions. - - set cmd [list exec find $cr_root -type f] + set cmd [list exec find $cr_root/ -type f] if {$mtime ne ""} {lappend cmd -mtime $mtime} foreach f [split [{*}$cmd] \n] { set name [string range $f $root_length end] if {![regexp {^[0-9/]+$} $name]} continue - set x [db_string fetch_path { *SQL* }] + + # For every file in the content respository directory, check if this + # file is still referenced from the content-revisions. + + set x [cr_count_file_entries $name] if {$x > 0} continue lappend result $f Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/packages/acs-content-repository/tcl/content-init.tcl'. Fisheye: No comparison available. Pass `N' to diff? Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/packages/acs-content-repository/tcl/content-procs-postgresql.xql'. Fisheye: No comparison available. Pass `N' to diff? Index: openacs-4/packages/acs-content-repository/tcl/content-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-procs.tcl,v diff -u -r1.12 -r1.12.2.1 --- openacs-4/packages/acs-content-repository/tcl/content-procs.tcl 31 May 2013 20:27:17 -0000 1.12 +++ openacs-4/packages/acs-content-repository/tcl/content-procs.tcl 31 Dec 2013 16:21:12 -0000 1.12.2.1 @@ -69,13 +69,22 @@ if the -move flag is given the file is renamed instead } { set content_file [cr_create_content_file_path $item_id $revision_id] + set dir [cr_fs_path] if { $move_p } { - file rename -- $client_filename [cr_fs_path]$content_file + file rename -- $client_filename $dir$content_file } else { - file copy -force -- $client_filename [cr_fs_path]$content_file + file copy -force -- $client_filename $dir$content_file } + # Record an entry in the file creation log for managing orphaned + # files. + ad_mutex_eval [nsv_get mutex cr_file_creation] { + set f [open $dir/file-creation.log a] + puts $f $content_file + close $f + } + return $content_file } @@ -92,6 +101,12 @@ puts -nonewline $ofp $str close $ofp + ad_mutex_eval [nsv_get mutex cr_file_creation] { + set f [open $dir/file-creation.log a] + puts $f $content_file + close $f + } + return $content_file } @@ -103,3 +118,69 @@ } { return [file size [cr_fs_path]$relative_file_path] } + + +# +# Manage a log for created files in the content repository. The log is +# used for cleaning up orphaned files after aborted transactions +# involving file inserts in the content repository. +# + +ad_proc -public cr_cleanup_orphaned_files {} { + + Helper proc to cleanup orphaned files in the content + repository. Orphaned files can be created during aborted + transactions involving the files being added to the content + respository. + +} { + cr_delete_orphans [cr_get_file_creation_log] +} + +ad_proc -private cr_get_file_creation_log {} { + + Return the contents of the file creation log and truncate it + (i.e. remove all entries). + +} { + set dir [cr_fs_path] + ad_mutex_eval [nsv_get mutex cr_file_creation] { + set f [open $dir/file-creation.log] + set content [read $f] + close $f + # truncate the log file + set f [open $dir/file-creation.log w]; close $f + } + return $content +} + +ad_proc -public cr_count_file_entries {name} { + + Count the number of entries from the content repository having the + specified partial path their content field. The result should be + 0 or 1 in consistent databases. + +} { + db_string count_entries { *SQL* } +} + +ad_proc -private cr_delete_orphans {files} { + + delete orphaned files in the content repository + +} { + set dir [cr_fs_path] + foreach name $files { + if {![file exists $dir$name]} { + # the file does not exist anymore, nothing to do + continue + } + set count [cr_count_file_entries $name] + if {$count == 0} { + # the content entry does not exist anymore, therefore the + # file is an orphan and should be removed + ns_log notice "delete orphaned file $dir$name" + file delete $dir$name + } + } +} 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.133.2.32 -r1.133.2.33 --- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 5 Dec 2013 10:48:39 -0000 1.133.2.32 +++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 31 Dec 2013 16:21:10 -0000 1.133.2.33 @@ -4800,3 +4800,41 @@ set j [ns_job queue $queue $args] return [ns_job wait {*}$timeout $queue $j] } + +# +# Provide a clean way of handling exceptions in mutexed regions +# (between locking and unlocking of an mutex). Should be used probably +# on more places in OpenACS. +# + +if {[ns_info name] eq "NaviServer"} { + ad_proc -public ad_mutex_eval {mutex script} { + + Compatibility proc for handling differences between NaviServer + and AOLserver since AOLserver does not support "ns_mutex + eval". + + @author Gustaf Neumann + + } { + uplevel [list ns_mutex eval $mutex $script] + } +} else { + ad_proc -public ad_mutex_eval {mutex script} { + + Compatibility proc for handling differences between NaviServer + and AOLserver since AOLserver does not support "ns_mutex + eval". + + @author Gustaf Neumann + + } { + ns_mutex lock $mutex + set err [catch {uplevel $script} result] + ns_mutex unlock $mutex + if {$err} { + error $result + } + return $result + } +}