#!/usr/local/bin/tclsh8.6

#
# Display topod status
#
# Called by: admin
#
# Parameters (form or url):
# - refresh : time (in sec) between each page refresh
# - nrefresh : new refresh time (supplied by the user)
# - key : "eqmod", "ifchg", "status" or "keepstate"
# - arg : "" or equipment name or keepstate object name
#  
# History
#   2010/11/15 : pda      : design
#   2010/12/13 : pda      : i18n
#   2010/12/26 : pda      : use cgi-dispatch (minimal modification)
#

#
# Template pages used by this script
#

set conf(page)		topotop.html

#
# Next actions
# 

set conf(next)		"topotop"
set conf(nextpar)	"admpar"

#
# Script parameters
#

# maximum number of lines in "processed equipement" cell
set conf(maxeq)		10

# maximum number of status lines in compact display
set conf(maxstatus)	10

# maximum size (in characters) of message display
set conf(maxmsg)	50

set conf(taball) {
    global {
	chars {10 normal}
	align {left}
	botbar {yes}
	columns {20 20 60}
	align {left}
	format {raw}
    }
    pattern Title {
	topbar {yes}
	vbar {yes}
	column {
	    chars {bold}
	    align {center}
	    multicolumn {3}
	}
	vbar {yes}
    }
    pattern Normal3 {
	topbar {yes}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
    }
    pattern Normal2 {
	topbar {yes}
	vbar {yes}
	column { }
	vbar {yes}
	column {
	    multicolumn {2}
	}
	vbar {yes}
    }
}

set conf(tabeqmod) {
    global {
	chars {10 normal}
	align {left}
	botbar {yes}
	columns {40 20 20 20}
	align {left}
	format {cooked}
    }
    pattern Title {
	chars {bold}
	align {center}
	topbar {yes}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
    }
    pattern Normal4 {
	topbar {yes}
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
    }
}

# eq
# iface
# reqdate
# login
# modif (vlan/voip/desc)
# processed
# moddate
# modlog (first characters)

set conf(tabifchg) {
    global {
	chars {10 normal}
	align {left}
	botbar {yes}
	columns {20 20 20 10 30 5 20 20}
	align {left}
	format {cooked}
    }
    pattern Title {
	chars {bold}
	align {center}
	topbar {yes}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
    }
    pattern Normal8 {
	topbar {yes}
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
    }
    pattern Bold8 {
	chars {bold}
	topbar {yes}
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
    }
}

set conf(tabstatus) {
    global {
	chars {10 normal}
	align {left}
	botbar {yes}
	columns {30 70}
	align {left}
	format {cooked}
    }
    pattern Title {
	topbar {yes}
	vbar {yes}
	column {
	    multicolumn {2}
	    chars {bold}
	    align {center}
	}
	vbar {yes}
    }
    pattern Normal2 {
	topbar {yes}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
    }
}

set conf(tabks) {
    global {
	chars {10 normal}
	align {left}
	botbar {yes}
	columns {100}
	align {left}
	format {cooked}
    }
    pattern Title {
	topbar {yes}
	vbar {yes}
	column {
	    chars {bold}
	    align {center}
	}
	vbar {yes}
    }
    pattern Normal1 {
	topbar {yes}
	vbar {yes}
	column {
	    format {lines}
	}
	vbar {yes}
    }
}

set conf(tabmodlog) $conf(tabks)

#
# Netmagis general library
#

source /usr/local/lib/netmagis/libnetmagis.tcl

# ::webapp::cgidebug ; exit

##############################################################################
# Display all elements, compact version
##############################################################################

