Version 10 of Embedded TCL Web Server

Updated 2006-02-11 09:46:25

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 ugly but working solution. (Change ::tls::socket to just socket to remove SSL)

Features:

  • Provides SSL support
  • Does Basic authentication
  • Does nothing else

I hope it'll be useful to someone.


  package require uri
  package require base64
 if 1 { ;# set to 0 if you don't want HTTPS access
  package require tls
  ::tls::init \
    -certfile server-public.pem \
    -keyfile  server-private.pem \
    -ssl2 1 \
    -ssl3 1 \
    -tls1 0 \
    -require 0 \
    -request 0
 }
  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} {
      if {$auth ne [base64::encode "mike:pwd"]} {
        respond $sock 401 Unauthorized "WWW-Authenticate: Basic realm=\"Authenticate\"\n"
        error "Unauthorized from $ip"
      }
    }
    proc handler {sock ip reqstring auth} {
      checkauth $sock $ip $auth
      array set req $reqstring
      switch -glob $req(path) {
        "" {
          respond $sock 200 "Happy times"
        }
        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]} {
        puts "Error: $msg"
      }
      close $sock
    }
  }
  ::tls::socket -server httpd::accept 9005
 #       socket -server httpd::accept 9005
  vwait forever

If this server is running, point your browser to https://localhost:9005/

The switch in proc handler provides a convenient interface for different urls, e.g. add "shutdown" { set ::forever 1 } to add a /shutdown location.

proc checkauth contains the username and password pair (mike:pwd) which can be changed or made into a list for multiple usernames.


Category Application - Category Networking