The following code is a version of the [DustMote] web server wrapped in a [Snit] type. It has all the functionality added in the [Tclssg] [https://github.com/tclssg/tclssg/blob/master/lib/tclssg/webserver/webserver.tcl%|%version], namely, * Basic logging (to stdout); * ''Content-Type''; * Custom route handlers. On top of it it adds new features: * Directory listings; * Every server being a Snit object, which means you can have multiple servers running at a time; * Path jailing (albeit not seriously tested for security); * ''Content-Range'' (resumed transfers); * [TLS] support; * Command line options when run as the [main script]; * Server reloading when run as the main script. Known bugs: * Unicode URLs do not work. * Canceled transfers are not logged correctly. You can download this server with [wiki-reaper]: `wiki-reaper -x 41336 0 | tee dustmote-snit.tcl` **Usage (from the command line)** `usage: ./dustmote-snit.tcl -root value ?-host localhost? ?-port 8080? ?-default index.html? ?-verbose 1? ?-dirlists 1? ?-certfile public.pem? ?-keyfile private.pem? ?-tls 0?` You can use the following shell command to generate a set of temporary SSL certificates with [OpenSSL]: `openssl req -x509 -newkey rsa:2048 -nodes -keyout private.pem -out public.pem -subj '/CN=localhost' -days 1` **Code** ====== #!/usr/bin/env tclsh # DustMote HTTP server originally developed by Harold Kaplan # (http://wiki.tcl.tk/4333). Modified by Danyil Bohdan. # This code is in the public domain. package require Tcl 8.5 package require fileutil package require snit 2 package require textutil namespace eval ::dmsnit { variable version 0.8.1 } ::snit::type ::dmsnit::httpd { # Basic web server configuration. option -root \ -default "" \ -configuremethod Set-normalized option -host localhost option -port 8080 option -default "index.html" option -verbose 1 option -dirlists 1 # TLS options. option -certfile \ -default public.pem \ -configuremethod Set-normalized \ -validatemethod File-exists option -keyfile \ -default private.pem \ -configuremethod Set-normalized \ -validatemethod File-exists option -tls \ -default 0 \ -configuremethod Set-tls # The "done" variable. Whoever creates the server object can vwait on this # variable using [vwait [$obj wait-var-name]] until a handler changes it to # signal that the server's work is done. Setting the variable to a true # value does not stop the server. It needs to be explicitly destroyed with # [$obj destroy] for that. variable done 0 # Custom route handlers. variable handlers {} # The command used to create a new server socket. variable socketCommand socket # The server socket channel. Does not itself transfer data but can be closed # to stop accepting new connections. variable socketChannel constructor {} {} destructor { variable socketChannel $self log "shutting down" close $socketChannel } # Private methods. method File-exists {option value} { if { ![file isfile $value] } { error "file \"$value\" used for option $option doesn't exist" } } method Set-normalized {option value} { set options($option) [::fileutil::fullnormalize $value] } method Set-tls {option value} { if { $option ne {-tls} } { error "Set-tls is only for setting the option -tls" } if { $value } { package require tls ::tls::init \ -certfile [$self cget -certfile] \ -keyfile [$self cget -keyfile] \ -ssl2 0 \ -ssl3 0 \ -tls1 1 \ -require 0 \ -request 1 set socketCommand ::tls::socket } else { set socketCommand socket } set options(-tls) $value } # Public methods. # Create a server socket and start accepting connections. method serve {} { variable socketCommand variable socketChannel set root [$self cget -root] set host [$self cget -host] set port [$self cget -port] set tls [$self cget -tls] if { $root eq {} } { error "no root set" } set message "serving path $root on $host port $port" if { $tls } { append message " with TLS" } $self log $message set socketChannel [$socketCommand \ -server "$self answer" \ -myaddr $host $port] } # Print $message to standard output if logging is enabled. method log {message} { variable verbose if { [$self cget -verbose] } { puts $message } } # Handle a new connection. method answer {connectChannel host2 port2} { fileevent $connectChannel readable \ [list $self read-request $connectChannel] } method return-file {connectChannel filename} { set fileSize [file size $filename] set fileChannel [open $filename RDONLY] fconfigure $fileChannel -translation binary fconfigure $connectChannel -translation binary -buffering full set contentLength $fileSize puts $connectChannel {HTTP/1.1 200 OK} puts $connectChannel "Content-Type: [::mime::type $filename]" puts $connectChannel "Content-Length: $contentLength" puts $connectChannel {Accept-Ranges: bytes} puts $connectChannel {} set closeCommand [list $self \ close-channels $fileChannel $connectChannel] fcopy $fileChannel $connectChannel \ -command $closeCommand $self log "200 $filename" } method return-file-range {connectChannel filename firstByte lastByte} { set fileSize [file size $filename] set fileChannel [open $filename RDONLY] fconfigure $fileChannel -translation binary fconfigure $connectChannel -translation binary -buffering full if { $lastByte eq {} } { set lastByte [expr { $fileSize - 1 }] } set contentLength [expr { $lastByte - $firstByte + 1 }] puts $connectChannel {HTTP/1.1 206 Partial Content} puts $connectChannel "Content-Type: [::mime::type $filename]" puts $connectChannel "Content-Length: $contentLength" puts $connectChannel \ "Content-Range: bytes $firstByte-$lastByte/$contentLength" puts $connectChannel {} set closeCommand [list $self \ close-channels $fileChannel $connectChannel] seek $fileChannel $firstByte fcopy $fileChannel $connectChannel \ -size $contentLength \ -command $closeCommand $self log "206 $filename" } method return-404 {connectChannel path} { puts -nonewline $connectChannel [::template::expand { HTTP/1.1 404 Not found Content-Type: text/html