OUTPUT BUFFER:
### # IRM External Process Manager ### package require cron 2.0 ::namespace eval ::processman {} ### # Attempt to locate some C - API helpers ### set ::processman::api tcl foreach {command package api} { {::twapi::process_exists} twapi twapi umask tclx tclx subprocess_exists tclextra tclextra {} odielibc tclextra } { if {[info commands $command] ne {}} { set ::processman::api $api break } if {![catch {package require $package}]} { set ::processman::api $api break } } switch $api { tclx { proc ::processman::kill_subprocess pid { catch {::kill $pid} } } tclextra { proc ::processman::kill_subprocess pid { catch {::kill_subprocess $pid} } } twapi { proc ::processman::priority {id level} { foreach pid [PIDLIST $id] { switch $level { background { if {[catch {twapi::set_priority_class $pid 0x00104000} err]} { puts "BG Mode failed - $err" twapi::set_priority_class $pid 0x00004000 } } low { twapi::set_priority_class $pid 0x00004000 } high { twapi::set_priority_class $pid 0x00000020 } default { twapi::set_priority_class $pid 0x00008000 } } } } proc ::processman::killexe name { set pids [twapi::get_process_ids -name $name.exe] foreach pid $pids { # Catch the error in case process does not exist any more if {[catch {twapi::end_process $pid} err]} { puts $err } } #catch {exec taskkill /F /IM $name.exe} err #puts $err } proc ::processman::kill_subprocess pid { if {[catch {::twapi::end_process $pid} err]} { puts $err } } proc ::processman::subprocess_exists pid { return [::twapi::process_exists $pid] } proc ::processman::keep_machine_awake {truefalse} { if {[string is true -strict $truefalse]} { twapi::SetThreadExecutionState 0x80000040 } else { twapi::SetThreadExecutionState 0x00000000 } } } default {} } ### # Create fallback implementations for functions we don't have a # C API call for ### proc ::processman::fallback {name arglist body} { if {[info commands ::${name}] eq {} && [info commands ::processman::${name}] eq {} } { ::proc ::processman::${name} $arglist $body } } # title: Keep the machine from going to sleep ::processman::fallback keep_machine_awake {truefalse} { } ::processman::fallback killexe name { if {[catch {exec killall -9 $name} err]} { puts $err } harvest_zombies } ### # title: Detect a running process # usage: subprocess_exists PID # description: # Returns true if PID is running. If PID is an integer # it is interpreted as Process Id from the operating system. # Otherwise it is assumed to be a handle previously registered # with the processman package ### ::processman::fallback subprocess_exists pid { set dat [exec ps] foreach line [split $dat \n] { if {![scan $line "%d %s" thispid rest]} continue if { $thispid eq $pid} { return $thispid } } return 0 } # title: Changes priority of task ::processman::fallback priority {id level} { if {$::tcl_platform(platform) eq "windows"} { return } foreach pid [PIDLIST $id] { switch $level { background { exec renice -n 20 -p $pid } low { exec renice -n 10 -p $pid } high { exec renice -n -5 -p $pid } default { exec renice -n 0 -p $pid } } } } ::processman::fallback kill_subprocess pid { catch {exec kill $pid} } ::processman::fallback harvest_zombies args { } ### # topic: a0cdb7503872cd302756c732956cd5c3 # title: Periodic scan of the state of processes ### proc ::processman::events {} { variable process_binding foreach {id bind} $process_binding { if {![running $id]} { kill $id catch {eval $bind} } } } ### # topic: 95edbb845e0a8802b1cc3119516a6502 # title: Locate and executable of name ### proc ::processman::find_exe name { global tcl_platform if {$tcl_platform(platform)=="windows"} {set suffix .exe} {set suffix {}} foreach f [list $name ~/irm/bin/$name ./$name/$name ./$name ../$name/$name ../../$name/$name] { if {[file executable $f]} break append f $suffix if {[file executable $f]} break } if {![file executable $f]} { error "Cannot find the $name executable" return {} } return $f } proc ::processman::PIDLIST id { variable process_list if {[string is integer -strict $id]} { return $id } if {[dict exists $process_list $id]} { return [dict get $process_list $id] } return {} } ### # topic: ac021b1116f0c1d5e3319d9f333f0c89 # title: Kill a process ### proc ::processman::kill id { variable process_list variable process_binding global tcl_platform foreach pid [PIDLIST $id] { kill_subprocess $pid } if {![string is integer $id]} { dict set process_list $id {} dict unset process_binding $id } harvest_zombies } ### # topic: 8987329d60cd1adc766e09a0227f87b6 # title: Kill all processes spawned by this program ### proc ::processman::kill_all {} { variable process_list if {![info exists process_list]} { return {} } foreach {name pidlist} $process_list { kill $name } harvest_zombies } ### # topic: 02406b2a7edd05c887554384ad2db41f # title: Issue a command when process {$id} exits ### proc ::processman::onexit {id cmd} { variable process_binding if {![running $id]} { catch {eval $cmd} return } dict set process_binding $id $cmd } ### # topic: 8bccf62b4fa11949dba4c85e05d116e9 # title: Return a list of processes and their current state ### proc ::processman::process_list {} { variable process_list set result {} dict set result self [pid] if {![info exists process_list]} { return $result } foreach {name pidlist} $process_list { foreach pid $pidlist { lappend result $name $pid [subprocess_exists $pid] } } return $result } ### # topic: 96b4b2c53ea1554006417e507197488c # title: Test if a process is running ### proc ::processman::running id { variable process_list set pidlist {} if {![string is integer -strict $id]} { if {$id eq "self"} { return [pid] } if {![dict exists $process_list $id]} { return 0 } set pidlist [dict get $process_list $id] } else { set pidlist $id } foreach pid $pidlist { if {[subprocess_exists $pid]} { return $pid } } return 0 } ### # topic: 61694ad97dbac52351431ad0d8c448e3 # title: Launch a task in the background ### proc ::processman::spawn {id command args} { variable process_list if {[llength $command] == 1} { set command [lindex $command 0] } if {$::tcl_platform(platform) eq "windows"} { set pid [exec "$command" {*}$args &] } else { set pid [exec $command {*}$args &] } dict lappend process_list $id $pid return $pid } ### # topic: 56fbf345652c5ca18543a67a6bc95787 # title: Process Management Tools ### namespace eval ::processman { ### # initialize tables ### variable process_list variable process_binding if { ![info exists process_list]} { set process_list {} } if {![info exists process_binding]} { set process_binding {} } } ::cron::every processman 60 ::processman::events package provide odie::processman 0.5 package provide processman 0.5