proc topotop-all {dbfd datefmt arg} {
    global conf

    set lines {}

    lappend lines [list "Title" [mc "General"]]

    #
    # Get "topo active" parameter
    #

    if {[dnsconfig get "topoactive"]} then {
	set active [mc "active"]
    } else {
	set active [mc "inactive"]
    }
    d urlset "" $conf(nextpar) {}
    set url [d urlget ""]
    set active [::webapp::helem "a" $active "href" $url]
    lappend lines [list "Normal2" [mc "Topo module"] $active]

    #
    # Get date of last full-rancid action
    #

    set lastfull [mc "(never)"]
    pg_select $dbfd "SELECT * FROM topo.lastrun" tab {
	if {$tab(date) ne ""} then {
	    set lastfull [clock format [clock scan $tab(date)] -format $datefmt]
	}
    }
    lappend donneees [list Normal2 [mc "Last full-rancid"] $lastfull]

    #
    # Get list of modified equipements and waiting for graph building
    #

    set unproc {}
    pg_select $dbfd "SELECT DISTINCT eq FROM topo.modeq WHERE processed=0" tab {
	d urlset "" $conf(next) [list {key eqmod} [list "arg" $tab(eq)]]
	set url [d urlget ""]
	lappend unproc [::webapp::helem "a" $tab(eq) "href" $url]
    }
    if {[llength $unproc] == 0} then {
	set unproc [mc "(none)"]
    } else {
	set unproc [join $unproc ", "]
    }

    d urlset "" $conf(next) [list {key eqmod}]
    set url [d urlget ""]
    set msg [::webapp::helem "a" [mc "Modified equipments"] "href" $url]
    lappend lines [list "Normal2" $msg $unproc]

    #
    # Get list of waiting interface modifications
    #

    set unproc {}
    set sql "SELECT DISTINCT eq FROM topo.ifchanges WHERE processed = 0"
    pg_select $dbfd $sql tab {
	d urlset "" $conf(next) [list {key ifchg} [list "arg" $tab(eq)]]
	set url [d urlget ""]
	lappend unproc [::webapp::helem "a" $tab(eq) "href" $url]
    }
    if {[llength $unproc] == 0} then {
	set unproc [mc "(none)"]
    } else {
	set unproc [join $unproc ", "]
    }

    d urlset "" $conf(next) [list {key ifchg}]
    set url [d urlget ""]
    set msg [::webapp::helem "a" [mc "Waiting changes"] "href" $url]
    lappend lines [list "Normal2" $msg $unproc]

    #
    # Last status lines
    #

    lappend lines [list "Title" [mc "Status"]]

    set status {}
    set sql "SELECT message FROM topo.keepstate WHERE type = 'status'"
    pg_select $dbfd $sql tab {
	set status $tab(message)
    }
    d urlset "" $conf(next) [list {key status}]
    set url [d urlget ""]
    set statut [::webapp::helem "a" [mc "Status"] "href" $url]
    set ls {}
    set i 0
    foreach s $status {
	lassign $s date msg
	set date [clock format [clock scan $date] -format $datefmt]
	set msg [::webapp::html-string $msg]
	lappend ls "$date $msg"
	incr i
	if {$i >= $conf(maxstatus)} then {
	    break
	}
    }
    lappend lines [list Normal2 $statut [join $ls "<br>"]]

    #
    # Get other keepstate messages
    #

    set sql "SELECT * FROM topo.keepstate
				WHERE type != 'status'
				ORDER BY date DESC"
    pg_select $dbfd $sql tab {
	set type $tab(type)
	set date [clock format [clock scan $tab(date)] -format $datefmt]
	set mess [string range $tab(message) 0 $conf(maxmsg)]
	regsub "\n" $mess "/" message
	set message [::webapp::html-string $message]
	if {$mess ne $tab(message)} then {
	    append message "..."
	    d urlset "" $conf(next) [list {key keepstate} [list "arg" $type]]
	    set url [d urlget ""]
	    set message [::webapp::helem "a" $message "href" $url]
	}
	lappend lines [list "Normal3" $type $date $message]
    }

    #
    # Get last processed equipments
    #

    d urlset "" $conf(next) [list {key eqmod}]
    set url [d urlget ""]
    set msg [::webapp::helem "a" [mc "Last processed equipments"] "href" $url]
    lappend lines [list "Title" $msg]

    set sql "SELECT * FROM topo.modeq
				WHERE processed != 0
				ORDER BY date desc
				LIMIT $conf(maxeq)"
    set le {}
    pg_select $dbfd $sql tab {
	set eq $tab(eq)
	set date [clock format [clock scan $tab(date)] -format $datefmt]
	set login $tab(login)

	d urlset "" $conf(next) [list {key eqmod} [list "arg" $eq]]
	set url [d urlget ""]
	set eq [::webapp::helem "a" $eq "href" $url]

	lappend lines [list "Normal3" $eq $date $login]
    }

    return [::arrgen::output "html" $conf(taball) $lines]
}

##############################################################################
# Function to display modified equipments
##############################################################################

