diff options
| -rwxr-xr-x | configure.tcl | 92 | ||||
| -rwxr-xr-x | http-cache.tcl | 6 | ||||
| -rwxr-xr-x | http.tcl | 10 | ||||
| -rwxr-xr-x | modules/document-viewer.tcl | 54 | ||||
| -rwxr-xr-x | tcl-httpd | 1 | ||||
| -rw-r--r-- | tcl-httpd.conf | 3 | ||||
| -rwxr-xr-x | test.tcl | 22 |
7 files changed, 166 insertions, 22 deletions
diff --git a/configure.tcl b/configure.tcl index 3c3a426..76fd37e 100755 --- a/configure.tcl +++ b/configure.tcl @@ -3,35 +3,99 @@ namespace eval http { # The directory which files are searched for. variable srv {/home/aleksei/www/files/} - # hook_namespace refers to a user-created namespace. - # It must have some things such as - # 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 { + namespace eval cache { variable precache { {/fonts/} } } namespace eval module { - #variable directory {} + variable targets {}; source modules/template.tcl } } - +proc temp {} { + # Run through and bring in all targets + foreach i [namespace children ::http::module] { + set ::http::module::targets [concat $::http::module::targets $i::targets] + # If there are duplicate elements, then error. + if [expr [llength [lsort -unique $::http::module::targets]] != [llength $::http::module::targets]] { + error "A duplicate target coming from $i." + } + } +} ## Validate configuration variables. ## Especially file exists content ## Especially validate the existence of necessary components in $content -proc validate {} { - # Two types of rules - # The VARIABLE=value - # For instance, SRV=/ and whatnot - # The @ACTION Etc - # For instance, @MODULE and @PRECACHE + +set config [open /etc/tcl-httpd.conf] + + +## Configure the server, whilst verifying options. + +namespace eval temp { + set error_state 0; + set error_message "Invalid lines:"; + set line_number 1; + + + namespace eval verify { + proc srv {s} { + + } + + proc module_path + } + + namespace eval actions { + proc @MODULE {v} { + if [info exists ::http::configure::module_path] { + set path [string cat $::http::configure::module_path $v ".tcl"] + if { [file exists $path] && [file isFile $path] } { + namespace eval [string cat "::http::module::" $v] { + source $path + } + } else { + error "Fatal Error: While trying to import module '$b', file $path' doesn't exist." + } + } else { + error "Fatal Error: Tried to import module '$b' without a module_path" + } + } + + proc @PRECACHE {a b} { + ::http::cache::add $b + } + } + + while {[gets $config line] != -1} { + if [regexp {^[[:lower:]_]+=[[:alnum:][:punct:]]+$} $line] { + set n [string first "=" $line] + set a [string range start [expr n-1]] + set b [string range [expr n+1] end] + # RUN VERIFICATION + namespace eval ::http::configure "variable $a $b" + } elseif [regexp {^@[[:upper:]]+ [[:alnum:][:punct:]]+$} $line] { + set n [string first " " $line] + set a [string range start [expr n-1]] + set b [string range [expr n+1] end] + # PERFORM ACTION + } else { + append error_message " $line_number" + set error_state 1; + } + incr line_number; + } + + if $error_state { + error "ERROR: There were multiple errors in your configuration.\n$error_message" + } } + +## Delete the namespace afterwards. +namespace delete temp; diff --git a/http-cache.tcl b/http-cache.tcl index 25e5f0d..f377770 100755 --- a/http-cache.tcl +++ b/http-cache.tcl @@ -27,9 +27,9 @@ namespace eval cache { } } - #TODO: Pre-cache all precache files. - foreach i $precache { - add [string cat $::http::root $i] + # Process the precache + foreach i $::http::configure::precache { + add [string cat $::http::configure::srv $i] } } @@ -40,8 +40,8 @@ namespace eval http { ] proc server {channel address port} { - variable hook_namespace; - variable srv; + #variable hook_namespace; + #variable srv; ## (1) Handle first line puts "(1)" @@ -51,6 +51,7 @@ namespace eval http { ## (2) Get rest of packet. set packet {} + while { [gets $channel line] } { puts $line ## Check if field-line is in correct form. @@ -80,7 +81,7 @@ namespace eval http { ## (3) Find if the file exists, or there is a hooked application. # If file exists, then 200 OK! - set filename [string cat $srv [request_target::file $request_target]] + set filename [string cat $configure::srv [request_target::file $request_target]] if [expr [file exists $filename] && [file isfile $filename]] { respond $channel 200 $filename } elseif [expr [file exists [string cat $filename "index.html"]] && [file isfile [string cat $filename "index.html"]]] { @@ -121,9 +122,8 @@ namespace eval http { proc respond {channel status {optional {}}} { ## Import Variables - variable srv; variable status_codes; - variable hook_namespace; + ## New Variables variable content {}; variable response {}; diff --git a/modules/document-viewer.tcl b/modules/document-viewer.tcl new file mode 100755 index 0000000..de8f0e7 --- /dev/null +++ b/modules/document-viewer.tcl @@ -0,0 +1,54 @@ +## Note that this code is leftover from the beginning of this project, +## which was originally a CGI document viewer that grew into a HTTP +## server instead, but I plan to implement this as a module. +## This is not at all supposed to be used right now. + +variable directories {articles test-one} + + + +### Content + +proc run {request_target} { + +} + + + + +append http::content [html::start Lame!] + +## If directory is not queried, +if { ([lsearch -exact [dict keys $query] "directory"] eq -1) || ([lsearch -exact $directories [dict get $query directory]] eq -1 )} { + append http::content "Utter failure." + append http::content [html::end] + http::respond + exit +} + +set directory [dict get $query directory] + + + +## If document is not queried, or does not exist in our directory, +set documents [exec ls -Q $directory] +if { ([lsearch -exact [dict keys $query] "document"] eq -1) || ([lsearch -exact $documents [dict get $query document]] eq -1 ) } { + foreach a $documents { + append http::content [html::link $a "?directory=$directory&document=$a"] + } + append http::content [html::end] + http::respond + exit +} + + + +## Open file +set file [open "$directory/[dict get $query document]" r] + +## Output lines +while {[gets $file line] != -1} { + append http::content "$line <br> " +} + +append http::content [html::end] @@ -1,5 +1,6 @@ #!/bin/tclsh + source configure.tcl source http.tcl diff --git a/tcl-httpd.conf b/tcl-httpd.conf new file mode 100644 index 0000000..efd3030 --- /dev/null +++ b/tcl-httpd.conf @@ -0,0 +1,3 @@ +srv=/home/aleksei/www/files/ +@MODULE template +@PRECACHE /style.css diff --git a/test.tcl b/test.tcl new file mode 100755 index 0000000..290994c --- /dev/null +++ b/test.tcl @@ -0,0 +1,22 @@ +#!/bin/tclsh + +set tests { + {exec curl -i http://localhost:8000} + {exec curl -i http://localhost:8000/style.css} + {exec curl -i http://localhost:8000/index.html} +} + +if [expr ($argc == 0)] { + set j 0; + foreach i $tests { + puts "($j) : [string range $i 13 end]" + incr j + } +} elseif [expr ($argc == 1)] { + set a [lindex $argv 0]; + if { ($a >= 0) && ($a < [llength $tests]) } { + puts [eval [lindex $tests $a]] + } else { + puts "Argument not in range." + } +} |