source: branches/1.7/lang/tcl/scripts/task.tcl @ 6715

Last change on this file since 6715 was 6715, checked in by clarksm, 4 years ago

Record [click] events when cache hit occurs.
Record squid with [click] event and with submit --local <command>
File size: 41.8 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
19package require uuid
20
21itcl::class Rappture::Task {
22    private method CheckForCachedRunFile { driverFile }
23    private method CollectUQResults {}
24    private method ExecuteSimulationCommand { cmd }
25    private method GetCommand {}
26    private method GetDriverFile {}
27    private method GetSignal { signal }
28    private method GetCacheHelperCommand { driverFile }
29    private method GetSimulationCommand { driverFile }
30    private method GetUQErrors {}
31    private method GetUQSimulationCommand { driverFile }
32    private method GetUQTemplateFile {}
33    private method IsCacheable {}
34    private method IsCacheHelperEligible {}
35    private method LogCachedSimulationUsage {}
36    private method LogSimulationUsage {}
37    private method LogSubmittedSimulationUsage {}
38    private method LogUQSimulationUsage {}
39    private method SetCpuResourceLimit {}
40
41    public variable logger ""
42    public variable jobstats Rappture::Task::MiddlewareTime
43    public variable resultdir "@default"
44    public variable xmlSource ""
45
46    constructor {xmlobj installdir args} { # defined below }
47    destructor { # defined below }
48
49    public method installdir {} { return $_installdir }
50
51    public method run {args}
52    public method get_uq {args}
53    public method abort {}
54    public method reset {}
55    public method xml {args}
56    public method save {xmlobj {name ""}}
57
58    protected method OnError {data}
59    protected method OnOutput {data}
60    protected method Log {args}
61    protected method BuildSubmitBoincCommand {tFile toolparamFile params_file}
62    protected method BuildSubmitLocalCommand {cmd tFile params_file}
63    protected method GetParamsForUQ {}
64
65    private variable _xmlobj ""      ;# XML object with inputs/outputs
66    private variable _origxml ""     ;# copy of original XML (for reset)
67    private variable _installdir ""  ;# installation directory for this tool
68    private variable _errorcb ""     ;# callback for tool error
69    private variable _outputcb ""    ;# callback for tool output
70    private common jobnum 0          ;# counter for unique job number
71    private variable _uq
72
73    private variable _job
74
75    # get global resources for this tool session
76    public proc resources {{option ""}}
77
78    public common _resources
79    public proc setAppName {name}         { set _resources(-appname) $name }
80    public proc setHubName {name}         { set _resources(-hubname) $name }
81    public proc setHubURL {name}          { set _resources(-huburl) $name }
82    public proc setSession {name}         { set _resources(-session) $name }
83    public proc setJobPrt {name}          { set _resources(-jobprotocol) $name }
84    public proc setResultDir {name}       { set _resources(-resultdir) $name }
85    public proc setCacheHosts {name}      { set _resources(-cachehosts) $name }
86    public proc setCacheUser {name}       { set _resources(-cacheuser) $name }
87    public proc setCacheWriteHost {name}  { set _resources(-cachewritehost) $name }
88
89    # default method for -jobstats control
90    public proc MiddlewareTime {args}
91}
92
93# must use this name -- plugs into Rappture::resources::load
94proc task_init_resources {} {
95    Rappture::resources::register \
96        application_name  Rappture::Task::setAppName \
97        application_id    Rappture::Task::setAppId \
98        hub_name          Rappture::Task::setHubName \
99        hub_url           Rappture::Task::setHubURL \
100        session_token     Rappture::Task::setSession \
101        job_protocol      Rappture::Task::setJobPrt \
102        results_directory Rappture::Task::setResultDir \
103        cache_hosts       Rappture::Task::setCacheHosts \
104        cache_user        Rappture::Task::setCacheUser \
105        cache_write_host  Rappture::Task::setCacheWriteHost
106}
107
108# ----------------------------------------------------------------------
109# CONSTRUCTOR
110# ----------------------------------------------------------------------
111itcl::body Rappture::Task::constructor {xmlobj installdir args} {
112    if {![Rappture::library isvalid $xmlobj]} {
113        error "bad value \"$xmlobj\": should be Rappture::Library"
114    }
115    set _xmlobj $xmlobj
116
117    # stash a copy of the original XML for later "reset" operations
118    set _origxml [Rappture::LibraryObj ::#auto "<?xml version=\"1.0\"?><run/>"]
119    $_origxml copy "" from $_xmlobj ""
120
121    if {![file exists $installdir]} {
122        error "directory \"$installdir\" doesn't exist"
123    }
124    set _installdir $installdir
125    package require http
126    package require tls
127    http::register https 443 [list ::tls::socket -tls1 0 -ssl2 0 -ssl3 0]
128
129    eval configure $args
130}
131
132# ----------------------------------------------------------------------
133# DESTRUCTOR
134# ----------------------------------------------------------------------
135itcl::body Rappture::Task::destructor {} {
136    itcl::delete object $_origxml
137}
138
139# ----------------------------------------------------------------------
140# USAGE: resources ?-option?
141#
142# Clients use this to query information about the tool.
143# ----------------------------------------------------------------------
144itcl::body Rappture::Task::resources {{option ""}} {
145    if {$option == ""} {
146        return [array get _resources]
147    }
148    if {[info exists _resources($option)]} {
149        return $_resources($option)
150    }
151    return ""
152}
153
154itcl::body Rappture::Task::GetSignal {code} {
155    set signals {
156        xxx HUP INT QUIT ILL TRAP ABRT BUS FPE KILL USR1 SEGV
157        USR2 PIPE ALRM TERM STKFLT CHLD CONT STOP TSTP TTIN
158        TTOU URG XCPU XFSZ VTALRM PROF WINCH POLL PWR SYS
159        RTMIN RTMIN+1 RTMIN+2 RTMIN+3 RTMAX-3 RTMAX-2 RTMAX-1 RTMAX
160    }
161    set sigNum [expr $code - 128]
162    if { $sigNum > 0 && $sigNum < [llength $signals] } {
163        return [lindex $signals $sigNum]
164    }
165    return "unknown exit code \"$code\""
166}
167
168itcl::body Rappture::Task::get_uq {args} {
169    foreach {path val} $args {
170        if {$path == "-uq_type"} {
171            set _uq(type) $val
172        } elseif {$path == "-uq_args"} {
173            set _uq(args) $val
174        }
175    }
176    #set varlist [$_xmlobj uq_get_vars]
177    foreach {varlist num} [$_xmlobj uq_get_vars] break
178    return [Rappture::UQ ::#auto $varlist $num $_uq(type) $_uq(args)]
179}
180
181# ----------------------------------------------------------------------
182# USAGE: run ?<path1> <value1> <path2> <value2> ...? ?-output <callbk>?
183#
184# This method causes the tool to run.  A "driver.xml" file is created
185# as the input for the run.  That file is fed to the executable
186# according to the <tool><command> string, and the job is executed.
187#
188# Any "<path> <value>" arguments are used to override the current
189# settings from the GUI.  This is useful, for example, when filling
190# in missing simulation results from the analyzer.
191#
192# If the -output argument is included, then the next arg is a
193# callback command for output messages.  Any output that comes in
194# while the tool is running is sent back to the caller, so the user
195# can see progress running the tool.
196#
197# Returns a list of the form {status result}, where status is an
198# integer status code (0=success) and result is the output from the
199# simulator.  Successful output is something like {0 run1293921.xml},
200# where 0=success and run1293921.xml is the name of the file containing
201# results.
202# ----------------------------------------------------------------------
203itcl::body Rappture::Task::run {args} {
204    global env errorInfo
205
206    #
207    # Make sure that we save the proper application name.  Actually, the
208    # best place to get this information is straight from the "installtool"
209    # script, but just in case we have an older tool, we should insert the
210    # tool name from the resources config file.
211    #
212    if {[info exists _resources(-appname)] && $_resources(-appname) ne "" &&
213        [$_xmlobj get tool.name] eq ""} {
214        $_xmlobj put tool.name $_resources(-appname)
215    }
216
217    # if there are any args, use them to override parameters
218    set _errorcb ""
219    set _outputcb ""
220    set _uq(type) ""
221    set _uq(tFile) ""
222    set _uq(toolparamFile) ""
223    set _uq(paramsFile) ""
224    foreach {path val} $args {
225        if {$path == "-stdout"} {
226            set _outputcb $val
227        } elseif {$path == "-stderr"} {
228            set _errorcb $val
229        } elseif {$path == "-uq_type"} {
230            set _uq(type) $val
231        } elseif {$path == "-uq_args"} {
232            set _uq(args) $val
233        } elseif {$path != "-output"} {
234            $_xmlobj put $path.current $val
235        }
236    }
237    foreach {path val} $args {
238        if {$path == "-output"} {
239            if {$_outputcb == ""} {
240                set _outputcb $val
241            }
242        }
243    }
244
245    # Initialize job array variables
246    array set _job {
247        control  ""
248        exitcode 0
249        mesg     ""
250        runfile  ""
251        stderr   ""
252        stdout   ""
253        success  0
254        xmlobj   ""
255        squid    ""
256    }
257
258    SetCpuResourceLimit
259
260    set helperEligible [IsCacheHelperEligible]
261    if { [info exists env(WHIMRC)] } {
262        set helperEligible 0
263    }
264
265    set driverFile [GetDriverFile]
266    set cached 0
267    if { [IsCacheable] } {
268puts stderr "Cache checking: [time {
269        set cached [CheckForCachedRunFile $driverFile]
270     } ]"
271puts stderr "checking cached=$cached"
272    } else {
273        set helperEligible 0
274    }
275    if { !$cached } {
276        if { $_uq(type) != "" } {
277            set _uq(tFile) [GetUQTemplateFile]
278        }
279        global env
280        if { $helperEligible } {
281            if { $_job(squid) != "" } {
282                set ::env(RAPPTURE_CACHE_SQUID) $_job(squid)
283            }
284        }
285#       puts stderr "RAPPTURE_CACHE_SQUID = $::env(RAPPTURE_CACHE_SQUID)"
286        if { $_uq(type) == "" } {
287            if { $helperEligible } {
288                set cmd [GetCacheHelperCommand $driverFile]
289            } else {
290                set cmd [GetSimulationCommand $driverFile]
291            }
292            set ::env(RAPPTURE_UQ) False
293        } else {
294            set cmd [GetUQSimulationCommand $driverFile]
295            set ::env(RAPPTURE_UQ) True
296        }
297        if { $cmd == "" } {
298            puts stderr "cmd is empty"
299            append mesg "There is no command specified by\n\n"
300            append mesg "    <command>\n"
301            append mesg "    </command>\n\n"
302            append mesg "in the tool.xml file."
303            return [list 1 $mesg]
304        }
305
306        if { ![ExecuteSimulationCommand $cmd] } {
307            return [list 1 $_job(mesg)]
308        }
309        if { $_uq(type) != "" } {
310            LogUQSimulationUsage
311        } elseif { [resources -jobprotocol] == "submit" } {
312            LogSubmittedSimulationUsage
313        } else {
314            LogSimulationUsage
315        }
316    } else {
317        LogCachedSimulationUsage
318    }
319    if { $_uq(tFile) ne "" } {
320        file delete -force -- $_uq(tFile)
321    }
322    if { $_uq(toolparamFile) ne "" } {
323        file delete -force -- $_uq(toolparamFile)
324    }
325    if { $_uq(paramsFile) ne "" } {
326        file delete -force -- $_uq(paramsFile)
327    }
328    if { $_job(success) } {
329        file delete -force -- $driverFile
330        Log run finished
331        return [list 0 $_job(xmlobj)]
332    } else {
333        # See if the job was aborted.
334        if {[regexp {^KILLED} $_job(control)]} {
335            Log run aborted
336            return [list 1 "ABORT"]
337        }
338        Log run failed [list 0 $_job(mesg)]
339        return [list 1 $_job(mesg)]
340    }
341}
342
343# ----------------------------------------------------------------------
344#  Turn the command string from tool.xml into the proper syntax to use
345#  with a submit parameter sweep with a temlate file.  Proper quoting
346#  of the template file is necessary to prevent submit from being too smart
347#  and converting it to a full pathname.
348# ----------------------------------------------------------------------
349itcl::body Rappture::Task::BuildSubmitBoincCommand {tFile toolparamFile params_file} {
350    set toolId   [$_xmlobj get tool.id]
351    set toolVers [$_xmlobj get tool.version.application.revision]
352    set newcmd "submit --venue boinc --progress submit --runName=puq --inputfile @:$tFile --data $params_file --env TOOL_PARAMETERS=$toolparamFile ${toolId}_r${toolVers} -w headless"
353
354    return $newcmd
355}
356
357itcl::body Rappture::Task::BuildSubmitLocalCommand {cmd tFile params_file} {
358    set quote_next 0
359    set newcmd "submit --local --progress submit --runName=puq --inputfile @:$tFile --data $params_file"
360    set cmds [split $cmd " "]
361    for {set i 0} {$i < [llength $cmds]} {incr i} {
362        set arg [lindex $cmds $i]
363        if {$quote_next == 1} {
364            set nc [string range $arg 0 0]
365            if {$nc != "\""} {
366                set arg "\"\\\"$arg\\\"\""
367            }
368        }
369        if {$arg == "--eval"} {
370            set quote_next 1
371        } else {
372            set quote_next 0
373        }
374        if {$arg == "@driver"} {
375            set arg "\"\\\"$tFile\\\"\""
376        }
377        append newcmd " " $arg
378    }
379    regsub -all @driver $newcmd $tFile newcmd
380
381    return $newcmd
382}
383
384# ----------------------------------------------------------------------
385# USAGE: abort
386#
387# Clients use this during a "run" to abort the current job.
388# Kills the job and forces the "run" method to return.
389# ----------------------------------------------------------------------
390itcl::body Rappture::Task::abort {} {
391    Log run abort
392    set _job(control) "abort"
393}
394
395# ----------------------------------------------------------------------
396# USAGE: reset
397#
398# Resets all input values to their defaults.  Sometimes used just
399# before a run to reset to a clean state.
400# ----------------------------------------------------------------------
401itcl::body Rappture::Task::reset {} {
402    $_xmlobj copy "" from $_origxml ""
403    foreach path [Rappture::entities -as path $_xmlobj input] {
404        if {[$_xmlobj element -as type $path.default] ne ""} {
405            set defval [$_xmlobj get $path.default]
406            $_xmlobj put $path.current $defval
407        }
408    }
409}
410
411# ----------------------------------------------------------------------
412# USAGE: xml <subcommand> ?<arg> <arg> ...?
413# USAGE: xml object
414#
415# Used by clients to manipulate the underlying XML data for this
416# tool.  The <subcommand> can be any operation supported by a
417# Rappture::library object.  Clients can also request the XML object
418# directly by using the "object" subcommand.
419# ----------------------------------------------------------------------
420itcl::body Rappture::Task::xml {args} {
421    if {"object" == $args} {
422        return $_xmlobj
423    }
424    return [eval $_xmlobj $args]
425}
426
427# ----------------------------------------------------------------------
428# USAGE: save <xmlobj> ?<filename>?
429#
430# Used by clients to save the contents of an <xmlobj> representing
431# a run out to the given file.  If <filename> is not specified, then
432# it uses the -resultsdir and other settings to do what Rappture
433# would normally do with the output.
434# ----------------------------------------------------------------------
435itcl::body Rappture::Task::save {xmlobj {filename ""}} {
436    if {$filename eq ""} {
437
438        # If there's a results_directory defined in the resources file,
439        # then move the run.xml file there for storage.
440
441        set rdir ""
442        if {$resultdir eq "@default"} {
443            if {[info exists _resources(-resultdir)]} {
444                set rdir $_resources(-resultdir)
445            } else {
446                global rapptureInfo
447                set rdir $rapptureInfo(cwd)
448            }
449        } elseif {$resultdir ne ""} {
450            set rdir $resultdir
451        }
452
453        # use the runfile name generated by the last run
454        if {$_job(runfile) ne ""} {
455            set filename [file join $rdir [file tail $_job(runfile)]]
456        } else {
457            set filename [file join $rdir run.xml]
458        }
459    }
460
461    # add any last-minute metadata
462    $xmlobj put output.time [clock format [clock seconds]]
463
464    $xmlobj put tool.version.rappture.version $::Rappture::version
465    $xmlobj put tool.version.rappture.revision $::Rappture::build
466    $xmlobj put output.filename $filename
467    $xmlobj put output.version $Rappture::version
468
469    if {[info exists ::tcl_platform(user)]} {
470        $xmlobj put output.user $::tcl_platform(user)
471    }
472
473    # save the output
474    set rdir [file dirname $filename]
475    file mkdir $rdir
476
477    set fid [open $filename w]
478    puts $fid "<?xml version=\"1.0\"?>"
479    puts $fid [$xmlobj xml]
480    close $fid
481
482    Log output saved in $filename
483}
484
485# ----------------------------------------------------------------------
486# USAGE: OnOutput <data>
487#
488# Used internally to send each bit of output <data> coming from the
489# tool onto the caller, so the user can see progress.
490# ----------------------------------------------------------------------
491itcl::body Rappture::Task::OnOutput {data} {
492    if {[string length $_outputcb] > 0} {
493        uplevel #0 $_outputcb [list $data]
494    }
495}
496
497# ----------------------------------------------------------------------
498# USAGE: OnError <data>
499#
500# Used internally to send each bit of error <data> coming from the
501# tool onto the caller, so the user can see progress.
502# ----------------------------------------------------------------------
503itcl::body Rappture::Task::OnError {data} {
504    if {[string length $_errorcb] > 0} {
505        uplevel #0 $_errorcb [list $data]
506    }
507}
508
509# ----------------------------------------------------------------------
510# USAGE: Log <cmd> <arg> <arg> ...
511#
512# Used internally to log interesting events during the run.  If the
513# -logger option is set (to Rappture::Logger::log, or something like
514# that), then the arguments to this method are passed along to the
515# logger and written out to a log file.  Logging is off by default,
516# so this method does nothing unless -logger is set.
517# ----------------------------------------------------------------------
518itcl::body Rappture::Task::Log {args} {
519    if {[string length $logger] > 0} {
520        uplevel #0 $logger [list $args]
521    }
522}
523
524# ----------------------------------------------------------------------
525# USAGE: MiddlewareTime <key> <value> ...
526#
527# Used as the default method for reporting job status information.
528# Implements the old HUBzero method of reporting job status info to
529# stderr, which can then be picked up by the tool session container.
530# Most tools use the "submit" command, which talks directly to a
531# database to log job information, so this isn't really needed.  But
532# it doesn't hurt to have this and it can be useful in some cases.
533# ----------------------------------------------------------------------
534itcl::body Rappture::Task::MiddlewareTime {args} {
535    set line "MiddlewareTime:"
536    foreach {key val} $args {
537        append line " $key=$val"
538    }
539    puts stderr $line
540}
541
542itcl::body Rappture::Task::IsCacheable {} {
543    if { ![info exists _resources(-cachehosts)] ||
544         $_resources(-cachehosts) == "" } {
545        puts stderr cachehosts=[info exists _resources(-cachehosts)]
546        return 0
547    }
548    global env
549    if { [info exists env(RAPPTURE_CACHE_OVERRIDE)] } {
550        set state $env(RAPPTURE_CACHE_OVERRIDE)
551    } else {
552        set state [$_xmlobj get "tool.cache"]
553    }
554    if { $state ne "" } {
555        puts stderr "cache tag is \"$state\""
556    }
557    if { $state eq "" || ![string is boolean $state] } {
558        return 1;                       # Default is to allow caching.
559    }
560    return $state
561}
562
563itcl::body Rappture::Task::IsCacheHelperEligible {} {
564    global env
565    if { ![info exists env(IONHELPER_ALLOWED)] } {
566        set helperEligible 0
567    } else {
568        if { $env(IONHELPER_ALLOWED) ne "1" } {
569            set helperEligible 0
570        } else {
571            if { $_uq(type) == "" } {
572#               puts stderr "cache_user exists       = [info exists _resources(-cacheuser)]"
573#               puts stderr "cache_write_host exists = [info exists _resources(-cachewritehost)]"
574                if { ![info exists _resources(-cacheuser)] || ![info exists _resources(-cachewritehost)] } {
575                    set helperEligible 0
576                } else {
577                    if { ![info exists env(USER)] } {
578                        set helperEligible 0
579                    } else {
580#                       puts stderr "env(USER)  = $env(USER)"
581#                       puts stderr "cache_user = $_resources(-cacheuser)"
582                        if { $env(USER) eq $_resources(-cacheuser) } {
583                            set helperEligible 0
584                        } else {
585                            set toolId    [$_xmlobj get tool.id]
586                            set toolVers  [$_xmlobj get tool.version.application.revision]
587                            set toolDir   [$_xmlobj get tool.version.application.directory(top)]
588                            set verifyDir [file join / apps ${toolId} r${toolVers}]
589#                           puts stderr "toolDir     = $toolDir"
590#                           puts stderr "verifyDir   = $verifyDir"
591                            if { $toolDir eq $verifyDir } {
592                                if { [ catch { file readlink [file join / apps ${toolId} current] } currentVers ] != 0 } {
593                                    set helperEligible 0
594                                } else {
595#                                   puts stderr "currentVers = $currentVers"
596                                    if { "r$toolVers" eq $currentVers } {
597                                        set helperEligible 1
598                                    } else {
599                                        set helperEligible 0
600                                    }
601                                }
602                            } else {
603                               set helperEligible 0
604                            }
605                        }
606                    }
607                }
608            } else {
609                set helperEligible 0
610            }
611        }
612    }
613#   puts stderr "helperEligible = $helperEligible"
614
615    return $helperEligible
616}
617
618#
619# Send the list of parameters to a python program so it can call PUQ
620# and get a CSV file containing the parameter values to use for the runs.
621itcl::body Rappture::Task::GetParamsForUQ {} {
622    set pid [pid]
623    # puts "puq.sh get_params $pid $_uq(varlist) $_uq(type) $_uq(args)"
624    if {[catch {
625        exec puq.sh get_params $pid $_uq(varlist) $_uq(type) $_uq(args)
626    } errs] != 0 } {
627        error "get_params.py failed: $errs\n[GetUQErrors]"
628    }
629    return "params${pid}.csv"
630}
631
632itcl::body Rappture::Task::SetCpuResourceLimit {} {
633    # Set limits for cpu time
634    set limit [$_xmlobj get tool.limits.cputime]
635    if { $limit == "unlimited" } {
636        set limit 43200;                # 12 hours
637    } else {
638        if { [scan $limit "%d" dum] != 1 } {
639            set limit 14400;            # 4 hours by default
640        } elseif { $limit > 43200 } {
641            set limit 43200;            # limit to 12 hrs.
642        } elseif { $limit < 10 } {
643            set limit 10;               # lower bound is 10 seconds.
644        }
645    }
646    Rappture::rlimit set cputime $limit
647}
648
649# Write out the driver.xml file for the tool
650itcl::body Rappture::Task::GetDriverFile {} {
651    global rapptureInfo
652    set fileName [file join $rapptureInfo(cwd) "driver[pid].xml"]
653#
654# Remove existing <meta> section
655    $_xmlobj remove "meta"
656# Copy original <meta> section
657    $_xmlobj copy "meta" from $_origxml "meta"
658# Add new <meta> entry
659    if { $xmlSource != "" } {
660        set identifier [uuid::uuid generate]
661        $_xmlobj put meta.driver($identifier).source $xmlSource
662        $_xmlobj put meta.driver($identifier).version $::Rappture::build
663        $_xmlobj put meta.driver($identifier).time [clock format [clock seconds]]
664        if { $xmlSource == "rapptureUI" } {
665            $_xmlobj put meta.generated human
666        }
667        set generated [$_xmlobj get meta.generated]
668        if { $generated == "" } {
669            $_xmlobj put meta.generated human
670        }
671        set generated [$_xmlobj get meta.generated]
672        global env
673        set ::env(RAPPTURE_GENERATED) $generated
674        if {[info exists env(RAPPTURE_GENERATED_FILE)]} {
675            set f [open $env(RAPPTURE_GENERATED_FILE) w]
676            puts $f "generated $generated"
677            close $f
678        }
679    }
680#
681    if { [catch {
682        set f [open $fileName w]
683        puts $f "<?xml version=\"1.0\"?>"
684        puts $f [$_xmlobj xml]
685        close $f
686    } errs] != 0 } {
687        error "can't create driver file \"$fileName\": $errs"
688    }
689    return $fileName
690}
691
692itcl::body Rappture::Task::GetCacheHelperCommand { driverFile } {
693    set cmd ""
694    set helperDriverDir [file join / var ion drivers]
695    if { [file exists $helperDriverDir] } {
696        set cacheHelperCommand [file join / apps bin iondrive]
697        if { [file exists $cacheHelperCommand] } {
698            file copy -force $driverFile $helperDriverDir
699            set cmd $cacheHelperCommand
700        }
701    }
702
703    return $cmd
704}
705
706itcl::body Rappture::Task::GetCommand { } {
707    set cmd [$_xmlobj get tool.command]
708    regsub -all @tool $cmd $_installdir cmd
709    set cmd [string trimleft $cmd " "]
710    return $cmd
711}
712
713itcl::body Rappture::Task::GetSimulationCommand { driverFile } {
714    set cmd [GetCommand]
715    if { $cmd == "" } {
716        return ""
717    }
718    regsub -all @driver $cmd $driverFile cmd
719
720    switch -glob -- [resources -jobprotocol] {
721        "submit*" {
722            # if job_protocol is "submit", then use use submit command
723            set cmd "submit --local $cmd"
724        }
725        "mx" {
726            # metachory submission
727            set cmd "mx $cmd"
728        }
729        "exec" {
730            # default -- nothing special
731        }
732    }
733    return $cmd
734}
735
736itcl::body Rappture::Task::GetUQSimulationCommand { driverFile } {
737    set cmd [GetCommand]
738    if { $cmd == "" } {
739        return ""
740    }
741    set _uq(paramsFile) [GetParamsForUQ]
742#   set cmd [BuildSubmitBoincCommand $_uq(tFile) $_uq(toolparamFile) $_uq(paramsFile)]
743    set cmd [BuildSubmitLocalCommand $cmd $_uq(tFile) $_uq(paramsFile)]
744
745    file delete -force puq
746
747    return $cmd
748}
749
750itcl::body Rappture::Task::GetUQTemplateFile {} {
751    global rapptureInfo
752    # Copy xml into a new file
753    set templateFile "template[pid].xml"
754    set f [open $templateFile w]
755    puts $f "<?xml version=\"1.0\"?>"
756    puts $f [$_xmlobj xml]
757    close $f
758
759    # Return a list of the UQ variables and their PDFs.
760    # Also turns $uq(tFile) into a template file.
761    set _uq(varlist) [lindex [$_xmlobj uq_get_vars $templateFile] 0]
762    set _uq(tFile) $templateFile
763
764    # Create toolparameter file
765    set toolParameterFile "toolParameter[pid].hz"
766    set f [open $toolParameterFile w]
767    puts $f "file(execute):$templateFile"
768    close $f
769
770    set _uq(toolparamFile) $toolParameterFile
771
772    return $templateFile
773}
774
775itcl::body Rappture::Task::ExecuteSimulationCommand { cmd } {
776
777    set _job(runfile) ""
778    set _job(success) 0
779    set _job(exitcode) 0
780
781    # Step 1.  Write the command into the run file.
782    $_xmlobj put tool.execute $cmd
783
784    Log run started
785    Rappture::rusage mark
786
787    # Step 2.  Check if it is a special case "ECHO" command which always
788    #          succeeds.
789    if { [string compare -nocase -length 5 $cmd "ECHO "] == 0 } {
790        set _job(stdout) [string range $cmd 5 end]
791        set _job(success) 1
792        set _job(exitcode) 0
793        set _job(mesg) ""
794        return 1;                       # Success
795    }
796
797    # Step 3. Execute the command, collecting its stdout and stderr.
798    catch {
799        eval blt::bgexec [list [itcl::scope _job(control)]] \
800            -keepnewline yes \
801            -killsignal  SIGTERM \
802            -onerror     [list [itcl::code $this OnError]] \
803            -onoutput    [list [itcl::code $this OnOutput]] \
804            -output      [list [itcl::scope _job(stdout)]] \
805            -error       [list [itcl::scope _job(stderr)]] \
806            $cmd
807    } result
808
809    # Step 4. Check the token and the exit code.
810    set logmesg $result
811    foreach { token _job(pid) _job(exitcode) mesg } $_job(control) break
812    if { $token == "EXITED" } {
813        if { $_job(exitcode) != 0 } {
814            # This means that the program exited normally but returned a
815            # non-zero exitcode.  Consider this an invalid result from the
816            # program.  Append the stderr from the program to the message.
817            if {$_job(exitcode) > 128} {
818                set logmesg "Program signaled: signal was [GetSignal $_job(exitcode)]"
819            } else {
820                set logmesg "Program finished: non-zero exit code is $_job(exitcode)"
821            }
822            set _job(mesg) "$logmesg\n\n$_job(stderr)"
823            Log run failed [list $logmesg]
824            return 0;                   # Fail.
825        }
826        # Successful program termination with exit code of 0.
827    } elseif { $token == "abort" }  {
828        # The user pressed the abort button.
829
830        set logmesg "Program terminated by user."
831        Log run failed [list $logmesg]
832        set _job(mesg) "$logmesg\n\n$_job(stdout)"
833        return 0;                       # Fail
834    } else {
835        # Abnormal termination
836
837        set logmesg "Abnormal program termination:"
838        Log run failed [list $logmesg]
839        set _job(mesg) "$logmesg\n\n$_job(stdout)"
840        return 0;                       # Fail
841    }
842    if { $_uq(type) != "" } {
843        CollectUQResults
844    }
845
846    # Step 5. Look in stdout for the name of the run file.
847    set pattern {=RAPPTURE-RUN=>([^\n]+)}
848    if {![regexp $pattern $_job(stdout) match fileName]} {
849        set _job(mesg) "Can't find result file in output.\n"
850        append _job(mesg) "Did you call Rappture::result in your simulator?"
851        return 0;                       # Fail
852    }
853    set _job(runfile) $fileName
854    set _job(success) 1
855    set _job(mesg) $_job(stdout)
856    return 1;                           # Success
857}
858
859itcl::body Rappture::Task::LogSimulationUsage {} {
860    array set times [Rappture::rusage measure]
861
862    set toolId     [$_xmlobj get tool.id]
863    set toolVers   [$_xmlobj get tool.version.application.revision]
864    set simulation "simulation"
865    if { $toolId ne "" && $toolVers ne "" } {
866        set simulation "[pid]_${toolId}_r${toolVers}"
867    }
868
869    # Need to save job info? then invoke the callback
870    if { [string length $jobstats] > 0} {
871        lappend args "job"      [incr jobnum] \
872                     "event"    $simulation \
873                     "start"    $times(start) \
874                     "walltime" $times(walltime) \
875                     "cputime"  $times(cputime) \
876                     "status"   $_job(exitcode)
877        uplevel #0 $jobstats $args
878    }
879
880    #
881    # Scan through stderr channel and look for statements that
882    # represent grid jobs that were executed.  The statements look
883    # like this:
884    #
885    # MiddlewareTime: job=1 event=simulation start=3.001094 ...
886    #
887
888    set subjobs 0
889    set pattern {(^|\n)MiddlewareTime:( +[a-z]+=[^ \n]+)+(\n|$)}
890    while { [regexp -indices $pattern $_job(stderr) match] } {
891        foreach {p0 p1} $match break
892        if { [string index $_job(stderr) $p0] == "\n" } {
893            incr p0
894        }
895        array unset data
896        array set data {
897            job 1
898            event simulation
899            start 0
900            walltime 0
901            cputime 0
902            status 0
903        }
904        foreach arg [lrange [string range $_job(stderr) $p0 $p1] 1 end] {
905            foreach {key val} [split $arg =] break
906            set data($key) $val
907        }
908        set data(job)   [expr { $jobnum + $data(job) }]
909        set data(event) "subsimulation"
910        set data(start) [expr { $times(start) + $data(start) }]
911
912        set details ""
913        foreach key {job event start walltime cputime status} {
914            # Add required keys in a particular order
915            lappend details $key $data($key)
916            unset data($key)
917        }
918        foreach key [array names data] {
919            # Add anything else that the client gave -- venue, etc.
920            if { $data($key) != "" } {
921                lappend details $key $data($key)
922            }
923        }
924
925        if {[string length $jobstats] > 0} {
926            uplevel #0 $jobstats $details
927        }
928
929        incr subjobs
930
931        # Done -- remove this statement
932        set _job(stderr) [string replace $_job(stderr) $p0 $p1]
933    }
934    incr jobnum $subjobs
935
936    # Add cputime info to run.xml file
937    if { [catch {
938        Rappture::library $_job(runfile)
939    } xmlobj] != 0 } {
940        error "Can't create rappture library: $xmlobj"
941    }
942    $xmlobj put output.walltime $times(walltime)
943    $xmlobj put output.cputime $times(cputime)
944    global env
945    if {[info exists env(SESSION)]} {
946        $xmlobj put output.session $env(SESSION)
947    }
948    set _job(xmlobj) $xmlobj
949}
950
951itcl::body Rappture::Task::LogSubmittedSimulationUsage {} {
952    array set times [Rappture::rusage measure]
953
954    set toolId     [$_xmlobj get tool.id]
955    set toolVers   [$_xmlobj get tool.version.application.revision]
956    set simulation "simulation"
957    if { $toolId ne "" && $toolVers ne "" } {
958        set simulation "[pid]_${toolId}_r${toolVers}"
959    }
960
961#   job info is not required because jobprotocol = submit
962#   if { [string length $jobstats] > 0} {
963#       lappend args \
964#           "job"      [incr jobnum] \
965#           "event"    $simulation \
966#           "start"    $times(start) \
967#           "walltime" $times(walltime) \
968#           "cputime"  $times(cputime) \
969#           "status"   $_job(exitcode)
970#       uplevel #0 $jobstats $args
971#   }
972
973# [click] messages go here
974    if { [string length $jobstats] > 0} {
975        set recordJobstats 1
976        if { [info exists _resources(-cacheuser)] } {
977            global env
978            if { $env(USER) eq $_resources(-cacheuser) } {
979                set recordJobstats 0
980            }
981        }
982        if { $recordJobstats } {
983            lappend args "job"      [incr jobnum] \
984                         "event"    "\[click\]" \
985                         "start"    $times(start) \
986                         "walltime" 0 \
987                         "cputime"  0 \
988                         "status"   0
989            if { $_job(squid) != "" } {
990                lappend args "squid" $_job(squid)
991            }
992            uplevel #0 $jobstats $args
993        }
994    }
995
996    #
997    # Scan through stderr channel and look for statements that
998    # represent grid jobs that were executed.  The statements look
999    # like this:
1000    #
1001    # MiddlewareTime: job=1 event=simulation start=3.001094 ...
1002    #
1003
1004    set subjobs 0
1005    set pattern {(^|\n)MiddlewareTime:( +[a-z]+=[^ \n]+)+(\n|$)}
1006    while { [regexp -indices $pattern $_job(stderr) match] } {
1007        foreach {p0 p1} $match break
1008        if { [string index $_job(stderr) $p0] == "\n" } {
1009            incr p0
1010        }
1011        array unset data
1012        array set data {
1013            job 1
1014            event simulation
1015            start 0
1016            walltime 0
1017            cputime 0
1018            status 0
1019            squid ""
1020        }
1021        foreach arg [lrange [string range $_job(stderr) $p0 $p1] 1 end] {
1022            foreach {key val} [split $arg =] break
1023            set data($key) $val
1024        }
1025        set data(job)   [expr { $jobnum + $data(job) }]
1026        set data(event) "subsimulation"
1027        set data(start) [expr { $times(start) + $data(start) }]
1028
1029#       puts stderr "event subsimulation start = $data(start)"
1030
1031        set details ""
1032        foreach key {job event start walltime cputime status} {
1033            # Add required keys in a particular order
1034            lappend details $key $data($key)
1035            unset data($key)
1036        }
1037        foreach key [array names data] {
1038            # Add anything else that the client gave -- venue, etc.
1039            if { $data($key) != "" } {
1040                lappend details $key $data($key)
1041            }
1042        }
1043
1044#       if {[string length $jobstats] > 0} {
1045#           uplevel #0 $jobstats $details
1046#       }
1047
1048        incr subjobs
1049
1050        # Done -- remove this statement
1051        set _job(stderr) [string replace $_job(stderr) $p0 $p1]
1052    }
1053    incr jobnum $subjobs
1054
1055    # Add session info to run.xml file
1056    if { [catch {
1057        Rappture::library $_job(runfile)
1058    } xmlobj] != 0 } {
1059        error "Can't create rappture library: $xmlobj"
1060    }
1061    global env
1062    if {[info exists env(SESSION)]} {
1063        $xmlobj put output.session $env(SESSION)
1064    }
1065    set _job(xmlobj) $xmlobj
1066}
1067
1068itcl::body Rappture::Task::LogUQSimulationUsage {} {
1069    array set times [Rappture::rusage measure]
1070
1071    if { [string length $jobstats] > 0} {
1072        lappend args "job"      [incr jobnum] \
1073                     "event"    "\[click-uq\]" \
1074                     "start"    $times(start) \
1075                     "walltime" 0 \
1076                     "cputime"  0 \
1077                     "status"   0
1078        uplevel #0 $jobstats $args
1079    }
1080
1081    # Add session info to run.xml file
1082    if { [catch { Rappture::library $_job(runfile) } xmlobj] != 0 } {
1083        error "Can't create rappture library: $xmlobj"
1084    }
1085    global env
1086    if {[info exists env(SESSION)]} {
1087        $xmlobj put output.session $env(SESSION)
1088    }
1089    set _job(xmlobj) $xmlobj
1090}
1091
1092itcl::body Rappture::Task::LogCachedSimulationUsage {} {
1093    Rappture::rusage mark
1094    array set times [Rappture::rusage measure]
1095
1096    if { [string length $jobstats] > 0} {
1097        set recordJobstats 1
1098        if { [info exists _resources(-cacheuser)] } {
1099            global env
1100            if { $env(USER) eq $_resources(-cacheuser) } {
1101                set recordJobstats 0
1102            }
1103        }
1104        if { $recordJobstats } {
1105            if { $_uq(type) != "" } {
1106                if { [string length $jobstats] > 0} {
1107                    lappend args "job"      [incr jobnum] \
1108                                 "event"    "\[click-uq\]" \
1109                                 "start"    $times(start) \
1110                                 "walltime" 0 \
1111                                 "cputime"  0 \
1112                                 "status"   0 \
1113                                 "squid"    $_job(squid)
1114                    uplevel #0 $jobstats $args
1115                }
1116            } else {
1117                lappend args "job"      [incr jobnum] \
1118                             "event"    "\[click\]" \
1119                             "start"    $times(start) \
1120                             "walltime" 0 \
1121                             "cputime"  0 \
1122                             "status"   0 \
1123                             "squid"    $_job(squid)
1124                uplevel #0 $jobstats $args
1125            }
1126        }
1127    }
1128
1129    if { [catch {
1130        Rappture::library $_job(runfile)
1131    } xmlobj] != 0 } {
1132        error "Can't create rappture library: $xmlobj"
1133    }
1134    set _job(xmlobj) $xmlobj
1135}
1136
1137
1138itcl::body Rappture::Task::CheckForCachedRunFile { driverFile } {
1139
1140    # Read the driver file and collect its contents as the query.
1141    set url http://$_resources(-cachehosts)/cache/request
1142    set f [open $driverFile "r"]
1143    set query [read $f]
1144    close $f
1145
1146    # Make the query
1147    if { [catch {
1148        http::geturl $url -query $query -timeout 6000 -binary yes
1149    } token] != 0 } {
1150        puts stderr "error performing cache query: driverFile=$driverFile url=$url token=$token"
1151        return 0
1152    }
1153
1154#   puts stderr "ncode  = [http::ncode $token]"
1155#   puts stderr "code   = [::http::code $token]"
1156#   puts stderr "status = [::http::status $token]"
1157#   puts stderr "meta   = [::http::meta $token]"
1158
1159    set squid ""
1160    foreach {key value} [::http::meta $token] {
1161        set headers([string tolower $key]) $value
1162        if { [string tolower $key] == "etag" } {
1163            set squid $value
1164        }
1165    }
1166    set _job(squid) $squid
1167
1168#   puts stderr "SQUID = $headers(etag)"
1169#   puts stderr "SQUID = $squid"
1170    if { [resources -jobprotocol] == "submit" } {
1171        if { $squid != "" } {
1172            # If the code is 200, we'll assume it's a cache hit.
1173            if { [http::ncode $token] == 200} {
1174                if { [catch {exec submit --cacheHit $squid} result] != 0 } {
1175                    puts stderr "submit --cacheHit $squid failed: $result"
1176                }
1177#               puts stderr "submit --cacheHit $squid"
1178            } else {
1179                if { [catch {exec submit --cacheMiss $squid} result] != 0 } {
1180                    puts stderr "submit --cacheMiss $squid failed: $result"
1181                }
1182#               puts stderr "submit --cacheMiss $squid"
1183            }
1184        } else {
1185            puts stderr "cache squid could not be determined."
1186        }
1187    }
1188
1189    # If the code isn't 200, we'll assume it's a cache miss.
1190    if { [http::ncode $token] != 200} {
1191        return 0
1192    }
1193    # Get contents of the run file.
1194    set contents [http::data $token]
1195    if { $contents == "" } {
1196        return 0
1197    }
1198
1199    # Create a new run.xml file and write the results into it.
1200    set secs [clock seconds]
1201    set millisecs [expr [clock clicks -milliseconds] % 1000]
1202    set timestamp [format %d%03d%03d $secs $millisecs 0]
1203
1204    global rapptureInfo
1205    set fileName [file join $rapptureInfo(cwd) "run${timestamp}.xml"]
1206    set f [open $fileName "w"]
1207    puts $f $contents
1208    close $f
1209    set _job(runfile) $fileName
1210    set _job(success) 1
1211    set _job(stderr) "Loading cached results\n"
1212    OnOutput "Loading cached results\n"
1213    update
1214    return 1
1215}
1216
1217itcl::body Rappture::Task::GetUQErrors {} {
1218    set contents {}
1219    if { [file exists "uq_debug.err"] } {
1220        set f [open "uq_debug.err" r]
1221        set contents [read $f]
1222        close $f
1223    }
1224    return $contents
1225}
1226
1227# UQ. Collect data from all jobs and put it in one xml run file.
1228itcl::body Rappture::Task::CollectUQResults {} {
1229    file delete -force -- "run_uq.xml"
1230    set hdfFile puq_[pid].hdf5
1231    if { [catch {
1232        exec puq.sh analyze $hdfFile
1233    } results] != 0 } {
1234        error "UQ analysis failed: $results\n[GetUQErrors]"
1235    } else {
1236        set _job(stdout) $results
1237    }
1238}
Note: See TracBrowser for help on using the repository browser.