#!/usr/bin/tclsh
# or
#!/opt/tcltk/bin/tclsh8.4

# copyright (C) 1997-2005 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: moomps.tcl,v 1.97 2005/01/02 00:45:07 jfontain Exp $


proc printUsage {exitCode} {
    puts stderr "Usage: $::argv0 \[OPTION\]... \[DIRECTORY|CONFIGURATIONFILE\]..."
    puts stderr {  --debug                module errors verbose reporting}
    puts stderr {  -f, --foreground       run in foreground as opposed to daemon mode}
    puts stderr {  -h, --help             display this help and exit}
    puts stderr {  -m, --mailto           send an email to specified address at startup}
    puts stderr {  -p, --poll-files-time  loaded files monitoring poll time in seconds}
    puts stderr {  --pid-file             file containing the daemon process ID}
    puts stderr {  -r                     preferences file name}
    puts stderr {  --version              output version information and exit}
    exit $exitCode
}

proc printVersion {} {
    puts "moomps (a Modular Object Oriented Multi-Purpose Service) version $global::applicationVersion"
}

source packlibs/misc.tcl
source global.tcl
source utility.tcl
startGatheringPackageDirectories                                                                   ;# done once for all interpreters
source getopt.tcl

if {[catch\
    {\
        set argv [parseCommandLineArguments\
            {
                --debug 0 -f 0 --foreground 0 -h 0 -he 0 -hel 0 -help 0 --help 0 -m 1 --mailto 1 --pid-file 1
                -p 1 --poll-files-time 1 -r 1 --version 0
            } $argv arguments\
        ]\
    } message\
]} {
    puts stderr $message
    printUsage 1
}

foreach {short long} {-f --foreground -h --help -m --mailto -p --poll-files-time} {
    catch {set arguments($short) $arguments($long)}                                          ;# long version if present has priority
}

if {\
    [info exists arguments(-h)] || [info exists arguments(-he)] || [info exists arguments(-hel)] ||\
    [info exists arguments(-help)]\
} {
    printUsage 1
}
set pollFilesTime 60000                                                                               ;# by default, in milliseconds
if {[info exists arguments(-p)] && [catch {expr {$arguments(-p) * 1000}} pollFilesTime]} {
    printUsage 1
}
if {[info exists arguments(--version)]} {
    printVersion
    exit
}
if {[llength $argv] == 0} {
    printUsage 1
}
set preferencesFile /etc/moomps/rc
if {[info exists arguments(-r)]} {
    set preferencesFile $arguments(-r)
    if {![file readable $preferencesFile]} {             ;# when an explicitely defined file is not readable, it considered an error
        puts stderr "cannot access preferences file: $preferencesFile"
        exit 1
    }
}
foreach file $argv {                        ;# do a basic check on file arguments in case there are some erroneous switches included
    if {![file readable $file]} {
        puts stderr "cannot access file: $file"
        exit 1
    }
}

set global::debug [info exists arguments(--debug)]

source tcllib/base64.tcl                                                                                   ;# needed by MIME package
source tcllib/md5.tcl
source tcllib/mime.tcl                                                                          ;# allow thresholds email capability
source tcllib/smtp.tcl
package require msgcat
namespace import msgcat::*
if {![info exists arguments(-f)]} {
    package require Tclx                                                 ;# provides system functions so that we can run as a daemon
}

lappend auto_path $::tcl_library/moodss                                               ;# usually where moodss packages are installed
if {[info exists package(directory,internationalization)]} {             ;# application library installed in a Tcl package directory
    package require internationalization
} else {
    lappend auto_path [pwd]                             ;# load relative to current directory, used for example in development stage
    if {[catch {package require internationalization} message]} {
        puts stderr $message:
        puts stderr\
            "either moomps is not properly installed or you need to run\nmoomps from its development directory with the -f option"
        exit 1
    }
}
set automaticPath $auto_path                           ;# save it now that it is pristine, so it can be reused in slave interpreters

