# 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: diskstats.tcl,v 1.18 2006/03/26 18:59:45 jfontain Exp $


package provide diskstats [lindex {$Revision: 1.18 $} 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 diskstats {variable threads 0}
} else {                                                                                  ;# load thread worker class implementation
    package require threads 1
    namespace eval diskstats {variable threads 1}
}
package require linetask 1


namespace eval diskstats {

    # the table key is obviously the disk or partition name:
    array set data {
        updates 0
        0,label name 0,type dictionary 0,message {partition or disk name (partitions are numbered)}
        1,label size 1,type real 1,message {size in megabytes}
        2,label read 2,type real 2,message {kilobytes read, per second, averaged over the last poll period}
        3,label written 3,type real 3,message {kilobytes written, per second, averaged over the last poll period}
        4,label reading 4,type real 4,message {time spent reading in % during the last poll period (for disks only)}
        5,label writing 5,type real 5,message {time spent writing in % during the last poll period (for disks only)}
        6,label busy 6,type real 6,message {time spent doing I/O in % during the last poll period (for disks only)}
        sort {0 increasing}
        persistent 1
        switches {-a 0 --all 0 -C 0 --daemon 0 -i 1 -p 1 --partitions 0 -r 1 --remote 1}
    }
    set file [open diskstats.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
        variable disks 1                                                                                 ;# whether to display disks
        variable partitions 0                                                                       ;# whether to display partitions

        if {[info exists options(--partitions)]} {                                                        ;# display partitions only
            set disks 0
            set partitions 1
        }
        if {[info exists options(-a)] || [info exists options(--all)]} {                        ;# display both disks and partitions
            set disks 1
            set partitions 1
        }
        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(partitions) [open /proc/partitions]                            ;# keep local files open for better performance
            catch {set local(diskstats) [open /proc/diskstats]}                                      ;# does not exist in 2.4 kernel
            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) diskstats($remote(host))
        # important: pack data in a single line using special control separator characters
        # ignore errors caused by missing diskstats file in 2.4 kernel
        set remote(command) {[ -r /proc/diskstats ] && cat /proc/partitions /proc/diskstats 2>&1 | tr '\n' '\v' || cat /proc/partitions 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 diskstats::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 {} {
        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(partitions) 0                                                               ;# rewind before retrieving data
            if {[info exists local(diskstats)]} {                                                                      ;# 2.6 kernel
                seek $local(diskstats) 0
                process [split [::read -nonewline $local(partitions)]\n[::read -nonewline $local(diskstats)] \n]
            } else {
                process [split [::read -nonewline $local(partitions)] \n]
            }
        }
    }

    proc process {lines} {                                         ;# process partitions and diskstats data lines and update display
        variable data
        variable last
        variable disks
        variable partitions

        set clock [expr {[clock clicks -milliseconds] / 1000.0}]                       ;# immediately store current clock in seconds
        if {[info exists last(clock)]} {
            set period [expr {$clock - $last(clock)}]
        }
        foreach line $lines {
            set length [llength $line]
            if {($length == 0) || ![string is integer -strict [lindex $line 0]]} continue   ;# a valid line begins with major number
            catch {unset blocks}
            catch {unset rsect}
            catch {unset ruse}
            switch $length {
                4 {    ;# partitions file line without statistics: 2.6 kernel or 2.4 with per partitions statistics feature disabled
                    foreach {major minor blocks name} $line {}
                }
                7 {                                                             ;# diskstats file line for a partition in 2.6 kernel
                    foreach {major minor name rio rsect wio wsect} $line {}
                }
                14 {                                                                 ;# diskstats file line for a disk in 2.6 kernel
                    foreach {major minor name rio rmerge rsect ruse wio wmerge wsect wuse running use aveq} $line {}
                }
                15 {                                                           ;# partitions file line with statistics in 2.4 kernel
                    foreach {major minor blocks name rio rmerge rsect ruse wio wmerge wsect wuse running use aveq} $line {}
                }
                default {
                    continue                                                     ;# invalid line (should never happen at this point)
                }
            }
            if {!$disks || !$partitions} {                                                                                 ;# filter
                set partition [string match {*[0-9]} $name]                     ;# if names ends by a number, it must be a partition
                if {($partition && !$partitions) || (!$partition && !$disks)} continue                             ;# skip this line
            }
            set row [format %u [expr {($major << 20) | $minor}]]
            set data($row,0) $name
            if {[info exist blocks]} {                                                                       ;# partitions file line
                set value [expr {$blocks / 1024.0}]                           ;# block size is always 1024 bytes in the Linux kernel
                if {$value < 100} {                                                                       ;# less than 100 megabytes
                    set data($row,1) [format %.1f $value]
                } else {
                    set data($row,1) [expr {round($value)}]
                }
            } elseif {![info exists data($row,1)]} {                             ;# do not erase existing value from partitions file
                set data($row,1) ?
            }
            set data($row,2) ?; set data($row,3) ?
            # notes: counters wrapping creates no problems since differences between current and last values are 64 bit integers
            # subtractions (automatic on 32 and 64 bit Tcl platforms) (counters format from block/genhd.c)
            # assume 512 bytes sector size (see iostat command and source), time data is in milliseconds
            if {[info exist rsect]} {                                                 ;# line with read and write minimal statistics
                if {[info exists last($row,rsect)]} {                                                   ;# previous poll data exists
                    set data($row,2) [format %.1f [expr {($rsect - $last($row,rsect)) / $period / 2.0}]]   ;# in Kb/s
                    set data($row,3) [format %.1f [expr {($wsect - $last($row,wsect)) / $period / 2.0}]]
                }
                set last($row,rsect) $rsect
                set last($row,wsect) $wsect
            }
            set data($row,4) ?; set data($row,5) ?; set data($row,6) ?
            if {[info exist ruse]} {             ;# this is a 2.6 kernel disk entry or an enabled 2.4 kernel disk or partition entry
                # notes: counters wrapping creates no problems since differences between current and last values are forced as pure
                # 32 bit integers subtractions (valid on 32 and 64 bit Tcl platforms) (counters format from block/genhd.c)
                if {[info exists last($row,ruse)]} {                                                    ;# previous poll data exists
                    set data($row,4) [format %.1f [expr {(($ruse - $last($row,ruse)) & 0xFFFFFFFF) / $period / 10.0}]]       ;# in %
                    set data($row,5) [format %.1f [expr {(($wuse - $last($row,wuse)) & 0xFFFFFFFF) / $period / 10.0}]]
                    set data($row,6) [format %.1f [expr {(($use - $last($row,use)) & 0xFFFFFFFF) / $period / 10.0}]]
                }
                set last($row,ruse) $ruse
                set last($row,wuse) $wuse
                set last($row,use) $use
            }
            set current($row) {}
        }
        foreach name [array names data *,0] {                                                         ;# cleanup disappeared entries
            set row [lindex [split $name ,] 0]
            if {![info exists current($row)]} {array unset data $row,\[0-9\]*}
        }
        set last(clock) $clock
        if {![info exists current] && ([string length [lindex $lines 0]] > 0)} {
            set message "invalid data: [lindex $lines 0]"
            if {[llength $lines] > 1} {append message "..."}
            flashMessage $message
        }
        incr data(updates)
    }

    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
    }

}
