# 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: mounts.tcl,v 2.33 2006/04/04 18:43:01 jfontain Exp $


package provide mounts [lindex {$Revision: 2.33 $} 1]
package require network 1
package require hashes
package require stooop 4.1
namespace import stooop::*
package require switched
if {[catch {package require Thread 2.5}]} {
    namespace eval mounts {variable threads 0}
} else {                                                                                  ;# load thread worker class implementation
    package require threads 1
    namespace eval mounts {variable threads 1}
}
package require linetask 1


namespace eval mounts {

    array set data {
        updates 0
        0,label directory 0,type ascii 0,message {mount point}
        1,label filesystem 1,type dictionary 1,message {filesystem device}
        2,label type 2,type ascii 2,message {filesystem type}
        3,label size 3,type integer 3,message {total size in kilobytes}
        4,label used 4,type integer 4,message {used user space in kilobytes}
        5,label available 5,type integer 5,message {available user space in kilobytes}
        6,label capacity 6,type integer 6,message {used user space in percent}
        sort {0 increasing}
        persistent 1 64Bits 1
        switches {-C 0 --daemon 0 -i 1 -p 1 -r 1 --remote 1}
    }
    set file [open mounts.htm]
    set data(helpText) [read $file]                                                           ;# initialize HTML help data from file
    close $file
    unset file

    proc initialize {optionsName} {
        upvar 1 $optionsName options
        variable remote
        variable data
        variable threads                                                                     ;# whether threads package is available
        variable system

        catch {set locator $options(-r)}
        catch {set locator $options(--remote)}                                                                  ;# favor long option
        if {![info exists locator]} {                                                                            ;# local monitoring
            package require filesystem 1                                        ;# only needed locally (also unavailable on windows)
            set data(pollTimes) [list 20 5 10 30 60 120 300 600]
            set system $::tcl_platform(os)
            switch $system {
                Linux - SunOS - FreeBSD {}
                default {error "unsupported operating system: $system"}
            }
            return
        }
        set data(pollTimes) [list 30 10 20 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) mounts($remote(host))
        set remote(pattern) %c
        if {$::tcl_platform(platform) eq "unix"} {
            if {$remote(rsh)} {                              ;# 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
        } 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}
        }
        set remote(task) [new lineTask -callback mounts::read -begin 0 -access $access -translation lf -threaded $threads]
        if {!$remote(rsh)} {
            switched::configure $remote(task) -command $command
        }
        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 system

        if {[info exists remote]} {
            if {$remote(busy)} return                                               ;# core invocation while waiting for remote data
            if {![info exists system]} {                                                              ;# system type is needed first
                # command must not end with an end of line as it is handled in pattern already
                regsub %c $remote(pattern) {uname 2>\&1 | tr -d '\n'} remote(command)
                if {$remote(rsh)} {
                    switched::configure $remote(task) -command $remote(command)
                }
            }
            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 {                        ;# note: local file must be opened each poll otherwise unmounted filesystems never disappear
            switch $system {
                Linux {set file [open /etc/mtab]}
                FreeBSD {set file [open /compat/linux/proc/mtab]}
                SunOS {set file [open /etc/mnttab]}
            }
            localUpdate [split [::read -nonewline $file] \n]
            close $file
        }
    }

    proc localUpdate {lines} {
        variable data
        variable system

        foreach line $lines {
            foreach {device directory type flags dump order} $line {}
            foreach {size total available used blockSize} [filesystem::statistics $directory] {}
            if {$available == 0} continue                            ;# ignore special cases, such as proc, pts, automount, usb, ...
            # take filesystem block size into account to get values in kilobytes
            switch $system {
                Linux - FreeBSD {set ratio [expr {$size / 1024.0}]}
                SunOS {set ratio [expr {$blockSize / 1024.0}]}
            }
            set row [\
                updateEntryData $directory $device $type [expr {round($total * $ratio)}] [expr {round($used * $ratio)}]\
                    [expr {round($available * $ratio)}] [expr {round(($used * 100.0) / ($used + $available))}]          ;# used in %
            ]
            if {$row eq ""} continue
            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\]*}
        }
        incr data(updates)
    }

    proc remoteUpdate {lines} {
        variable data
        variable system

        set first 1
        foreach line $lines {
            if {$first} {
                set first 0
                continue                                                                                         ;# skip header line
            }
            switch $system {
                Linux - FreeBSD {
                    foreach {device type size used available capacity directory} $line {}
                }
                SunOS {
                    if {[lindex $line 1] eq ":"} {                                               ;# type line (example: /home : ufs)
                        foreach {directory : type} $line {}
                        foreach {device size used available capacity directory} $list($directory) {}
                    } else {                       ;# statistics line (example: /dev/dsk/c0t0d0s7 13048715 817838 12100390 7% /home)
                        set list([lindex $line end]) $line
                        continue                                                                        ;# wait till we get the type
                    }
                }
            }
            if {$size == 0} continue                                                                     ;# skip unavailable entries
            set row [updateEntryData $directory $device $type $size $used $available [string trimright $capacity %]]
            if {$row eq ""} continue
            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\]*}
        }
        incr data(updates)
    }

    proc updateEntryData {directory filesystem type size used available capacity} {
        variable data

        if {[catch {set row [hash64::string $directory 1]} message]} {                                            ;# repeatable mode
            flashMessage "warning: duplicate row ($directory) removed: $message"                              ;# should be very rare
            return {}
        }
        if {![info exists data($row,0)]} {                                                                              ;# new entry
            set data($row,0) $directory                                                                    ;# initialize static data
            set data($row,1) $filesystem
            set data($row,2) $type
        }
        set data($row,3) $size
        set data($row,4) $used
        set data($row,5) $available
        set data($row,6) $capacity
        return $row
    }

    proc read {line} {                                       ;# read remote data now that it is available and possibly handle errors
        variable remote
        variable system

        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)"
            }
        }
        if {[info exists message]} {
            flashMessage $message
        }
        if {![info exists system]} {
            set system [string trim $line]
            switch $system {
                Linux - FreeBSD {
                    set command {df -PT 2>\&1 | tr '\n' '\v'}                           ;# use POSIX formatting to avoid line breaks
                }
                SunOS {
                    set command {(df -k \&\& df -n) 2>\&1 | tr '\n' '\v'}                       ;# also retrieve the filesystem type
                }
                default {
                    flashMessage "unsupported operating system: $system"
                }
            }
            if {[info exists command]} {
                regsub %c $remote(pattern) $command remote(command)
                if {$remote(rsh)} {
                    switched::configure $remote(task) -command $remote(command)
                }
                set remote(busy) 0
                after idle mounts::update                                               ;# since an update was requested by the core
            }                                            ;# else remain busy so that nothing else happens now that error is reported
        } else {
            remoteUpdate [split [string trimright $line \v] \v]
            set remote(busy) 0
        }
    }

}
