From a61f03cfbf62eb006e6bd845694f18d40101d4e8 Mon Sep 17 00:00:00 2001 From: alekseiplusplus Date: Sat, 29 Jun 2024 20:27:11 +1000 Subject: Added cache --- README | 5 +++++ configure.tcl | 6 ++++++ http-cache.tcl | 35 +++++++++++++++++++++++++++++++++++ http.tcl | 14 ++++++++------ 4 files changed, 54 insertions(+), 6 deletions(-) create mode 100755 http-cache.tcl diff --git a/README b/README index b56a36b..126d1a4 100755 --- a/README +++ b/README @@ -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] + } + +} diff --git a/http.tcl b/http.tcl index 68cb163..307aebf 100755 --- a/http.tcl +++ b/http.tcl @@ -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 -- cgit v1.2.3