/usr/lib/exmh/html_cache.tcl is in exmh 1:2.8.0-6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | # manage the image file cache.
proc Cache_Init {} {
global cache cachesize WebTk
set max [expr 1024 * 1024 * 2]
catch {set max $cachesize(max)}
catch {unset cachesize}
set cachesize(total) 0
set cachesize(max) $max
CacheMkDir $WebTk(cache)
foreach u [array names cache] {
Cache_SetFile $u $cache($u)
}
}
proc !Cache_Preferences {win} {
global cachesize WebTk imagecachesize
set current 0
catch {set current [expr $cachesize(total) / 1024]}
set max [expr $cachesize(max)/1024]
DialogEntry $win .cache "
Images are cached in two ways.
1) A directory holds data between uses of WebTk. You
can choose the location and the max size of this image cache.
Increasing this parameter increases disk space usage.
The current size is $current Kbytes out of $max Kbytes.
2) In-memory images are retained after you leave a page.
You can control how many images are retained. Increasing
this parameter increases memory use. A setting of zero
minimizes memory use.
" CachePrefOK [list [list Directory $WebTk(cache)] \
[list "Max Kbytes" $max] \
[list "Image Count" $imagecachesize] \
]
}
proc !CachePrefOK {list} {
global cachesize WebTk imagecachesize
array set t $list
set WebTk(cache) $t(Directory)
catch {set cachesize(max) [expr $t(Max\ Kbytes) * 1024]}
catch {set imagecachesize [expr $t(Image\ Count)]}
if {$cachesize(max) < 0} {
set cachesize(max) 0
}
if {$imagecachesize < 0} {
set imagecachesize 0 ;# Enforced when a new page is displayed
}
while {$cachesize(total) > $cachesize(max)} {
CacheDeleteOne
}
CheckPoint
}
proc CachePrefTrace {} {
global cachesize WebTk imagecachesize
if {$cachesize(max) < 0} {
set cachesize(max) 0
}
if {$imagecachesize < 0} {
set imagecachesize 0 ;# Enforced when a new page is displayed
}
while {$cachesize(total) > $cachesize(max)} {
CacheDeleteOne
}
}
proc Cache_Cleanup {} {
global cache
foreach url [array names cache] {
File_Delete $cache($url)
}
}
proc Cache_NewFile {url} {
global cache WebTk
if ![info exists cache($url)] {
set hash 8251
foreach c [split $url {}] {
scan $c %c x
set hash [expr {($hash << 5) ^ $x}]
}
set hash [expr {$hash & 0x7FFFFFFF}]
return [file join $WebTk(cache) [format %x $hash][file extension $url]]
} else {
return $cache($url)
}
}
# If a name is in the cache, but no cache size, then the
# cache has not been fully loaded.
proc Cache_GetFile {url} {
global cache
if [info exists cache($url)] {
return $cache($url)
} else {
return {}
}
}
proc Cache_SetFile {url file} {
global cache cachesize
set old 0
catch {set old $cachesize($file)}
if [catch {
# File may no longer exist
set cachesize($file) [file size $file]
incr cachesize(total) [expr $cachesize($file)-$old]
set cache($url) $file
Exmh_Debug "cache $file $url"
while {$cachesize(total) > $cachesize(max)} {
CacheDeleteOne
}
}] {
catch {unset cachesize($file)}
catch {unset cache($url)}
incr cachesize(total) -$old
if {$cachesize(total) < 0} {
set cachesize(total) 0
}
}
}
proc CacheDeleteOne {} {
global cache cachesize
set urls [array names cache] ;# Random hash
set url [lindex $urls 0]
set file $cache($url)
File_Delete $file
catch {unset cache($url)}
catch {incr cachesize(total) -$cachesize($file)}
catch {unset cachesize($file)}
if {[llength $urls] <= 1} {
set cachesize(total) 0
}
}
proc CacheMkDir {dir} {
file mkdir $dir
}
Cache_Init
|