A simple webserver based on DustMote with a few changes.
I'm learning Tcl and thought it would be handy to write something that can handle basic directory structures and serve files via http. Much of this came from DustMote, with a few ideas from scwsd. It doesn't offer any particular features not offered up in other webservers, but I figured I'd upload it here for anyone interested.
No guarantees regarding performance or standards compliance.
# tcliki: a small and basic portable http server # # Inspired by DustMote (wiki.tcl.tk/4333) # and scwsd (wiki.tcl.tk/3900) # # All _necessary_ configuration is in the "Configuration" section # # Written by Wade Nelson ([email protected]) # with heavy reliance on DustMote by Harold Kaplan ## Configuration # sitename : Your website/server's name # docroot : The default document directory. # IMPORTANT: Use "/" or "\\" as directory delimiters, not "\" # defaultdoc : The default document to serve, typically index.html # port : The port for the server to accept connections on # httpVer : HTTP protocol version we use; editing not recommended. array set config { sitename "Unconfigured Webserver" docroot ".\\docroot" defaultdoc "index.html" port 80 httpVer "HTTP/1.0" } ## HTTP/1.0 Codes we use set httpCodes(200) "$config(httpVer) 200 OK" set httpCodes(404) "$config(httpVer) 404 Not Found" ## Initial Configuration # Set file paths from config array to match local filesystem standards. proc preConfig {} { global config set $config(docroot) [file nativename $config(docroot)] set $config(defaultdoc) [file nativename $config(defaultdoc)] } ## Start Service proc startService {} { global config preConfig puts "Staring service on port $config(port)." set runService [socket -server accepting $config(port)] vwait forever } ## Accept Connection # csock: the socket connection from the client # caddr: client IP address # cport: client port number proc accepting {csock caddr cport} { puts "Accepting $csock from $caddr on port $cport." fileevent $csock readable [list handle $csock] } ## Handle Requests # csock: the socket connection from the client proc handle {csock} { global config global httpCodes fconfigure $csock -blocking 0 set dataIn [gets $csock] if { [fblocked $csock] } { return } fileevent $csock readable "" # Gather document requested regexp {/[^ ]*} $dataIn docrequest # Decide document to serve regexp {.$} $docrequest lastchar if { $lastchar eq "/" && [string length $docrequest] == 1 } { # root dir "/" requested, serve defaultdoc set docserve $config(defaultdoc) } else { # root dir "/" not requested, serve requested doc regexp {^/(.*)} $docrequest "" docserve } # Attempt to serve requested doc set docserve [file nativename [file join $config(docroot) $docserve]] if { ![catch {set fileserve [open $docserve r]}] } { # Document found, serve document serveDoc $csock $fileserve return } # Document wasn't found as requested, perhaps client requested # a directory. Attempt to serve client_request/defaultdoc elseif { ![catch {set fileserve [open \ [file nativename [file join $docserve $config(defaultdoc)]]]}] } { # found client_request/defaultdoc if { $lastchar ne "/" } { # redirect client_req_dir to client_req_dir/ # Doing this prevents relative paths in served documents from breaking. puts $csock "$httpCodes(200)" puts $csock "Refresh: 0; url=$docrequest/" } # Serve Document serveDoc $csock $fileserve return } # Document still wasn't found as requested, serve error else { serve404 $csock return } } ## Serve Document # csock : client socket to serve document on # fileserve: $docroot/path/to/document open file to serve proc serveDoc {csock fileserve} { global httpCodes fconfigure $fileserve -translation binary fconfigure $csock -translation binary -buffering full puts $csock "$httpCodes(200)" puts $csock "" fcopy $fileserve $csock -command [list closeConnection $fileserve $csock] } ## Serve 404 Error # csock: client socket to receive 404 proc serve404 {csock} { global config global httpCodes puts $csock "$httpCodes(404)" puts $csock "" puts $csock "<html>" puts $csock "<head><title>$config(sitename) - 404 Error</title></head>" puts $csock "<body>" puts $csock "HTTP Error 404: The document requested is not available" puts $csock "</body>" puts $csock "</html>" close $csock } ## Close Connections # file : local file to close # socket: client socket to close proc closeConnection {file socket args} { close $file close $socket } # Engage! startService
A couple notes:
The script works as-is tested on Tcl 8.5 on Windows. To get it to work under 8.4 on Linux the "else" and "elseif" had to come directly after the } on the preceding statements, so remove the extraneous comments there.
Using "/" and "\\" as delimiters for docroot works under Tcl 8.5 on Windows. To get it work under 8.4 on Linux only the "/" delimiter seems to work properly.