See Also edit
Description edit
In Tcl, exec and open |... invoke new processes.To obtain a ps(1)-like list of Windows processes, use pslist from pstools. [tlist?]Alternatively, use get_process_ids [1] from the TWAPI package.
To obtain a ps(1)-like list of Solaris or Linux processes, use procfs.tcl from http://inferno.slug.org/tarballs/procfs.tcl
lavapsEF The link is dead but available via the Wayback machine, copying it here below:## ********************************************************
##
## Name: procfs.tcl
##
## Description:
## Tcl package for parsing the /proc filesystem on Linux
## and Solaris.
##
## Parameters:
##
## Usage:
##
## On Linux, the proc filesystem is text, so easily parsed:
##
## /proc/<pid>/stat contains:
##
## pid (fname) state ppid pgrp
## session tty tpgid flags minflt
## cminflt majflt cmajflt utime stime
## cutime cstime pri nice 0
## itreadv stt vsz rss rlim
## startcode endcode startstack kstkesp kstkeip
## signal blocked sigignore sigcatch wchan
## nswap cnswap exit_signal processor
##
## Except that there seems to be a mystery field somewhere
## between rss and processor.
##
## state: R - run S - sleep D - disk Z - zombie T - stop W - swap
##
## On Solaris, the parse the /proc/<pid>/psinfo files are binary:
##
## /* process ps(1) information file. /proc/<pid>/psinfo */
##
## typedef struct psinfo {
## int pr_flag; /* process flags */
## int pr_nlwp; /* number of lwps in process */
## pid_t pr_pid; /* unique process id */
## pid_t pr_ppid; /* process id of parent */
## pid_t pr_pgid; /* pid of process group leader */
## pid_t pr_sid; /* session id */
## uid_t pr_uid; /* real user id */
## uid_t pr_euid; /* effective user id */
## gid_t pr_gid; /* real group id */
## gid_t pr_egid; /* effective group id */
## uintptr_t pr_addr; /* address of process */
## size_t pr_size; /* size of process image in Kbytes */
## size_t pr_rssize; /* resident set size in Kbytes */
## size_t pr_pad1; /* padding */
## dev_t pr_ttydev; /* controlling tty device (or PRNODEV) */
## /* The following percent numbers are 16-bit binary */
## /* fractions [0 .. 1] with the binary point to the */
## /* right of the high-order bit (1.0 == 0x8000) */
## ushort_t pr_pctcpu; /* % of recent cpu time used by all lwps */
## ushort_t pr_pctmem; /* % of system memory used by process */
## timestruc_t pr_start; /* process start time, from the epoch */
## timestruc_t pr_time; /* usr+sys cpu time for this process */
## timestruc_t pr_ctime; /* usr+sys cpu time for reaped children */
## char pr_fname[PRFNSZ]; /* name of execed file (16 chars) */
## char pr_psargs[PRARGSZ]; /* initial 80 characters of arg list */
## int pr_wstat; /* if zombie, the wait() status */
## int pr_argc; /* initial argument count */
## uintptr_t pr_argv; /* address of initial argument vector */
## uintptr_t pr_envp; /* address of initial environment vector */
## char pr_dmodel; /* data model of the process */
## char pr_pad2[3]; /* 3 bytes padding */
## taskid_t pr_taskid; /* task id */
## projid_t pr_projid; /* project id */
## int pr_filler[5]; /* reserved for future use */
## lwpsinfo_t pr_lwp; /* information for representative lwp */
## } psinfo_t;
##
## Comments:
##
## ********************************************************
;#barecode
# copyright 2003 by Phil Ehrens <[email protected]>
# conditions of GNU General Public License apply to this
# code. see http://www.gnu.org/licenses/
package provide procfs 1.0
namespace eval ps {}
;#end
## ********************************************************
##
## Name: ps::solaris
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::solaris { pid } {
if { [ catch {
set file /proc/${pid}/psinfo
set now [ clock seconds ]
set usr [ file attributes $file -owner ]
set fid [ open $file r ]
fconfigure $fid -encoding binary -translation binary
set numinfo [ read $fid 88 ]
set fname [ read $fid 16 ]
set args [ read $fid 80 ]
set more [ read $fid 16 ]
::close $fid
;## the meaty part
binary scan $numinfo IIIIIIIIIIIIIIISSI \
. . pid ppid . . ruser . . . . vsz rsz . . pcpu pmem stt
;## try to make sense out of pr_wstat
binary scan $more I state
if { $state == 0 } {
set state R
} else {
set state Z
}
regsub -all \x00 $fname {} fname
regsub -all \x00 $args {} args
set etime [ expr { $now - $stt } ]
set pmem [ format %.2f [ expr { $pmem / 327.67 } ] ]
set pcpu [ format %.2f [ expr { $pcpu / 327.67 } ] ]
} err ] } {
return -code error "[ myName ]: $err"
}
return [ list $pid $state $usr $vsz $rsz $pcpu $pmem $etime $fname $args ]
}
## ********************************************************
## ********************************************************
##
## Name: ps::linux
##
## Description:
## Parses /proc/<pid>/stat
## Parameters:
##
## Usage:
##
## Comments:
## Funny, we seem to have some disagreement about the
## fields with vsz rsz, and state... not a good sign.
proc ps::linux { pid } {
if { [ catch {
set file /proc/${pid}/stat
;## we need the total memory on the box for pmem
set fid [ open /proc/meminfo r ]
set mem [ read $fid 1024 ]
::close $fid
regexp {Mem:\s+(\S+)} $mem -> mem
;## we need the uptime (returned in seconds)
set fid [ open /proc/uptime r ]
set uptime [ read $fid 80 ]
::close $fid
set uptime [ lindex $uptime 0 ]
;## convert to jiffies at 100/sec
set uptime [ expr { $uptime * 100 } ]
set usr [ file attributes $file -owner ]
;## here's where we open the /proc/<pid>/stat file
set fid [ open $file r ]
set data [ read $fid 1024 ]
::close $fid
set data [ split $data ]
set pid [ lindex $data 0 ]
set fname [ lrange $data 1 end-38 ]
;## R-unning, Z-ombie, ...
set state [ lindex $data end-37 ]
regexp {\((.+)\)} $fname -> fname
set vsz [ lindex $data end-17 ]
set rsz [ lindex $data end-16 ]
set rsz [ expr { $rsz * 4096 } ]
;## this is the time in jiffies that the process was
;## started after system boot...
set etime [ lindex $data end-18 ]
set etime [ expr { $uptime - $etime } ]
;## number of jiffies it has been scheduled...
set utime [ lindex $data end-25 ]
;## and the calculated values
set pcpu [ expr { (double($utime) / double($etime)) * 100 } ]
set etime [ expr { int($etime / 100) } ]
set pmem [ expr { (double($vsz) / double($mem)) * 100 } ]
set pcpu [ format %.2f $pcpu ]
set pmem [ format %.2f $pmem ]
set vsz [ expr { $vsz / 1000 } ]
set rsz [ expr { $rsz / 1000 } ]
} err ] } {
return -code error "[ myName ]: $err"
}
return [ list $pid $state $usr $vsz $rsz $pcpu $pmem $etime $fname $fname ]
}
## ********************************************************
## ********************************************************
##
## Name: ps::procfsValidate
##
## Description:
## Since there is always the possibility that the proc
## filesystem structure will change, it would be nice
## to be able to validate the state of the procfs that
## is being queried.
##
## Parameters:
##
## Usage:
##
## Comments:
## Pending investigation of usable validation modes. I can
## validate the Solaris procfs.h by version, but the linux
## procfs.h does not use a version id.
##
proc ps::procfsValidate { args } {
if { [ catch {
set os [ lindex [ ps::os ] 0 ]
set fname /usr/include/sys/procfs.h
set sol_rx {pragma\s+ident.+procfs.h\s+([\d\.]+)}
set mtime [ file mtime $fname ]
set size [ file size $fname ]
set fid [ open $fname r ]
set data [ read $fid $size ]
close $fid
switch -exact -- $os {
solaris {
regexp $sol_rx $data -> version
}
linux {
set version unknown
}
default {
set version unknown
}
}
set retval [ list $size $mtime $version ]
} err ] } {
return -code error "[ myName ]: $err"
}
return $retval
}
## ********************************************************
## ********************************************************
##
## Name: ps::os
##
## Description:
## Get the OS and the filename under /proc/<pid> that we
## are going to parse.
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::os { args } {
set os $::tcl_platform(os)
switch -exact $os {
SunOS {
set os solaris
set filename psinfo
}
Linux {
set os linux
set filename stat
}
default {
return -code error "unsupported OS: $os"
}
}
return [ list $os $filename ]
}
## ********************************************************
## ********************************************************
##
## Name: ps::type
##
## Description:
## Discriminate between pid's, executable programs, and
## users.
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::type { program } {
if { [ catch {
if { [ regexp {^\d+$} $program ] } {
set type pid
} elseif { [ string length [ auto_execok $program ] ] } {
set type prog
} elseif { [ file exists /home/$program ] } {
set type user
} else {
set fid [ open /etc/passwd r ]
set data [ read $fid [ file size /etc/passwd ] ]
::close $fid
set data [ split $data "\n" ]
set type unknown
foreach user $data {
set user [ lindex [ split $user : ] 0 ]
if { [ string equal $program $user ] } {
set type user
break
}
}
}
} err ] } {
return -code error "[ myName ]: $err"
}
return $type
}
## ********************************************************
## ********************************************************
##
## Name: ps::ps
##
## Description:
##
## Parameters:
##
## Usage:
##
## to see the pids of all rxvt processes:
##
## ps::ps rxvt
##
## to see the process info for pid 123:
##
## ps::ps 123
##
## a user may be specified as well
##
## Comments:
##
proc ps::ps { program { user all } } {
if { [ catch {
set pids [ list ]
set noperm [ list ]
foreach [ list os filename ] [ ps::os ] { break }
set type [ ps::type $program ]
foreach file [ ps::procfiles $user ] {
foreach [ list owner file ] $file { break }
set pid [ lindex [ split $file / ] end-1 ]
if { [ file readable $file ] } {
set data [ ps::$os $pid ]
if { [ string equal all $program ] && \
[ string equal all $user ] } {
lappend pids $data
continue
}
;## return all data for the pid
if { [ string equal $program $pid ] } {
set pids $data
break
;## collect all pids for the given program name
} elseif { ! [ string equal self $pid ] } {
set fname [ lindex $data end-1 ]
if { [ string length $program ] < 9 } {
if { [ string equal $fname $program ] } {
lappend pids [ lindex $data 0 ]
}
} elseif { [ string length $fname ] && \
[ string match $fname* $program ] } {
lappend pids [ lindex $data 0 ]
}
}
;## what if file is owned by 'program' and is not
;## readable?
} elseif { [ string equal user $type ] } {
lappend noperm $file
}
}
} err ] } {
return -code error "[ myName ]: $err"
}
return $pids
}
## ********************************************************
## ********************************************************
##
## Name: ps::userpids
##
## Description:
## Return all process i.d.'s owned by a user.
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::userpids { user } {
if { [ catch {
set pids [ list ]
set files [ ps::procfiles $user ]
foreach file $files {
foreach [ list owner file ] $file { break }
set pid [ lindex [ split $file / ] end-1 ]
lappend pids $pid
}
} err ] } {
return -code error "[ myName ]: $err"
}
return $pids
}
## ********************************************************
## ********************************************************
##
## Name: ps::procfiles
##
## Description:
## Return the full list of proc files on the box, or a list
## of all proc files owned by a user.
##
## Parameters:
##
## Usage:
##
## Comments:
## Typically takes 250 usec * number of processes running.
proc ps::procfiles { { user all } } {
if { [ catch {
set temp [ list ]
foreach [ list os filename ] [ ps::os ] { break }
set files [ glob /proc/*/$filename ]
set files [ lsort -dictionary $files ]
if { [ string match /proc/self* [ lindex $files end ] ] } {
set files [ lrange $files 0 end-1 ]
}
if { [ string length $user ] } {
foreach file $files {
if { [ file exists $file ] } {
set owner [ file attributes $file -owner ]
if { [ string equal all $user ] || \
[ string equal $user $owner ] } {
lappend temp [ list $owner $file ]
}
}
set files $temp
}
}
} err ] } {
return -code error "[ myName ]: $err"
}
return $files
}
## ********************************************************
## ********************************************************
##
## Name: ps::procids
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::procids { user } {
if { [ catch {
set pids [ list ]
set files [ ps::procfiles $user ]
foreach file $files {
foreach [ list owner file ] $file { break }
lappend pids [ lindex [ split $file / ] end-1 ]
}
} err ] } {
return -code error "[ myName ]: $err"
}
return $pids
}
## ********************************************************
## ********************************************************
##
## Name: ps::zombies
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::zombies { program } {
if { [ catch {
set data [ list ]
set zombies [ list ]
if { [ string equal all $program ] } {
set type user
} else {
set type [ ps::type $program ]
}
foreach [ list os filename ] [ ps::os ] { break }
switch -exact -- $type {
pid {
set pids $program
}
prog {
set pids [ ps::ps $program ]
}
user {
set pids [ ps::procids $program ]
}
unknown {
return "argument of unknown type: '$program'"
}
}
foreach pid $pids {
set file /proc/${pid}/$filename
if { [ file readable $file ] } {
set data [ ps::$os $pid ]
set state [ lindex $data 1 ]
if { [ string equal Z $state ] } {
set owner [ lindex $data 2 ]
lappend zombies [ list $owner $data ]
}
}
}
} err ] } {
return -code error "[ myName ]: $err"
}
return $zombies
}
## ********************************************************
## ********************************************************
##
## Name: ps::kill
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::kill { program } {
if { [ catch {
foreach pid [ ps::ps $program ] {
puts stderr "calling kill -9 $pid ($program)"
catch { ::exec kill -9 $pid }
}
after 1000
if { [ catch {
set undead [ ps::zombies $program ]
if { [ llength $undead ] } {
put stderr "zombie ${program}'s: '$undead'"
}
} err ] } {
puts stderr "no zombie ${program}'s found."
set undead [ ps::zombies all ]
if { [ llength $undead ] } {
puts stderr "other zombies: '$undead'"
}
}
puts stderr DONE!
} err ] } {
return -code error "[ myName ]: $err"
}
}
## ********************************************************
## ********************************************************
##
## Name: ps::self
##
## Description:
## Returns lots of useful and ACCURATE information about
## the current process.
##
## Parameters:
##
## Usage:
##
## Comments:
## typical runtime is 2 ms.
proc ps::self { } {
if { [ catch {
set self [ pid ]
set me $::argv0
set os [ lindex [ ps::os ] 0 ]
set data [ ps::$os $self ]
foreach \
[ list pid state usr vsz rsz pcpu pmem etime fname args ] \
$data { break }
set etime [ ps::duration $etime ]
set retval [ list $me $self $pcpu $pmem $vsz $rsz $etime ]
} err ] } {
return -code error "[ myName ]: $err"
}
return $retval
}
## ********************************************************
## ********************************************************
##
## Name: ps::children
##
## Description:
## Return ps info for all children of current process.
##
## Parameters:
##
## Usage:
##
## Comments:
## Need ppid for this to work.
##
proc ps::children { args } {
if { [ llength $args ] == 1 } {
set args [ lindex $args 0 ]
}
if { [ catch {
return -code error UNIMPLEMENTED!
} err ] } {
return -code error "[ myName ]: $err"
}
}
## ********************************************************
## ********************************************************
##
## Name: ps::all
##
## Description:
## Return a full ps of all procs on the host.
##
## Parameters:
##
## Usage:
##
## Comments:
## Roughly 2 ms per process.
##
proc ps::all { args } {
if { [ catch {
set os [ lindex [ ps::os ] 0 ]
set files [ ps::procfiles {} ]
foreach file $files {
if { [ file readable $file ] } {
lappend data \
[ ps::$os [ lindex [ split $file / ] end-1 ] ]
}
}
} err ] } {
return -code error "[ myName ]: $err"
}
return $data
}
## ********************************************************
## ********************************************************
##
## Name: ps::duration
##
## Description:
## Apply to etime value to get 'human' time.
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::duration { secs } {
set timeatoms [ list ]
if { [ catch {
foreach div { 86400 3600 60 1 } \
mod { 0 24 60 60 } \
name { day hr min sec } {
set n [ expr {$secs / $div} ]
if { $mod > 0 } { set n [ expr {$n % $mod} ] }
if { $n > 1 } {
lappend timeatoms "$n ${name}s"
} elseif { $n == 1 } {
lappend timeatoms "$n $name"
}
}
set timeatoms [ join $timeatoms ]
if { ! [ string length $timeatoms ] } {
set timeatoms [ list 0 sec ]
}
} err ] } {
return -code error "duration: $err"
}
return $timeatoms
}
## ********************************************************
## ********************************************************
##
## Name: ps::server
##
## Description:
## Canned server definition so this library can be used
## as a server on a remote host.
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::server { port } {
if { [ catch {
ps::standalone
set cid [ socket -server ps::servercfg $port ]
} err ] } {
puts stderr "[ myName ]: $err"
}
}
## ********************************************************
## ********************************************************
##
## Name: ps::servercfg
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::servercfg { cid addr port } {
if { [ catch {
fileevent $cid readable "ps::serverhandler $cid"
} err ] } {
return -code error "[ myName ]: $err"
}
}
## ********************************************************
## ********************************************************
##
## Name: ps::serverhandler
##
## Description:
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::serverhandler { cid } {
if { [ catch {
::gets $cid cmd
if { ! [ regexp {^ps::[a-z]+(\s+\S+)?$} $cmd ] } {
set err "invalid command received: '$cmd'"
return -code error $err
}
catch { eval $cmd } reply
::puts $cid $reply
::close $cid
} err ] } {
catch { ::close $cid }
return -code error "[ myName ]: $err"
}
}
## ********************************************************
## ********************************************************
##
## Name: ps::standalone
##
## Description:
## Some helper functions that may not be defined outside
## of my API's.
##
## call this procedure once before using any of the above
## functions.
##
## Parameters:
##
## Usage:
##
## Comments:
##
proc ps::standalone { args } {
if { [ catch {
proc myName { args } {
return [ lindex [ info level -1 ] 0 ]
}
proc addLogEntry { args } {
puts "[ uplevel myName ]: $args"
}
proc bgerror { args } {
puts stderr $::errorInfo
}
} err ] } {
return -code error "[ myName ]: $err"
}
}
## ******************************************************** In Alpha, processes is a command that returns (drumroll) a list of descriptions of running processes (well, rather applications). Excerpt from join [processes] \n:
loginwindow lgnw APPL 5793 0000000000020001 /System/Library/CoreServices/loginwindow.app/Contents/MacOS/loginwindow
Dock dock APPL 8123 0000000000060001 /System/Library/CoreServices/Dock.app/Contents/MacOS/Dock
SystemUIServer syui APPL 8189 0000000000080001 /System/Library/CoreServices/SystemUIServer.app/Contents/MacOS/SystemUIServer
Finder MACS FNDR 8190 00000000000a0001 /System/Library/CoreServices/Finder.app/Contents/MacOS/Finder
iTunesHelper ithp APPL 9456 00000000000c0001 /Applications/iTunes.app/Contents/Resources/iTunesHelper.app/Contents/MacOS/iTunesHelper
iCalAlarmScheduler ???? APPL 9466 00000000000e0001 /Applications/iCal.app/Contents/Resources/iCalAlarmScheduler.app/Contents/MacOS/iCalAlarmScheduler
{Acrobat Reader 5.0} CARO APPL 102108211 0000000006e40001 {/Applications/Acrobat Reader 5.0/Contents/MacOS/Acrobat Reader 5.0}Newly released procfs
is an interface to the proc pseudo-filesystem on linux. The interface comes with a test suite, is not complete, but yet a good start. Any volunteer? EF
