# From configuration # root Directory which files reside in. namespace eval http { # server channel address port # Server process # # content-type filename # Find the MIME content type of a file # # send-file channel filename # Open and send a file. # # respond channel status ?optional # Makes HTTP response with status on channel. Optional is an optional argument with various meanings. # # error-page status # Returns a small error page. variable status_codes \ [dict create \ 200 {OK} \ 301 {Moved Permanently} \ 400 {Bad Request} \ 404 {Not Found} \ ] variable mime_types \ [dict create \ .txt text/plain \ .html text/html \ .css text/css \ {} text/html \ .png image/png \ .jpg image/jpeg \ .ttf font/ttf \ .pdf application/pdf \ .mp3 audio/mpeg \ ] proc server {channel address port} { variable hook_namespace; variable root; ## (1) Handle first line puts "(1)" gets $channel line set request_target [request_target::get $channel $line] ## (2) Get rest of packet. set packet {} while { [gets $channel line] } { puts $line ## Check if field-line is in correct form. ## ^field-name : OWS field-value OWS $ if [expr ![regexp {^[[:alpha:]-]+(:){1}[[:space:]]?[[:print:]]+[[:space:]]?$} $line]] { respond $channel 400 } ## Reject duplicates of the host field. set key [string tolower [string range $line 0 [expr [string first : $line] - 1]]] if [expr ([string compare $key "host"] == 0) && ([lsearch $packet "host"] != -1)] { respond $channel 400 } ## Add to packet dictionary dict append packet \ [string tolower [string range $line 0 [expr [string first : $line] - 1]]] \ [string range $line [expr [string first : $line] + 2] end] } ## Reject packets that have no host field. if {[lsearch [dict keys $packet] "host"] == -1} { respond $channel 400 } ## (3) Find if the file exists, or there is a hooked application. # If file exists, then 200 OK! set filename [string cat $root [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"]]] { respond $channel 200 [string cat $filename "index.html"] } #TODO: Make some filler for this. # If it's one of the targets of the imported namespace, then 200 OK! #elseif [namespace eval $hook_namespace [string cat {lsearch $targets } "$filename"]] { # respond $channel 200 $filename #} ## Otherwise, 404. respond $channel 404 } proc content-type {filename} { variable mime_types; return [dict get $mime_types [file extension $filename]] } # Sends an opened file or cached file. proc send-file {channel filename} { fconfigure $channel -translation binary if [cache::hit $filename] { puts $channel [cache::get $filename] } else { set file [open $filename] fconfigure $file -translation binary fcopy $file $channel close $file } } ## Header ## optional stands for a few different values. ## 200 : Request Target ## 3xx : Location proc respond {channel status {optional {}}} { ## Import Variables variable root; variable status_codes; variable hook_namespace; ## New Variables variable content {}; variable response {}; ## If it's not a status code we know, then error, it's your fault! if [expr [lsearch [dict keys $status_codes] $status] == -1] { error "Invalid status response" } ## (1) Give Status Line append response "HTTP/1.1 $status [dict get $status_codes $status]\n" append response "Server: unknown\n" #append response "Last-Modified: Sun, 14 Apr 2024 01:58:24 GMT\n" append response "Date: [clock format [clock seconds] -format {%a, %d %b %Y %T GMT} -gmt 1]\n" if { $status == 200 } { if [file exists $optional] { append response "Content-Length: [file size $optional]\n" append response "Content-Type: [content-type $optional]\n" append response "\n" puts -nonewline $channel $response send-file $channel $optional } else { #TODO: implement this when have something to implement! set content "Sup mate!" append response "Content-Length: [string bytelength $content]\n" append response "Content-Type: text/html\n" append response "\n" puts -nonewline $channel $response puts -nonewline $channel $content } # give a Last-Modified: field puts -nonewline $channel $response } else { ## Error Page set content [error-page $status] append response "Content-Type: text/html\n" append response "Content-Length: [string bytelength $content]\n" if [expr ($status >= 300) && ($status <= 308) && ([string compare $optional {}] != 0)] { append response "Location: $optional\n" } append response "\n" puts -nonewline $channel $response puts -nonewline $channel $content } close $channel return -level 2 } proc error-page {status {location {}}} { variable status_codes return "