# copyright (C) 1997-2006 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

# $Id: cpustats.tcl,v 2.31 2006/01/28 19:16:59 jfontain Exp $


package provide cpustats [lindex {$Revision: 2.31 $} 1]
package require network 1
package require stooop 4.1
namespace import stooop::*
package require switched
if {[catch {package require Thread 2.5}]} {
    namespace eval cpustats {variable threads 0}
} else {                                                                                  ;# load thread worker class implementation
    package require threads 1
    namespace eval cpustats {variable threads 1}
}
package require linetask 1


namespace eval cpustats {

    array set data {
        updates 0
        0,label CPU 0,type ascii 0,message {CPU number (0 for all or a single CPUs)}
        1,label user 1,type real 1,message {percentage spent in user mode}
        2,label system 2,type real 2,message {percentage spent in system mode}
        3,label nice 3,type real 3,message {percentage spent in nice mode}
        4,label idle 4,type real 4,message {percentage spent in idle mode}
        5,label iowait 5,type real 5,message {percentage spent waiting for I/O to complete}
        6,label irq 6,type real 6,message {percentage spent servicing interrupts}
        7,label softirq 7,type real 7,message {percentage spent servicing software interrupts}
        sort {0 increasing}
        persistent 1 64Bits 1
        switches {-C 0 --daemon 0 -i 1 -p 1 --proc 1 -r 1 --remote 1}
    }
    # note: a 64 bit module since it has been observed on a 2.6 Linux kernel that /proc/stat contains 64 bit counters
    set file [open cpustats.htm]
    set data(helpText) [::read $file]                                                         ;# initialize HTML help data from file
    close $file
    unset file

