diff options
| -rwxr-xr-x | README | 5 | ||||
| -rwxr-xr-x | configure.tcl | 6 | ||||
| -rwxr-xr-x | http-cache.tcl | 35 | ||||
| -rwxr-xr-x | http.tcl | 14 |
4 files changed, 54 insertions, 6 deletions
@@ -4,3 +4,8 @@ It has currently only implemented what is necessary to serve GET requests, becau Configuration is performed with the configure.tcl file, the others should not need to be touched. - for now, perhaps later we can do a simple config file - You can configure it to hook into Tcl + +Todo: +- Will create some modules that go along with this + - Textboard + - Text File Display
\ No newline at end of file diff --git a/configure.tcl b/configure.tcl index 717a59d..5691763 100755 --- a/configure.tcl +++ b/configure.tcl @@ -8,6 +8,12 @@ namespace eval http { # A proc 'main' which is what the server will execute to get information. # A list $targets which have all the valid targets. variable hook_namespace {} + + namespace eval cache { + variable precache { + {/fonts/} + } + } } diff --git a/http-cache.tcl b/http-cache.tcl new file mode 100755 index 0000000..25e5f0d --- /dev/null +++ b/http-cache.tcl @@ -0,0 +1,35 @@ +namespace eval cache { + + # Dictionary containing filename and contents pairs. + variable cache {}; + + proc hit {filename} { + variable cache + return [dict exists $cache $filename] + } + + proc get {filename} { + variable cache + return [dict get $cache $filename] + } + + proc add {filename} { + variable cache + set file [open $filename] + fconfigure $file -translation binary + dict append cache $filename [read $file] + } + + proc remove {filename} { + variable cache + if [dict exists $cache $filename] { + set cache [dict remove $cache $filename] + } + } + + #TODO: Pre-cache all precache files. + foreach i $precache { + add [string cat $::http::root $i] + } + +} @@ -103,13 +103,15 @@ namespace eval http { # Sends an opened file or cached file. proc send-file {channel filename} { - #TODO: configure it to try the cache. - #TODO: configure channels to use binary translation if content type is not text/* - set file [open $filename] - fconfigure $file -translation binary fconfigure $channel -translation binary - fcopy $file $channel - close $file + if [cache::hit $filename] { + puts $channel [cache::get $filename] + } else { + set file [open $filename] + fconfigure $file -translation binary + fcopy $file $channel + close $file + } } ## Header |