[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.


***Authentication***


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.

***Save/Load***

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.

***Window Management***

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.

***Code***

My application is https://cmacleod.me.uk/tartaniser/ , the code I wrote for this follows:

****index.tml****


======
[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>

======


****tartan_code.tcl****


======
# 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"
}

======


****Code added to the original application:****


======
##### 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"}
    }
}

======

<<categories>>TclHttpd