source: trunk/lang/tcl/scripts/task.tcl @ 4135

Last change on this file since 4135 was 4135, checked in by mmc, 11 years ago

Oops! Fixed the handling of run files. If the task -resultdir is set to
@default and the session directory doesn't exist, then the run file is
stored in the current directory. This is the behavior that Rappture has
had all along. It got messed up when -resultdir was introduced at the
task level.

File size: 18.7 KB
Line 
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# ======================================================================
18package require BLT
19
20itcl::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
62proc 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# ----------------------------------------------------------------------
76itcl::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# ----------------------------------------------------------------------
97itcl::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# ----------------------------------------------------------------------
106itcl::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# ----------------------------------------------------------------------
138itcl::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# ----------------------------------------------------------------------
422itcl::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# ----------------------------------------------------------------------
439itcl::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# ----------------------------------------------------------------------
450itcl::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# ----------------------------------------------------------------------
469itcl::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# ----------------------------------------------------------------------
482itcl::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# ----------------------------------------------------------------------
497itcl::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# ----------------------------------------------------------------------
513itcl::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}
Note: See TracBrowser for help on using the repository browser.