1 | |
---|
2 | # ---------------------------------------------------------------------- |
---|
3 | # COMPONENT: exec - simple way to exec with streaming output |
---|
4 | # |
---|
5 | # This utility makes it easy to exec another tool and get streaming |
---|
6 | # output from stdout and stderr. Any stderr messages are specially |
---|
7 | # encoded with the =RAPPTURE-ERROR=> tag, so they show up in red |
---|
8 | # in the execution output. |
---|
9 | # ====================================================================== |
---|
10 | # AUTHOR: Michael McLennan, Purdue University |
---|
11 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
12 | # |
---|
13 | # See the file "license.terms" for information on usage and |
---|
14 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
15 | # ====================================================================== |
---|
16 | package require BLT |
---|
17 | |
---|
18 | namespace eval Rappture { |
---|
19 | # Forward declaration |
---|
20 | variable execout |
---|
21 | variable execctl |
---|
22 | |
---|
23 | set execout(error) "" |
---|
24 | set execout(output) "" |
---|
25 | set execout(channel) "" |
---|
26 | set execout(extra) "" |
---|
27 | set execctl "" |
---|
28 | } |
---|
29 | |
---|
30 | # ---------------------------------------------------------------------- |
---|
31 | # USAGE: exec <arg> <arg>... |
---|
32 | # |
---|
33 | # This utility acts like the standard Tcl "exec" command, but it also |
---|
34 | # streams stdout and stderr messages while the command is executing, |
---|
35 | # instead of waiting till the end. Any error messages are prefixed |
---|
36 | # with the special =RAPPTURE-ERROR=> tag, so they are recognized as |
---|
37 | # errors within Rappture. |
---|
38 | # ---------------------------------------------------------------------- |
---|
39 | proc Rappture::exec {args} { |
---|
40 | variable execout |
---|
41 | variable execctl |
---|
42 | |
---|
43 | set execout(error) "" |
---|
44 | set execout(output) "" |
---|
45 | set execout(channel) "" |
---|
46 | set execout(extra) "" |
---|
47 | set execctl "" |
---|
48 | |
---|
49 | set status [catch {eval blt::bgexec ::Rappture::execctl \ |
---|
50 | -keepnewline yes \ |
---|
51 | -killsignal SIGTERM \ |
---|
52 | -onoutput {{::Rappture::_exec_out stdout}} \ |
---|
53 | -onerror {{::Rappture::_exec_out stderr}} \ |
---|
54 | $args} result] |
---|
55 | |
---|
56 | # add any extra stuff pending from the last stdout/stderr change |
---|
57 | append execout(output) $execout(extra) |
---|
58 | |
---|
59 | if { $status != 0 } { |
---|
60 | # We're here because the exec-ed program failed |
---|
61 | if { $execctl != "" } { |
---|
62 | foreach { token pid code mesg } $execctl break |
---|
63 | if { $token == "EXITED" } { |
---|
64 | # This means that the program exited normally but |
---|
65 | # returned a non-zero exitcode. Consider this an |
---|
66 | # invalid result from the program. Append the stderr |
---|
67 | # from the program to the message. |
---|
68 | set result \ |
---|
69 | "Program finished: exit code is $code\n\n" |
---|
70 | append result $execout(error) |
---|
71 | } elseif { $token == "abort" } { |
---|
72 | # The user pressed the abort button. |
---|
73 | set result "Program terminated by user.\n\n" |
---|
74 | append result $execout(output) |
---|
75 | } else { |
---|
76 | # Abnormal termination |
---|
77 | set result "Abnormal program termination: $mesg\n\n" |
---|
78 | append result $execout(output) |
---|
79 | } |
---|
80 | } |
---|
81 | puts stderr $result |
---|
82 | error $result |
---|
83 | } |
---|
84 | return $execout(output) |
---|
85 | } |
---|
86 | |
---|
87 | # ---------------------------------------------------------------------- |
---|
88 | # USAGE: _exec_out <channel> <message> |
---|
89 | # |
---|
90 | # Called automatically whenever output comes in from the Rappture::exec |
---|
91 | # utility. Streams the output to stdout and adds it to the "execout" |
---|
92 | # variable, so it can be returned as one large string at the end of |
---|
93 | # the exec. |
---|
94 | # ---------------------------------------------------------------------- |
---|
95 | proc Rappture::_exec_out {channel message} { |
---|
96 | variable execout |
---|
97 | |
---|
98 | # |
---|
99 | # If this message is being written to the stderr channel, then |
---|
100 | # add the =RAPPTURE-ERROR=> prefix to each line. |
---|
101 | # |
---|
102 | if {$channel == "stderr"} { |
---|
103 | append execout(error) $message |
---|
104 | set newmesg "" |
---|
105 | foreach line [split $message \n] { |
---|
106 | append newmesg "=RAPPTURE-ERROR=>$line\n" |
---|
107 | } |
---|
108 | set message $newmesg |
---|
109 | } |
---|
110 | # |
---|
111 | # If this message is coming in on the same channel as the |
---|
112 | # last, then fine, add it on. But if it's coming in on a |
---|
113 | # different channel, we must make sure that we're at a good |
---|
114 | # breakpoint. If there's not a line break at the end of the |
---|
115 | # current output, then add the extra stuff onto a buffer |
---|
116 | # that we will merge in later once we get to a good point. |
---|
117 | # |
---|
118 | if {$execout(channel) == ""} { |
---|
119 | set execout(channel) $channel |
---|
120 | } |
---|
121 | |
---|
122 | set ready [expr {[string length $execout(output)] == 0 |
---|
123 | || [string index $execout(output) end] == "\n"}] |
---|
124 | |
---|
125 | if {$channel != $execout(channel)} { |
---|
126 | if {$ready} { |
---|
127 | # changing channels... |
---|
128 | if {[string length $execout(extra)] > 0} { |
---|
129 | # any extra stuff on this new channel? put it out now |
---|
130 | puts -nonewline $execout(extra) |
---|
131 | append execout(output) $execout(extra) |
---|
132 | set execout(extra) "" |
---|
133 | } |
---|
134 | puts -nonewline $message |
---|
135 | append execout(output) $message |
---|
136 | set execout(channel) $channel |
---|
137 | } else { |
---|
138 | # not ready to change channels -- keep this for later |
---|
139 | append execout(extra) $message |
---|
140 | } |
---|
141 | } else { |
---|
142 | # no need to change channels -- keep printing |
---|
143 | puts -nonewline $message |
---|
144 | append execout(output) $message |
---|
145 | } |
---|
146 | } |
---|