# copyright (C) 1997-2001 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

set rcsId {$Id: ps.tcl,v 2.17 2001/01/27 15:08:19 jfontain Exp $}


# System dependent process data access procedures. Only Linux is supported at this time (who needs another OS?).
# Corresponding pkgIndex.tcl file content: package ifneeded ps 2 "source [file join $dir ps.tcl]"

package provide ps [lindex {$Revision: 2.17 $} 1]
package require miscellaneous 1
package require network 1

namespace eval ps {

    array set data {
        updates 0
        0,label PID 0,type integer 0,message {process identifier}
        1,label user 1,type ascii 1,message {user name}
        2,label %CPU 2,type real 2,message {processor usage in percent}
        3,label %memory 3,type real 3,message {memory usage in percent}
        4,label RSS 4,type integer 4,message {real memory size in kiloBytes}
        5,label TTY 5,type dictionary 5,message {terminal device (may be empty)}
        6,label status 6,type ascii 6,message {state: Running, Sleeping (D: uninterruptible), Zombie, Traced (or stopped)}
        7,label name 7,type dictionary 7,message {filename of the executable} 7,anchor left
        8,label {command line} 8,type dictionary 8,message {full command line} 8,anchor left
        views {
            {visibleColumns {0 1 2 3 4 5 6 7} sort {2 decreasing}}
            {visibleColumns {0 7 8} sort {7 increasing}}
        }
        switches {-r 1 --remote 1 -u 1 --users 1}
    }
    set file [open ps.htm]
    set data(helpText) [read $file]
    close $file

    proc initialize {optionsName} {
        upvar $optionsName options
        variable remote
        variable data
        variable userOrPID

        if {![catch {set locator $options(--remote)}]||![catch {set locator $options(-r)}]} {                   ;# remote monitoring
            set data(pollTimes) {30 20 60 120 300 600}                                   ;# poll less often when remotely monitoring
            set data(2,message) {processor usage in percent (approximated)}                                         ;# see help text
            foreach {remote(protocol) remote(user) remote(host)} [network::parseRemoteLocator $locator] {}
            network::checkRemoteOutputEmptiness $remote(protocol) $remote(user) $remote(host)
            set data(identifier) ps($remote(host))
            set remote(busy) 0
        } else {
            set data(pollTimes) {20 10 30 60 120 300 600}
        }
        set string {}
        catch {set string $options(-u)}
        catch {set string $options(--users)}                                                                    ;# favor long option
        foreach item [split $string ,] {                                      ;# comma separated list of PIDs / users (may be empty)
            set userOrPID($item) {}
        }
        updateUserNameArray                                               ;# inititialize user identifier to user name mapping array
    }

    proc updateUserNameArray {} {
        variable remote
        variable userName

        if {[info exists remote]} {
            set file [open "| /usr/bin/$remote(protocol) -n -l $remote(user) $remote(host) cat /etc/passwd"]
            fileevent $file readable {incr ::ps::remote(busy)}
            vwait ::ps::remote(busy)
        } else {
            set file [open /etc/passwd]
        }
        while {[gets $file line]>=0} {                                                    ;# build a user identifier to name mapping
            set list [split $line :]
            set userName([lindex $list 2]) [lindex $list 0]
        }
        close $file
        if {[info exists remote]} {
            incr remote(busy) -1
        }
    }

    proc ttyName {number} {                     ;# convert a terminal number into a terminal name (see linux/Documentation/proc.txt)
        variable pseudoTty

        set major [expr {$number>>8}]
        set minor [expr {$number&0xFF}]
        switch $major {
            2 {
                return pty$minor
            }
            3 {
                return ttyp$minor
            }
            4 {
                if {$minor<64} {
                    return tty$minor
                } elseif {$minor<68} {
                    return ttyS$minor
                }
            }
            5 {
                switch $minor {
                    0 {return tty}
                    1 {return console}
                    2 {return ptmx}
                }
                if {($minor>=64)&&($minor<68)} {
                    return cua$minor
                }
            }
            128 {
                return ptm$minor
            }
            136 {
                return pts$minor
            }
        }
        return {}                                                                                                  ;# not a terminal
    }

    proc update {} {
        variable remote

        if {[info exists remote]} {
            if {!$remote(busy)} {
                remoteUpdate
            }
        } else {
            localUpdate
        }
    }

