# 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: partitions.tcl,v 1.12 2006/03/26 19:25:24 jfontain Exp $


package provide partitions [lindex {$Revision: 1.12 $} 1]
package require network 1
if {[string equal $::tcl_platform(platform) unix]} {   ;# note: since this module is obsolete, include soon to be obsolete procedure
    proc network::checkRemoteOutputEmptiness {command user host} {
        catch "exec $command -n -l $user $host :" output
        if {[string length $output] > 0} {
            error "remote host \"$host\" error:\n$output"
        }
    }
} else {                                                                                                                  ;# windows
    proc network::checkRemoteOutputEmptiness {command user host} {
        catch "exec plink -batch $host :" output
        if {[string length $output] > 0} {
            error "remote host \"$host\" error:\n$output"
        }
    }
}

namespace eval partitions {

    variable nextIndex 0                                                                                ;# unique index for new rows

    # the table key is obviously the 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 {number of kilobytes read, per second, averaged over the last poll period}
        3,label written 3,type real 3,message {number of kilobytes written, per second, averaged over the last poll period}
        4,label operations 4,type real
            4,message {number of kilobytes read or written, per second, averaged over the last poll period}
        5,label {read duration} 5,type integer
            5,message {number of milliseconds per read operation, averaged over the last poll period}
        6,label {write duration} 6,type integer
            6,message {number of milliseconds per write operation, averaged over the last poll period}
        7,label queueing 7,type integer 7,message {average queueing timer per operation, in milliseconds, for the last poll period}
        sort {0 increasing}
        switches {-a 0 --all 0 -d 0 --disks 0 -r 1 --remote 1}
    }

    set file [open partitions.htm]
    set data(helpText) [read $file]                                                           ;# initialize HTML help data from file
    close $file
    unset file

    proc initialize {optionsName} {
        upvar 1 $optionsName options
        variable remote
        variable data
        variable partitionsFile
        variable disks 0                                                                                 ;# whether to display disks
        variable partitions 1                                                                       ;# whether to display partitions

        if {[info exists options(-d)] || [info exists options(--disks)]} {                                     ;# display disks only
            set disks 1
            set partitions 0
        }
        if {[info exists options(-a)] || [info exists options(--all)]} {                        ;# display both disks and partitions
            set disks 1
            set partitions 1
        }
        if {![catch {set locator $options(--remote)}] || ![catch {set locator $options(-r)}]} {                 ;# remote monitoring
            set data(pollTimes) {20 10 30 60 120 300 600}                                ;# poll less often when remotely monitoring
            foreach {remote(protocol) remote(user) remote(host)} [network::parseRemoteLocator $locator] {}
            network::checkRemoteOutputEmptiness $remote(protocol) $remote(user) $remote(host)
            set data(identifier) partitions($remote(host))
            if {[string equal $::tcl_platform(platform) unix]} {
                set command "$remote(protocol) -n -l $remote(user) $remote(host) head -1 /proc/partitions"
            } else {                                                                                                      ;# windows
                set command "plink -batch $remote(host) head -1 /proc/partitions"                  ;# host is rather a putty session
            }
            set file [open "| $command"]
            fileevent $file readable {set ::partitions::remote(busy) 0}
            vwait ::partitions::remote(busy)                                                           ;# do not hang user interface
        } else {
            set data(pollTimes) {10 5 20 30 60 120 300 600}
            set file [open /proc/partitions]
        }
        set line [gets $file]                                                                               ;# retrieve headers line
        if {[info exists remote]} {
            # detect errors early (but avoid write on pipe with no readers errors by reading whole data)
            if {[catch {read $file} message] || [catch {close $file} message]} {
                error "on remote host $remote(host) as user $remote(user): $message"
            }
        } else {
            set partitionsFile $file                                                  ;# keep local file open for better performance
        }
        if {[llength $line] < 15} {                                                        ;# see if there are enough fields present
            error "bad /proc/partitions format:\n\"per partition statistics in /proc/partitions\" feature\nis probably not enabled in the kernel"
        }
        if {[info exists remote]} {
            # do as much pre-processing as possible on the remote host and return only the required data to optimize performance on
            # slow links. skip first 2 lines: header and blank separator.
            set remote(command) \
                {(read; read; while read major minor blocks name rio rmerge rsect ruse wio wmerge wsect wuse running use aveq; do }
            if {$disks && $partitions} {
                append remote(command) {echo $blocks $name $rsect $ruse $wsect $wuse $aveq;}
            } else {
                if {$disks} {
                    set pattern {*[^0-9]}
                } else {
                    set pattern {*[0-9]}                                                          ;# partition names end by a number
                }
                append remote(command) \
                    "if \[\[ \$name == $pattern \]\]; then echo \$blocks \$name \$rsect \$ruse \$wsect \$wuse \$aveq; fi"
            }
            append remote(command) { done) < /proc/partitions}
        }
    }

    proc update {} {                                                                             ;# invoked periodically by the core
        variable remote

        if {[info exists remote]} {
            if {!$remote(busy)} remoteUpdate                                                             ;# avoid concurrent updates
        } else {
            localUpdate
        }
    }

    proc localUpdate {} {                                                                          ;# data resides in the local host
        variable partitionsFile
        variable disks
        variable partitions

        seek $partitionsFile 0                                                                      ;# rewind before retrieving data
        gets $partitionsFile; gets $partitionsFile                                          ;# skip headers and blank separator line
        set lines {}
        while {[gets $partitionsFile line] >= 0} {
            set name {}
            foreach {major minor blocks name rio rmerge rsect ruse wio wmerge wsect wuse running use aveq} $line break
            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
            }
            lappend lines [list $blocks $name $rsect $ruse $wsect $wuse $aveq]
        }
        process $lines
    }

    proc remoteUpdate {} {                                                               ;# initiate data retrieval from remote host
        variable remote

        set remote(busy) 1
        if {[string equal $::tcl_platform(platform) unix]} {
            set channel [open [list | $remote(protocol) -n -l $remote(user) $remote(host) $remote(command)]]
        } else {                                                                                                          ;# windows
            set channel [open [list | plink -batch $remote(host) $remote(command)]]
        }
        fileevent $channel readable "partitions::remoteUpdated $channel"     ;# do not hang user interface and other modules updates
    }

    proc remoteUpdated {channel} {                                                         ;# data is now available from remote host
        variable remote

        set lines {}
        while {[gets $channel line] >= 0} {
            lappend lines $line
        }
        read $channel                                        ;# avoid write on pipe with no readers errors by reading remaining data
        if {[catch {close $channel} message]} {                                                                  ;# an error occured
            flashMessage "error: $message"
            set lines {}                                                                       ;# consider data corrupted as a whole
        }
        process $lines
        set remote(busy) 0
    }

    # sample /proc/partitions output:
    #
    # major minor #blocks  name rio  rmerge rsect  ruse   wio  wmerge wsect wuse  running use    aveq
    #
    #   22     0   8257032 hdc  1    3      8      10     0    0      0     0     -2      643770 41676482
    #   22     1   8249346 hdc1 0    0      0      0      0    0      0     0     0       0      0
    #   22    64    674978 hdd  0    0      0      0      0    0      0     0     -14     629370 34141112
    #    3     0   2062368 hda  182  1035   1228   460    2    2      4     20    0       480    480
    #    3     1   1798240 hda1 180  1032   1212   400    2    2      4     20    0       420    420
    #    3     2    264096 hda2 1    0      8      30     0    0      0     0     0       30     30
    #    3    64  40209120 hdb  5049 9492   116292 153170 2763 2575   42832 92630 -3      642110 41278532
    #    3    65  40209088 hdb1 5048 9489   116284 153170 2763 2575   42832 92630 0       30310  245870

    # process partitions file entries including the following fields only: blocks name rsect ruse wsect wuse aveq
    proc process {lines} {
        variable data
        variable last                                                                          ;# last values for delta calculations
        variable index                                                                                 ;# name to row number mapping
        variable nextIndex

        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 {
            if {[scan $line {%u %s %u %u %u %u %u} blocks name rsect ruse wsect wuse aveq] != 7}\
                continue                                                                               ;# only process valid entries
            if {[catch {set row $index($name)}]} {                                                                      ;# new entry
                set row [set index($name) $nextIndex]
                incr nextIndex
                set data($row,0) $name                                                                     ;# initialize static data
                set data($row,2) ?                                                                         ;# and yet unknown values
                set data($row,3) ?
                set data($row,4) ?
                set data($row,5) ?
                set data($row,6) ?
                set data($row,7) ?
            }
            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)}]
            }
            if {[info exists last($row,rsect)]} {                                                       ;# previous poll data exists
                # note: counters wrapping creates no problems since differences between current and last values are forced as pure
                # integers subtractions:
                set read [expr {($rsect - $last($row,rsect)) & 0xFFFFFFFF}]
                set written [expr {($wsect - $last($row,wsect)) & 0xFFFFFFFF}]
                set operations [expr {$read + $written}]
                set data($row,2) [format %.1f [expr {$read / 2 / $period}]] ;# assume 512 bytes size (see iostat command and source)
                set data($row,3) [format %.1f [expr {$written / 2 / $period}]]
                set data($row,4) [format %.1f [expr {$operations / 2 / $period}]]
                if {$operations > 0} {
                    set data($row,5) [expr {round((($ruse - $last($row,ruse)) & 0xFFFFFFFF) / $operations)}]
                    set data($row,6) [expr {round((($wuse - $last($row,wuse)) & 0xFFFFFFFF) / $operations)}]
                    set data($row,7) [expr {round((($aveq - $last($row,aveq)) & 0xFFFFFFFF) / $operations)}]
                } else {                                                             ;# there was no operations during the last poll
                    set data($row,5) ?
                    set data($row,6) ?
                    set data($row,7) ?
                }
            }
            set last($row,rsect) $rsect
            set last($row,wsect) $wsect
            set last($row,ruse) $ruse
            set last($row,wuse) $wuse
            set last($row,aveq) $aveq
            set current($name) {}
        }
        cleanupEntriesData current
        set last(clock) $clock
        incr data(updates)
    }

    proc cleanupEntriesData {currentName} {
        upvar $currentName current
        variable index
        variable data
        variable last

        foreach {name row} [array get index] {                                                        ;# cleanup disappeared entries
            if {[info exists current($name)]} continue
            unset index($name) last($row,rsect) last($row,wsect) last($row,ruse) last($row,wuse) last($row,aveq)\
                data($row,0) data($row,1) data($row,2) data($row,3) data($row,4) data($row,5) data($row,6) data($row,7)
        }
    }

}
