Version 1 of Websocket on TclHttpd

Updated 2014-08-08 04:25:59 by JeffSmith

Reading about HTML5 Websocket I noticed there was a Websocket Library in Tcllib. Reading the man page it could be used on existing webservers. Searching the wiki there was no information on using it with TclHttpd so I thought I would give it a try. Below are my efforts. I have created a Starkit with a demo which is available from [L1 ].

It works with the Tclkit 8.5.15 from Roy Keenes site but for some reason does not work with the Tclkit 8.6.1?

Point your browser to http://127.0.0.1:8015/ and click on the Websocket Test link on the home page.

# I made a few modifications to the Websocket library to make it work with Tclhttpd.
#
#       1. In the procedure ::websocket::test changed the following line from
#          [string equal -nocase $v "upgrade"] } {
#          to
#          [string compare -nocase $v "*upgrade*"] } {
#          Most browsers send the header "Connection: Upgrade" but Firefox sends
#          "Connection: keep-alive, Upgrade"
#
#       2. In the procedure ::websocket::takeover changed the following line from
#          fconfigure $sock -translation binary -blocking on
#          to
#          fconfigure $sock -translation binary -blocking off
#
#       So make the above modifications and then save the following to
#       websocket-echo.tcl and drop in the custom directory.
#


Url_PrefixInstall /sample [list ::sample::domain /sample]

        package require websocket

namespace eval ::sample {
         # ensure ::sample namespace exists
}

proc ::sample::domain {prefix sock suffix} {
        upvar #0 Httpd$sock data

# To get started register the socket as a websocket server.

        ::websocket::server $sock

# The callback procedure when a message/data is present.

        ::websocket::live $sock /sample ::sample::Echo

# Test the Http headers via data(headerlist) to see if it is a websocket request.

        set wstest [::websocket::test $sock $sock /sample $data(headerlist) $data(query)]

# If ::websocket::test returns 1 it's a valid websocket request so suspend the Http request
# in TclHttpd. Let the websocket library return the correct Http headers via the
# ::websocket::upgrade and take control.

        if {$wstest == 1} {
            Httpd_Suspend $sock 0
            ::websocket::upgrade $sock
        } else {
            Httpd_ReturnData $sock text/html "Not a valid Websocket connection!"
        }
}


# ::sample::Echo --
#       This procedure is called when the server
#       can read data from the client
#
# Arguments: appended to the callback procedure by the Websocket library.
#       sock    The socket connection to the client
#       type    Type of message either:
#               request (initial connection generated by the websocket library.)
#               close
#               disconnect
#               binary
#               text
#       msg     message or data
#

proc ::sample::Echo {sock type msg} {

# Uncomment the following line to view what's being sent from the client.

#puts "Echo sock=$sock type=$type msg=$msg"


# All we want to do is echo back what was sent (thought I would append
# my own message ;-))

          switch $type {
                request {return }
                close { return }
                disconnect { return }
                binary { return }
                text {
                      ::websocket::send $sock text "$msg on the TclHttpd Web Server"
                }
        }
}