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

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

updates for video widget code. adding uploadWord to filexfer to match the downloadWord. adding some images.

File size: 12.7 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        uploadWord {
94            if {[Rappture::filexfer::enabled]} {
95                return "Upload"
96            } else {
97                return "Browse"
98            }
99        }
100        download {
101            if {[Rappture::filexfer::enabled]} {
102                return "Download"
103            } else {
104                return "Save As..."
105            }
106        }
107        downloadWord {
108            if {[Rappture::filexfer::enabled]} {
109                return "Download"
110            } else {
111                return "Save"
112            }
113        }
114        default {
115            error "bad option \"$operation\": should be upload, uploadWord, download, or downloadWord"
116        }
117    }
118}
119
120
121# ----------------------------------------------------------------------
122# USAGE: Rappture::filexfer::upload <toolName> <controlList> <callback>
123#
124# Clients use this to prompt the user to upload a file.  The string
125# <toolName> is used to identify the application within the web form.
126# The <controlList> is a list of controls that could be uploaded:
127#
128#   { <id1> <label1> <desc1>  <id2> <label2> <desc2> ... }
129#
130# The user is prompted for each of the controls in <controlList>.
131# If successful, the <callback> is invoked to handle the uploaded
132# information.  If anything goes wrong, the same callback is used
133# to post errors near the widget that invoked this operation.
134# ----------------------------------------------------------------------
135proc Rappture::filexfer::upload {tool controlList callback} {
136    global env
137    variable enabled
138    variable commands
139    variable job
140
141    if {$enabled} {
142        set cmd $commands(import)
143        if {"" != $tool} {
144            lappend cmd --for "for $tool"
145        }
146
147        set dir ~/data/sessions/$env(SESSION)/spool
148        if {![file exists $dir]} {
149            catch {file mkdir $dir}
150        }
151
152        set i 0
153        foreach {path label desc} $controlList {
154            set file [file join $dir upload[pid]-[incr i]]
155            set file2path($file) $path
156            set file2label($file) $label
157            lappend cmd --label $label $file
158        }
159
160        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."]
161
162        set job(output) ""
163        set job(error) ""
164
165        set status [catch {eval \
166            blt::bgexec ::Rappture::filexfer::job(control) \
167              -output ::Rappture::filexfer::job(output) \
168              -error ::Rappture::filexfer::job(error) \
169              $cmd
170        } result]
171
172        if {$status == 0} {
173            set changed ""
174            set errs ""
175            foreach file $job(output) {
176                # load the uploaded for this control
177                set status [catch {
178                    set fid [open $file r]
179                    fconfigure $fid -translation binary -encoding binary
180                    set info [read $fid]
181                    close $fid
182                    file delete -force $file
183                } result]
184
185                if {$status != 0} {
186                    append errs "Error loading data for \"$file2label($file)\":\n$result\n"
187                } else {
188                    lappend changed $file2path($file)
189                    uplevel #0 [list $callback path $file2path($file) data $info]
190                }
191            }
192            if {[llength $changed] == 0} {
193                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."
194            }
195            if {[string length $errs] > 0} {
196                uplevel #0 [list $callback error $errs]
197            }
198        } else {
199            uplevel #0 [list $callback error $job(error)]
200        }
201    } else {
202        #
203        # Filexfer via importfile is disabled.  This tool must be
204        # running in a desktop environment.  Instead of uploading,
205        # perform a "Load File..." operation with a standard file
206        # selection dialog.
207        #
208        set i 0
209        foreach {path label desc} $controlList {
210            set file [tk_getOpenFile -title "Load File: $label"]
211            if {"" != $file} {
212                set cmds {
213                    # try to read first as binary
214                    set fid [open $file r]
215                    fconfigure $fid -encoding binary -translation binary
216                    set info [read $fid]
217                    close $fid
218                    if {![Rappture::encoding::is binary $info]} {
219                        # not binary? then re-read and translate CR/LF
220                        set fid [open $file r]
221                        set info [read $fid]
222                        close $fid
223                    }
224                }
225                if {[catch $cmds err]} {
226                    uplevel #0 [list $callback error "Error loading file [file tail $file]: $err"]
227                } else {
228                    uplevel #0 [list $callback path $path data $info]
229                }
230            }
231        }
232    }
233}
234
235# ----------------------------------------------------------------------
236# USAGE: Rappture::filexfer::download <string> ?<filename>?
237#
238# Clients use this to send a file off to the user.  The <string>
239# is stored in a file called <filename> in the user's spool directory.
240# If there is already a file by that name, then the name is modified
241# to make it unique.  Once the string has been stored in the file,
242# a message is sent to all clients listening, letting them know
243# that the file is available.
244#
245# If anything goes wrong, this function returns a string that should
246# be displayed to the user to explain the problem.
247# ----------------------------------------------------------------------
248proc Rappture::filexfer::download {string {filename "output.txt"}} {
249    global env
250    variable enabled
251    variable commands
252    variable job
253
254    if {$enabled} {
255        # make a spool directory, if we don't have one already
256        set dir ~/data/sessions/$env(SESSION)/spool
257        if {![file exists $dir]} {
258            catch {file mkdir $dir}
259        }
260
261        if {[file exists [file join $dir $filename]]} {
262            #
263            # Find a similar file name that doesn't conflict
264            # with an existing file:  e.g., output2.txt
265            #
266            set root [file rootname $filename]
267            set ext [file extension $filename]
268            set counter 2
269            while {1} {
270                set filename "$root$counter$ext"
271                if {![file exists [file join $dir $filename]]} {
272                    break
273                }
274                incr counter
275            }
276        }
277
278        #
279        # Save the file in the spool directory, then have it
280        # exported.
281        #
282        if {[catch {
283            set file [file join $dir $filename]
284            set fid [open $file w]
285            fconfigure $fid -encoding binary -translation binary
286            puts -nonewline $fid $string
287            close $fid
288        } result]} {
289            return $result
290        }
291
292        set job(output) ""
293        set job(error) ""
294
295        set status [catch {blt::bgexec ::Rappture::filexfer::job(control) \
296            -output ::Rappture::filexfer::job(output) \
297            -error ::Rappture::filexfer::job(error) \
298            $commands(export) --timeout 300 --delete $file} result]
299
300        if {$status != 0} {
301            return $Rappture::filexfer::job(error)
302        }
303    } else {
304        #
305        # Filexfer via exportfile is disabled.  This tool must be
306        # running in a desktop environment.  Instead of downloading,
307        # perform a "Save As..." operation with a standard file
308        # selection dialog.
309        #
310        set file [tk_getSaveFile -title "Save As..." -initialfile $filename]
311        # FIXME: Why is there a grab still pending?
312        set grab [grab current]
313        if { $grab != "" } {
314            grab release $grab
315        }
316        if {"" != $file} {
317            if {[catch {
318                set fid [open $file w]
319                if {[Rappture::encoding::is binary $string]} {
320                    fconfigure $fid -encoding binary -translation binary
321                    puts -nonewline $fid $string
322                } else {
323                    puts $fid $string
324                }
325                close $fid
326            } result]} {
327                return $result
328            }
329        }
330    }
331    return ""
332}
333
334# ----------------------------------------------------------------------
335# USAGE: Rappture::filexfer::webpage <url>
336#
337# Clients use this to pop up a web page for the specified <url> on
338# the user's desktop.  The <url> should start with http:// or https://.
339# If anything goes wrong, this function beeps.
340# ----------------------------------------------------------------------
341proc Rappture::filexfer::webpage {url} {
342    if {[regexp -nocase {^https?://} $url]} {
343        foreach prog {
344              clientaction
345              /apps/bin/clientaction
346              /apps/xvnc/bin/clientaction
347              /usr/lib/mw/bin/clientaction
348              ""
349        } {
350            if {"" != [auto_execok $prog]} {
351                break
352            }
353        }
354        if {"" != $prog} {
355            exec $prog url $url &
356            return
357        }
358    }
359    bell
360}
Note: See TracBrowser for help on using the repository browser.