# include XML and DOM libraries:
source tcllib/uri.tcl                                                                                       ;# needed by XML library
package provide xml 2.6
package provide dom 2.6
package provide dom::tcl 2.6
package provide dom::tclgeneric 2.6
namespace eval ::xml {}
source tclxmldom/sgml-8.1.tcl
source tclxmldom/xml-8.1.tcl
source tclxmldom/sgmlparser.tcl
source tclxmldom/xml__tcl.tcl
source tclxmldom/tclparser-8.1.tcl
source tclxmldom/xpath.tcl
namespace eval ::dom {variable strictDOM 0}
source tclxmldom/domimpl.tcl
source tclxmldom/dom.tcl
source tclxmldom/dommap.tcl
source preferen.tcl
source config.tcl
if {[catch {package require stooop 4.1}]} {
    source stooop.tcl                                                                     ;# in case stooop package is not installed
}
namespace import stooop::*
if {[catch {package require switched 2.2}]} {                                           ;# in case switched package is not installed
    source switched.tcl
}
source database.tcl
source modules.tcl
source record.tcl
source viewer.tcl
source threshold.tcl
source store.tcl


if {[string length $preferencesFile] > 0} {
    configuration::load [preferences::read $preferencesFile]                              ;# needed for email serveurs and addresses
}
set startMessage "$::argv0 $global::applicationVersion starting..."

if {[info exists arguments(-m)]} {
    set message [emailAddressError $arguments(-m)]
    if {[string length $message] > 0} {
        puts stderr "invalid email address: \"$arguments(-m)\""
        exit 1
    }
    if {[catch {sendTextEmail $global::fromAddress $arguments(-m) {moomps starting} $startMessage} message]} {
        puts stderr "email error: $message"
        exit 1
    }
}

set current [pwd]
foreach file $argv {                                                                                    ;# now check dashboard files
    if {[catch {file stat $file data} message]} {
        puts stderr "error: $message"
        exit 2
    }
    if {[string equal $data(type) directory]} {                                                 ;# load .moo files in that directory
        foreach file [glob -nocomplain [file join $file *.moo]] {
            if {[package vcompare $::tcl_version 8.4] < 0} {
                set file [file join $current $file]
            } else {
                set file [file normalize $file]
            }
            set fileName($file) {}                                ;# use absolute path, duplicate files are automatically eliminated
        }
    } else {
        if {[package vcompare $::tcl_version 8.4] < 0} {set file [file join $current $file]} else {set file [file normalize $file]}
        set fileName($file) {}                                    ;# use absolute path, duplicate files are automatically eliminated
    }
}
if {![info exists fileName]} {
    catch {unset message}
    foreach file $argv {
        if {[info exists message]} {append message {, }} else {set message {error: could not find any dashboard files in: }}
        append message "\"$file\""
    }
    puts stderr $message
    exit 1
}
set fileNames [array names fileName]                                                          ;# list of unique dashboard file names
unset fileName; catch {unset file data}

proc archive {} {                                                                    ;# whether database archiving is set in options
    set data(-file) {}                                               ;# for backward compatibility when SQLite was not yet supported
    array set data $global::databaseOptions
    return [expr {([string length $data(-file)] > 0) || ([string length $data(-dsn)] > 0) || ([string length $data(-host)] > 0)}]
}

proc checkFilesContents {names} {                  ;# check that dashboards contain data required by moomps and report errors if any
    set archive [archive]
    set store 0; set emails 0; set scripts 0
    foreach name $names {
        set record [new record -file $name]
        record::read $record
        foreach {class cells x y width height level xIcon yIcon switchedOptions} [record::viewersData $record] {
            switch $class {
                ::store {                                                                      ;# configuration of sole store viewer
                    if {([llength $cells] > 0) && $archive} {incr store [store::active $switchedOptions]}
                }
                ::thresholds {                                                            ;# configuration of sole thresholds viewer
                    if {[llength $cells] > 0} {
                        set list [thresholds::active $switchedOptions]
                        incr emails [lindex $list 0]; incr scripts [lindex $list end]
                    }
                }
            }
        }
        delete $record
    }
    if {!$emails && !$scripts && !$store} {                ;# also see createSavedViewers{} that reports problems per dashboard file
        puts stderr {error: nothing to do (database archiving, thresholds emails or scripts)}
    }
}
checkFilesContents $fileNames                                                         ;# check for errors before going in background

