The procfs.tcl Script

Modification Date: 11/04/2009

Table of Procedures

getPid killChild procfs.tcl ps::all ps::children ps::duration ps::jiffieOverflow ps::kill ps::linuxTime ps::memOverflow ps::os ps::procfiles ps::procfsValidate

ps::procids ps::ps ps::self ps::server ps::servercfg ps::serverhandler ps::standalone ps::trace ps::type ps::userPids ps::zombies sysData

      foreach [ list name pid pcpu pmem vsz rss updt ] \
         [ sysData ] { break }
  returns:


           name pid pcpu pmem vsz rss updt
    where:


           name - name of the process as reported by ps
            pid - process i.d.


           pcpu - percent of cpu cycles used by process
           pmem - percent of system memory used by process
            vsz - total allocated memory for process
            rss - current memory in use
           updt - elapsed run time of process

proc getPidX { { prog "" } { host "" } } {
     set tmp  [ list ]
     set data [ list ]
     set pids [ list ]
     set api_rx "([ join $::API_LIST | ])"
     if { [ catch {
        if { [ string length $host ] } {
           ;## no problem
        } elseif { [ regexp -nocase $api_rx $prog -> api ] } {
           set host [ set ::${api}(host) ]
        } else {
           set host $::env(HOST)
        }
        ;## make sure to use * here instead of [pid] as we need API's pid
        if { [ info exists api ] } {
           set lockfile \
            [ glob -nocomplain [ file join $::env(RUNDIR) ${api}API .$api.*.lock ] ]
           if { [ file exists $lockfile ] } {
              set fid [ open $lockfile r ]
              set pids [ read $fid [ file size $lockfile ] ]
              addLogEntry "getting pids '$pids' from lockfile $lockfile" purple
              ::close $fid
           }
        }
        ;## should never get here
	   if { [ llength $pids ] == 0 } {
           if { ! [ string equal localhost $host ] && \
                ! [ string equal $host $::env(HOST) ] } {
              set data [ execssh $host /bin/ps -Ao fname,pid ]
           } else {
              set data [ exec /bin/ps -Ao fname,pid ]
           }
		
           ;## ps only returns first 8 chars of program name
           set pattern [ string range $prog 0 7 ]
           foreach line [ split $data "\n" ] {
              if { [ string equal $pattern [ lindex $line 1 ] ] } {
                 set pids [ lindex $line 0 ]
                 addLogEntry "pids $pids obtained from ps" purple
                 break
              } elseif { [ string match ${pattern}* [ lindex $line 0 ] ] } {
                 lappend pids [ lindex $line 1 ]
                 addLogEntry "appending pids $pids obtained from ps" purple
              }
           }
           set pids [ lsort -dictionary $pids ]
        }
	
     } err ] } {
     	addLogEntry $err red
        catch { ::close $fid }
        set pids [ list ]
     }
     return $pids
}

• pidlist - a list of program names and/or process id's.
  

      killChild $pidlist

proc killChild { pids_or_names { host "" } } {
     set errs [ list ]
     set api_rx "([ join $::API_LIST | ])"
     if { [ uplevel info exists jobid ] } {
        set jobid [ uplevel set jobid ]
     }
     set caller [ uplevel myName ]
     if { [ string equal manager $::API ] } {
        set manager 1
     } else {
        set manager 0
     }
     if { [ string equal cntlmon $::API ] } {
        set cntlmon 1
     } else {
        set cntlmon 0
     }
     set localhost $::env(HOST)
     if { ! [ string length $host ] } {
        set host $localhost
     }
     if { [ string equal $localhost $host ] } {
        set localhost 1
     } else {
        set localhost 0
     }
     foreach item $pids_or_names {
        if { [ catch {
           if { ! [ regexp {^[0-9]+$} $item pid ] } {
              set pid 0
           }
           if { [ regexp $api_rx $item -> api ]} {
              set host [ set ::${api}(host) ]
           } else {
              set api [ list ]
           }
           if { $localhost } {
              if { [ string length $api ] } {
                 if { $manager } {
                    exec /usr/bin/pkill -9 ${api}API
                 } else {
                    set err "Only the manager API can kill other API's, "
                    append err "sorry!"
                    return -code error $err
                 }
              } else {
                 if { $pid } {
                    kill -9 $pid
                 } else {
                    exec /usr/bin/pkill -9 $item
                 }
              }
           } else {
              if { [ string length $api ] } {
                 if { $manager } {
                    execssh $host /usr/bin/pkill -9 ${api}API
                 } else {
                    set err "Only the manager API can kill other API's, "
                    append err "sorry!"
                    return -code error $err
                 }
              } else {
                 if { $manager || $cntlmon } {
                    if { $pid } {
                       execssh $host kill -9 $pid
                    } else {
                       execssh $host /usr/bin/pkill -9 $item
                    }
                 } else {
                    set err "Only the manager and cntmon API's "
                    append err "can kill processes on remote hosts, "
                    append err "sorry!"
                    return -code error $err
                 }
              }
           }
        } err ] } {
           if { ! [ regexp {exited\s+abnormally} $err ] } {
              lappend errs "error while killing '$item': $err"
           }
        }
     } ;## end of foreach item
     if { [ llength $errs ] } {
        addLogEntry "$errs (called by $caller)" red
     }
}

