CloudTk provides a very neat way to put Tcl/Tk applications on the web. However some adaptation may be needed for such applications to be safe and functional. I recently set up a web version of a Tcl/Tk program I had originally written for local desktop use. I will try to document the changes I had to make. Now my web design skills are rudimentary and I make no claim that these methods are ideal, so if anyone else can contribute improvements please do so.
I wanted my application to be usable by anyone without requiring registration or login. But even the demo TkPool application supplied with CloudTk would demand that I log in to use it. The documentation says that this can be turned off from the auth/AuthTarget.txt file but this did not work for me. As a workaround for this, I started my index.tml file with [source myapp_code.tcl] and in myapp_code.tcl I put
Doc_Dynamic
proc AuthVerifyTcl args {return 1}which disabled the user authentication check. I believe Doc_Dynamic is needed to make sure tclhttpd executes this code each time the page is requested, otherwise it will just cache the generated page.
The original application had Save and Load functions which would write and read files on the user's local disk. In the CloudTk environment this would mean reading/writing on the server's local disk. This could be a security problem, also I wanted users to be able to move their work between the web and the desktop versions of the program. So I decided to reimplement save/load as downloading and uploading of files to/from the user's PC.
Tclhttpd can handle downloading and uploading of files, but there was no obvious way to connect this functionality to the Tcl/Tk application. So I decided to remove the save/load options in the Tcl application, and instead drive them from the web code. For my starting page I created an index.tml containing:
[source myapp_code.tcl] <strong>MyApp Online</strong> <iframe height="50" width="75%" frameborder="0" align="middle" name="topleft" src="/myapp/top?session=$sessionId"></iframe> <iframe height="95%" width="100%" frameborder="0" src="/cloudtk/VNC?session=$sessionId&Tk=MyApp" allowfullscreen></iframe>
This divides the screen into two regions, a narrow one at the top which just displays a title and buttons for Save/Load/etc. and the rest of the screen which displays the CloudTk application. For these two sections to work together they need to share an identifier for the user's session. This is sessionId, which is generated in myapp_code.tcl and passed in to both subwindows. The communication channel is that the handlers for the save/load buttons write commands to the stdin of the Tcl process. The Tcl program is adapted by adding a fileevent on stdin which reads and executes these commands. The CloudTk code launches the Tcl/Tk application using bgexec, and one of the things this does is to create a pipe to the stdin of the application. The code in myapp_code.tcl can identify this pipe from ::Session:${session}(Bgexec,input) .
So the code for the Save button sends a command to the application to write data to a temporary file, waits for that file to appear, then returns it as the result of the http request.
The code for the Load button first returns an upload form which gets displayed in the top area of the screen. A handler for the upload is registered using Upload_Url (which appears to be undocumented apart from its source code), when the file is received this handler sends a command to the application telling it to load the file.
My application does not open any other windows, so I felt the decoration which the matchbox window manager adds for switching windows was redundant. I turned this off by copying the Tk/CloudTk.conf to Tk/MyApp/MyApp.conf and changing the line
state Wm,use_titlebar yes
from yes to no. Actually the desktop version does open another window to display help info, but I replaced this with a button in the top html area to open a help web page.
I had thought perhaps I could do without the window manager, but when I tried not starting it at all, I found that changing the browser window size did not propagate to the application, its window kept a fixed size. Since I want the user to be able to use the application in as big or small a window as suits them, I concluded that I needed to keep running the window manager.
Make sure you define a bgerror handler, you do not want an error in your code to pop up the default Tk error dialog, which will allow J.Random.User to poke around your filesystem if they select the option to Save the error report!
My application is https://cmacleod.me.uk/tartaniser/ , the code I wrote for this follows:
[source tartan_code.tcl] <strong>Tartaniser Online</strong> <iframe height="50" width="75%" frameborder="0" align="middle" name="topleft" src="/tartan/top?session=$sessionId"></iframe> <iframe height="95%" width="100%" frameborder="0" src="/cloudtk/VNC?session=$sessionId&Tk=Tartaniser" allowfullscreen></iframe>
# Tcl code to support running Tartaniser in CloudTk
Doc_Dynamic
set sessionId [Session_Create WsInit 0]
proc AuthVerifyTcl args {return 1}
Direct_Url /tartan
proc /tartan/top session {
set html {
<form action=/none method=post target="topleft">
<input type=submit value="User Guide" formaction="https://chiselapp.com/user/cmacleod/repository/tartaniser/doc/trunk/help.md" formtarget="tartan_help" />
<input type=submit value="Save Design" formaction="/tartanisation/mytartan.tartan" />
<input type=submit value="Load Design" formaction="/tartan/load" />
<input type=submit value="Save Image" formaction="/tartanisation/mytartan.png" />
}
append html "<input type='hidden' name='session' value='$session' /> </form> "
return $html
}
proc write2Tk {session msg} {
set pipe2Tk [set ::Session:${session}(Bgexec,input)]
puts $pipe2Tk $msg
flush $pipe2Tk
}
Url_PrefixInstall /tartanisation tartanisation
proc tartanisation {sock suffix} {
# Find the session id
upvar #0 Httpd$sock data
set session ""
foreach {name value} [Url_DecodeQuery $data(query)] {
if {$name eq "session"} {set session $value; break}
}
if {$session eq ""} {
tailcall reportError $sock "No valid Session ID"
}
# Check type of file to generate
set ext [file extension $suffix]
switch $ext \
.tartan {
set mimetype text/tartan
set cmd save
} .png {
set mimetype image/png
set cmd image
} default {
tailcall reportError $sock "Bad request '$suffix'"
}
# Get the file from tartaniser
set name [string range $session end-7 end]
set filename $name$ext
file delete /tmp/$filename
write2Tk $session "$cmd $name"
while {![file exists /tmp/$filename]} {
if {[incr tries] > 10} {
tailcall reportError $sock "Timed-out waiting for file"
}
after 1000
}
Httpd_AddHeaders $sock Content-Disposition attachment
Httpd_ReturnFile $sock $mimetype /tmp/$filename
}
proc reportError {sock msg} {
Httpd_ReturnData $sock text/html "<strong>$msg</strong>"
}
proc /tartan/load session {
set html {
<form ENCtype=multipart/form-data action=/tartan_loader method=post target="topleft">
<input type=file name='filename' accept='.tartan'/>
<input type=submit value="Load" />
}
append html "<input type='hidden' name='session' value='$session' /> </form> "
return $html
}
package require httpd::upload
Upload_Url /tartan_loader uploads tartan_loader -maxbytes 1000
proc tartan_loader {files data} {
foreach {name value} $files {
if {$name eq "filename"} {set filename $value}
}
foreach {name value} $data {
if {$name eq "session"} {set session $value}
}
write2Tk $session "load $filename"
Redirect_Self "/tartan/top?session=$session"
}
##### Control interface for use in a web page #####
fconfigure stdin -blocking 0 -buffering line
fileevent stdin readable getStdin
proc getStdin {} {
gets stdin line
#puts "TARTANISER READ '$line'"
lassign $line cmd arg1 arg2
#puts "TARTANISER READ cmd='$cmd' arg1='$arg1' arg2='$arg2'"
switch $cmd {
save {
if {[string first / $arg1] < 0} {
set filename /tmp/$arg1.tartan
save_design_to_file $filename.tmp
file rename -force $filename.tmp $filename
} else {
puts stderr "Bad save argument: '$arg1'"
}
}
image {
if {[string first / $arg1] < 0} {
set filename /tmp/$arg1.png
tartan_img write $filename.tmp -format png
file rename -force $filename.tmp $filename
} else {
puts stderr "Bad image argument: '$arg1'"
}
}
load {
load_design_from_file $arg1
}
clear {clear}
default {puts stderr "Not Recognised"}
}
}