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


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


namespace eval memstats {

    array set data {
        updates 0
        0,label type 0,type ascii 0,message {type} 0,0 memory 1,0 swap
        1,label available 1,type integer 1,message {total available (in kilobytes)}
        2,label used 2,type integer 2,message "used (in kilobytes)\n(= total - free - buffers - cached)"
        3,label free 3,type integer 3,message {free (in kilobytes)}
        4,label shared 4,type integer 4,message "shared memory (in kilobytes)\n(not available in kernel 2.6)"
        5,label buffers 5,type integer 5,message {memory used for buffers (in kilobytes)}
        6,label cached 6,type integer 6,message {cached memory (in kilobytes)}
        7,label active 7,type integer 7,message {active memory (in kilobytes)}
        8,label {high total} 8,type integer 8,message {(in kilobytes)}
        9,label {high free} 9,type integer 9,message {(in kilobytes)}
        10,label {low total} 10,type integer 10,message {(in kilobytes)}
        11,label {low free} 11,type integer 11,message {(in kilobytes)}
        12,label inactive 12,type integer 12,message {(in kilobytes)}
        views {{indices {0 1 2 3 4 5 6 7 8 9 10 11 12} swap 1}}
        persistent 1
        switches {-C 0 --daemon 0 -i 1 -p 1 --proc 1 -r 1 --remote 1}
    }
    # note: dirty, clean and target memory columns (Linux kernel between 2.4.0 and 2.4.10) are no longer supported
    array set data [list 0,6 {} 1,4 {} 1,5 {} 1,7 {} 1,8 {} 1,9 {} 1,10 {} 1,11 {} 1,12 {}]           ;# initialize static cells and
    array set data [list 0,4 {} 0,7 {} 0,8 {} 0,9 {} 0,10 {} 0,11 {} 0,12 {}]   ;# optional cells (remain blank if no extended data)
    set file [open memstats.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 memory /proc; catch {set memory $options(--proc)}                            ;# note: use /compat/linux/proc for FreeBSD
        set memory [file join $memory meminfo]                                                                          ;# data file
        catch {set locator $options(-r)}; catch {set locator $options(--remote)}                                ;# favor long option
        if {[info exists locator]} {                                                                                  ;# remote host
            set data(pollTimes) [list 20 10 30 60 120 300 600]                           ;# poll less often when remotely monitoring
        } else {                                                                                                       ;# local host
            set data(pollTimes) [list 10 5 20 30 60 120 300 600]
            set local(memory) [open $memory]                                          ;# 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) memstats($remote(host))
        # important: pack data in a single line using special control separator characters
        set remote(command) "cat $memory 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(task) [new lineTask\
            -command $command -callback memstats::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 {} {
        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(memory) 0                                                                   ;# rewind before retrieving data
            process [split [::read -nonewline $local(memory)] \n]
        }
    }

    proc process {lines} {
        variable data

        foreach line $lines {
            set unit {}
            foreach {string number unit} $line break                                         ;# format example: "MemTotal: 62668 kB"
            if {![string equal $unit kB] || ![string match *: $string]} continue
            set value($string) $number
        }
        if {![info exists value]} {                                                                   ;# collected data is corrupted
            array set data {0,1 ? 0,2 ? 0,3 ? 0,5 ? 1,1 ? 1,2 ? 1,3 ? 1,6 ?}
            if {[string length $data(0,4)] > 0} {                                         ;# shared memory was available at one time
                set data(0,4) ?
            }
            if {[string length $data(0,7)] > 0} {                                         ;# extended data was available at one time
                array set data {0,7 ? 0,8 ? 0,9 ? 0,10 ? 0,11 ?}                            ;# show voids values (instead of blanks)
                if {[string length $data(0,12)] > 0} {                                  ;# inactive memory was available at one time
                    set data(0,12) ?
                }
            }
            set message "invalid data: [lindex $lines 0]"
            if {[llength $lines] > 1} {append message "..."}
            flashMessage $message
            incr data(updates)
            return
        }
        set data(0,1) $value(MemTotal:)                                                                              ;# total memory
        set data(0,3) $value(MemFree:)                                                                                ;# free memory
        if {[catch {set data(0,4) $value(MemShared:)}]} {set data(0,4) {}}           ;# shared memory (does not exist in 2.6 kernel)
        set data(0,5) $value(Buffers:)                                                                                    ;# buffers
        set data(1,6) $value(Cached:)                                                                               ;# cached memory
        set data(1,1) $value(SwapTotal:)                                                                               ;# total swap
        set data(1,3) $value(SwapFree:)                                                                                 ;# free swap
        # used memory = total - free - buffers - cached:
        set data(0,2) [expr {$data(0,1) - $data(0,3) - $data(0,5) - $data(1,6)}]
        set data(1,2) [expr {$data(1,1) - $data(1,3)}]                                                                  ;# used swap
        if {[info exists value(Active:)]} {
            set data(0,7) $value(Active:)
            set data(0,8) $value(HighTotal:)
            set data(0,9) $value(HighFree:)
            set data(0,10) $value(LowTotal:)
            set data(0,11) $value(LowFree:)
            if {[info exists value(Inactive:)]} {                                                         ;# kernel 2.4.10 and above
                set data(0,12) $value(Inactive:)
            }
        }
        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
        }
        process [split [string trimright $line \v] \v]
        set remote(busy) 0
    }

}
