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

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


namespace eval sensors {

    array set data {
        updates 0
        0,label data 0,type dictionary 0,message {monitored data identification}
        1,label value 1,type real 1,message {current value}
        2,label unit 2,type dictionary 2,message {data unit}
        3,label minimum 3,type real 3,message {data suggested safe minimum value}
        4,label maximum 4,type real 4,message {data suggested safe maximum value}
        sort {0 increasing}
        persistent 1 64Bits 1
        switches {-C 0 --daemon 0 -i 1 -p 1 --path 1 -r 1 --remote 1}
    }
    set file [open sensors.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 path /usr/bin                                                                        ;# default path for sensors command
        catch {set path $options(--path)}                                                                ;# may be overriden by user
        set path [file join $path sensors]
        catch {set locator $options(-r)}
        catch {set locator $options(--remote)}                                                                  ;# favor long option
        if {![info exists locator]} {                                                                                  ;# local host
            set data(pollTimes) {30 10 20 60 120 300 600}
            exec $path                                                 ;# detect errors early by attempting immediate data retrieval
            set local(command) $path
            return                                                                                               ;# local monitoring
        }
        set data(pollTimes) {60 20 30 120 300 600}                                       ;# poll less often when remotely 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) sensors($remote(host))
        # important: pack data in a single line using special control separator characters
        set remote(command) "$path 2>&1 | tr '\\n' '\\v'"
        if {$::tcl_platform(platform) eq "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
                # note: redirect standard error to pipe output in order to be able to detect remote errors
                append command " -T -l $remote(user) $remote(host) 2>@ stdout"
            }
        } else {                                                                                                          ;# windows
            if {$remote(rsh)} {
                error {use -r(--remote) ssh://session syntax (see help)}
            }
            set remote(rsh) 0                                      ;# note: host must be a putty session and pageant must be running
            set command "plink -ssh -batch -T $remote(host) 2>@ stdout"
        }
        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 sensors::read -begin 0 -access $access -translation lf -threaded $threads -encoding utf-8\
        ]                               ;# note: use UTF encoding for proper display of the degrees character in temperature entries
        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
            }
        } elseif {[catch {set result [exec $local(command)]} message]} {                ;# immediate retrieval failure on local host
            flashMessage "sensors error: $message"
        } else {
            process [split $result \n]
        }
    }

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

        foreach line $lines {
            if {[string match *: $line]} {                                                            ;# reconstruct bi-line entries
                set first $line
                continue                                                                                          ;# get second part
            } elseif {[info exists first]} {
                set line "$first $line"                                                                                ;# join parts
                unset first
            }
            set list [parse $line]
            if {[llength $list] == 0} continue                                                                       ;# invalid data
            foreach {name value unit minimum maximum} $list {}
            if {[string length $name] > 8} {
                flashMessage "error: data name \"$name\" too long (please report to author)"
            }
            binary scan [string range $name end-7 end] H* row                       ;# transform up to the last 8 characters of name
            set row [format %lu 0x$row]                                                           ;# into a 64 bits unsigned integer
            if {![info exists data($row,0)]} {                                                                          ;# new entry
                set data($row,0) $name                                                                     ;# initialize static data
                set data($row,2) $unit
                set data($row,3) $minimum
                set data($row,4) $maximum
            } elseif {[info exists current($row)]} {                   ;# multiple instances of identical names: keep the last entry
                set data($row,2) $unit
                set data($row,3) $minimum
                set data($row,4) $maximum
            }
            set data($row,1) $value
            set current($row) {}
        }
        foreach name [array names data *,0] {                         ;# display unknown values for data that is no longer available
            set row [lindex [split $name ,] 0]
            if {![info exists current($row)]} {set data($row,1) ?}
        }
        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 parse {line} {
        set name1 {}; set value1 {}; set name2 {}; set value2 {}                 ;# in case entry (such as vid) has no limit defined
        if {[scan $line {%[^:]: %f%s (%s = %f%*[^,], %s = %f%*[^)]} name value unit name1 value1 name2 value2] >= 3} {
            set minimum ?; set maximum ?
            if {$name1 eq "min"} {
                set minimum $value1
            }
            if {$name1 eq "limit"} {
                set maximum $value1
            }
            if {$name2 eq "max"} {
                set maximum $value2
            }
            return [list $name $value $unit $minimum $maximum]
        } else {
            return {}
        }
    }

    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)"
            }
        }
        # unpack list while removing extra last separator without copying to a variable for better performance, as data could be big
        # 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
    }

}
