'''[http://cloudtk.tcl-lang.org%|%CloudTk]''' is based on [WebSockit2me - WebSocket to TCP gateway for noVNC and a WebSocket Telnet Client built on TclHttpd%|%WebSockit2me], a [TCP] to [WebSocket] gateway that uses [http://novnc.com/info.html%|%noVNC] to display [Tk] applications (X11 apps) 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 [http://cloudtk.tcl-lang.org%|%CloudTk website]. Over 100 Tk Applications listed from this wiki are [https://wiki.tcl-lang.org/search?Q="Below%20is%20an%20online%20demo%20using%20CloudTk"%|%demonstrated here]. All demos are run using Docker Containers. '''Please email [Jeff Smith] with CloudTk in the subject to report any issues.'''

A presentation of [CloudTk] at the 2021 SqLite and Tcl Conference by [Steve Landers] and [Steve Blinkhorn]. Unfortuanately a video of the Conference was never released. Below is the abstract of the presentation.

'''CloudTk - The Holy Grail of Tk Deployment'''

Web browsers are ubiquitous. Many of us would like to see our Tk applications become more ubiquitous. Attempts to deploy Tk through browsers have a 30-year history, from the original Tcl/Tk plugin to Tk-workalike implementations over HTML/CSS/JS. But none has provided the combination of broad browser support and full Tk functionality needed for many real-life applications. Under constant pressure to widen and simplify deployment the authors have long histories of using Starkits for remote deployment but there are limitations with that approach, in particular the need to install software and to traverse firewalls. Now there is a solution that ticks many of the deployment boxes - CloudTk, by Jeff Smith. This supplies, on demand from a common URL, per-user instances of Tcl/Tk applications to a Javascript VNC viewer running in remote browsers. This allows deployment of centrally hosted and managed applications even via restrictive firewalls. We describe CloudTk and its implementation, highlight its use in two commercial applications, and discuss whether this might just be the holy grail of Tk deployment. 

[Jeff Smith] 2023-07-16 : Updated [CloudTk] to include [https://github.com/novnc/noVNC/releases/tag/v1.4.0%|%noVNC 1.4.0].  Changed version numbers to include the noVNC version. New version 1.4.0-51. Many new feature mainly with configuration.

[Jeff Smith] 2020-07-15 : Updated [CloudTk] to include [https://github.com/novnc/noVNC/releases/tag/v1.2.0%|%noVNC 1.2.0]. ('''Please Note''' - You may have to clear your browser cache if an error appears in pages on this wiki which display an online demo using [CloudTk].) Bumped version to 1.0.10.

[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 [http://cloudtk.tcl-lang.org/iotherguis.tml]

[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 [http://cloudtk.tcl-lang.org/iframe.tml] 

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" [https://wiki.tcl.tk/13400] to launch an Xdisplay via Xvnc, the matchbox window manager [https://www.yoctoproject.org/tools-resources/projects/matchbox] and the Tk application.

**** CloudTk.tcl ****
======
# 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

======




**** Xdisplay.tcl ****

======

# 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 add variable ::X${Xdisplay}(XvncClose) {array write} "Xdisplay_Close $Xdisplay Xvnc"
                set ::X${Xdisplay}(TkClose) 0
                trace add variable ::X${Xdisplay}(TkClose) {array write} "Xdisplay_Close $Xdisplay Tk"
                set ::X${Xdisplay}(WmClose) 0
                trace add variable ::X${Xdisplay}(WmClose) {array write} "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 &]
     }
}

======

<<categories>>TclHttpd