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

Last change on this file since 743 was 743, checked in by mmc, 14 years ago

Added a test so we can simulate jobs that dump core mid-way through.
Also, a few minor tweaks to bug reporting. Now reports Rappture errors
in category "Rappture" and problem-launching-job errors as "Tools".

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