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 [http://www.freewebs.com/headsup/tclhttpd-websocket.kit].
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"
}
}
}
======
<>Enter Category Here