source: trunk/gui/scripts/bugreport.tcl @ 1252

Last change on this file since 1252 was 1077, checked in by mmc, 16 years ago

Fixed the Rappture::filexfer facility so that if importfile/exportfile
commands are not available, it reverts to local Load/Save? operations.
This is important for applications that are not deployed in a hub, but
used instead in a standard desktop environment.
File size: 15.8 KB
Line 
1# ----------------------------------------------------------------------
2#  UTILITY: bugreport
3#
4#  This redefines the usual Tcl bgerror command to install a nicer
5#  looking bug handler.
6# ======================================================================
7#  AUTHOR:  Michael McLennan, Purdue University
8#  Copyright (c) 2004-2006  Purdue Research Foundation
9#
10#  See the file "license.terms" for information on usage and
11#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12# ======================================================================
13option add *BugReport*banner*foreground white startupFile
14option add *BugReport*banner*background #a9a9a9 startupFile
15option add *BugReport*banner*highlightBackground #a9a9a9 startupFile
16option add *BugReport*banner*font \
17    -*-helvetica-bold-r-normal-*-18-* startupFile
18option add *BugReport*Label.font \
19    -*-helvetica-medium-r-normal-*-12-* startupFile
20option add *BugReport*xmit*wrapLength 3i startupFile
21option add *BugReport*expl.width 50 startupFile
22option add *BugReport*expl.font \
23    -*-helvetica-medium-r-normal-*-12-* startupFile
24option add *BugReport*expl.boldFont \
25    -*-helvetica-bold-r-normal-*-12-* startupFile
26
27namespace eval Rappture::bugreport {
28    # assume that if there's a problem launching a job, we should know it
29    variable reportJobFailures 1
30}
31
32# ----------------------------------------------------------------------
33# USAGE: install
34#
35# Called once in the main program to install this bug reporting
36# facility.  Any unexpected errors after this call will be handled
37# by this mechanism.
38# ----------------------------------------------------------------------
39proc Rappture::bugreport::install {} {
40    proc ::bgerror {err} { ::Rappture::bugreport::activate $err }
41}
42
43# ----------------------------------------------------------------------
44# USAGE: activate <error>
45#
46# Used internally to pop up the bug handler whenver a bug is
47# encountered.  Tells the user that there is a bug and logs the
48# problem, so it can be fixed.
49# ----------------------------------------------------------------------
50proc Rappture::bugreport::activate {err} {
51    global env errorInfo
52
53    if {"@SHOWDETAILS" == $err} {
54        pack forget .bugreport.xmit
55        pack forget .bugreport.ok
56        pack .bugreport.details -after .bugreport.banner \
57            -expand yes -fill both -padx 8 -pady 8
58        focus .bugreport.details.cntls.ok
59        return
60    }
61
62    # always fill in details so we can submit trouble reports later
63    .bugreport.details.info.text configure -state normal
64    .bugreport.details.info.text delete 1.0 end
65    .bugreport.details.info.text insert end "$err\n-----\n$errorInfo"
66    .bugreport.details.info.text configure -state disabled
67
68    if {[shouldReport for oops]} {
69        pack forget .bugreport.details
70        pack forget .bugreport.expl
71        pack .bugreport.ok -side bottom -after .bugreport.banner -pady {0 8}
72        pack .bugreport.xmit -after .bugreport.ok -padx 8 -pady 8
73        focus .bugreport.ok
74        set dosubmit 1
75    } else {
76        pack forget .bugreport.expl
77        pack forget .bugreport.xmit
78        pack forget .bugreport.ok
79        pack .bugreport.details -after .bugreport.banner \
80            -expand yes -fill both -padx 8 -pady 8
81        focus .bugreport.details.cntls.ok
82        set dosubmit 0
83    }
84
85    set w [winfo reqwidth .bugreport]
86    set h [winfo reqheight .bugreport]
87    set x [expr {([winfo screenwidth .bugreport]-$w)/2}]
88    set y [expr {([winfo screenheight .bugreport]-$w)/2}]
89
90    wm geometry .bugreport +$x+$y
91    wm deiconify .bugreport
92    raise .bugreport
93
94    catch {grab set .bugreport}
95    update
96
97    if {$dosubmit} {
98        submit
99    }
100}
101
102# ----------------------------------------------------------------------
103# USAGE: deactivate
104#
105# Used internally to take down the bug handler dialog.
106# ----------------------------------------------------------------------
107proc Rappture::bugreport::deactivate {} {
108    grab release .bugreport
109    wm withdraw .bugreport
110
111    # reset the grab in case it's hosed
112    Rappture::grab::reset
113}
114
115# ----------------------------------------------------------------------
116# USAGE: submit
117#
118# Takes details currently stored in the panel and registers them
119# as a support ticket on the hosting hub site.  Pops up a panel
120# during the process and informs the user of the result.
121# ----------------------------------------------------------------------
122proc Rappture::bugreport::submit {} {
123    set info [.bugreport.details.info.text get 1.0 end]
124
125    pack forget .bugreport.details
126    pack .bugreport.ok -side bottom -after .bugreport.banner -pady {0 8}
127    pack .bugreport.xmit -after .bugreport.ok -padx 8 -pady 8
128    .bugreport.xmit.title configure -text "Sending trouble report to [Rappture::Tool::resources -hubname]..."
129    focus .bugreport.ok
130
131    # send off the trouble report...
132    .bugreport.xmit.icon start
133    set status [catch {register $info} result]
134    .bugreport.xmit.icon stop
135
136    pack forget .bugreport.xmit
137    pack .bugreport.expl -after .bugreport.ok -padx 8 -pady 8
138    .bugreport.expl configure -state normal
139    .bugreport.expl delete 1.0 end
140
141    # handle the result
142    if {$status != 0} {
143        # add error to the details field, so we can see it with magic clicks
144        .bugreport.details.info.text configure -state normal
145        .bugreport.details.info.text insert 1.0 "Ticket submission failed:\n$result\n-----\n"
146        .bugreport.details.info.text configure -state disabled
147
148        .bugreport.expl insert end "This tool encountered an unexpected error.  We tried to submit a trouble report automatically, but that failed.  If you want to report this incident, you can file your own trouble report.  Look for the \"Help\" or \"Support\" links on the main navigation bar of the web site.\n\nIf you continue having trouble with this tool, please close it and launch another session."
149    } elseif {[regexp {Ticket #([0-9]*) +\((.*?)\) +([0-9]+) +times} $result match ticket extra times]} {
150        .bugreport.expl insert end "This tool encountered an unexpected error.  The problem has been reported as " "" "Ticket #$ticket" bold " in our system." ""
151        if {[string is integer $times] && $times > 1} {
152            .bugreport.expl insert end "  This particular problem has been reported $times times."
153        }
154        .bugreport.expl insert end "\n\nIf you continue having trouble with this tool, please close it and launch another session."
155    } else {
156        .bugreport.expl insert end "This tool encountered an unexpected error, and the problem was reported.  Here is the response from the hub, which may contain information about your ticket:\n" "" $result bold "\n\nIf you continue having trouble with this tool, please close it and launch another session." ""
157    }
158    for {set h 1} {$h < 50} {incr h} {
159        .bugreport.expl configure -height $h
160        .bugreport.expl see 1.0
161        update idletasks
162        if {"" != [.bugreport.expl bbox end-1char]} {
163            break
164        }
165    }
166    .bugreport.expl configure -state disabled
167}
168
169# ----------------------------------------------------------------------
170# USAGE: download
171#
172# Used to download the current ticket information to the user's
173# desktop.
174# ----------------------------------------------------------------------
175proc Rappture::bugreport::download {} {
176    set info [.bugreport.details.info.text get 1.0 end]
177    Rappture::filexfer::download $info bugreport.txt
178}
179
180# ----------------------------------------------------------------------
181# USAGE: register <stackTrace>
182#
183# Low-level function used to send bug reports back to the hub site.
184# Error details in the <stackTrace> are posted to a URL that creates
185# a support ticket.  Returns a string of the following form,
186# representing details about the new or existing ticket:
187#   Ticket #XX (XXXXXX) XX times
188# ----------------------------------------------------------------------
189proc Rappture::bugreport::register {stackTrace} {
190    global env tcl_platform
191
192    package require http
193    package require tls
194    http::register https 443 ::tls::socket
195
196    if {![regexp {^([^\n]+)\n} $stackTrace match summary]} {
197        if {[string length $stackTrace] == 0} {
198            set summary "Unexpected error from Rappture"
199        } else {
200            set summary $stackTrace
201        }
202    }
203    if {[string length $summary] > 200} {
204        set summary "[string range $summary 0 200]..."
205    }
206    if {[string match {Problem launching job*} $summary]} {
207        append summary " (in tool \"[Rappture::Tool::resources -appname]\")"
208        set category "Tools"
209    } else {
210        set category "Rappture"
211    }
212
213    # make sure that the stack trace isn't too long
214    set toolong 20000
215    if {[string length $stackTrace] > $toolong} {
216        #
217        # If this came from "Problem launching job", then it will have
218        # a "== RAPPTURE INPUT ==" part somewhere in the middle.  Try
219        # to show the first part, this middle part, and the very last
220        # part, cutting out whatever we have to in the middle.
221        #
222        if {[regexp -indices {\n== RAPPTURE INPUT ==\n} $stackTrace match]} {
223            foreach {smid0 smid1} $match break
224            set quarter [expr {$toolong/4}]
225            set s0 $quarter
226            set smid0 [expr {$smid0-$quarter}]
227            set smid1 [expr {$smid1+$quarter}]
228            set s1 [expr {[string length $stackTrace]-$quarter}]
229
230            if {$smid0 < $s0} {
231                # first part is short -- truncate last part
232                set stackTrace "[string range $stackTrace 0 $smid1]\n...\n[string range $stackTrace [expr {[string length $stackTrace]-($toolong-$smid1)}] end]"
233            } elseif {$smid1 > $s1} {
234                # last part is short -- truncate first part
235                set tailsize [expr {[string length $stackTrace]-$smid0}]
236                set stackTrace "[string range $stackTrace 0 [expr {$toolong-$tailsize}]]\n...\n[string range $stackTrace $smid0 end]"
237            } else {
238                # rappture input line is right about in the middle
239                set stackTrace "[string range $stackTrace 0 $s0]\n...\n[string range $stackTrace $smid0 $smid1]\n...\n[string range $stackTrace $s1 end]"
240            }
241        } else {
242            # no Rappture input -- just show first part and last part
243            set half [expr {$toolong/2}]
244            set stackTrace "[string range $stackTrace 0 $half]\n...\n[string range $stackTrace [expr {[string length $stackTrace]-$half}] end]"
245        }
246    }
247
248    set query [http::formatQuery \
249        option com_support \
250        task create \
251        no_html 1 \
252        report $stackTrace \
253        login $tcl_platform(user) \
254        sesstoken [Rappture::Tool::resources -session] \
255        hostname [info hostname] \
256        category $category \
257        summary $summary \
258        referrer "tool \"[Rappture::Tool::resources -appname]\"" \
259    ]
260   
261    set url [Rappture::Tool::resources -huburl]
262    if {[string index $url end] == "/"} {
263        append url "index2.php"
264    } else {
265        append url "/index2.php"
266    }
267
268    set token [http::geturl $url -query $query -timeout 60000]
269
270    if {[http::ncode $token] != 200} {
271        error [http::code $token]
272    }
273    upvar #0 $token rval
274    if {[regexp {Ticket #[0-9]* +\(.*?\) +[0-9]+ +times} $rval(body) match]} {
275        return $match
276    }
277    error "Report received, but ticket may not have been filed.  Here's the result...\n$rval(body)"
278}
279
280# ----------------------------------------------------------------------
281# USAGE: shouldReport jobfailures <boolean>
282# USAGE: shouldReport for ?oops|jobs?
283#
284# Used internally to determine whether or not this system should
285# automatically report errors back to the hosting hub.  Returns 1
286# if the tool should, and 0 otherwise.  The decision is made based
287# on whether this is a current tool in production, whether it is
288# being tested in a workspace, and whether the tool commonly generates
289# problems (by pilot error in its input deck).
290# ----------------------------------------------------------------------
291proc Rappture::bugreport::shouldReport {option value} {
292    global env
293
294    switch -- $option {
295        jobfailures {
296            variable reportJobFailures
297            if {![string is boolean $value]} {
298                error "bad value \"$value\": should be boolean"
299            }
300            set reportJobFailures $value
301        }
302        for {
303            # is this a tool in production?
304            if {![info exists env(RAPPTURE_VERSION)]
305                  || $env(RAPPTURE_VERSION) != "current"} {
306                return 0
307            }
308
309            # is it being run within a workspace?
310            set appname [Rappture::Tool::resources -appname]
311            if {[string match {[Ww]orkspace*} $appname]} {
312                return 0
313            }
314
315            # if this is a problem launching a job and the tool
316            # expects this, then don't bother with automatic reports.
317            variable reportJobFailures
318            if {"jobs" == $value && !$reportJobFailures} {
319                return 0
320            }
321
322            # this is a real problem -- report it!
323            return 1
324        }
325        default {
326            error "bad option \"$option\": should be jobfailures or for"
327        }
328    }
329}
330
331# ----------------------------------------------------------------------
332# Build the bug reporting dialog
333# ----------------------------------------------------------------------
334toplevel .bugreport -class BugReport -borderwidth 1 -relief solid
335wm overrideredirect .bugreport 1
336wm withdraw .bugreport
337
338frame .bugreport.banner -background #a9a9a9
339pack .bugreport.banner -side top -fill x
340label .bugreport.banner.icon -image [Rappture::icon alert]
341pack .bugreport.banner.icon -side left -padx 2 -pady 2
342label .bugreport.banner.title -text "Oops! Unexpected Error"
343pack .bugreport.banner.title -side left -padx {0 8} -pady 2
344
345# add these frustration bindings in case the "Dismiss" button is off screen
346bind .bugreport.banner.icon <Double-ButtonPress-1> \
347    Rappture::bugreport::deactivate
348bind .bugreport.banner.title <Double-ButtonPress-1> \
349    Rappture::bugreport::deactivate
350
351button .bugreport.ok -text "Dismiss" -command Rappture::bugreport::deactivate
352pack .bugreport.ok -side bottom -pady {0 8}
353
354frame .bugreport.xmit
355Rappture::Animicon .bugreport.xmit.icon -images {
356    circle-ball1 circle-ball2 circle-ball3 circle-ball4
357    circle-ball5 circle-ball6 circle-ball7 circle-ball8
358}
359pack .bugreport.xmit.icon -side left
360label .bugreport.xmit.title -anchor w
361pack .bugreport.xmit.title -side left -expand yes -fill x
362
363text .bugreport.expl -borderwidth 0 -highlightthickness 0 -wrap word
364.bugreport.expl tag configure bold \
365    -font [option get .bugreport.expl boldFont Font]
366
367bind .bugreport.expl <Control-1><Control-1><Control-3><Control-3> {
368    Rappture::bugreport::activate @SHOWDETAILS
369}
370
371bind .bugreport.expl <Control-1><Control-1><Control-Shift-1><Control-Shift-1> {
372    Rappture::bugreport::activate @SHOWDETAILS
373}
374
375frame .bugreport.details
376frame .bugreport.details.cntls
377pack .bugreport.details.cntls -side bottom -fill x
378button .bugreport.details.cntls.ok -text "Dismiss" -command {
379    Rappture::bugreport::deactivate
380}
381pack .bugreport.details.cntls.ok -side right -padx 2 -pady 4
382button .bugreport.details.cntls.send -text "Send Trouble Report" -command {
383    Rappture::bugreport::submit
384}
385pack .bugreport.details.cntls.send -side left -padx 2 -pady 4
386button .bugreport.details.cntls.dload -text "Download" -command {
387    Rappture::bugreport::download
388}
389pack .bugreport.details.cntls.dload -side left -padx 2 -pady 4
390
391Rappture::Scroller .bugreport.details.info -xscrollmode auto -yscrollmode auto
392text .bugreport.details.info.text -width 50 -height 15 -wrap none
393.bugreport.details.info contents .bugreport.details.info.text
394pack .bugreport.details.info -expand yes -fill both
395
396# this binding keeps the bugreport window on top
397bind BugReportOnTop <ButtonPress> {
398    wm deiconify %W
399    raise %W
400}
401set btags [bindtags .bugreport]
402bindtags .bugreport [linsert $btags 0 BugReportOnTop]
Note: See TracBrowser for help on using the repository browser.