    # gather processes status information (based on the proc man page information and fs/proc/array.c kernel source)
    proc localUpdate {} {
        variable uid                                                                                     ;# pid to uid mapping cache
        variable cmdline                                                                                ;# pid to command line cache
        variable data

        set currentDirectory [pwd]
        cd /proc                                                                                         ;# change to data directory
        set file [open meminfo]
        while {[gets $file line]>=0} {
            if {[scan $line {MemTotal: %u} memoryTotal]>0} break
        }
        close $file
        set file [open uptime]
        set uptime [lindex [gets $file] 0]                                                                             ;# in seconds
        close $file
        set pids [glob -nocomplain {[1-9]*}]
        foreach pid $pids {
            if {![info exists uid($pid)]} {                                                              ;# if uid is not yet cached
                if {[catch {open $pid/status} file]} continue                             ;# no valid data for this process, abandon
                while {[gets $file line]>=0} {
                    if {[scan $line {Uid: %u} uid($pid)]>0} break                                               ;# save uid in cache
                }
                close $file
                if {![info exists uid($pid)]} continue         ;# process may have disappeared while we were reading its status file
            }
            set current($pid) {}                                                                       ;# remember process existence
            if {[string length [set user [filteredUserFromPID $pid]]]==0} continue
            if {![info exists cmdline($pid)]} {                                                 ;# if command line is not yet cached
                if {[catch {open $pid/cmdline} file]} {                                                      ;# account for failures
                    unset current($pid)                                                                          ;# mark for cleanup
                    continue                                                              ;# no valid data for this process, abandon
                }
                set length [gets $file line]
                close $file
                if {$length==0} {                                                                            ;# account for failures
                    unset current($pid)
                    continue
                }
                regsub -all {\0} $line { } cmdline($pid) ;# command line arguments are null separated: replace with space characters
            }
            if {[catch {open $pid/stat} file]} {                                                     ;# process may have disappeared
                unset current($pid)
                continue
            }
            set length [gets $file line]
            set clock [expr {[clock clicks -milliseconds]/1000.0}]                     ;# immediately store current clock in seconds
            close $file
            if {$length==0} {                                                                                ;# account for failures
                unset current($pid)
                continue
            }
            updateProcessData $pid $user $uptime $clock $memoryTotal $line
        }
        cd $currentDirectory
        cleanupProcessesData current                                                          ;# clean up disappeared processes data
        incr data(updates)
    }

    proc remoteUpdate {} {                                    ;# modeled after localUpdate{}: comments there are not duplicated here
        variable remote

        # gather data at the other end in 1 shot to minimize network delays and remote processor usage, while also minimizing
        # local processing (data returned in array set command compatible list) and ignoring errors (empty data is then returned)

set command {\
exec 2>/dev/null
cd /proc
echo pid {$$}
pids=$(echo [0-9]*)
echo pids {$pids}
echo meminfo {$(fgrep MemTotal: meminfo)}
for id in $pids; do
    echo $id,status {$(fgrep Uid: $id/status)} $id,cmdline {$(tr "\0" " " < $id/cmdline)} $id,stat {$(cat $id/stat)}
done
echo uptime {$(cat uptime)}\
}
        incr remote(busy)
        set file [open [list | /usr/bin/$remote(protocol) -n -l $remote(user) $remote(host) $command]]
        fileevent $file readable "ps::remoteUpdated $file"                   ;# do not hang user interface and other modules updates
    }

    proc remoteUpdated {file} {                               ;# modeled after localUpdate{}: comments there are not duplicated here
        variable remote
        variable uid
        variable cmdline
        variable data

        if {[catch {array set there [read $file]}]} {          ;# network data may be corrupted or empty if host becomes unreachable
            flashMessage "ps error: data from network corrupted"
        }
        if {[catch {close $file} message]} {                                                                  ;# communication error
            flashMessage "ps error: $message"
            catch {unset there}                                                                ;# consider data corrupted as a whole
        }
        # array sample extract:
        # there(pid)         = 2504
        # there(pids)        = 1 1163 1164 1239 142 151 162 173 184 2 215 216 218 233 235 237 238 239 2494 2502 2504 2509 260 3
        # there(meminfo)     = MemTotal: 63520 kB
        # there(uptime)      = 1611.47 1549.09
        # there(184,cmdline) = gpm -t ps/2
        # there(184,stat)    = 184 (gpm) S 1 184 184 0 -1 320 8 0 11 0 0 0 0 0 0 0 0 0 1757 761856 85 2147483647 134512640 ...
        # there(184,status)  = Uid: 0 0 0 0
        if {![info exists there(meminfo)]||([scan $there(meminfo) {MemTotal: %u} memoryTotal]!=1)} {        ;# invalid returned data
            catch {unset there}                                                                ;# consider data corrupted as a whole
        }
        if {![info exists there(uptime)]||([llength $there(uptime)]==0)} {                                  ;# invalid returned data
            catch {unset there}                                                                ;# consider data corrupted as a whole
        }
        if {[info exists there]} {
            set uptime [lindex $there(uptime) 0]                                            ;# expected (example): "1611.47 1549.09"
            # use the same local clock value for all remote processes calculations
            set clock [expr {[clock clicks -milliseconds]/1000.0}]
            ldelete there(pids) $there(pid)                                                  ;# ignore data retrieval process itself
            foreach pid $there(pids) {
                if {![info exists uid($pid)]&&([scan $there($pid,status) {Uid: %u} uid($pid)]!=1)} continue
                set current($pid) {}                                                                   ;# remember process existence
                if {[string length [set user [filteredUserFromPID $pid]]]==0} continue
                if {![info exists cmdline($pid)]} {
                    set cmdline($pid) $there($pid,cmdline)
                }
                if {[string length $there($pid,stat)]==0} {
                    unset current($pid)
                    continue
                }
                updateProcessData $pid $user $uptime $clock $memoryTotal $there($pid,stat)
            }
        }
        cleanupProcessesData current
        incr remote(busy) -1
        incr data(updates)
    }

