1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
2 | # ---------------------------------------------------------------------- |
---|
3 | # COMPONENT: task - represents the executable part of a tool |
---|
4 | # |
---|
5 | # This object is an executable version of a Rappture xml file. |
---|
6 | # A tool is a task plus its graphical user interface. Each task |
---|
7 | # resides in an installation directory with other tool resources |
---|
8 | # (libraries, examples, etc.). Each task is defined by its inputs |
---|
9 | # and outputs, and understands the context in which it executes |
---|
10 | # (via exec, submit, mx, etc.). |
---|
11 | # ====================================================================== |
---|
12 | # AUTHOR: Michael McLennan, Purdue University |
---|
13 | # Copyright (c) 2004-2014 HUBzero Foundation, LLC |
---|
14 | # |
---|
15 | # See the file "license.terms" for information on usage and |
---|
16 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
17 | # ====================================================================== |
---|
18 | package require BLT |
---|
19 | |
---|
20 | itcl::class Rappture::Task { |
---|
21 | public variable logger "" |
---|
22 | public variable jobstats Rappture::Task::MiddlewareTime |
---|
23 | public variable resultdir "@default" |
---|
24 | |
---|
25 | constructor {xmlobj installdir args} { # defined below } |
---|
26 | destructor { # defined below } |
---|
27 | |
---|
28 | public method installdir {} { return $_installdir } |
---|
29 | |
---|
30 | public method run {args} |
---|
31 | public method abort {} |
---|
32 | public method reset {} |
---|
33 | public method xml {args} |
---|
34 | |
---|
35 | protected method _mkdir {dir} |
---|
36 | protected method _output {data} |
---|
37 | protected method _log {args} |
---|
38 | |
---|
39 | private variable _xmlobj "" ;# XML object with inputs/outputs |
---|
40 | private variable _origxml "" ;# copy of original XML (for reset) |
---|
41 | private variable _installdir "" ;# installation directory for this tool |
---|
42 | private variable _outputcb "" ;# callback for tool output |
---|
43 | private common job ;# array var used for blt::bgexec jobs |
---|
44 | private common jobnum 0 ;# counter for unique job number |
---|
45 | |
---|
46 | # get global resources for this tool session |
---|
47 | public proc resources {{option ""}} |
---|
48 | |
---|
49 | public common _resources |
---|
50 | public proc setAppName {name} { set _resources(-appname) $name } |
---|
51 | public proc setHubName {name} { set _resources(-hubname) $name } |
---|
52 | public proc setHubURL {name} { set _resources(-huburl) $name } |
---|
53 | public proc setSession {name} { set _resources(-session) $name } |
---|
54 | public proc setJobPrt {name} { set _resources(-jobprotocol) $name } |
---|
55 | public proc setResultDir {name} { set _resources(-resultdir) $name } |
---|
56 | |
---|
57 | # default method for -jobstats control |
---|
58 | public proc MiddlewareTime {args} |
---|
59 | } |
---|
60 | |
---|
61 | # must use this name -- plugs into Rappture::resources::load |
---|
62 | proc task_init_resources {} { |
---|
63 | Rappture::resources::register \ |
---|
64 | application_name Rappture::Task::setAppName \ |
---|
65 | application_id Rappture::Task::setAppId \ |
---|
66 | hub_name Rappture::Task::setHubName \ |
---|
67 | hub_url Rappture::Task::setHubURL \ |
---|
68 | session_token Rappture::Task::setSession \ |
---|
69 | job_protocol Rappture::Task::setJobPrt \ |
---|
70 | results_directory Rappture::Task::setResultDir |
---|
71 | } |
---|
72 | |
---|
73 | # ---------------------------------------------------------------------- |
---|
74 | # CONSTRUCTOR |
---|
75 | # ---------------------------------------------------------------------- |
---|
76 | itcl::body Rappture::Task::constructor {xmlobj installdir args} { |
---|
77 | if {![Rappture::library isvalid $xmlobj]} { |
---|
78 | error "bad value \"$xmlobj\": should be Rappture::Library" |
---|
79 | } |
---|
80 | set _xmlobj $xmlobj |
---|
81 | |
---|
82 | # stash a copy of the original XML for later "reset" operations |
---|
83 | set _origxml [Rappture::LibraryObj ::#auto "<?xml version=\"1.0\"?><run/>"] |
---|
84 | $_origxml copy "" from $_xmlobj "" |
---|
85 | |
---|
86 | if {![file exists $installdir]} { |
---|
87 | error "directory \"$installdir\" doesn't exist" |
---|
88 | } |
---|
89 | set _installdir $installdir |
---|
90 | |
---|
91 | eval configure $args |
---|
92 | } |
---|
93 | |
---|
94 | # ---------------------------------------------------------------------- |
---|
95 | # DESTRUCTOR |
---|
96 | # ---------------------------------------------------------------------- |
---|
97 | itcl::body Rappture::Task::destructor {} { |
---|
98 | itcl::delete object $_origxml |
---|
99 | } |
---|
100 | |
---|
101 | # ---------------------------------------------------------------------- |
---|
102 | # USAGE: resources ?-option? |
---|
103 | # |
---|
104 | # Clients use this to query information about the tool. |
---|
105 | # ---------------------------------------------------------------------- |
---|
106 | itcl::body Rappture::Task::resources {{option ""}} { |
---|
107 | if {$option == ""} { |
---|
108 | return [array get _resources] |
---|
109 | } |
---|
110 | if {[info exists _resources($option)]} { |
---|
111 | return $_resources($option) |
---|
112 | } |
---|
113 | return "" |
---|
114 | } |
---|
115 | |
---|
116 | # ---------------------------------------------------------------------- |
---|
117 | # USAGE: run ?<path1> <value1> <path2> <value2> ...? ?-output <callbk>? |
---|
118 | # |
---|
119 | # This method causes the tool to run. A "driver.xml" file is created |
---|
120 | # as the input for the run. That file is fed to the executable |
---|
121 | # according to the <tool><command> string, and the job is executed. |
---|
122 | # |
---|
123 | # Any "<path> <value>" arguments are used to override the current |
---|
124 | # settings from the GUI. This is useful, for example, when filling |
---|
125 | # in missing simulation results from the analyzer. |
---|
126 | # |
---|
127 | # If the -output argument is included, then the next arg is a |
---|
128 | # callback command for output messages. Any output that comes in |
---|
129 | # while the tool is running is sent back to the caller, so the user |
---|
130 | # can see progress running the tool. |
---|
131 | # |
---|
132 | # Returns a list of the form {status result}, where status is an |
---|
133 | # integer status code (0=success) and result is the output from the |
---|
134 | # simulator. Successful output is something like {0 run1293921.xml}, |
---|
135 | # where 0=success and run1293921.xml is the name of the file containing |
---|
136 | # results. |
---|
137 | # ---------------------------------------------------------------------- |
---|
138 | itcl::body Rappture::Task::run {args} { |
---|
139 | global env errorInfo |
---|
140 | |
---|
141 | # |
---|
142 | # Make sure that we save the proper application name. |
---|
143 | # Actually, the best place to get this information is |
---|
144 | # straight from the "installtool" script, but just in |
---|
145 | # case we have an older tool, we should insert the |
---|
146 | # tool name from the resources config file. |
---|
147 | # |
---|
148 | if {[info exists _resources(-appname)] |
---|
149 | && $_resources(-appname) ne "" |
---|
150 | && [$_xmlobj get tool.name] eq ""} { |
---|
151 | $_xmlobj put tool.name $_resources(-appname) |
---|
152 | } |
---|
153 | |
---|
154 | # if there are any args, use them to override parameters |
---|
155 | set _outputcb "" |
---|
156 | foreach {path val} $args { |
---|
157 | if {$path == "-output"} { |
---|
158 | set _outputcb $val |
---|
159 | } else { |
---|
160 | $_xmlobj put $path.current $val |
---|
161 | } |
---|
162 | } |
---|
163 | |
---|
164 | foreach item {control output error} { set job($item) "" } |
---|
165 | |
---|
166 | # write out the driver.xml file for the tool |
---|
167 | set file "driver[pid].xml" |
---|
168 | set status [catch { |
---|
169 | set fid [open $file w] |
---|
170 | puts $fid "<?xml version=\"1.0\"?>" |
---|
171 | puts $fid [$_xmlobj xml] |
---|
172 | close $fid |
---|
173 | } result] |
---|
174 | |
---|
175 | # Set limits for cpu time |
---|
176 | set limit [$_xmlobj get tool.limits.cputime] |
---|
177 | if { $limit == "unlimited" } { |
---|
178 | set limit 43200; # 12 hours |
---|
179 | } else { |
---|
180 | if { [scan $limit "%d" dum] != 1 } { |
---|
181 | set limit 14400; # 4 hours by default |
---|
182 | } elseif { $limit > 43200 } { |
---|
183 | set limit 43200; # limit to 12 hrs. |
---|
184 | } elseif { $limit < 10 } { |
---|
185 | set limit 10; # lower bound is 10 seconds. |
---|
186 | } |
---|
187 | } |
---|
188 | Rappture::rlimit set cputime $limit |
---|
189 | # execute the tool using the path from the tool description |
---|
190 | if {$status == 0} { |
---|
191 | set cmd [$_xmlobj get tool.command] |
---|
192 | regsub -all @tool $cmd $_installdir cmd |
---|
193 | regsub -all @driver $cmd $file cmd |
---|
194 | regsub -all {\\} $cmd {\\\\} cmd |
---|
195 | set cmd [string trimleft $cmd " "] |
---|
196 | if { $cmd == "" } { |
---|
197 | puts stderr "cmd is empty" |
---|
198 | return [list 1 "Command is empty.\n\nThere is no command specified by\n\n <command>\n </command>\n\nin the tool.xml file."] |
---|
199 | } |
---|
200 | |
---|
201 | switch -glob -- [resources -jobprotocol] { |
---|
202 | "submit*" { |
---|
203 | # if job_protocol is "submit", then use use submit command |
---|
204 | set cmd "submit --local $cmd" |
---|
205 | } |
---|
206 | "mx" { |
---|
207 | # metachory submission |
---|
208 | set cmd "mx $cmd" |
---|
209 | } |
---|
210 | "exec" { |
---|
211 | # default -- nothing special |
---|
212 | } |
---|
213 | } |
---|
214 | $_xmlobj put tool.execute $cmd |
---|
215 | |
---|
216 | # starting job... |
---|
217 | _log run started |
---|
218 | Rappture::rusage mark |
---|
219 | |
---|
220 | if {0 == [string compare -nocase -length 5 $cmd "ECHO "] } { |
---|
221 | set status 0; |
---|
222 | set job(output) [string range $cmd 5 end] |
---|
223 | } else { |
---|
224 | set status [catch { |
---|
225 | set ::Rappture::Task::job(control) "" |
---|
226 | eval blt::bgexec \ |
---|
227 | ::Rappture::Task::job(control) \ |
---|
228 | -keepnewline yes \ |
---|
229 | -killsignal SIGTERM \ |
---|
230 | -onoutput [list [itcl::code $this _output]] \ |
---|
231 | -output ::Rappture::Task::job(output) \ |
---|
232 | -error ::Rappture::Task::job(error) \ |
---|
233 | $cmd |
---|
234 | } result] |
---|
235 | |
---|
236 | if { $status != 0 } { |
---|
237 | # We're here because the exec-ed program failed |
---|
238 | set logmesg $result |
---|
239 | if { $::Rappture::Task::job(control) ne "" } { |
---|
240 | foreach { token pid code mesg } \ |
---|
241 | $::Rappture::Task::job(control) break |
---|
242 | if { $token == "EXITED" } { |
---|
243 | # This means that the program exited normally but |
---|
244 | # returned a non-zero exitcode. Consider this an |
---|
245 | # invalid result from the program. Append the stderr |
---|
246 | # from the program to the message. |
---|
247 | set logmesg "Program finished: exit code is $code" |
---|
248 | set result "$logmesg\n\n$::Rappture::Task::job(error)" |
---|
249 | } elseif { $token == "abort" } { |
---|
250 | # The user pressed the abort button. |
---|
251 | set logmesg "Program terminated by user." |
---|
252 | set result "$logmesg\n\n$::Rappture::Task::job(output)" |
---|
253 | } else { |
---|
254 | # Abnormal termination |
---|
255 | set logmesg "Abnormal program termination: $mesg" |
---|
256 | set result "$logmesg\n\n$::Rappture::Task::job(output)" |
---|
257 | } |
---|
258 | } |
---|
259 | _log run failed [list $logmesg] |
---|
260 | return [list $status $result] |
---|
261 | } |
---|
262 | } |
---|
263 | # ...job is finished |
---|
264 | array set times [Rappture::rusage measure] |
---|
265 | |
---|
266 | if {[resources -jobprotocol] ne "submit"} { |
---|
267 | set id [$_xmlobj get tool.id] |
---|
268 | set vers [$_xmlobj get tool.version.application.revision] |
---|
269 | set simulation simulation |
---|
270 | if { $id ne "" && $vers ne "" } { |
---|
271 | set pid [pid] |
---|
272 | set simulation ${pid}_${id}_r${vers} |
---|
273 | } |
---|
274 | |
---|
275 | # need to save job info? then invoke the callback |
---|
276 | if {[string length $jobstats] > 0} { |
---|
277 | uplevel #0 $jobstats [list job [incr jobnum] \ |
---|
278 | event $simulation start $times(start) \ |
---|
279 | walltime $times(walltime) cputime $times(cputime) \ |
---|
280 | status $status] |
---|
281 | } |
---|
282 | |
---|
283 | # |
---|
284 | # Scan through stderr channel and look for statements that |
---|
285 | # represent grid jobs that were executed. The statements |
---|
286 | # look like this: |
---|
287 | # |
---|
288 | # MiddlewareTime: job=1 event=simulation start=3.001094 ... |
---|
289 | # |
---|
290 | set subjobs 0 |
---|
291 | while {[regexp -indices {(^|\n)MiddlewareTime:( +[a-z]+=[^ \n]+)+(\n|$)} $job(error) match]} { |
---|
292 | foreach {p0 p1} $match break |
---|
293 | if {[string index $job(error) $p0] == "\n"} { incr p0 } |
---|
294 | |
---|
295 | catch {unset data} |
---|
296 | array set data { |
---|
297 | job 1 |
---|
298 | event simulation |
---|
299 | start 0 |
---|
300 | walltime 0 |
---|
301 | cputime 0 |
---|
302 | status 0 |
---|
303 | } |
---|
304 | foreach arg [lrange [string range $job(error) $p0 $p1] 1 end] { |
---|
305 | foreach {key val} [split $arg =] break |
---|
306 | set data($key) $val |
---|
307 | } |
---|
308 | set data(job) [expr {$jobnum+$data(job)}] |
---|
309 | set data(event) "subsimulation" |
---|
310 | set data(start) [expr {$times(start)+$data(start)}] |
---|
311 | |
---|
312 | set details "" |
---|
313 | foreach key {job event start walltime cputime status} { |
---|
314 | # add required keys in a particular order |
---|
315 | lappend details $key $data($key) |
---|
316 | unset data($key) |
---|
317 | } |
---|
318 | foreach key [array names data] { |
---|
319 | # add anything else that the client gave -- venue, etc. |
---|
320 | lappend details $key $data($key) |
---|
321 | } |
---|
322 | |
---|
323 | if {[string length $jobstats] > 0} { |
---|
324 | uplevel #0 $jobstats $details |
---|
325 | } |
---|
326 | |
---|
327 | incr subjobs |
---|
328 | |
---|
329 | # done -- remove this statement |
---|
330 | set job(error) [string replace $job(error) $p0 $p1] |
---|
331 | } |
---|
332 | incr jobnum $subjobs |
---|
333 | } |
---|
334 | |
---|
335 | } else { |
---|
336 | set job(error) "$result\n$errorInfo" |
---|
337 | } |
---|
338 | if {$status == 0} { |
---|
339 | file delete -force -- $file |
---|
340 | } |
---|
341 | |
---|
342 | # see if the job was aborted |
---|
343 | if {[regexp {^KILLED} $job(control)]} { |
---|
344 | _log run aborted |
---|
345 | return [list 0 "ABORT"] |
---|
346 | } |
---|
347 | |
---|
348 | # |
---|
349 | # If successful, return the output, which should include |
---|
350 | # a reference to the run.xml file containing results. |
---|
351 | # |
---|
352 | if {$status == 0} { |
---|
353 | set result [string trim $job(output)] |
---|
354 | if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} { |
---|
355 | set status [catch {Rappture::library $file} result] |
---|
356 | if {$status == 0} { |
---|
357 | # add cputime info to run.xml file |
---|
358 | $result put output.walltime $times(walltime) |
---|
359 | $result put output.cputime $times(cputime) |
---|
360 | if {[info exists env(SESSION)]} { |
---|
361 | $result put output.session $env(SESSION) |
---|
362 | } |
---|
363 | } else { |
---|
364 | global errorInfo |
---|
365 | set result "$result\n$errorInfo" |
---|
366 | } |
---|
367 | |
---|
368 | # if there's a results_directory defined in the resources |
---|
369 | # file, then move the run.xml file there for storage |
---|
370 | set rdir "" |
---|
371 | if {$resultdir eq "@default"} { |
---|
372 | if {[info exists _resources(-resultdir)]} { |
---|
373 | set rdir $_resources(-resultdir) |
---|
374 | } else { |
---|
375 | set rdir "." |
---|
376 | } |
---|
377 | } elseif {$resultdir ne ""} { |
---|
378 | set rdir $resultdir |
---|
379 | } |
---|
380 | |
---|
381 | if {$status == 0 && $rdir ne ""} { |
---|
382 | catch { |
---|
383 | file delete -force -- $file |
---|
384 | if {![file exists $rdir]} { |
---|
385 | _mkdir $rdir |
---|
386 | } |
---|
387 | set tail [file tail $file] |
---|
388 | set fid [open [file join $rdir $tail] w] |
---|
389 | puts $fid "<?xml version=\"1.0\"?>" |
---|
390 | puts $fid [$result xml] |
---|
391 | close $fid |
---|
392 | } |
---|
393 | } else { |
---|
394 | # don't keep the file |
---|
395 | file delete -force -- $file |
---|
396 | } |
---|
397 | } else { |
---|
398 | set status 1 |
---|
399 | set result "Can't find result file in output.\nDid you call Rappture |
---|
400 | ::result in your simulator?" |
---|
401 | } |
---|
402 | } elseif {$job(output) ne "" || $job(error) ne ""} { |
---|
403 | set result [string trim "$job(output)\n$job(error)"] |
---|
404 | } |
---|
405 | |
---|
406 | # log final status for the run |
---|
407 | if {$status == 0} { |
---|
408 | _log run finished |
---|
409 | } else { |
---|
410 | _log run failed [list $result] |
---|
411 | } |
---|
412 | |
---|
413 | return [list $status $result] |
---|
414 | } |
---|
415 | |
---|
416 | # ---------------------------------------------------------------------- |
---|
417 | # USAGE: _mkdir <directory> |
---|
418 | # |
---|
419 | # Used internally to create the <directory> in the file system. |
---|
420 | # The parent directory is also created, as needed. |
---|
421 | # ---------------------------------------------------------------------- |
---|
422 | itcl::body Rappture::Task::_mkdir {dir} { |
---|
423 | set parent [file dirname $dir] |
---|
424 | if {$parent ne "." && $parent ne "/"} { |
---|
425 | if {![file exists $parent]} { |
---|
426 | _mkdir $parent |
---|
427 | } |
---|
428 | } |
---|
429 | file mkdir $dir |
---|
430 | } |
---|
431 | |
---|
432 | |
---|
433 | # ---------------------------------------------------------------------- |
---|
434 | # USAGE: abort |
---|
435 | # |
---|
436 | # Clients use this during a "run" to abort the current job. |
---|
437 | # Kills the job and forces the "run" method to return. |
---|
438 | # ---------------------------------------------------------------------- |
---|
439 | itcl::body Rappture::Task::abort {} { |
---|
440 | _log run abort |
---|
441 | set job(control) "abort" |
---|
442 | } |
---|
443 | |
---|
444 | # ---------------------------------------------------------------------- |
---|
445 | # USAGE: reset |
---|
446 | # |
---|
447 | # Resets all input values to their defaults. Sometimes used just |
---|
448 | # before a run to reset to a clean state. |
---|
449 | # ---------------------------------------------------------------------- |
---|
450 | itcl::body Rappture::Task::reset {} { |
---|
451 | $_xmlobj copy "" from $_origxml "" |
---|
452 | foreach path [Rappture::entities -as path $_xmlobj input] { |
---|
453 | if {[$_xmlobj element -as type $path.default] ne ""} { |
---|
454 | set defval [$_xmlobj get $path.default] |
---|
455 | $_xmlobj put $path.current $defval |
---|
456 | } |
---|
457 | } |
---|
458 | } |
---|
459 | |
---|
460 | # ---------------------------------------------------------------------- |
---|
461 | # USAGE: xml <subcommand> ?<arg> <arg> ...? |
---|
462 | # USAGE: xml object |
---|
463 | # |
---|
464 | # Used by clients to manipulate the underlying XML data for this |
---|
465 | # tool. The <subcommand> can be any operation supported by a |
---|
466 | # Rappture::library object. Clients can also request the XML object |
---|
467 | # directly by using the "object" subcommand. |
---|
468 | # ---------------------------------------------------------------------- |
---|
469 | itcl::body Rappture::Task::xml {args} { |
---|
470 | if {"object" == $args} { |
---|
471 | return $_xmlobj |
---|
472 | } |
---|
473 | return [eval $_xmlobj $args] |
---|
474 | } |
---|
475 | |
---|
476 | # ---------------------------------------------------------------------- |
---|
477 | # USAGE: _output <data> |
---|
478 | # |
---|
479 | # Used internally to send each bit of output <data> coming from the |
---|
480 | # tool onto the caller, so the user can see progress. |
---|
481 | # ---------------------------------------------------------------------- |
---|
482 | itcl::body Rappture::Task::_output {data} { |
---|
483 | if {[string length $_outputcb] > 0} { |
---|
484 | uplevel #0 $_outputcb [list $data] |
---|
485 | } |
---|
486 | } |
---|
487 | |
---|
488 | # ---------------------------------------------------------------------- |
---|
489 | # USAGE: _log <cmd> <arg> <arg> ... |
---|
490 | # |
---|
491 | # Used internally to log interesting events during the run. If the |
---|
492 | # -logger option is set (to Rappture::Logger::log, or something like |
---|
493 | # that), then the arguments to this method are passed along to the |
---|
494 | # logger and written out to a log file. Logging is off by default, |
---|
495 | # so this method does nothing unless -logger is set. |
---|
496 | # ---------------------------------------------------------------------- |
---|
497 | itcl::body Rappture::Task::_log {args} { |
---|
498 | if {[string length $logger] > 0} { |
---|
499 | uplevel #0 $logger [list $args] |
---|
500 | } |
---|
501 | } |
---|
502 | |
---|
503 | # ---------------------------------------------------------------------- |
---|
504 | # USAGE: MiddlewareTime <key> <value> ... |
---|
505 | # |
---|
506 | # Used as the default method for reporting job status information. |
---|
507 | # Implements the old HUBzero method of reporting job status info to |
---|
508 | # stderr, which can then be picked up by the tool session container. |
---|
509 | # Most tools use the "submit" command, which talks directly to a |
---|
510 | # database to log job information, so this isn't really needed. But |
---|
511 | # it doesn't hurt to have this and it can be useful in some cases. |
---|
512 | # ---------------------------------------------------------------------- |
---|
513 | itcl::body Rappture::Task::MiddlewareTime {args} { |
---|
514 | set line "MiddlewareTime:" |
---|
515 | foreach {key val} $args { |
---|
516 | append line " $key=$val" |
---|
517 | } |
---|
518 | puts stderr $line |
---|
519 | } |
---|