    proc initialize {optionsName} {
        upvar 1 $optionsName options
        variable local
        variable remote
        variable data
        variable threads                                                                     ;# whether threads package is available

        set statistics /proc; catch {set statistics $options(--proc)}                    ;# note: use /compat/linux/proc for FreeBSD
        set statistics [file join $statistics stat]                                                                     ;# data file
        catch {set locator $options(-r)}; catch {set locator $options(--remote)}                                ;# favor long option
        if {[info exists locator]} {                                                                                  ;# remote host
            set data(pollTimes) {20 10 30 60 120 300 600}                                ;# poll less often when remotely monitoring
        } else {                                                                                                       ;# local host
            set data(pollTimes) {10 5 20 30 60 120 300 600}
            set local(statistics) [open $statistics]                                  ;# keep local file open for better performance
            return                                                                                               ;# local monitoring
        }
        # for remote monitoring, decode protocol, remote user and host
        foreach {remote(protocol) remote(user) remote(host)} [network::parseRemoteLocator $locator] {}
        set remote(rsh) [string equal $remote(protocol) rsh]
        set data(identifier) cpustats($remote(host))
        # important: pack data in a single line using special control separator characters
        set remote(command) "cat $statistics 2>&1 | tr '\\n' '\\v'"
        if {[string equal $::tcl_platform(platform) unix]} {
            if {$remote(rsh)} {
                set command "rsh -n -l $remote(user) $remote(host) {$remote(command)}"
            } else {
                set command ssh
                if {[info exists options(-C)]} {append command { -C}}                                            ;# data compression
                if {[info exists options(-i)]} {append command " -i \"$options(-i)\""}                              ;# identity file
                if {[info exists options(-p)]} {append command " -p $options(-p)"}                                           ;# port
                append command " -T -l $remote(user) $remote(host)"
            }
        } else {                                                                                                          ;# windows
            if {$remote(rsh)} {error {use -r(--remote) ssh://session syntax (see help)}}
            set remote(rsh) 0
            set command "plink -ssh -batch -T $remote(host)"       ;# note: host must be a putty session and pageant must be running
        }
        if {$remote(rsh)} {
            set access r                                                                            ;# writing to pipe is not needed
        } else {
            set access r+                                                                                     ;# bi-directional pipe
            # terminate remote command output by a newline so that the buffered stream flushes it through the pipe as soon as the
            # remote data becomes available:
            append remote(command) {; echo}
        }
        set remote(task) [new lineTask\
            -command $command -callback cpustats::read -begin 0 -access $access -translation lf -threaded $threads\
        ]
        if {![info exists options(--daemon)] && !$remote(rsh)} {             ;# for ssh, detect errors early when not in daemon mode
            lineTask::begin $remote(task)
        }                                                       ;# note: for rsh, shell and command need be restarted at each update
        set remote(busy) 0
    }

    proc update {} {                                               ;# gather cpu statistics (based on the proc man page information)
        variable remote
        variable local

        if {[info exists remote]} {
            if {$remote(busy)} return                                               ;# core invocation while waiting for remote data
            set remote(busy) 1
            if {[lineTask::end $remote(task)]} {                                                           ;# rsh or ssh daemon mode
                lineTask::begin $remote(task)                       ;# note: for rsh, shell and command are restarted here each time
            }
            if {!$remote(rsh)} {
                lineTask::write $remote(task) $remote(command)             ;# start data retrieval by sending command to remote side
            }
        } else {
            seek $local(statistics) 0                                                               ;# rewind before retrieving data
            process [split [::read -nonewline $local(statistics)] \n]
        }
    }

    proc process {lines} {                                                       ;# process statistics data lines and update display
        variable last
        variable data

        set list {}
        foreach line $lines {
            if {[string match cpu* $line]} {lappend list $line}                                       ;# only process CPU data lines
        }
        set single [expr {[llength $list] <= 2}]                                ;# single processor: 1 total line + 1 processor line
        set first 1                                                     ;# first line is for all CPUs, data is in 100ths of a second
        foreach line $list {
            if {$first} {
                set first 0
                set columns [scan $line {cpu %lu %lu %lu %lu %lu %lu %lu} user nice system idle iowait irq softirq]
                if {$columns < 7} {                                                                                    ;# kernel 2.4
                    set iowait {}; set irq {}; set softirq {}
                }                                                                                       ;# else kernel 2.6 and above
                updateRow 0 $user $nice $system $idle $iowait $irq $softirq
                if {$single} break                                    ;# display per CPU statistics only if there is more than 1 CPU
            } elseif {[scan $line {cpu%u %lu %lu %lu %lu %lu %lu %lu} index user nice system idle iowait irq softirq] >= 4} {
                updateRow [expr {$index + 1}] $user $nice $system $idle $iowait $irq $softirq       ;# real CPU numbers start from 1
            }
        }
        if {$first} {                                                                                           ;# data is corrupted
            catch {array unset data {[0-9]*,[0-9]*}}
            catch {unset last}
            array set data {0,0 0 0,1 ? 0,2 ? 0,3 ? 0,4 ? 0,5 ? 0,6 ? 0,7 ?}           ;# only display first row with unknown values
            set message "invalid data: [lindex $lines 0]"
            if {[llength $lines] > 1} {append message "..."}
            flashMessage $message
        }
        incr data(updates)
    }

    proc updateRow {index user nice system idle iowait irq softirq} {                          ;# the last 3 parameters can be empty
        variable last
        variable data

        set extended [string length $iowait]                                    ;# boolean, implies irq and softirq are also defined
        if {[info exists last($index,user)]} {
            set userDelta [expr {$user - $last($index,user)}]
            set niceDelta [expr {$nice - $last($index,nice)}]
            set systemDelta [expr {$system - $last($index,system)}]
            set idleDelta [expr {$idle - $last($index,idle)}]
            # force floating point calculations:
            if {$extended} {
                set iowaitDelta [expr {$iowait - $last($index,iowait)}]
                set irqDelta [expr {$irq - $last($index,irq)}]
                set softirqDelta [expr {$softirq - $last($index,softirq)}]
                set divider [expr {\
                    ($userDelta + $niceDelta + $systemDelta + $idleDelta + $iowaitDelta + $irqDelta + $softirqDelta) / 100.0}\
                ]
            } else {
                set divider [expr {($userDelta + $niceDelta + $systemDelta + $idleDelta) / 100.0}]
            }
            if {$divider == 0} {                                                                              ;# should never happen
                array set data [list $index,1 0 $index,2 0 $index,3 0 $index,4 100]
                if {$extended} {
                    array set data [list $index,5 0 $index,6 0 $index,7 0]
                }
            } else {
                array set data [list\
                    $index,1 [format %.1f [expr {$userDelta / $divider}]] $index,2 [format %.1f [expr {$systemDelta / $divider}]]\
                    $index,3 [format %.1f [expr {$niceDelta / $divider}]] $index,4 [format %.1f [expr {$idleDelta / $divider}]]\
                ]
                if {$extended} {
                    array set data [list\
                        $index,5 [format %.1f [expr {$iowaitDelta / $divider}]]\
                        $index,6 [format %.1f [expr {$irqDelta / $divider}]]\
                        $index,7 [format %.1f [expr {$softirqDelta / $divider}]]\
                    ]
                }
            }
        } else {                                                                       ;# first pass: CPU usage cannot be determined
            set data($index,0) $index
            array set data [list $index,1 ? $index,2 ? $index,3 ? $index,4 ? $index,5 ? $index,6 ? $index,7 ?]
        }
        set last($index,user) $user
        set last($index,system) $system
        set last($index,nice) $nice
        set last($index,idle) $idle
        if {$extended} {
            set last($index,iowait) $iowait
            set last($index,irq) $irq
            set last($index,softirq) $softirq
        }
    }

    proc read {line} {                                       ;# read remote data now that it is available and possibly handle errors
        variable remote

        switch $lineTask::($remote(task),event) {
            end {
                # either valid data availability as rsh connection was closed, or connection broken for ssh, in which case remote
                # shell command will be attempted to be restarted at next update
            }
            error {                                                                              ;# some communication error occured
                set message "error on remote data: $lineTask::($remote(task),error)"
            }
            timeout {                                                                         ;# remote host did not respond in time
                set message "timeout on remote host: $remote(host)"
            }
        }
        # note: in case of an unexpected event, task insures that line is empty
        if {[info exists message]} {
            flashMessage $message
        }
        process [split [string trimright $line \v] \v]
        set remote(busy) 0
    }

}
