# 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: interrupts.tcl,v 1.25 2006/03/26 13:31:25 jfontain Exp $


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


namespace eval interrupts {

    variable cpuColumn 3                                                                         ;# CPU(s) data start at this column

    array set data {
        updates 0
        0,label number 0,type dictionary 0,message {interrupt number or identification: NMI (Non Maskable Interrupt), LOC (local interrupt counter of the internal APIC) or ERR (incremented in the case of errors in the IO-APIC bus)}
        1,label device 1,type dictionary 1,message {device name}
        2,label type 2,type ascii 2,message {interrupt type}
        sort {0 increasing}
        persistent 1
        switches {-C 0 -i 1 -p 1 -r 1 --remote 1}
    }
    set file [open interrupts.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 cpuColumn
        variable cpus

        # note: --daemon option not supported as data retrieval is required in initialization stage, to determine number of CPUs
        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
            # 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) interrupts($remote(host))
            # important: pack data in a single line using special control separator characters
            set remote(command) {cat /proc/interrupts 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(initialize) 1
            set remote(task) [new lineTask\
                -command $command -callback interrupts::read -begin 0 -access $access -translation lf -threaded $threads\
            ]
            if {!$remote(rsh)} {                                                                     ;# for ssh, detect errors early
                lineTask::begin $remote(task)
            }                                                   ;# note: for rsh, shell and command need be restarted at each update
            set remote(busy) 0
            update
            vwait interrupts::remote(line)
            if {[info exists remote(message)]} {
                error $remote(message)                                                                       ;# treat as fatal error
            } else {
                set remote(initialize) 0
            }
            set line $remote(line)
            unset remote(line)
        } else {                                                                                                       ;# local host
            set data(pollTimes) {10 5 20 30 60 120 300 600}
            set local(interrupts) [open /proc/interrupts]                             ;# keep local file open for better performance
            gets $local(interrupts) line                                                  ;# only first line is needed at this point
        }
        set cpus 0
        set column $cpuColumn                                                                 ;# add CPU columns to existing columns
        foreach cpu $line {                                                    ;# line format: CPU0 CPU1 ... (with blank separators)
            if {[scan $cpu CPU%u index] != 1} continue
            set data($column,label) "count($index)"
            set data($column,type) real
            set data($column,message) "interrupts count for CPU $index"
            incr column
            set data($column,label) "rate($index)"
            set data($column,type) real
            set data($column,message) "interrupts per second for CPU $index"
            incr column
            incr cpus
        }
        if {$cpus == 0} {
            error "invalid data: $line"
        }
    }

    proc update {} {
        variable local
        variable remote

        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(interrupts) 0                                                               ;# rewind before retrieving data
            process [split [::read -nonewline $local(interrupts)] \n]
        }
    }

    proc process {lines} {
        variable data
        variable last
        variable cpuColumn
        variable cpus

        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)}]
        }
        set first 1
        foreach line $lines {
            if {$first} {
                set first 0
                continue                                                                                         ;# skip header line
            }
            # examples:
            #    1:       8949       8958    IO-APIC-edge  keyboard
            #  NMI:    2457961    2457959
            #  LOC:    2457882    2457881
            #  ERR:       2155
            set column 0
            set device {}
            foreach value $line {
                if {$column == 0} {                                                     ;# number or identification is followed by :
                    set value [string trimright $value :]
                    if {[string is integer -strict $value]} {
                        set row $value
                    } else {
                        if {[string length $value] > 4} {
                            flashMessage "error: interrupt name \"$value\" too long (please report to author)"
                        }
                        binary scan [string range $value end-3 end] H* row          ;# transform up to the last 4 characters of name
                        set row [format %u 0x$row]                                                ;# into a 32 bits unsigned integer
                    }
                    set data($row,0) $value
                    set data($row,2) {}                                                  ;# type is undefined for NMI, LOC, ERR, ...
                    for {set cpu 0; set number $cpuColumn} {$cpu < $cpus} {incr cpu} {
                        # in case of data error or NMI, LOC, ERR, ... with single value even if several CPUs:
                        set data($row,$number) ?; incr number
                        set data($row,$number) ?; incr number
                    }
                } elseif {$column <= $cpus} {                                                              ;# CPU interrupt counters
                    set cpu [expr {$column - 1}]
                    set number [expr {$cpuColumn + (2 * $cpu)}]
                    set data($row,$number) $value                                                                           ;# count
                    incr number
                    if {[info exists last($row,$cpu)]} {                               ;# (counters format from arch/*/kernel/irq.c)
                        # rate (per second), using 32 bit integer subtraction (valid on 32 and 64 bit Tcl platforms)
                        set data($row,$number) [format %.1f [expr {(($value - $last($row,$cpu)) & 0xFFFFFFFF) / $period}]]
                    }
                    set last($row,$cpu) $value
                } elseif {$column == ($cpus + 1)} {                                                                          ;# type
                    set data($row,2) $value
                } else {                                                                         ;# device name (may contain spaces)
                    if {[string length $device] > 0} {
                        append device { }
                    }
                    append device $value
                }
                incr column
            }
            set data($row,1) $device
            set current($row) {}
        }
        set last(clock) $clock
        foreach name [array names data *,0] {                                                         ;# cleanup disappeared entries
            set row [lindex [split $name ,] 0]
            if {[info exists current($row)]} continue
            for {set cpu 0; set number $cpuColumn} {$cpu < $cpus} {incr cpu} {
                set data($row,$number) ?; incr number
                set data($row,$number) ?; incr number
                catch {unset last($row,$cpu)}
            }
        }
        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
        }
        if {$remote(initialize)} {
            if {[info exists message]} {set remote(message) $message}                                              ;# remember error
            set remote(line) [lindex [split [string trimright $line \v] \v] 0]
        } else {
            process [split [string trimright $line \v] \v]
        }
        set remote(busy) 0
    }

}
