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

Last change on this file since 738 was 733, checked in by mmc, 17 years ago

Fixed long messages (usually resulting from "Problem launching job")
so that they will show as much of the job output (including the tail
end) and as much of the Rappture input as it can. It used to show
the first part of job output and the last part of the Rappture input,
and that wasn't very helpful.
File size: 15.9 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] > 50} {
212        set summary "[string range $summary 0 50]..."
213    }
214    append summary " (in tool \"[Rappture::Tool::resources -appname]\")"
215
216    # make sure that the stack trace isn't too long
217    set toolong 20000
218    if {[string length $stackTrace] > $toolong} {
219        #
220        # If this came from "Problem launching job", then it will have
221        # a "== RAPPTURE INPUT ==" part somewhere in the middle.  Try
222        # to show the first part, this middle part, and the very last
223        # part, cutting out whatever we have to in the middle.
224        #
225        if {[regexp -indices {\n== RAPPTURE INPUT ==\n} $stackTrace match]} {
226            foreach {smid0 smid1} $match break
227            set quarter [expr {$toolong/4}]
228            set s0 $quarter
229            set smid0 [expr {$smid0-$quarter}]
230            set smid1 [expr {$smid1+$quarter}]
231            set s1 [expr {[string length $stackTrace]-$quarter}]
232
233            if {$smid0 < $s0} {
234                # first part is short -- truncate last part
235                set stackTrace "[string range $stackTrace 0 $smid1]\n...\n[string range $stackTrace [expr {[string length $stackTrace]-($toolong-$smid1)}] end]"
236            } elseif {$smid1 > $s1} {
237                # last part is short -- truncate first part
238                set tailsize [expr {[string length $stackTrace]-$smid0}]
239                set stackTrace "[string range $stackTrace 0 [expr {$toolong-$tailsize}]]\n...\n[string range $stackTrace $smid0 end]"
240            } else {
241                # rappture input line is right about in the middle
242                set stackTrace "[string range $stackTrace 0 $s0]\n...\n[string range $stackTrace $smid0 $smid1]\n...\n[string range $stackTrace $s1 end]"
243            }
244        } else {
245            # no Rappture input -- just show first part and last part
246            set half [expr {$toolong/2}]
247            set stackTrace "[string range $stackTrace 0 $half]\n...\n[string range $stackTrace [expr {[string length $stackTrace]-$half}] end]"
248        }
249    }
250
251    set query [http::formatQuery \
252        option com_support \
253        task create \
254        no_html 1 \
255        report $stackTrace \
256        login $tcl_platform(user) \
257        sesstoken [Rappture::Tool::resources -session] \
258        hostname [info hostname] \
259        category rappture \
260        summary $summary \
261        referrer "tool \"[Rappture::Tool::resources -appname]\"" \
262    ]
263   
264    set url [Rappture::Tool::resources -huburl]
265    if {[string index $url end] == "/"} {
266        append url "index2.php"
267    } else {
268        append url "/index2.php"
269    }
270
271    set token [http::geturl $url -query $query -timeout 60000]
272
273    if {[http::ncode $token] != 200} {
274        error [http::code $token]
275    }
276    upvar #0 $token rval
277    if {[regexp {Ticket #[0-9]* +\(.*?\) +[0-9]+ +times} $rval(body) match]} {
278        return $match
279    }
280    error "Report received, but ticket may not have been filed.  Here's the result...\n$rval(body)"
281}
282
283# ----------------------------------------------------------------------
284# USAGE: shouldReport jobfailures <boolean>
285# USAGE: shouldReport for ?oops|jobs?
286#
287# Used internally to determine whether or not this system should
288# automatically report errors back to the hosting hub.  Returns 1
289# if the tool should, and 0 otherwise.  The decision is made based
290# on whether this is a current tool in production, whether it is
291# being tested in a workspace, and whether the tool commonly generates
292# problems (by pilot error in its input deck).
293# ----------------------------------------------------------------------
294proc Rappture::bugreport::shouldReport {option value} {
295    global env
296
297    switch -- $option {
298        jobfailures {
299            variable reportJobFailures
300            if {![string is boolean $value]} {
301                error "bad value \"$value\": should be boolean"
302            }
303            set reportJobFailures $value
304        }
305        for {
306            # is this a tool in production?
307            if {![info exists env(RAPPTURE_VERSION)]
308                  || $env(RAPPTURE_VERSION) != "current"} {
309                return 0
310            }
311
312            # is it being run within a workspace?
313            set appname [Rappture::Tool::resources -appname]
314            if {[string match {[Ww]orkspace*} $appname]} {
315                return 0
316            }
317
318            # if this is a problem launching a job and the tool
319            # expects this, then don't bother with automatic reports.
320            variable reportJobFailures
321            if {"jobs" == $value && !$reportJobFailures} {
322                return 0
323            }
324
325            # this is a real problem -- report it!
326            return 1
327        }
328        default {
329            error "bad option \"$option\": should be jobfailures or for"
330        }
331    }
332}
333
334# ----------------------------------------------------------------------
335# Build the bug reporting dialog
336# ----------------------------------------------------------------------
337toplevel .bugreport -class BugReport -borderwidth 1 -relief solid
338wm overrideredirect .bugreport 1
339wm withdraw .bugreport
340
341frame .bugreport.banner -background #a9a9a9
342pack .bugreport.banner -side top -fill x
343label .bugreport.banner.icon -image [Rappture::icon alert]
344pack .bugreport.banner.icon -side left -padx 2 -pady 2
345label .bugreport.banner.title -text "Oops! Unexpected Error"
346pack .bugreport.banner.title -side left -padx {0 8} -pady 2
347
348# add these frustration bindings in case the "Dismiss" button is off screen
349bind .bugreport.banner.icon <Double-ButtonPress-1> \
350    Rappture::bugreport::deactivate
351bind .bugreport.banner.title <Double-ButtonPress-1> \
352    Rappture::bugreport::deactivate
353
354button .bugreport.ok -text "Dismiss" -command Rappture::bugreport::deactivate
355pack .bugreport.ok -side bottom -pady {0 8}
356
357frame .bugreport.xmit
358Rappture::Animicon .bugreport.xmit.icon -images {
359    circle-ball1 circle-ball2 circle-ball3 circle-ball4
360    circle-ball5 circle-ball6 circle-ball7 circle-ball8
361}
362pack .bugreport.xmit.icon -side left
363label .bugreport.xmit.title -anchor w
364pack .bugreport.xmit.title -side left -expand yes -fill x
365
366text .bugreport.expl -borderwidth 0 -highlightthickness 0 -wrap word
367.bugreport.expl tag configure bold \
368    -font [option get .bugreport.expl boldFont Font]
369
370bind .bugreport.expl <Control-1><Control-1><Control-3><Control-3> {
371    Rappture::bugreport::activate @SHOWDETAILS
372}
373
374bind .bugreport.expl <Control-1><Control-1><Control-Shift-1><Control-Shift-1> {
375    Rappture::bugreport::activate @SHOWDETAILS
376}
377
378frame .bugreport.details
379frame .bugreport.details.cntls
380pack .bugreport.details.cntls -side bottom -fill x
381button .bugreport.details.cntls.ok -text "Dismiss" -command {
382    Rappture::bugreport::deactivate
383}
384pack .bugreport.details.cntls.ok -side right -padx 2 -pady 4
385button .bugreport.details.cntls.send -text "Send Trouble Report" -command {
386    Rappture::bugreport::submit
387}
388pack .bugreport.details.cntls.send -side left -padx 2 -pady 4
389button .bugreport.details.cntls.dload -text "Download" -command {
390    Rappture::bugreport::download
391}
392pack .bugreport.details.cntls.dload -side left -padx 2 -pady 4
393
394Rappture::Scroller .bugreport.details.info -xscrollmode auto -yscrollmode auto
395text .bugreport.details.info.text -width 50 -height 15 -wrap none
396.bugreport.details.info contents .bugreport.details.info.text
397pack .bugreport.details.info -expand yes -fill both
398
399# this binding keeps the bugreport window on top
400bind BugReportOnTop <ButtonPress> {
401    wm deiconify %W
402    raise %W
403}
404set btags [bindtags .bugreport]
405bindtags .bugreport [linsert $btags 0 BugReportOnTop]
Note: See TracBrowser for help on using the repository browser.