proc ps::memOverflow { val } {
     if { [ catch {
        if { [ string length $val ] > 9 } {
           set val [ string range $val 0 end-3 ]
           set val [ expr int($val * (1000.0/1024)) ]
        } else {
           set val [ expr { $val / 1024 } ]
        }
     } err ] } {
        return -code error "[ myName ]: $err"
     }
     return $val
}

proc ps::linuxTime { pid uptime etime utime } {
     if { [ catch {
        ;## everything to seconds
        set etime [ ps::jiffieOverflow $etime ]
        set utime [ ps::jiffieOverflow $utime ]
        set etime [ expr { int($uptime) - $etime } ]
        if { [ info exists ::ps::pcpu($pid) ] } {
           foreach [ list x0 y0 ] $::ps::pcpu($pid) { break }
           if { [ catch {
              set pcpu [ expr { double($utime - $y0) / ($etime - $x0) } ]
              set pcpu [ expr { $pcpu * 100 } ]
           } err ] } {
              set pcpu 0
           }
           set ::ps::pcpu($pid) [ list $etime $utime ]
        } else {
           set ::ps::pcpu($pid) [ list $etime $utime ]
           set pcpu 0
        }
     } err ] } {
        return -code error "[ myName ]: $err"
     }
     return [ list $etime $pcpu ]
}

proc ps::jiffieOverflow { val } {
     if { [ catch {
        if { [ string length $val ] > 9 } {
           set val [ string range $val 0 end-2 ]
        } else {
           set val [ expr { $val / 100 } ]
        }
     } err ] } {
        return -code error "[ myName ]: $err"
     }
     return $val
}

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
}

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 ]
}

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
}

  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

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 [ getPSInfo $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
}

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
}

proc ps::procfiles { { user all } } {
     if { [ catch {
        set temp [ list ]
        foreach [ list os filename ] [ ps::os ] { break }
	 set files [ lsort -dictionary [ glob /proc/{0,1,2,3,4,5,6,7,8,9}*/$filename ] ]
        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
}

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
}

proc ps::zombies { { program all } } {
     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 [ getPSInfo $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
}

proc ps::kill { program } {
     if { [ catch {
	
	   foreach pid [ ps::ps $program ] {
           puts stderr "calling kill -9 $pid ($program)"
           catch { 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"
     }
}

proc ps::self { } {
     if { [ catch {
        set self [ pid ]
        set me $::argv0
        set data [ getPSInfo $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
}

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"
     }
}

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 \
		       [ getPSInfo [ lindex [ split $file / ] end-1 ] ]
	      }
	   }
	} err ] } {
        return -code error "[ myName ]: $err"
     }
	return $data
}

proc ps::trace { pid { sec 10 } } {
     if { [ catch {
	
	   set time [ expr { $sec * 1000 } ]
	   switch -exact $::tcl_platform(os) {
             SunOS {
                   set traceprog "/usr/bin/truss -f -p -rall -wall -i"
                   }
             Linux {
                   set traceprog "/usr/bin/strace -f -p"
                   }
           default {
                   return {}
                   }
           } ;## end of switch
		 set file ${::API}APItrace.[ clock seconds]
           set tracepid [ eval ::exec /usr/bin/env LD_PRELOAD= \
                          $traceprog $pid >& $file & ]
		 set traceprog [ lindex [ lindex $traceprog 0 ] end ]
		 after $time [ list ps::kill $traceprog ]
     } err ] } {
        return -code error "[ myName ]: $err"
     }
}

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
}

proc ps::server { port } {
     if { [ catch {
	   ps::standalone
        set cid [ socket -server ps::servercfg $port ]
     } err ] } {
        puts stderr "[ myName ]: $err"
     }
}

proc ps::servercfg { cid addr port } {
     if { [ catch {
        fileevent  $cid readable "ps::serverhandler $cid"
     } err ] } {
        return -code error "[ myName ]: $err"
     }
}

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"
     }
}

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"
     }
}