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: * Command line options when run as the [main script]; * 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); * [TLS] support. 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 namespace eval ::dmsnit { variable version 0.5.2 } ::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 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 fileChannel [open $filename RDONLY] fconfigure $fileChannel -translation binary fconfigure $connectChannel -translation binary -buffering full puts $connectChannel "HTTP/1.0 200 OK" puts $connectChannel "Content-Type: [::mime::type $filename]" puts $connectChannel "" fcopy $fileChannel $connectChannel \ -command [list $self close-channels \ $fileChannel $connectChannel] } method return-404 {connectChannel} { puts $connectChannel "HTTP/1.0 404 Not found" puts $connectChannel "Content-Type: text/html" puts $connectChannel "" puts $connectChannel "" puts $connectChannel "