if {[info exists arguments(-f)]} {
    proc writeLog {message {level info}} { ;# level possible values: emergency, alert, critical, error, warning, notice, info, debug
        puts "[clock format [clock seconds] -format {%b %d %T}] $level: $message"
    }
} else {
    package require logging                                                                             ;# provides syslog interface

    rename exit _exit
    proc exit {{code 0}} {                                                                               ;# so that it can be logged
        writeLog "$::argv0 exiting..."
        if {[info exists ::processFile]} {                                                    ;# eventually clean up process ID file
            file delete -force $::processFile
        }
        _exit $code
    }

    rename puts _puts
    proc puts {args} {                                                            ;# overload in order to be able to redirect to log
        if {[string equal [lindex $args 0] -nonewline]} {
            set arguments [lreplace $args 0 0]                                     ;# no new line switch has no meaning when logging
        } else {
            set arguments $args
        }
        if {[llength $arguments] == 1} {                                                                       ;# to standard output
            writeLog [lindex $arguments 0]
        } elseif {[llength $arguments] == 2} {                                                        ;# to standard output or error
            switch -- [lindex $arguments 0] {
                stdout {writeLog [lindex $arguments 1]}
                stderr {writeLog [lindex $arguments 1] error}
                default {eval _puts $args}
            }
        } else {
            eval _puts $args
        }
    }

    proc writeLog {message {level info}} { ;# level possible values: emergency, alert, critical, error, warning, notice, info, debug
        logging::system moomps $level $message
    }

    proc daemonize {} {
       if {[fork]} _exit
       cd /                                            ;# we are now in the detached process (comment this line out for development)
       set null [open /dev/null r+]
       dup $null stdin
       dup $null stdout
       dup $null stderr
       close $null
    }

    proc bgerror {message} {                                                                                      ;# just in case...
        writeLog $message error
    }

    daemonize                                                ;# now that there are no more obvious errors to detect, run as a daemon
    signal ignore SIGHUP
    signal unblock {QUIT TERM}
    signal trap {QUIT TERM} exit
}


