source: branches/blt4/gui/scripts/bugreport.tcl @ 1651

Last change on this file since 1651 was 1651, checked in by gah, 14 years ago
File size: 15.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    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 "index.php"
264    } else {
265        append url "/index.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    set info $rval(body)
275    http::cleanup $token
276
277    if {[regexp {Ticket #[0-9]* +\(.*?\) +[0-9]+ +times} $info match]} {
278        return $match
279    }
280    error "Report received, but ticket may not have been filed.  Here's the result...\n$info"
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
394set scrollset .bugreport.details.info
395blt::scrollset $scrollset -xscrollbar $scrollset.xs -yscrollbar $scrollset.ys \
396    -window $scrollset.text
397blt::tk::scrollbar $scrollset.xs
398blt::tk::scrollbar $scrollset.ys
399text .bugreport.details.info.text -width 50 -height 15 -wrap none
400pack .bugreport.details.info -expand yes -fill both
401
402# this binding keeps the bugreport window on top
403bind BugReportOnTop <ButtonPress> {
404    wm deiconify %W
405    raise %W
406}
407set btags [bindtags .bugreport]
408bindtags .bugreport [linsert $btags 0 BugReportOnTop]
Note: See TracBrowser for help on using the repository browser.