CloudTk is based on WebSockit2me, a TCP to WebSocket gateway that uses noVNC to display Tk applications in a modern Web Browser. It runs on Linux and requires an Xvnc(TigerVNC) server to be loaded. Tk applications are listed on a web page. TclHttpd dynamically launches an Xdisplay via Xvnc and then starts a matchbox window manager and launches the Tk application.
It runs on Linux x86_64 or arm(Raspberry Pi) with Tcl/Tk version 8.6.
A Starkit is available at the CloudTk website .Some Tk Applications listed from this wiki are demonstrated here . Please email Jeff Smith with CloudTk in the subject to report any issues.
Jeff Smith 2020-06-19 : Updated CloudTk with TLS 1.7.21 statically linked with LibreSSL 3.1.2 (using BAWT) on X86_64 and Raspberry Pi(Arm). Fixed black screen bug introduced in version 0.1.7 on Raspberry Pi. Bumped version to 1.0.01
Jeff Smith 2019-07-28 : Upgraded NoVNC to 1.1.0. Fixed random disconnects. Bumped version to 0.1.7
Jeff Smith 2018-01-05 : Updated the version of noVNC used with CloudTk. Now web pages with iframes get the keyboard focus. Also older versions of Tcl/Tk and other non Tcl/Tk applications like Tkinter and X11 apps (e.g. xclock) run also. To see an example of other gui apps working with CloudTk go to [L1 ]
Jeff Smith 2017-12-16: I have made some changes to the Xdisplay_Reap procedure. Now it works more reliably with inline frame or <iframe> HTML tag. To see an example of CloudTk with iframe go to [L2 ]
Below are the two main files in the custom directory of TclHttpd. CloudTk.tcl controls the websocket to TCP gateway. Xdisplay.tcl uses "Standalone bgexec" [L3 ] to launch an Xdisplay via Xvnc, the matchbox window manager [L4 ] and the Tk application.
# Copyright (c) 2017 Jeff Smith # # See the file "license.terms" of TclHttpd for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # I made a few modifications to the Websocket library to make it work with TclHttpd. # # 1. In the procedure ::websocket::takeover changed the following line from # fconfigure $sock -translation binary -blocking on # to # fconfigure $sock -translation binary -blocking off # # # 2. In the procedure ::websocket::Receiver changed the following line from # binary scan $dta Iu mask # to # binary scan $dta I mask # # Without this change the intial handshake with the VNC or Telnet Server # was intermittent ie. did not connect. # # So make the above modifications and then save the following to # WebSocketTCP-gateway.tcl and drop in the custom directory. # # Setup the AuthUserFile and copy the default webmaster credentials to the file # outside the Starkit. if {![file exists $Config(AuthUserFile)]} { set fd [open $Config(AuthUserFile) w] puts $fd "webmaster:$authdefault(user,webmaster)" close $fd unset fd } # If the user is Upgrading noVNC by creating a noVNC directory outside the Starkit, # remap this new directory via Doc_AddRoot. # # The Config(starkitTop) array variable is defined in the main.tcl file of the # Starkit and is used by the startup scripts of TclHttpd to define certain paths. if {[file isdirectory [file join [file dirname $Config(starkitTop)] noVNC]]} { Doc_AddRoot /kanaka/noVNC [file join [file dirname $Config(starkitTop)] noVNC] } else { Doc_AddRoot /kanaka/noVNC [file join $Config(starkitTop) noVNC-master] } Mtype_Add .svg image/svg+xml Url_AccessInstallPrepend ::cloudtk::AccessHook Url_PrefixInstall /cloudtk [list ::cloudtk::Start /cloudtk] package require websocket namespace eval ::cloudtk { # ensure ::cloudtk namespace exists set ::Config(cloudtkVersion) 0.1.4 } proc ::cloudtk::Start {prefix sock suffix} { upvar #0 Httpd$sock data variable Target set suffix [Url_PathCheck [string trimleft $suffix /]] if {![regexp {.*(/)$} $suffix _ slash]} { set slash "" } if {[info exists ::Session:$suffix]} { upvar #0 Session:$suffix state if { $state(type) == {WsActive} } { Redirect_Self /cloudtk/ } else { return [::cloudtk::Session $sock $suffix] } } set noVNCpath {/kanaka/noVNC/vnc.html?path=cloudtk/$session&resize=remote&autoconnect=true} switch -- $suffix { "VNC" { ::cloudtk::Dynamic $sock $noVNCpath } default { append pagehtml "<p>\n" append pagehtml "Enter the Tk Application you wish to launch.\n<p>\n" append pagehtml "<form action=$data(prefix)/VNC method=POST>\n" append pagehtml "<input type=hidden name=session value=new>\n" append pagehtml "<table>\n" foreach d [glob [file join [file dirname $::Config(starkitTop)] Tk]/*] { set Tkapp [file tail $d] append pagehtml [::html::row $Tkapp "<input type=radio [html::radioValue Tk $Tkapp]>"]\n } # append pagehtml [::html::row "VNC Host" "<input type=text [html::formValue TCPhost]>"]\n # append pagehtml [::html::row "VNC Port" "<input type=text [html::formValue TCPport]>"]\n append pagehtml "</table>\n<p>\n<p>\n" append pagehtml "<input type=submit>\n<p>\n</form>\n" append pagehtml "</body>\n</html>" Httpd_ReturnData $sock text/html "[::mypage::header "Tk Application"] $pagehtml [mypage::footer]" } } } # ::cloudtk::Session -- # This procedure control access to the websocket to TCP gateway via a Session ID # via a Url query parameter. proc ::cloudtk::Session {sock session} { 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 /cloudtk [list ::cloudtk::Gateway $session] # Test the Http headers via data(headerlist) to see if it is a websocket request. set wstest [::websocket::test $sock $sock /cloudtk $data(headerlist) $data(query)] # If ::websocket::test returns 1 it's a valid websocket request so suspend the Http request # in TclHtppd. 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!" } } # ::cloudtk::Gateway -- # 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 ::cloudtk::Gateway {session sock type msg} { upvar #0 Session:$session state # Uncomment the following line to view what's being sent from the client. #puts "Gateway sock=$sock type=$type msg=$msg" # In Tcl Websocket Library in tcllib there was a change in the type of connection label. In # Version 1.3.1 the intial connection type was "request" in Version 1.4 it changed to "connect". # Have kept both incase a different version is used. switch $type { request { set state(type) WsActive return [::cloudtk::SocketTCP $sock $session $state(TCPhost) $state(TCPport)] } connect { set state(type) WsActive return [::cloudtk::SocketTCP $sock $session $state(TCPhost) $state(TCPport)] } close { return } disconnect { Xdisplay_Close $state(Xdisplay) Xvnc close $state(TCPsock) Session_Destroy $session unset ::Httpd$sock unset ::websocket::Server_$sock return } binary { puts -nonewline $state(TCPsock) $msg return } text { return } } } # ::cloudtk::SocketTCP -- # This procedure connect via socket -async to the TCP host port. proc ::cloudtk::SocketTCP {sock session TCPhost TCPport} { upvar #0 Session:$session state set state(TCPsock) [socket -async $TCPhost $TCPport] fconfigure $state(TCPsock) -translation binary -blocking off -buffering none fileevent $state(TCPsock) r [list ::cloudtk::ReceiveTCP $sock $session $state(TCPsock)] } # ::cloudtk::ReceiveTCP -- # This procedure receives data on the TCP socket and then # resends it on the websocket via ::websocket::send proc ::cloudtk::ReceiveTCP {sock session TCPsock} { upvar #0 Session:$session state set error [fconfigure $state(TCPsock) -error] if {$error ne ""} { ::websocket::close $sock } elseif {[eof $state(TCPsock)]} { ::websocket::close $sock } else { ::websocket::send $sock binary [read $state(TCPsock)] } } # ::cloudtk::Auth -- # This procedure is used in the callback of the .tclaccess # files. proc ::cloudtk::Auth {sock realm user pass} { set file [file join $::Config(docRoot) cloudtk .tclaccess] set ::auth${file}(htaccessp,userfile) $::Config(AuthUserFile) # now check the Basic credentials set crypt [AuthGetPass $sock $file $user] set salt [string range $crypt 0 1] set crypt2 [crypt $pass $salt] if {[string compare $crypt $crypt2] != 0} { return 0 ;# Not the right password } else { return 1 } } # ::cloudtk::AccessHook -- # This procedure is used via Url_AccessInstallPrepend to change # the default behaviour of the authentication. It check if the # the url starts with /cloudtk or /kanaka and allows access # based on what is set in the AuthTargetFile.txt file. proc ::cloudtk::AccessHook {sock url} { global Doc upvar #0 Httpd$sock data variable Target if {![string equal [file mtime $Target(AuthTargetFile,file)] $Target(AuthTargetFile,mtime)]} { ::cloudtk::AuthTarget } # Make sure the path doesn't sneak out via .. # This turns the URL suffix into a list of pathname components if {[catch {Url_PathCheck $data(suffix)} data(pathlist)]} { Doc_NotFound $sock return denied } # Figure out the directory corresponding to the domain, taking # into account other document roots. if {[regexp {^(/cloudtk|/kanaka|/favicon.ico|/images)} $url]} { set directory [file join $Doc(root,/) cloudtk] set suffix [Url_PathCheck [string trimleft $data(suffix) /]] if {![regexp {.*(/)$} $suffix _ slash]} { set slash "" } if {$Target(AuthTargetFile,VNC) == 0} { if {[regexp {^(/cloudtk/|/kanaka/noVNC|/favicon.ico|/images/)} $url]} { return ok } elseif {[info exists ::Session:$suffix]} { return ok } } # Look for .tclaccess file in cloudtk directory. # This controls access to cloudtk and kanaka # directories. set cookie [Auth_Check $sock $directory ""] # Finally, check access if {![Auth_Verify $sock $cookie]} { return denied } else { return skip } } elseif {[regexp {^(/debug|/status)} $url]} { return skip } elseif {[regexp {^(/)} $url]} { if {$Target(AuthTargetFile,Website) == 0} { return ok } else { return skip } } else { return skip } } # ::cloudtk::AuthTarget -- # This procedure sets up the Auth Target file and gets its contents # into an array. If the file doesn't exist it sets some defaults. proc ::cloudtk::AuthTarget {} { variable Target set Target(AuthTargetFile,file) [file join [file dirname $::Config(starkitTop)] auth AuthTarget.txt] if {![file exists $Target(AuthTargetFile,file)]} { set fd [open $Target(AuthTargetFile,file) w] puts $fd "VNC 0" puts $fd "Website 0" close $fd unset fd set Target(AuthTargetFile,VNC) "0" set Target(AuthTargetFile,Website) "0" set Target(AuthTargetFile,mtime) [file mtime $Target(AuthTargetFile,file)] } else { set Target(AuthTargetFile,mtime) [file mtime $Target(AuthTargetFile,file)] set fd [open $Target(AuthTargetFile,file) r] while {[gets $fd line] >= 0} { set Target(AuthTargetFile,[lindex $line 0]) "[lindex $line 1]" } close $fd unset fd } } # ::cloudtk::Dynamic --- # This procedure is run when a Host and Port is configured in the form. It checks # to make sure that the previous page was a referer page from same server or # source you configure. # It checks a valid Session ID is created and not a crafted Session ID. # Tests the Host and Port are valid before establishing the WebSocket and # the TCP connection. proc ::cloudtk::Dynamic {sock urlRedirect} { upvar #0 Httpd$sock data set session [Session_Match [Url_DecodeQuery $data(query)] WsInit {} 0] if {$session eq ""} { Httpd_ReturnData $sock text/html "<br><h2><b>Error message = Not a valid Session ID</b></h2>" } else { upvar #0 Session:$session state # Xdisplay_SessionReap 90 WsInit foreach {name value} [Url_DecodeQuery $data(query)] { if {[string match $name session] == 1 } { continue } else { set state($name) $value } } set state(Xdisplay) [Xdisplay_Start 10 $session] set state(TCPhost) 127.0.0.1 set state(TCPport) [expr {5900 + $state(Xdisplay)}] Redirect_Self [subst $urlRedirect] } } # ::cloudtk::TkPool -- # This procedure sets up TkPool in the Tk directory. It copies 2 files # TkStartup.tcl and TkPool.tcl from the TclHttpd's custom directory into # Tk/TkPool direcory of the Starkit. proc ::cloudtk::TkPool {} { set TkPool(dir) [file join [file dirname $::Config(starkitTop)] Tk TkPool] set TkPool(custom,file) [file join $::Config(home) ../custom]/TkPool.tcl.custom set TkPool(custom,start) [file join $::Config(home) ../custom]/TkStartup.tcl.custom set TkPool(Tk,file) $TkPool(dir)/TkPool.tcl set TkPool(Tk,start) $TkPool(dir)/TkStartup.tcl if {![file isdirectory $TkPool(dir)]} { file mkdir $TkPool(dir) file copy -force $TkPool(custom,file) $TkPool(Tk,file) # file copy -force $TkPool(custom,start) $TkPool(Tk,start) set fd [open $TkPool(Tk,start) w] set in [open $TkPool(custom,start) r] set IN [read $in] close $in append IN "source $TkPool(Tk,file)\n" append IN "\}" puts $fd $IN close $fd } else { return } } # Generate the Auth file. ::cloudtk::AuthTarget # Generate TkPool ::cloudtk::TkPool
# Copyright (c) 2017 Jeff Smith # # See the file "license.terms" of TclHttpd for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # package require bgexec # Xdisplay_Start -- # # The purpose of the below procedure is to manage the X display number used # when an Xvnc server is launched. Once the X display is lauched the Tk # application and a Window Manager(if needed) is started that use the same X display. # It also does checks to make sure that it won't use an active X display # otherwise Xvnc won't start. # # Bgexec is used to launch the Xvnc server, Tk application and Window # Manager as a background process. proc Xdisplay_Start {{Xdisplay 1} session} { upvar #0 Session:$session state set Xincr 1 while {$Xincr == 1} { if {[info exists ::X${Xdisplay}] || [file exists /tmp/.X${Xdisplay}-lock] || [file exists /tmp/.X11-unix/X$Xdisplay]} { incr Xdisplay } else { set ::X${Xdisplay}(Session) Session:$session set state(TCPhost) 127.0.0.1 set state(TCPport) [expr {5900 + $Xdisplay}] set ::X${Xdisplay}(Start) [clock seconds] set ::X${Xdisplay}(XvncClose) 0 trace variable ::X${Xdisplay}(XvncClose) aw "Xdisplay_Close $Xdisplay Xvnc" set ::X${Xdisplay}(TkClose) 0 trace variable ::X${Xdisplay}(TkClose) aw "Xdisplay_Close $Xdisplay Tk" set ::X${Xdisplay}(WmClose) 0 trace variable ::X${Xdisplay}(WmClose) aw "Xdisplay_Close $Xdisplay Wm" set ::X${Xdisplay}(XvncPid) [bgexec ::X${Xdisplay}(XvncClose) -killsignal SIGTERM -linebuffered true -onerror "Xdisplay_XvncStart $Xdisplay $session" /usr/bin/Xvnc :$Xdisplay -localhost -desktop $state(Tk) SecurityTypes=None &] set Xincr 0 } } Xdisplay_Reap Xdisplay_SessionReap 90 WsInit return $Xdisplay } # Xdisplay_Close -- # # The purpose of the below procedure is to close all the processes associated # with an X display. This is called once the process dies or we kill it # and a trace variable is triggered. Setting the trace variable will kill # the process under the control of bgexec. proc Xdisplay_Close {Xdisplay type args} { upvar #0 X$Xdisplay Xstate switch $type { Xvnc { set Xstate(TkClose) 1 set Xstate(WmClose) 1 set Xstate(XvncClose) 1 } Tk { set Xstate(WmClose) 1 set Xstate(XvncClose) 1 } Wm { set Xstate(TkClose) 1 set Xstate(XvncClose) 1 } } } # Xdisplay_Reap -- # # The purpose of the procedure below is to clean up any X display variable # that still exist in TclHttpd but no longer have an active X display. This # produre is called after a new X display is started in Xdisplay_Start proc Xdisplay_Reap {} { foreach xd [info globals X*] { upvar #0 $xd Xstate foreach var {Xstate(XvncClose) Xstate(WmClose) Xstate(TkClose)} { if {[info exists $var]} { if {[regexp {^(EXITED|KILLED)} $Xstate(XvncClose)]} { set Xstate(XvncClose) 1 set Xstate(WmClose) 1 set Xstate(TkClose) 1 } } else { set Xstate(XvncClose) 1 set Xstate(WmClose) 1 set Xstate(TkClose) 1 } } if { $Xstate(TkClose) && $Xstate(WmClose) && $Xstate(XvncClose) } { Stderr "Reaping Xdisplay variable $xd" unset Xstate } } } # Destroy all sessions older than a certain age (in seconds) # age: time (in seconds) since the most recent access # type: a regexp to mach session types with (defaults to all) proc Xdisplay_SessionReap {age {type .*}} { foreach id [info globals Session:*] { upvar #0 $id session set old [expr {[clock seconds] - $age}] if {[regexp -- $type $session(type)] && $session(current) < $old} { catch {interp delete $session(interp)} Stderr "Reaping session $id" if { [info exists session(TCPport)] } { set Xdisplay [expr {$session(TCPport) - 5900}] Xdisplay_Close $Xdisplay Xvnc } unset session } } } proc Xdisplay_XvncStart {Xdisplay session data} { upvar #0 Session:$session state # Wait until Xdisplay has started before loading Tk app and Window Manager if {[string match "*Listening for VNC connections on * port *" $data]} { set ::X${Xdisplay}(WmPid) [bgexec ::X${Xdisplay}(WmClose) -killsignal SIGTERM /usr/bin/matchbox-window-manager -display :$Xdisplay &] set ::X${Xdisplay}(TkPid) [bgexec ::X${Xdisplay}(TkClose) -killsignal SIGTERM [info nameofexecutable] [file join [file dirname $::Config(starkitTop)] Tk $state(Tk) TkStartup.tcl] -display :$Xdisplay &] } }