# 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: diskstats.tcl,v 2.10 2001/01/27 15:08:19 jfontain Exp $}


package provide diskstats [lindex {$Revision: 2.10 $} 1]

namespace eval diskstats {

    set file [open /proc/version]                                                                      ;# first check kernel version
    regexp {^[\d\.]+} [lindex [gets $file] 2] version                             ;# ignore extra characters, such as in 2.2.0-pre1
    close $file

    if {[package vcompare $version 2]<0} {
        error {at least a version 2 kernel is needed}
    }
    set full [expr {[package vcompare $version 2.1]>=0}]                                 ;# 2.1 kernels and up support full features

    array set data {
        updates 0
        0,label disk 0,type integer 0,message {disk index}
        1,label {read IOs} 1,type integer 1,message {number of read operations}
        2,label {write IOs} 2,type integer 2,message {number of write operations}
        3,label {blocks read} 3,type integer 3,message {number of blocks read}
        4,label {blocks written} 4,type integer 4,message {number of blocks written}
        pollTimes {10 5 20 30 60 120 300}
        sort {0 increasing}
    }
    set file [open diskstats.htm]
    set data(helpText) [read $file]
    close $file

    if {$full} {
        array set data {
            5,label device 5,type ascii 5,message {device (sd*: SCSI, hd*: IDE)}
            6,label type 6,type ascii 6,message {type or media}
            7,label size 7,type real 7,message {size in MegaBytes}
            8,label model 8,type ascii 8,message {model description} 8,anchor left
            views {
                {visibleColumns {0 1 2 3 4} sort {0 increasing}}
                {visibleColumns {0 5 6 7 8} sort {0 increasing}}
            }
        }
    }

    # initialize disk index, device, type, size and model cells
    array set data {
        0,0 0 1,0 1 2,0 2 3,0 3 0,5 {} 1,5 {} 2,5 {} 3,5 {} 0,6 {} 1,6 {} 2,6 {} 3,6 {} 0,7 0 1,7 0 2,7 0 3,7 0
        0,8 {} 1,8 {} 2,8 {} 3,8 {}
    }

    set statistics [open /proc/stat]                                                   ;# keep the files open for better performance

    if {$full} {
        set partitions [open /proc/partitions]
        array set scsiFromCharacter {h 0 s 1}
        array set indexFromCharacter {a 0 b 1 c 2 d 3}
    }

    proc update {} {                                                                                       ;# gather disk statistics
        variable full
        variable statistics
        variable last
        variable data

        if {$full} {
            variable partitions
            variable scsiFromCharacter
            variable indexFromCharacter

            seek $partitions 0                                                               ;# always rewind before retrieving data
            gets $partitions; gets $partitions                                                                       ;# skip headers
            set nextSCSINumber 0
            while {[gets $partitions line]>=0} {
                if {![regexp {([hs])d([abcd])$} $line device type character]} continue                                 ;# not a disk
                set index $indexFromCharacter($character)
                set exists($index) {}                                                         ;# keep track of existing disk indices
                if {[string length $data($index,5)]>0} continue                         ;# known disk, no need to update static data
                # SCSI has highest priority. IDE entry is taken into account only if SCSI was not present.
                if {$scsiFromCharacter($type)||([string length $data($index,5)]==0)} {
                    set data($index,5) $device
                    scan $line {%*u %*u %u} blocks
                    # assume block size is always 1024 in /proc/partitions and avoid integer overflowing
                    set data($index,7) [expr {round($blocks/1024.0)}]
                    if {$scsiFromCharacter($type)} {                                                                         ;# SCSI
                        set file [open /proc/scsi/scsi]
                        gets $file                                                                               ;# skip header line
                        set diskNumber 0
                        while {[gets $file line]>=0} {                                             ;# each entry has 3 lines of data
                            regexp {Vendor:(.*)Model:(.*)Rev:(.*)$} [gets $file] dummy vendor model revision
                            regexp {Type:(.*)ANSI SCSI revision:} [gets $file] dummy media
                            set media [string trim $media]
                            if {![string equal $media Direct-Access]} continue      ;# not a disk therefore not listed in partitions
                            if {$diskNumber==$nextSCSINumber} {            ;# assume that SCSI devices are listed in discovery order
                                set data($index,6) $media
                                set data($index,8) "[string trim $vendor], [string trim $model], [string trim $revision]"
                                incr nextSCSINumber
                                break                                                                          ;# done for this disk
                            }
                            incr diskNumber
                        }
                        close $file
                    } else {                                                                                                  ;# IDE
                        set file [open /proc/ide/$device/media]
                        gets $file data($index,6)
                        close $file
                        set file [open /proc/ide/$device/model]
                        gets $file data($index,8)
                        close $file
                    }
                }
            }
            for {set index 0} {$index<4} {incr index} {                                            ;# cleanup disappeared disks data
                if {[info exists exists($index)]} continue                                                      ;# no cleanup needed
                array set data "$index,5 {} $index,6 {} $index,7 0 $index,8 {}"                          ;# reset static table cells
            }
        }

        seek $statistics 0                                                                   ;# always rewind before retrieving data
        # forward to first disk entry line (in case there are several CPUs)
        while {![string match disk* [set line [gets $statistics]]]} {}
        if {[string match disk_io* $line]} {                                                                           ;# 2.4 kernel
            scan $line {disk_io: (%*u,%u):(%*u,%u,%u,%u,%u)} index readIOs readBlocks writeIOs writeBlocks
            set found($index) {}
            array set data [list $index,1 $readIOs $index,2 $writeIOs $index,3 $readBlocks $index,4 $writeBlocks]
            while {\
                [scan [gets $statistics] {disk_io: (%*u,%u):(%*u,%u,%u,%u,%u)} index readIOs readBlocks writeIOs writeBlocks]==5\
            } {
                array set data [list $index,1 $readIOs $index,2 $writeIOs $index,3 $readBlocks $index,4 $writeBlocks]
                set found($index) {}
            }
            for {set row 0} {$row<=3} {incr row} {
                if {![info exists found($row)]} {
                    array set data [list $row,1 0 $row,2 0 $row,3 0 $row,4 0]
                }
            }
        } else {                                                                                    ;#  probably 2.2 or below kernel
            scan [gets $statistics] {disk_rio %u %u %u %u} data(0,1) data(1,1) data(2,1) data(3,1)
            scan [gets $statistics] {disk_wio %u %u %u %u} data(0,2) data(1,2) data(2,2) data(3,2)
            scan [gets $statistics] {disk_rblk %u %u %u %u} data(0,3) data(1,3) data(2,3) data(3,3)
            scan [gets $statistics] {disk_wblk %u %u %u %u} data(0,4) data(1,4) data(2,4) data(3,4)
        }
        if {[info exists last]} {
            for {set row 0} {$row<=3} {incr row} {
                for {set column 1} {$column<=4} {incr column} {
                    set value $data($row,$column)
                    incr data($row,$column) -$last($row,$column)
                    set last($row,$column) $value
                }
            }
        } else {                                                                                                     ;# first update
            for {set row 0} {$row<=3} {incr row} {
                for {set column 1} {$column<=4} {incr column} {
                    set last($row,$column) $data($row,$column)
                    set data($row,$column) 0
                }
            }
        }
        incr data(updates)
    }
}