    proc updateProcessData {pid user uptime clock memoryTotal statLine} {
        variable last
        variable data
        variable cmdline                                                                                ;# pid to command line cache

        # scan some of the fields among:
        # pid comm state ppid pgrp session tty tpgid flags minflt cminflt majflt cmajflt utime stime cutime cstime priority nice
        # timeout itrealvalue starttime vsize rss rlim startcode endcode startstack kstkesp kstkeip signal blocked sigignore
        # sigcatch wchan nswap cnswap
        scan $statLine {\
            %*d (%[^)]) %s %d %*d %*d %d %*d %*u %*u %*u %*u %*u %u %u %*d %*d %*d %d %*d %*d %u %u %d %*u %*u %*u %*u %*u %*u %*u\
            %*u %*u %*u %u %*u %*u\
        } comm state ppid tty utime stime nice starttime vsize rss wchan
        # utime, stime and starttime are in hundredths of a second
        if {![info exists last($pid,utime)]} {                                                        ;# first occurence of this pid
            set cpu% [expr {($utime+$stime)/($uptime-($starttime/100.0))}]                ;# use average value since process started
        } else {                                                            ;# calculate cpu utilization during the last poll period
            set cpu% [expr {($utime-$last($pid,utime)+$stime-$last($pid,stime))/($clock-$last($pid,clock))}]
        }
        array set last "$pid,clock $clock $pid,utime $utime $pid,stime $stime"
        # set row data with pid (unique by definition) as row number. take into account page size (4 kBytes)
        array set data [list\
            $pid,0 $pid $pid,1 $user $pid,2 [format %.1f ${cpu%}] $pid,3 [format %.1f [expr {409.6*$rss/$memoryTotal}]]\
            $pid,4 [expr {4*$rss}] $pid,5 [ttyName $tty] $pid,6 $state $pid,7 $comm $pid,8 $cmdline($pid)\
        ]
    }

if {$::tcl_version>=8.4} {                                                                        ;# actually including and after a2
    proc cleanupProcessesData {currentPidsName} {
        upvar $currentPidsName current
        variable uid
        variable cmdline
        variable data
        variable last

        foreach pid [array names uid] {
            if {[info exists current($pid)]} continue
            unset uid($pid)                                                                                 ;# cleanup cache entries
            catch {unset cmdline($pid)}
            catch {unset last($pid,clock) last($pid,utime) last($pid,stime)}
            foreach name [array names data -regexp $pid,\\d+] {                                                    ;# cell data only
                unset data($name)                                                                                    ;# current data
                catch {unset last($name)}                                                                ;# and eventually last data
            }
        }
    }
} else {
    proc cleanupProcessesData {currentPidsName} {
        upvar $currentPidsName current
        variable uid
        variable cmdline
        variable data
        variable last

        foreach pid [array names uid] {
            if {[info exists current($pid)]} continue
            unset uid($pid)                                                                                 ;# cleanup cache entries
            catch {unset cmdline($pid)}
            catch {unset last($pid,clock) last($pid,utime) last($pid,stime)}
            foreach name [array names data $pid,\[0-9\]*] {                                                        ;# cell data only
                unset data($name)                                                                                    ;# current data
                catch {unset last($name)}                                                                ;# and eventually last data
            }
        }
    }
}

    proc filteredUserFromPID {pid} {
        variable uid
        variable userName
        variable userOrPID

        set user [set id $uid($pid)]                                                         ;# user name defaults to its identifier
        if {[catch {set user $userName($user)}]} {
            updateUserNameArray                                                                                  ;# handle new users
            if {[catch {set user $userName($user)}]} {                                                               ;# unknown user
                set userName($user) $user                                                   ;# keep using its identifier from now on
            }
        }
        if {[info exists userOrPID]} {                                                                                  ;# filtering
            if {[info exists userOrPID($user)]||[info exists userOrPID($id)]} {                                 ;# on user or its ID
                return $user
            } else {
                return {}
            }
        } else {                                                                                                     ;# no filtering
            return $user
        }
    }

}