proc initialize {interpreter} {
    interp eval $interpreter "set ::argv0 $::argv0"                                                      ;# needed for some messages
    interp eval $interpreter "array set ::package [list [array get ::package]]"          ;# already determined from main interpreter
    $interpreter alias exit exit                                                               ;# in case modules exit by themselves
    $interpreter alias writeLog writeLog
    $interpreter alias mc mc                                                 ;# so that internationalization is available in modules
    interp eval $interpreter {
        source packlibs/misc.tcl
        source global.tcl                                                 ;# alone on a line so that source.tcl can do its job right
        source utility.tcl
        source getopt.tcl
        source tcllib/base64.tcl                                                                           ;# needed by MIME package
        source tcllib/md5.tcl
        source tcllib/mime.tcl                                                                  ;# allow thresholds email capability
        source tcllib/smtp.tcl
    }
    interp eval $interpreter "set ::auto_path [list $::automaticPath]"
    interp eval $interpreter {
        if {[catch {package require stooop 4.1}]} {
            source stooop.tcl                                                             ;# in case stooop package is not installed
        }
        namespace import stooop::*
        if {[catch {package require switched 2.2}]} {                                   ;# in case switched package is not installed
            source switched.tcl
        }
    }
    interp eval $interpreter "
        set ::global::debug $::global::debug
        set ::preferencesFile $::preferencesFile
    "
    interp eval $interpreter {
        proc bgerror {message} {
            if {$::global::debug} {
                writeLog $::errorInfo critical
            } else {
                writeLog $message critical
            }
        }
    }
    if {$global::database != 0} {                                                              ;# database history storage requested
        interp eval $interpreter "set global::database $global::database"
        $interpreter alias $global::database object $global::database                     ;# create a unique database object command
    }
    interp eval $interpreter {
        source record.tcl
        source datatrace.tcl
        source viewer.tcl
        source threshold.tcl
        source viewtab.tcl
        source sumtable.tcl
        source valuetab.tcl
        source formutab.tcl
        source module.tcl
        source modperl.tcl
        source modpython.tcl
        source modules.tcl
        # include XML and DOM libraries:
        source tcllib/uri.tcl                                                                               ;# needed by XML library
        package provide xml 2.6
        package provide dom 2.6
        package provide dom::tcl 2.6
        package provide dom::tclgeneric 2.6
        namespace eval ::xml {}
        source tclxmldom/sgml-8.1.tcl
        source tclxmldom/xml-8.1.tcl
        source tclxmldom/sgmlparser.tcl
        source tclxmldom/xml__tcl.tcl
        source tclxmldom/tclparser-8.1.tcl
        source tclxmldom/xpath.tcl
        namespace eval ::dom {variable strictDOM 0}
        source tclxmldom/domimpl.tcl
        source tclxmldom/dom.tcl
        source tclxmldom/dommap.tcl
        source preferen.tcl
        source config.tcl
        source store.tcl

        modules::loadResidentTraceModule
        if {[string length $preferencesFile] > 0} {
            configuration::load [preferences::read $preferencesFile]                  ;# initialize from rc file as soon as possible
        }
        proc moduleInitializationError {namespace message} {                                              ;# namespace of the module
            writeLog $message error
        }

        proc createSavedViewers {record file} {                                                     ;# also see checkFilesContents{}
            set store 0; set emails 0; set scripts 0
            foreach {class cells x y width height level xIcon yIcon switchedOptions} [record::viewersData $record] {
                switch $class {
                    ::store {               ;# handle store special case (note: module instance registration is done in store class)
                        set viewer $store::singleton
                        eval switched::configure $viewer $switchedOptions
                        if {[llength $cells] > 0} {set store [store::active $switchedOptions]}
                    }
                    ::thresholds {                                                                 ;# handle thresholds special case
                        set viewer $thresholds::singleton
                        eval switched::configure $viewer $switchedOptions
                        if {[llength $cells] > 0} {foreach {emails scripts} [thresholds::active $switchedOptions] {}}
                    }
                    ::summaryTable - ::currentValueTable - ::formulas::table {
                        set viewer [eval new $class $switchedOptions]  ;# handle statistics, values or formulas tables special cases
                    }
                    default {
                        continue                                                                             ;# ignore other viewers
                    }
                }
                set viewerCells($viewer) $cells                                                                      ;# gather cells
            }
            # monitor cells now that all viewers exist (for example, summary tables have their own data and thus need be created
            # before other viewers can reference them)
            foreach {viewer cells} [array get viewerCells] {
                viewer::view $viewer $cells
            }
            set messages {}
            if {($global::database == 0) && ($store > 0)} {
                lappend messages {some cells activated for archiving but no database defined}
            }
            if {(($global::database == 0) || ($store == 0)) && ($emails == 0) && ($scripts == 0)} {
                lappend messages {nothing to do (database archiving, thresholds emails or scripts)}
            }
            foreach message $messages {
                writeLog "$file: $message" warning
            }
        }

        set modules::(synchronous) {}                                                            ;# save list of synchronous modules
        proc processModule {instance} {
            if {[lindex $modules::instance::($instance,times) 0] > 0} {                                  ;# if module is synchronous
                lappend modules::(synchronous) $instance                                     ;### should be done in modules code ###
            }
            set index 0
            set namespace $modules::instance::($instance,namespace)
        }

        proc refresh {} {
            static updateEvent

            catch {after cancel $updateEvent}                                                     ;# eventually cancel current event
            if {[llength $modules::(synchronous)] == 0} return                                                      ;# nothing to do
            foreach instance $modules::(synchronous) {
                set namespace $modules::instance::($instance,namespace)
                ${namespace}::update                                                        ;# ask module to update its dynamic data
            }
            set updateEvent [after [expr {1000 * $global::pollTime}] refresh]                             ;# convert to milliseconds
        }

        proc cellThresholdCondition {array row column color level summary} {}             ;# does nothing here since there is no GUI

        proc notInstance {file namespace} {                                                 ;# do not allow loading instance modules
            if {[string equal [lindex [modules::decoded $namespace] 0] instance]} {
                writeLog "skipped loading database instance module from $file" error
                return 0
            } else {
                return 1
            }
        }

        proc processFile {name} {
            if {$global::debug} {
                writeLog "loading configuration from file: $name"
            }
            set initializer [new record -file $name]
            record::read $initializer
            configuration::load [record::configurationData $initializer]                         ;# set global values from save file
            modules::parse [record::modulesWithArguments $initializer "notInstance $name"]                              ;# recursive
            set modules::(initialized) [record::modules $initializer]
            return $initializer
        }

    }

}

