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

Last change on this file since 4970 was 4970, checked in by mmc, 6 years ago

Fixed auto-execution via TOOL_PARAMETERS to produce status output in a
file called rappture.status. This makes it easier for the web service
to monitor progress and know when everything is finished. Also, fixed
auto-execution to move the run file to the data/results directory and
clean up the original driver file.

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