# arg = "" or eq
proc topotop-eqmod {dbfd datefmt arg} {
    global conf

    set lines {}
    lappend lines [list "Title" \
				[mc "quipment"] \
				[mc "Date"] \
				[mc "Login"] \
				[mc "Processed"] \
			    ]
    if {$arg eq ""} then {
	set where ""
    } else {
	set qeq [::pgsql::quote $arg]
	set where "WHERE eq = '$qeq'"
    }

    set sql "SELECT * FROM topo.modeq $where ORDER BY date DESC"
    pg_select $dbfd $sql tab {
	set date [clock format [clock scan $tab(date)] -format $datefmt]
	if {$tab(processed)} then {
	    set procd [mc "Yes"]
	} else {
	    set procd [mc "No"]
	}
	set eq $tab(eq)
	if {$arg eq ""} then {
	    d urlset "" $conf(next) [list {key eqmod} [list "arg" $eq]]
	    set url [d urlget ""]
	    set eq [::webapp::helem "a" $eq "href" $url]
	}
	lappend lines [list "Normal4" $eq $date $tab(login) $procd]
    }
    return [::arrgen::output "html" $conf(tabeqmod) $lines]
}

##############################################################################
# Function to display interface changes
##############################################################################

# arg = "" or eq
proc topotop-ifchg {dbfd datefmt arg} {
    global conf

    set lines {}
    lappend lines [list "Title" \
			[mc "Equipment"] \
			[mc "Interface"] \
			[mc "Date"] \
			[mc "Login"] \
			[mc "Change"] \
			[mc "Processed"] \
			[mc "Date sent"] \
			[mc "Log"] \
		    ]
    set w ""
    if {$arg ne ""} then {
	set qeq [::pgsql::quote $arg]
	set w "WHERE eq = '$qeq'"
    }
    set sql "SELECT * FROM topo.ifchanges $w ORDER BY reqdate DESC"

    pg_select $dbfd $sql tab {
	set reqdate [clock format [clock scan $tab(reqdate)] -format $datefmt]
	if {$tab(processed)} then {
	    set pattern "Normal8"
	    set procd [mc "Yes"]
	} else {
	    set pattern "Bold8"
	    set procd [mc "No"]
	}

	d urlset "" $conf(next) [list {key ifchg} [list "arg" $tab(eq)]]
	set url [d urlget ""]
	set eq [::webapp::helem "a" $tab(eq) "href" $url]

	set mod [mc {vlan=%1$s, voip=%2$s, desc=%3$s} $tab(ethervlan) $tab(voicevlan) $tab(ifdesc)]
	set moddate $tab(moddate)
	if {$moddate ne ""} then {
	    set moddate [clock format [clock scan $moddate] -format $datefmt]
	}

	set modlog [string range $tab(modlog) 0 $conf(maxmsg)]
	regsub "\n" $modlog "/" modlog
	set modlog [::webapp::html-string $modlog]
	if {$modlog ne $tab(modlog)} then {
	    append modlog "..."
	    set arg "$tab(eq)|$tab(iface)|$tab(reqdate)"
	    d urlset "" $conf(next) [list {key modlog} [list "arg" $arg]]
	    set url [d urlget ""]
	    set modlog [::webapp::helem "a" $modlog "href" $url]
	}

	lappend lines [list $pattern \
				$eq $tab(iface) $reqdate $tab(login) \
				$mod $procd $moddate $modlog]
    }
    return [::arrgen::output "html" $conf(tabifchg) $lines]
}

##############################################################################
# Function to display interface modification log
##############################################################################