proc modificationsPoll {pollTime files} {                         ;# see whether loaded files are modified and reload when necessary
    static lastModified

    foreach file $files {
        if {![file readable $file]} continue                                               ;# ignore files that may have disappeared
        set seconds [file mtime $file]
        if {![info exists lastModified($file)]} {                                                              ;# first time checked
            set lastModified($file) $seconds
        } elseif {$seconds > $lastModified($file)} {                                                            ;# file was modified
            # clean up and delete interpreter for that file:
            $::interpreter($file) eval {
                foreach instance $modules::(instances) {   ;# no need to empty module data as viewers are destroyed with interpreter
                    modules::unload $instance                                         ;# so that module termination is done properly
                }
            }
            interp delete $::interpreter($file)  ;# should stop refresh process for that interpreter, also frees all objects, memory
            set interpreter [interp create]                                                        ;# replace with a new interpreter
            initialize $interpreter
            interp eval $interpreter "set initializer \[processFile $file\]"
            $interpreter eval modules::initialize 1 moduleInitializationError
            $interpreter eval "
                modules::setPollTimes \[record::pollTime \$initializer\]
                createSavedViewers \$initializer $file
                foreach instance \$modules::(instances) {
                    processModule \$instance
                }
                refresh                                                                                ;# initialize refresh process
            "
            set ::interpreter($file) $interpreter                                                                            ;# done
            set lastModified($file) $seconds                                                       ;# remember new modification time
            writeLog "reloaded $file"
        }
    }
    if {[info exists ::processFile]} {     ;# touch file so an external program can detect that moomps is hung (watchdog like usage)
        file mtime $::processFile [clock seconds]
    }
    after $pollTime modificationsPoll $pollTime [list $files]                                        ;# keep checking every so often
}

writeLog $startMessage
if {([string length $preferencesFile] > 0) && ![file readable $preferencesFile]} {
    writeLog "could not read preferences file: $preferencesFile" warning
}
if {[archive]} {                                                   ;# save some data cells values in a database for history purposes
    set database [eval new database $global::databaseOptions]
    if {[string length $database::($database,error)] > 0} {                  ;# there was a problem probably due to misconfiguration
        writeLog $database::($database,error) critical
        exit 1
    }
    if {$database::($database,created)} {
        writeLog {created table(s) in moodss database}
    }
    set global::database $database
    # needed by database code:
    source viewer.tcl
    source modules.tcl
    proc object {this procedure args} {        ;# simple and unsafe stooop to object command conversion for use between interpreters
        if {[string match ::* $procedure] || ([string length [namespace qualifiers $procedure]] > 0)} {
            eval $procedure $this $args
        } else {
            eval [classof $this]::$procedure $this $args
        }
    }
}

if {[catch {          ;# note: we may be running in daemon mode, so errors need be caught since standard error channel is redirected
    foreach file $fileNames {
        set interpreter($file) [interp create]                                                ;# use a separate interpreter per file
        initialize $interpreter($file)
        interp eval $interpreter($file) "set initializer \[processFile $file\]"
    }
    if {$global::debug} {
        writeLog {initializing modules...}
    }
    foreach file $fileNames {
        $interpreter($file) eval modules::initialize 1 moduleInitializationError
        $interpreter($file) eval "
            modules::setPollTimes \[record::pollTime \$initializer\]
            createSavedViewers \$initializer $file
            foreach instance \$modules::(instances) {
                processModule \$instance
            }
            refresh                                                                                    ;# initialize refresh process
        "
    }
    if {![info exists arguments(-f)] && [info exists arguments(--pid-file)]} {    ;# eventually write process ID file in daemon mode
        set processFile $arguments(--pid-file)
        set file [open $processFile w]
        puts -nonewline $file [id process]
        close $file
    }
    if {$pollFilesTime > 0} {
        modificationsPoll $pollFilesTime $fileNames
    }
    vwait forever                                                                                                       ;# main loop
} message]} {                                                                                               ;# end of error catching
    writeLog $::errorInfo error                                                               ;# keep a trace of error for debugging
}