I wanted a trivial web server to embed into my TCL application to show status / provide minor control. Doing this with [Tclhttpd] turned out to be too difficult / cumbersome, so I came up with this. Features: * Provides SSL support * Does Basic authentication * Does nothing else I hope it'll be useful to someone. ---- Time passed, as with any code in active use, it evolved. I've updated the snippet below with the newer version. Please see revision history if you want the simpler but less generic version. ---- package require uri package require base64 package require html proc HTTPD {port certfile keyfile userpwds realm handler} { if {![llength [info commands Log]]} { proc Log {args} { puts $args } } namespace eval httpd [list set handlers $handler] namespace eval httpd [list set realm $realm] foreach up $userpwds { namespace eval httpd [list lappend auths [base64::encode $up]] } namespace eval httpd { proc respond {sock code body {head ""}} { puts -nonewline $sock "HTTP/1.0 $code ???\nContent-Type: text/html; charset=ISO-8859-1\nConnection: close\nContent-length: [string length $body]\n$head\n$body" } proc checkauth {sock ip auth} { variable auths variable realm if {[info exist auths] && [lsearch -exact $auths $auth]==-1} { respond $sock 401 Unauthorized "WWW-Authenticate: Basic realm=\"$realm\"\n" error "Unauthorized from $ip" } } proc handler {sock ip reqstring auth} { variable auths variable handlers checkauth $sock $ip $auth array set req $reqstring switch -glob $req(path) [concat $handlers [list default { respond $sock 404 "Error" }]] } proc accept {sock ip port} { if {[catch { gets $sock line set auth "" for {set c 0} {[gets $sock temp]>=0 && $temp ne "\r" && $temp ne ""} {incr c} { regexp {Authorization: Basic ([^\r\n]+)} $temp -- auth if {$c == 30} { error "Too many lines from $ip" } } if {[eof $sock]} { error "Connection closed from $ip" } foreach {method url version} $line { break } switch -exact $method { GET { handler $sock $ip [uri::split $url] $auth } default { error "Unsupported method '$method' from $ip" } } } msg]} { Log "Error: $msg" } close $sock } } if {$certfile ne ""} { package require tls ::tls::init \ -certfile $certfile \ -keyfile $keyfile \ -ssl2 1 \ -ssl3 1 \ -tls1 0 \ -require 0 \ -request 0 ::tls::socket -server httpd::accept $port } else { socket -server httpd::accept $port } } # Generating SSL key is very easy, just use these two commands: # openssl genrsa -out server-private.pem 1024 # openssl req -new -x509 -key server-private.pem -out server-public.pem -days 365 # Or just don't specify the key files to use HTTP instead of HTTPS # HTTPD 9005 "" "" {mike:pwd} {AuthRealm} { HTTPD 9005 server-public.pem server-private.pem {mike:pwd you:yourpwd} {AuthRealm} { "" { respond $sock 200 {Want to know the time?} } "time" { respond $sock 200 "Time: [clock format [clock seconds]]" "Refresh: 6;URL=/\n" } } vwait forever ---- If this server is running, point your browser to '''https://localhost:9005/''' (or '''http://localhost:9005/''' if not using SSL). The username/pw is "mike"/"pwd" or "you"/"yourpwd". The last argument to HTTPD proc is [switch] syntax (uses glob matching). It provides a convenient interface for different urls, e.g. add "shutdown" { set ::forever 1 } to add a /shutdown location. ---- [JohnBuckman] I wanted to test various web servers, as I was moving off of tclhttpd, which has been a bit pokey in the software I've developed (Lyris ListManager and MailShield) for Magnatune and BookMooch, two other sites I maintain. What I found was that this trivial tcl based web server is screamingly fast. Benchmarks on my mac mini (a VERY slow machine): Requests per second handled with trivial tcl dynamic web page (hello world): - lighttpd-cgi: 15/second - tclhttpd: 32/s - aolserver: between 640/s and 750/s - trivial all-tcl-web-server http://wiki.tcl.tk/15244: 1162/s 900 byte image fetch benchmark: - apache img fetch: 593 /s - aolserver img fetch: between 1019 and 1267/s - lighthttp img fetch: 1089/s - tclhttpd: 69/s - trivial http w/image cache: 1127/s Notice the amazing speeds from the trivial tcl server. Those aren't mistakes, I verified them. I passed these results onto the Lyris folks, and I'm hoping they figure out what's so fab about this algorithm vs. the http loop in tclhttpd. ---- [BAS] Perhaps logging has something to do with it? Was logging enabled for the other web servers? Also, I'm curious what you changed it the code sample to have it serve the images. I found using fcopy (where convenient) is quite a bit faster than [puts $sock ...] ---- [XO] (2006/12/04) - I played around with the script and came up a Snit version of it. # myTrivialTclWeb.tcl - Snit version of Trivial Tcl Web Server package require uri package require base64 package require ncgi package require snit lappend auto_path ./tls proc bgerror {msg} {puts "bgerror: $::errorInfo"} proc respond {sock code body {head ""}} { puts -nonewline $sock "HTTP/1.0 $code ???\nContent-Type: text/html; \ charset=Big-5\nConnection: close\nContent-length: [string length $body]\n$head\n$body" } snit::type HTTPD { option -port "80" option -pki {} option -userpwds {} option -realm {Trivial Tcl Web V2.0} option -handler {default {respond $sock 200 "Invalid uri:$uri"}} variable authList {} variable listeningSocket constructor {args} { $self configurelist $args foreach up $options(-userpwds) {lappend authList [base64::encode $up]} if {$options(-pki) ne {}} { package require tls foreach {certfile keyfile} $options(-pki) {break} tls::init -certfile $certfile -keyfile $keyfile \ -ssl2 1 -ssl3 1 -tls1 0 -require 0 -request 0 set listeningSocket [tls::socket -server [mymethod accept] $options(-port)] } else { set listeningSocket [socket -server [mymethod accept] $options(-port)] } puts "Listening socket: $listeningSocket started on port $options(-port) ..." } destructor { catch {close $listeningSocket} } method authenticate {sock ip auth} { if {[lsearch -exact $authList $auth]==-1} { respond $sock 401 Unauthorized "WWW-Authenticate: Basic realm=\"$options(-realm)\"\n" puts "Unauthorized from $ip" return 0 } else {return 1} } method serve {sock ip uri auth} { if {[llength $authList] ne 0 && [$self authenticate $sock $ip $auth] ne 1} return array set request [uri::split $uri] switch -glob $request(path) $options(-handler) } method accept {sock ip port} { if {[catch { gets $sock line set auth "" for {set c 0} {[gets $sock temp]>=0 && $temp ne "\r" && $temp ne ""} {incr c} { regexp {Authorization: Basic ([^\r\n]+)} $temp -- auth if {$c == 30} {error "Too many lines from $ip"} } if {[eof $sock]} {error "Connection closed from $ip"} foreach {method uri version} $line {break} switch -exact $method { GET {$self serve $sock $ip $uri $auth} default {error "Unsupported method '$method' from $ip"} } } msg]} { puts "Error: $msg" } close $sock } }; # end of snit::type HTTPD # Available variables for actionList # sock - Server socket connecting to Browser # uri - requested uri # request - parsed uri in array format, with the following relevant elements # request(path) # request(query) - query string after path? set actionList { "" { respond $sock 200 {Want to know the time?} } "time" { respond $sock 200 "Time: [clock format [clock seconds]]" "Refresh: 6;URL=/\n" } "*.htm" { set fd [open $request(path) r] set content [read $fd]; close $fd respond $sock 200 $content } "*.tcl" { set ::env(QUERY_STRING) [ncgi::decode $request(query)] set pipe [open "|tclsh $request(path)" r] set result [read $pipe] close $pipe respond $sock 200 $result } "eval" { catch {uplevel #0 [ncgi::decode $request(query)]} result set result [string map {\n
\n} $result] respond $sock 200 $result } "shutdown" { respond $sock 200 "Server will be shutdown in 3 seconds ..." after 3000 {set ::forever no} } default { respond $sock 200 "Invalid uri:$uri" } } # Generating SSL key is very easy, just use these two commands: # openssl genrsa -out server-private.pem 1024 # openssl req -new -x509 -key server-private.pem -out server-public.pem -days 365 # Or just don't specify the -pki option to use HTTP instead of HTTPS HTTPD webServer -port 9005 -userpwds {mike:pwd you:yourpwd} -handler $actionList HTTPD securedWebServer -port 9006 -pki {server-public.pem server-private.pem} \ -userpwds {mike:pwd you:yourpwd} -handler $actionList vwait forever catch {webServer destroy} catch {securedWebServer destroy} ---- [pcam] I receive an error message "application Error" when I point my browser to the base URL that says : unable to set certificate file server-public.pem: No such file or directory unable to set certificate file server-public.pem: No such file or directory while executing "tls::import sock268 -server 1 -certfile server-public.pem -keyfile server-private.pem -ssl2 1 -ssl3 1 -tls1 0 -require 0 -request 0" ("eval" body line 1) invoked from within "eval [list tls::import $chan] $iopts" (procedure "tls::_accept" line 4) invoked from within "tls::_accept {-server 1 -certfile server-public.pem -keyfile server-private.pem -ssl2 1 -ssl3 1 -tls1 0 -require 0 -request 0} httpd::accept sock268 1..." Can anyone tell me how can I create a valid server-public.pem file so that I can run the server with TLS (though I could probably do without it) ? ''Read the code. Embedded in the code is a comment that very clearly states how to do this.'' [pcam] Thanks! I was doing this in a hurry and missed it. ---- [[[Category Application]|[Category Networking]|[Category Webserver]]]