source: branches/1.3/lang/tcl/scripts/task.tcl @ 4514

Last change on this file since 4514 was 4514, checked in by gah, 10 years ago

tool execution split out from gui, oauth modules added.

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.