# arg = "eq|iface|date"
proc topotop-modlog {dbfd datefmt arg} {
    global conf

    if {! [regexp {^([^|]+)\|([^|]+)\|([^|]+)$} $arg bidon eq iface date]} then {
	d error [mc "Invalid argument '%s'" $arg]
    }

    set qeq [::pgsql::quote $eq]
    set qif [::pgsql::quote $iface]
    set qdate [::pgsql::quote $date]
    set sql "SELECT moddate, modlog FROM topo.ifchanges
			WHERE eq = '$qeq'
			    AND iface = '$qif'
			    AND reqdate = '$qdate'"
    set lines {}
    pg_select $dbfd $sql tab {
	set moddate $tab(moddate)
	set modlog $tab(modlog)
    }

    if {$moddate ne ""} then {
	set moddate [clock format [clock scan $moddate] -format $datefmt]
    }
    regsub -all "\n+" $modlog "\n" modlog
    regsub -all "\b" $modlog "" modlog

    set harg [::webapp::html-string $arg]
    if {$moddate eq ""} then {
	set msg [mc "Change of '%s' not yet processed" "$eq/$iface"]
	lappend lines [list "Title" $msg]
    } else {
	set msg [mc {Change log of '%1$s' at %2$s} "$eq/$iface" $moddate]
	lappend lines [list "Title" $msg]
	lappend lines [list "Normal1" $modlog]
    }

    return [::arrgen::output "html" $conf(tabmodlog) $lines]
}

##############################################################################
# Function to display detailed status
##############################################################################

# arg = ""
proc topotop-status {dbfd datefmt arg} {
    global conf

    set lines {}
    lappend lines [list "Title" [mc "Status"]]

    set status {}
    set sql "SELECT message FROM topo.keepstate WHERE type = 'status'"
    set status {}
    pg_select $dbfd $sql tab {
	set status $tab(message)
    }
    foreach s $status {
	lassign $s date msg
	set date [clock format [clock scan $date] -format $datefmt]
	set msg [::webapp::html-string $msg]
	lappend lines [list "Normal2" $date $msg]
    }

    return [::arrgen::output "html" $conf(tabstatus) $lines]
}

##############################################################################
# Function to display detailed keepstate
##############################################################################

# arg = type
proc topotop-keepstate {dbfd datefmt arg} {
    global conf

    set lines {}

    set qtype [::pgsql::quote $arg]
    set sql "SELECT date, message FROM topo.keepstate WHERE type = '$qtype'"

    set date ""
    set message ""
    pg_select $dbfd $sql tab {
	set date [clock format [clock scan $tab(date)] -format $datefmt]
	set message $tab(message)
    }

    set harg [::webapp::html-string $arg]
    if {$date eq ""} then {
	set msg [mc "No message for '%s'" $harg
	lappend lines [list "Title" $msg]
    } else {
	set msg [mc {Last message for '%1$s' at %2$s} $harg $date]
	lappend lines [list "Title" $msg]
	lappend lines [list "Normal1" $message]
    }

    return [::arrgen::output "html" $conf(tabks) $lines]
}

##############################################################################
# Display topo*d dashboard 
##############################################################################

d cgi-register {} {
     {refresh	0 1}
     {nrefresh	0 1}
     {key	0 1}
     {arg	0 1}
} {
    global conf

    # nrefresh (text field given by the user) has priority over refresh
    # value supplied in URL. Thus, the new URL will use nrefresh.
    if {$nrefresh ne ""} then {
	set refresh $nrefresh
    }

    d urlset "%URLFORM%" $conf(next) [list \
					    [list "key" $key] \
					    [list "arg" $arg] \
					    [list "refresh" $refresh] \
					]

    set datefmt [dnsconfig get "datefmt"]

    set date [clock format [clock seconds] -format $datefmt]

    #
    # Active refresh
    #

    set meta ""
    if {[regexp {^[0-9]+$} $refresh] && $refresh > 0} then {
	d urlset "" $conf(next) [list \
					    [list "key" $key] \
					    [list "arg" $arg] \
					    [list "refresh" $refresh] \
					]
	set u [d urlget ""]
	append meta "<meta http-equiv=\"refresh\" content=\"$refresh;url=$u\">"
	append meta "<meta http-equiv=\"pragma\" content=\"no-cache\">"
    } else {
	set refresh [::webapp::html-string $refresh]
    }


    #
    # Specific key?
    #

    if {$key eq "" || [catch {info args topotop-$key}]} then {
	set top [topotop-all $dbfd $datefmt ""]
    } else {
	set top [topotop-$key $dbfd $datefmt $arg]
    }

    #
    # End of script: output page and close database
    #

    set key [::webapp::html-string $key]
    set arg [::webapp::html-string $arg]

    d result $conf(page) [list \
				[list %META% $meta] \
				[list %REFRESH% $refresh] \
				[list %DATE% $date] \
				[list %TOP% $top] \
			    ]
}

##############################################################################
# Main procedure
##############################################################################

d cgi-dispatch "admin" "admin"
