source: trunk/gui/scripts/filexfer.tcl @ 1756

Last change on this file since 1756 was 1756, checked in by dkearney, 11 years ago

adding new path to search for clientaction

File size: 12.6 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: filexfer - support for file transfer with user's desktop
3#
4#  Supports interactions with the filexfer middleware, enabling
5#  Rappture to transfer files to and from the user's desktop.
6#  Files are downloaded by invoking "exportfile", and uploaded by
7#  invoking "importfile".  The middleware handles the rest.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2007  Purdue Research Foundation
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require BLT
16
17namespace eval Rappture { # forward declaration }
18namespace eval Rappture::filexfer {
19    variable enabled 0   ;# set to 1 when middleware is in place
20    variable commands    ;# complete path to exportfile/importfile
21    variable job         ;# used to manage bgexec jobs
22}
23
24# ----------------------------------------------------------------------
25# USAGE: Rappture::filexfer::init
26#
27# Called in the main application to see if the filexfer middleware
28# is installed.  Returns 1 if the middleware is installed, and 0
29# otherwise.
30# ----------------------------------------------------------------------
31proc Rappture::filexfer::init {} {
32    variable enabled
33    variable commands
34
35    #
36    # Look for the exportfile/importfile commands and see if
37    # they appear to be working.  If we have both, then this
38    # is "enabled".
39    #
40    foreach op {export import} {
41        set prog "${op}file"
42        set path [auto_execok $prog]
43        if {"" == $path} {
44            foreach dir {/apps/bin /apps/filexfer/bin} {
45                set p [file join $dir $prog]
46                if {[file executable $p]} {
47                    set path $p
48                    break
49                }
50            }
51        }
52        if {[file executable $path]} {
53            set commands($op) $path
54        } else {
55            return 0
56        }
57    }
58
59    return [set enabled 1]
60}
61
62# ----------------------------------------------------------------------
63# USAGE: Rappture::filexfer::enabled
64#
65# Clients use this to see if the filexfer stuff is up and running.
66# If so, then the GUI will provide "Download..." and other filexfer
67# options.  If not, then Rappture must be running within an
68# environment that doesn't support it.  As a backup, Rappture provides
69# file load/save operations instead.
70# ----------------------------------------------------------------------
71proc Rappture::filexfer::enabled {} {
72    variable enabled
73    return $enabled
74}
75
76# ----------------------------------------------------------------------
77# USAGE: Rappture::filexfer::label upload|download
78#
79# Clients use this to query the proper label for an "upload" or
80# "download" opertion.  These are usually "Upload..." and "Download",
81# but could change to "Load File..." and "Save As..." for applications
82# in desktop mode.
83# ----------------------------------------------------------------------
84proc Rappture::filexfer::label {operation} {
85    switch -- $operation {
86        upload {
87            if {[Rappture::filexfer::enabled]} {
88                return "Upload..."
89            } else {
90                return "Load File..."
91            }
92        }
93        download {
94            if {[Rappture::filexfer::enabled]} {
95                return "Download"
96            } else {
97                return "Save As..."
98            }
99        }
100        downloadWord {
101            if {[Rappture::filexfer::enabled]} {
102                return "Download"
103            } else {
104                return "Save"
105            }
106        }
107        default {
108            error "bad option \"$operation\": should be upload, download, or downloadWord"
109        }
110    }
111}
112
113
114# ----------------------------------------------------------------------
115# USAGE: Rappture::filexfer::upload <toolName> <controlList> <callback>
116#
117# Clients use this to prompt the user to upload a file.  The string
118# <toolName> is used to identify the application within the web form.
119# The <controlList> is a list of controls that could be uploaded:
120#
121#   { <id1> <label1> <desc1>  <id2> <label2> <desc2> ... }
122#
123# The user is prompted for each of the controls in <controlList>.
124# If successful, the <callback> is invoked to handle the uploaded
125# information.  If anything goes wrong, the same callback is used
126# to post errors near the widget that invoked this operation.
127# ----------------------------------------------------------------------
128proc Rappture::filexfer::upload {tool controlList callback} {
129    global env
130    variable enabled
131    variable commands
132    variable job
133
134    if {$enabled} {
135        set cmd $commands(import)
136        if {"" != $tool} {
137            lappend cmd --for "for $tool"
138        }
139
140        set dir ~/data/sessions/$env(SESSION)/spool
141        if {![file exists $dir]} {
142            catch {file mkdir $dir}
143        }
144
145        set i 0
146        foreach {path label desc} $controlList {
147            set file [file join $dir upload[pid]-[incr i]]
148            set file2path($file) $path
149            set file2label($file) $label
150            lappend cmd --label $label $file
151        }
152
153        uplevel #0 [list $callback error "Upload starting...\nA web browser page should pop up on your desktop.  Use that form to handle the upload operation.\n\nIf the upload form doesn't pop up, make sure that you're allowing pop ups from this site.  If it still doesn't pop up, you may be having trouble with the version of Java installed for your browser.  See our Support area for details.\n\nClick anywhere to dismiss this message."]
154
155        set job(output) ""
156        set job(error) ""
157
158        set status [catch {eval \
159            blt::bgexec ::Rappture::filexfer::job(control) \
160              -output ::Rappture::filexfer::job(output) \
161              -error ::Rappture::filexfer::job(error) \
162              $cmd
163        } result]
164
165        if {$status == 0} {
166            set changed ""
167            set errs ""
168            foreach file $job(output) {
169                # load the uploaded for this control
170                set status [catch {
171                    set fid [open $file r]
172                    fconfigure $fid -translation binary -encoding binary
173                    set info [read $fid]
174                    close $fid
175                    file delete -force $file
176                } result]
177
178                if {$status != 0} {
179                    append errs "Error loading data for \"$file2label($file)\":\n$result\n"
180                } else {
181                    lappend changed $file2path($file)
182                    uplevel #0 [list $callback path $file2path($file) data $info]
183                }
184            }
185            if {[llength $changed] == 0} {
186                set errs "The form was empty, so none of your controls were changed.  In order to upload a file, you must select the file name--or enter text into the copy/paste area--before pushing the Upload button."
187            }
188            if {[string length $errs] > 0} {
189                uplevel #0 [list $callback error $errs]
190            }
191        } else {
192            uplevel #0 [list $callback error $job(error)]
193        }
194    } else {
195        #
196        # Filexfer via importfile is disabled.  This tool must be
197        # running in a desktop environment.  Instead of uploading,
198        # perform a "Load File..." operation with a standard file
199        # selection dialog.
200        #
201        set i 0
202        foreach {path label desc} $controlList {
203            set file [tk_getOpenFile -title "Load File: $label"]
204            if {"" != $file} {
205                set cmds {
206                    # try to read first as binary
207                    set fid [open $file r]
208                    fconfigure $fid -encoding binary -translation binary
209                    set info [read $fid]
210                    close $fid
211                    if {![Rappture::encoding::is binary $info]} {
212                        # not binary? then re-read and translate CR/LF
213                        set fid [open $file r]
214                        set info [read $fid]
215                        close $fid
216                    }
217                }
218                if {[catch $cmds err]} {
219                    uplevel #0 [list $callback error "Error loading file [file tail $file]: $err"]
220                } else {
221                    uplevel #0 [list $callback path $path data $info]
222                }
223            }
224        }
225    }
226}
227
228# ----------------------------------------------------------------------
229# USAGE: Rappture::filexfer::download <string> ?<filename>?
230#
231# Clients use this to send a file off to the user.  The <string>
232# is stored in a file called <filename> in the user's spool directory.
233# If there is already a file by that name, then the name is modified
234# to make it unique.  Once the string has been stored in the file,
235# a message is sent to all clients listening, letting them know
236# that the file is available.
237#
238# If anything goes wrong, this function returns a string that should
239# be displayed to the user to explain the problem.
240# ----------------------------------------------------------------------
241proc Rappture::filexfer::download {string {filename "output.txt"}} {
242    global env
243    variable enabled
244    variable commands
245    variable job
246
247    if {$enabled} {
248        # make a spool directory, if we don't have one already
249        set dir ~/data/sessions/$env(SESSION)/spool
250        if {![file exists $dir]} {
251            catch {file mkdir $dir}
252        }
253
254        if {[file exists [file join $dir $filename]]} {
255            #
256            # Find a similar file name that doesn't conflict
257            # with an existing file:  e.g., output2.txt
258            #
259            set root [file rootname $filename]
260            set ext [file extension $filename]
261            set counter 2
262            while {1} {
263                set filename "$root$counter$ext"
264                if {![file exists [file join $dir $filename]]} {
265                    break
266                }
267                incr counter
268            }
269        }
270
271        #
272        # Save the file in the spool directory, then have it
273        # exported.
274        #
275        if {[catch {
276            set file [file join $dir $filename]
277            set fid [open $file w]
278            fconfigure $fid -encoding binary -translation binary
279            puts -nonewline $fid $string
280            close $fid
281        } result]} {
282            return $result
283        }
284
285        set job(output) ""
286        set job(error) ""
287
288        set status [catch {blt::bgexec ::Rappture::filexfer::job(control) \
289            -output ::Rappture::filexfer::job(output) \
290            -error ::Rappture::filexfer::job(error) \
291            $commands(export) --timeout 300 --delete $file} result]
292
293        if {$status != 0} {
294            return $Rappture::filexfer::job(error)
295        }
296    } else {
297        #
298        # Filexfer via exportfile is disabled.  This tool must be
299        # running in a desktop environment.  Instead of downloading,
300        # perform a "Save As..." operation with a standard file
301        # selection dialog.
302        #
303        set file [tk_getSaveFile -title "Save As..." -initialfile $filename]
304        # FIXME: Why is there a grab still pending?
305        set grab [grab current]
306        if { $grab != "" } {
307            grab release $grab
308        }
309        if {"" != $file} {
310            if {[catch {
311                set fid [open $file w]
312                if {[Rappture::encoding::is binary $string]} {
313                    fconfigure $fid -encoding binary -translation binary
314                    puts -nonewline $fid $string
315                } else {
316                    puts $fid $string
317                }
318                close $fid
319            } result]} {
320                return $result
321            }
322        }
323    }
324    return ""
325}
326
327# ----------------------------------------------------------------------
328# USAGE: Rappture::filexfer::webpage <url>
329#
330# Clients use this to pop up a web page for the specified <url> on
331# the user's desktop.  The <url> should start with http:// or https://.
332# If anything goes wrong, this function beeps.
333# ----------------------------------------------------------------------
334proc Rappture::filexfer::webpage {url} {
335    if {[regexp -nocase {^https?://} $url]} {
336        foreach prog {
337              clientaction
338              /apps/bin/clientaction
339              /apps/xvnc/bin/clientaction
340              /usr/lib/mw/bin/clientaction
341              ""
342        } {
343            if {"" != [auto_execok $prog]} {
344                break
345            }
346        }
347        if {"" != $prog} {
348            exec $prog url $url &
349            return
350        }
351    }
352    bell
353}
Note: See TracBrowser for help on using the repository browser.