# 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: disks.tcl,v 1.14 2006/01/28 19:16:59 jfontain Exp $


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


namespace eval disks {

    # the table key is obviously the device name:
    array set data {
        updates 0
        0,label name 0,type dictionary 0,message {device name}
        1,label type 1,type ascii 1,message {type of device}
        2,label media 2,type ascii 2,message {media of device}
        3,label size 3,type real 3,message {size in megabytes}
        4,label model 4,type ascii 4,message {model description} 4,anchor left
        sort {0 increasing}
        persistent 1
        switches {-C 0 --daemon 0 -i 1 -p 1 -r 1 --remote 1}
    }
    set file [open disks.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

        catch {set locator $options(-r)}; catch {set locator $options(--remote)}                                ;# favor long option
        if {[info exists locator]} {                                                                                  ;# remote host
            set data(pollTimes) {120 10 20 30 60 300 600}                                ;# poll less often when remotely monitoring
        } else {                                                                                                       ;# local host
            set data(pollTimes) {60 5 10 20 30 120 300 600}
            set local(partitions) [open /proc/partitions]                             ;# 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) disks($remote(host))
        # important: pack data in a single line using special control separator characters
        set remote(pattern) {cat %f 2>&1 | tr '\n' '\v'}
        if {[string equal $::tcl_platform(platform) unix]} {
            if {$remote(rsh)} {                         ;# pipe command is included in line task command, so it must include pattern
                set remote(pattern) "rsh -n -l $remote(user) $remote(host) {$remote(pattern)}"
            } 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
            regsub %f $remote(pattern) /proc/partitions command
        } 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(pattern) {; echo}
            regsub %f $remote(pattern) /proc/partitions remote(command)
        }
        set remote(process) process
        set remote(task) [new lineTask\
            -command $command -callback disks::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 {} {                                                                             ;# invoked periodically by the core
        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
            process [split [::read -nonewline $local(partitions)] \n]
        }
    }

    # sample /proc/partitions output, on kernel 2.4, then 2.6:
    #
    # 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
    #
    # major minor #blocks name
    #
    #    3     0  3153024 hda
    #    3     1  3152992 hda1
    #    3    64 40209120 hdb
    #    3    65 40209088 hdb1
    #   22     0  8257032 hdc
    #   22     1  8249346 hdc1

    # process partitions file entries including the following fields only: blocks name rio ruse wio wuse aveq
    proc process {lines} {
        variable data
        variable last                                                                          ;# last values for delta calculations

        foreach line $lines {
            if {[scan $line {%u %u %u %s} major minor blocks name] != 4} continue                      ;# only process valid entries
            if {[string match {*[0-9]} $name]} continue                         ;# if names ends by a number, it must be a partition
            # generate unique 32 unsigned integer from device numbers (as defined in kernel include/linux/kdev_t.h)
            set row [format %u [expr {($major << 20) | $minor}]]
            if {![info exists data($row,0)]} {
                set data($row,0) $name                                                                     ;# initialize static data
                foreach [list data($row,1) data($row,2) data($row,4)] [data $name] {}
            }
            set value [expr {$blocks / 1024.0}]                               ;# block size is always 1024 bytes in the Linux kernel
            # note: disk size is usually static, but update it at each poll in case disk can be dynamically resized
            if {$value < 100} {                                                                           ;# less than 100 megabytes
                set data($row,3) [format %.1f $value]
            } else {
                set data($row,3) [expr {round($value)}]
            }
            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\]*}
        }
        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 lines {fileName} {                                                                         ;# return whole contents of file
        variable remote
        variable lines

        if {[info exists remote]} {
            set remote(process) processLines
            regsub %f $remote(pattern) $fileName command
            if {$remote(rsh)} {
                switched::configure $remote(task) -command $command
            }
            set remote(busy) 1
            if {[lineTask::end $remote(task)]} {                                                           ;# rsh or ssh daemon mode
                lineTask::begin $remote(task)
            }
            if {!$remote(rsh)} {
                lineTask::write $remote(task) $command
            }
            vwait ::disks::lines                                                                       ;# wait for data to come back
            set remote(process) process                                                             ;# restore normal update process
            if {$remote(rsh)} {
                regsub %f $remote(pattern) /proc/partitions command
                switched::configure $remote(task) -command $command
            }
            set data $lines
            unset lines
        } else {
            if {[catch {set file [open $fileName]} message]} {
                flashMessage "error: $message"
                set data {}                                                     ;# make sure to return empty but clean data on error
            } else {
                set data [split [::read -nonewline $file] \n]
                close $file
            }
        }
        return $data
    }

    proc processLines {list} {
        variable lines
        set lines $list
    }

    # sample /proc/scsi/scsi output:
    #
    # Attached devices:
    # Host: scsi0 Channel: 00 Id: 01 Lun: 00
    #   Vendor: SEAGATE  Model: ST39173N         Rev: 5764
    #   Type:   Direct-Access                    ANSI SCSI revision: 02
    # Host: scsi0 Channel: 00 Id: 04 Lun: 00
    #   Vendor: CWS ORB2 Model: -SI U ID 4       Rev: D33
    #   Type:   Direct-Access                    ANSI SCSI revision: 02
    # Host: scsi1 Channel: 00 Id: 01 Lun: 00
    #   Vendor: TOSHIBA  Model: DVD-ROM SD-M1201 Rev: 1R04
    #   Type:   CD-ROM                           ANSI SCSI revision: 02
    # Host: scsi1 Channel: 00 Id: 02 Lun: 00
    #   Vendor: EPSON    Model: SCANNER GT-9600  Rev: 1.03
    #   Type:   Processor                        ANSI SCSI revision: 02
    proc data {device} {                                                            ;# return device type, media and model from name
        set type {}; set media {}; set model {}                                                                           ;# unknown
        switch [string index $device 0] {
            h {
                set type IDE
                set media [string trim [lindex [lines /proc/ide/$device/media] 0]]
                set model [string trim [lindex [lines /proc/ide/$device/model] 0]]
            }
            s {
                set type SCSI
                set number [expr {[scan [string index $device end] %c] - [scan a %c]}]      ;# device index: sda -> 0, sdb -> 1, ...
                set index 0
                # skip header line, each entry has 3 lines of data
                foreach {line(0) line(1) line(2)} [lrange [lines /proc/scsi/scsi] 1 end] {
                    regexp {Type:(.*)ANSI SCSI revision:} $line(2) dummy media
                    set media [string trim $media]
                    # mountable devices from drivers/scsi/scsi.c kernel source
                    switch $media {
                        Direct-Access - WORM - CD-ROM - {Medium Changer} {}
                        default {
                            continue                                                                     ;# skip unmountable devices
                        }
                    }
                    if {$index == $number} {
                        regexp {Vendor:(.*)Model:(.*)Rev:(.*)$} $line(1) dummy vendor model revision
                        set model "[string trim $vendor] [string trim $model] [string trim $revision]"
                        break                                                            ;# found the device corresponding to number
                    }
                    incr index
                }
            }
        }
        return [list $type $media $model]
    }

    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
        }
        $remote(process) [split [string trimright $line \v] \v]
        set remote(busy) 0
    }

}
