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

#
# Display equipment list, or equipment details
#
# Called by: every topo script
#
# Parameters (form or url):
#	- eq: equipment name (glob)
#	- iface: interface name
#
# History
#   2006/06/05 : pda      : design
#   2006/08/14 : pda      : merge listeq
#   2007/01/04 : pda      : add parameter uid
#   2007/01/11 : pda      : common initialisation
#   2007/01/11 : pda      : possible to substitute uid
#   2008/05/06 : pda      : add localition
#   2008/07/31 : pda/boggia : tree view
#   2008/08/01 : pda      : wifi statistics
#   2010/08/31 : pda/jean : add "native vlan" information
#   2010/12/11 : pda      : i18n
#   2010/12/25 : pda      : use cgi-dispatch
#

#
# Template pages used by this script
#

set conf(page1)		eq.html
set conf(pagen)		topolist.html

#
# Next actions
# 

set conf(nexteq)	"eq"
set conf(nextl2)	"l2"
set conf(nextl3)	"l3"
set conf(nextmetro)	"metro"
set conf(nextifchg)	"ifchg"

#
# Script parameters
#

set conf(dumpgraph)	"dumpgraph -o eq %s"
set conf(extractcoll)	"extractcoll -w %s"

#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Wifi statistics
##############################################################################

#
# General note:
# Wifi statistics is an array containing following indexes:
#	tab(:ssid)		{<ssid> ... <ssid>}	(sorted list)
#	tab(:assoc:cumul)	<id>+<id>+...
#	tab(:assoc:ssid)	{<ssid> ... <ssid>}	(sorted list)
#	tab(:assoc:ssid:<ssid>)	{<id>}	ou {}
#	(idem with :auth)
# Function "cumul-wifi" accumulates these statistics
#

#
# Initialize wifi statistics
#
# Input:
#   - _tab : name of an array containing, in return, accumulated stats
# Output:
#   - return value: none
#   - parameter _tab : see above
#
# History
#   2008/08/03 : pda        : design
#

proc init-cumul-wifi {_tab} {
    upvar $_tab tab

    catch {unset tab}

    set lkeys {assoc auth}

    set tab(:ssid)	   {}

    foreach k $lkeys {
	set tab(:$k:cumul)  {}
	set tab(:$k:ssid)   {}
	set tab(:$k:ap)     {}
    }
}

#
# Cumulate wifi statistics for an access point
#
# Input:
#   - sensors : wifi sensor list for this access point
#		{{<nbauthwifi|nbassocwifi> <id> <ssid>}
#   - _tab : name of an array containing, in return, accumulated stats
# Output:
#   - return value: none
#   - parameter _tab : see above
#
# History
#   2008/08/02 : pda        : design
#

proc cumul-wifi {sensors _tab} {
    upvar $_tab tab

    init-cumul-wifi tab

    set lkeys {assoc auth}

    foreach l $sensors {
	lassign $l kw id ssid

	if {! [info exists seen($ssid)]} then {
	    lappend tab(:ssid) $ssid
	    set seen($ssid) 1
	    foreach k $lkeys {
		set tab(:$k:ssid:$ssid) {}
	    }
	}

	switch $kw {
	    nbassocwifi { set k "assoc" }
	    nbauthwifi  { set k "auth" }
	    default     { set k "???" }
	}

	lappend tab(:$k:cumul) $id
	lappend tab(:$k:ssid:$ssid) $id
	lappend tab(:$k:ssid) $ssid
    }

    foreach k $lkeys {
	set tab(:$k:cumul) [join $tab(:$k:cumul) "+"]
    }

    set tab(:ssid) [lsort $tab(:ssid)]
    foreach k $lkeys {
	set tab(:$k:ssid) [lsort $tab(:$k:ssid)]
    }
}

#
# Cumulate wifi statistics for a new access point
#
# Input:
#   - _tr : array containing all stats
#   - _t1 : array containing stats for one access point
# Output:
#   - return value: none
#   - parameters _tr, _t1 : see above
#
# History
#   2008/08/04 : pda        : specification
#   2008/08/14 : pda        : end of coding
#

proc accumulate {_tr _t1} {
    upvar $_tr tr
    upvar $_t1 t1

    set lkeys {assoc auth}

    #
    # Add ssid to list of ssids
    #

    foreach ssid $t1(:ssid) {
	if {[lsearch $ssid $tr(:ssid)]} then {
	    lappend tr(:ssid) $ssid
	}
    }

    #
    # Add per ssid stats
    #

    foreach k $lkeys {
	foreach ssid $t1(:$k:ssid) {
	    set c ":$k:ssid:$ssid"
	    if {[info exists tr($c)]} then {
		set l [concat $tr($c) $t1($c)]
	    } else {
		set l $t1($c)
	    }
	    set tr($c) $l
	}
    }

    #
    # Add per ap stats
    #

    foreach k $lkeys {
	set l {}
	foreach ssid $t1(:$k:ssid) {
	    lappend l $t1(:$k:ssid:$ssid)
	}
	lappend tr(:$k:ap) [join $l "+"]
    }

    #
    # Cumulate the cumul
    #

    foreach k $lkeys {
	if {$tr(:$k:cumul) eq ""} then {
	    set tr(:$k:cumul) $t1(:$k:cumul)
	} else {
	    append tr(:$k:cumul) "+$t1(:$k:cumul)"
	}
    }

    #
    # Sort final lists
    #

    set tr(:ssid) [lsort $tr(:ssid)]
    foreach k $lkeys {
	set tr(:$k:ssid) [lsort $tr(:$k:ssid)]
    }
}

##############################################################################
# Make a tree from an equipment list
##############################################################################

#
# Place an element into a tree
#
# Input:
#   - _thier : array containing the tree
#   - list : element list by level
#   - cumul : 1 if elements must be accumulated, else 0 (see below)
# Output:
#   - return value: none
#   - array _thier : updated
#
# Example 1 :
#   if list = {anapat -ap 3} and cumul = 1 and thier =
#	t()		= {anapat}
#	t(anapat)	= {anapat-ap}
#	t(anapat-ap)	= {anapat-ap1}
#	t(anapat-ap1)	= {}
#   then thier is updated with:
#	t()		= {anapat}
#	t(anapat)	= {anapat-ap}
#	t(anapat-ap)	= {anapat-ap1 anapat-ap3} (order don't matter 3/1 or 1/3)
#	t(anapat-ap1)	= {}
#	t(anapat-ap3)	= {}
#
# Example 2 :
#   in above example, if cumul = 0, we should have the list:
#		{anapat anapat-ap anapat-ap3}
#
# Example 3 :
#   if list = {horus} and thier =
#	(nothing)
#   then thier is updated with:
#	t()		= {horus}
#	t(horus)	= {}
#
# History
#   2008/07/31 : pda/boggia : design
#

proc place-into-tree {_thier list cumul} {
    upvar $_thier thier

    set root ""
    set idx ""
    foreach word $list {
	if {$cumul} then {
	    append idx $word
	} else {
	    set idx $word
	}
	if {! ([info exists thier($root)] && $idx in $thier($root))} then {
	    lappend thier($root) $idx
	}
	set root $idx
    }
    lappend thier($root) {}
}

#
# Make a tree from an equipment list
#
# Input:
#   - _t : tree
#   - leq : equipment list
# Output:
#   - return value: none
#   - _t : updated
#
# Note: grouping in a tree is realized on equipment name, which is
#   splitted following a local specific policy, which is:
#	[xxx] [-tt] [nn]
#   where xxx is a prefix, -tt is the equipment type and nn the number
#   within the type. For example, "anapat-ap3" is splitted in: anapat -ap 3
#
# History
#   2008/07/31 : pda/boggia : design
#

proc listeq-to-tree {_t leq} {
    upvar $_t t

    catch {unset t}

    #
    # First phase: make a tree from all elements
    #

    foreach eq $leq {
	if {[regexp  {(.*)(-[a-z]+)([0-9]+)$} $eq bidon n1 n2 n3]} then {
	    place-into-tree t [list $n1 $n2 $n3] 1
	} else {
	    place-into-tree t [list $eq] 1
	}
    }

    #
    # Second phase: move up one level (recursively) all equipments
    # when they are alone on their level (except "-ap" equipments,
    # which are wifi access-points in our local policy)
    #

    # XXX : not yet

    #
    # Third phase: sort each level
    #

    foreach i [array names t] {
	set t($i) [lsort $t($i)]
    }
}

#
# Display equipment tree
#
# Input:
#   - root: root of tree
#   - _thier : tree
#   - _tabeq : array containaing all equipments
#   - _tabwifi : array containing all wifi sensors
# Output:
#   - return value: list of trees where root is at this level
#
# History
#   2008/07/31 : pda/boggia : design
#   2008/08/01 : pda/boggia : add tabwifi
#

proc display-eq-tree {root _thier _tabeq _tabwifi} {
    global conf
    upvar $_thier thier
    upvar $_tabeq tabeq
    upvar $_tabwifi tabwifi

    set tree {}
    set nwifi 0
    init-cumul-wifi twa

    foreach son $thier($root) {
	#
	# The goal of this loop is to avoid to make multiple levels
	# when there is only one son at each level
	#
	set prec $root
	while {$son ne "" && [llength $thier($son)] <= 1} {
	    set prec $son
	    set son [lindex $thier($son) 0]
	}

	#
	# Node or leaf ?
	#

	if {$son eq ""} then {
	    #
	    # Leaf: it's an equipment
	    #
	    set type  [lindex $tabeq($prec) 0]
	    set model [lindex $tabeq($prec) 1]

	    d urlset "" $conf(nexteq) [list [list "eq" $prec]]
	    set url [d urlget ""]
	    set link [::webapp::helem "a" $prec "href" $url]
	    lappend tree [list "$link $type $model"]

	    #
	    # Wifi stats
	    #
	    if {[info exists tabwifi($prec)]} then {
		incr nwifi
		cumul-wifi $tabwifi($prec) tw
		accumulate twa tw
	    }
	} else {
	    #
	    # Note: repeat recursively
	    #
	    lappend tree [display-eq-tree $son thier tabeq tabwifi]
	}
    }

    #
    # Root display
    #

    set rhtml $root
    if {$nwifi > 1 && $nwifi == [llength $thier($root)]} then {
	#
	# Display wifi stats if all leafs are access points
	#

	#
	# Cumul
	#

	append rhtml [format " (%s " [mc "sums"]]
	foreach k {assoc auth} {
	    set tk [mc "$k"]
	    set hid $twa(:$k:cumul)
	    d urlset "" $conf(nextmetro) [list [list "id" $hid]]
	    set url [d urlget ""]
	    append rhtml [::webapp::helem "a" "\[$tk\]" "href" $url]
	}

	#
	# Details per SSID
	#

	append rhtml [format ", %s " [mc "detail/SSID"]]
	foreach k {assoc auth} {
	    set tk [mc "$k"]
	    set lid {}
	    foreach ssid $twa(:$k:ssid) {
		set lid [concat $lid $twa(:$k:ssid:$ssid)]
	    }
	    set hid [join $lid "|"]
	    d urlset "" $conf(nextmetro) [list [list "id" $hid]]
	    set url [d urlget ""]
	    append rhtml [::webapp::helem "a" "\[$tk\]" "href" $url]
	}

	#
	# Details per access point
	#

	append rhtml [format ", %s " [mc "detail/AP"]]
	foreach k {assoc auth} {
	    set tk [mc "$k"]
	    set hid [join $twa(:$k:ap) "|"]
	    d urlset "" $conf(nextmetro) [list [list "id" $hid]]
	    set url [d urlget ""]
	    append rhtml [::webapp::helem "a" "\[$tk\]" "href" $url]
	}
	append rhtml ")"
    }

    return [linsert $tree 0 $rhtml]
}

##############################################################################
# Equipment display
##############################################################################

proc format-one-eq {eqname iface _tabuid} {
    global conf
    upvar $_tabuid tabuid

    #
    # Read equipment information from graph.
    #

    set l [eq-iflist $eqname tabuid]

    lassign $l eqname type model location liferr iflist arrayif arrayvlan
    array set tabiface $arrayif

    #
    # Title
    #

    set title [mc "Equipment"]
    append title " $eqname $type $model"
    if {$location ne ""} then {
	append title [format " (%s)" [mc "location"]]
    }

    #
    # If an error is found, exit immediately. This case means that
    # one (or more) interface(s) which is writable, but not readable.
    #

    if {[llength $liferr] > 0} then {
	set l [join $liferr " "]
	set text [mc "Inconsistent permissions on interfaces: %s" $l]
	return [list $title $text]
    }

    set eqmod 0
    set text ""
    foreach i $iflist {
	set txt ""

	#
	# Interface name and parameters (Ethernet, radio)
	#

	lassign $tabiface($i) name edit radio stat mode desc link native
	set line [lreplace $tabiface($i) 0 7]

	if {$iface eq $name} then {
	    append txt [::webapp::helem "b" $name]
	} else {
	    append txt "$name"
	}

	if {[llength $radio] > 0} then {
	    set channel [conv-channel [lindex $radio 0]]
	    set power   [lindex $radio 1]
	    append txt " ("
	    append txt [mc {channel %1$s power %2$s mW} $channel $power]
	    append txt ")"
	}

	if {$stat ne "-"} then {
	    d urlset "" $conf(nextmetro) [list [list "id" $stat]]
	    set url [d urlget ""]
	    append txt " "
	    append txt [::webapp::helem "a" {[Trafic]} "href" $url]
	}

	append txt " $mode"

	if {$desc ne "-"} then {
	    append txt " ("
	    append txt [::webapp::html-string [binary format H* $desc]]
	    append txt ")"
	}

	if {[llength $link] > 1} then {
	    lassign $link via eq2 if2
	    d urlset "" $conf(nexteq) [list \
					    [list "eq" $eq2] \
					    [list "iface" $if2] \
					]
	    set urleqiface [d urlget ""]
	    append txt " $via "
	    append txt [mc "to"]
	    append txt " "
	    append txt [::webapp::helem "a" "$eq2 $if2" "href" $urleqiface]
	}

	#
	# Wifi statistics
	#

	if {[info exists tabwifi($eqname:$i)]} then {

	    cumul-wifi $tabwifi($eqname:$i) tw

	    append txt " "

	    foreach k {assoc auth} {
		if {[llength $tw(:$k:ssid)] > 1} then {
		    #
		    # Display sums (only if more than one ssid)
		    #

		    set tk [mc "Sum $k"]
		    set hid $tw(:$k:cumul)
		    d urlset "" $conf(nextmetro) [list [list "id" $hid]]
		    set url [d urlget ""]
		    append txt " "
		    append txt [::webapp::helem "a" "\[$tk\]" "href" $url]

		    #
		    # Detail per ssid (only if more than one ssid)
		    #

		    set lid {}
		    foreach ssid $tw(:$k:ssid) {
			set lid [concat $lid $tw(:$k:ssid:$ssid)]
		    }
		    set tk [mc "Detail $k"]
		    set hid [join $lid "|"]
		    d urlset "" $conf(nextmetro) [list [list "id" $hid]]
		    set url [d urlget ""]
		    append txt " "
		    append txt [::webapp::helem "a" "\[$tk\]" "href" $url]
		}
	    }
	}

	#
	# If this interface is writable, activate the button.
	#

	if {$edit eq "edit"} then {
	    d urlset "" $conf(nextifchg) [list \
						[list "eq" $eqname] \
						[list "iface" $i] \
					    ]
	    set e [mc "Edit"]
	    set url [d urlget ""]
	    append txt " "
	    append txt [::webapp::helem "a" "\[$e\]" "href" $url]
	    incr eqmod
	}

	#
	# Traverse vlans available on this interface
	#

	set nvlan [llength $line]
	foreach vlan [lsort -index 0 -integer $line] {
	    lassign $vlan vlanid desc stat

	    if {$desc eq "-"} then {
		set desc [mc "no description"]
	    } else {
		set desc [binary format H* $desc]
	    }
	    set natv ""
	    if {$vlanid == $native} then {
		set natv [format " (%s)" [mc "native vlan"]]
	    }

	    append txt "\n<BR>\n"

	    if {$nvlan > 1 || $vlanid != 0} then {
		d urlset "" $conf(nextl2) [list \
						[list "eq" $eqname] \
						[list "iface" $i] \
						[list "vlan" $vlanid] \
					    ]
		set urll2 [d urlget ""]
		append txt [mc "Vlan"]
		append txt " "
		append txt [::webapp::helem "a" "$vlanid ($desc)" "href" $urll2]
		append txt $natv

		if {$stat ne "-"} then {
		    set t [mc "Traffic"]
		    d urlset "" $conf(nextmetro) [list [list "id" $stat]]
		    set url [d urlget ""]
		    append txt " "
		    append txt [::webapp::helem "a" "\[$t\]" "href" $url]
		}
	    }

	    foreach ip [lsort [lindex $vlan 3]] {
		d urlset "" $conf(nextl3) [list [list "addr" $ip]]
		set urll3 [d urlget ""]
		append txt " "
		append txt [::webapp::helem "a" $ip "href" $urll3]
	    }
	}

	#
	# For radio interfaces, fetch sensors
	#

	if {[info exists tabwifi($eqname:$i)]} then {
	    foreach ssid $tw(:ssid) {
		append txt "\n<BR>\n"
		append txt [mc "SSID %s " $ssid]
		foreach k {assoc auth} {
		    set tk [mc $k]
		    set id [lindex $tw(:$k:ssid:$ssid) 0]
		    if {$id ne ""} then {
			d urlset "" $conf(nextmetro) [list [list "id" $id]]
			set url [d urlget ""]
			append txt [::webapp::helem "a" "\[$tk\]" "href" $url]
		    }
		}
	    }
	}

	#
	# Final result
	#
	append text [::webapp::helem "li" [::webapp::helem "p" $txt] STYLE "padding: 0 ; background: none ; list-style: outside url(/images/dash.gif) disc;"]
    }

    set text [::webapp::helem "ul" $text]

    if {$eqmod > 1} then {
	set t [mc "Edit interfaces"]
	d urlset "" $conf(nextifchg) [list [list "eq" $eqname]]
	set url [d urlget ""]
	append title " "
	append title [::webapp::helem "a" "\[$t\]" "href" $url]
    }

    return [list $title $text]
}

##############################################################################
# Display equipment
##############################################################################

d cgi-register {} {
    {eq		0 1}
    {iface	0 1}
} {
    global conf

    #
    # Initialization
    #

    set msgsta [topo-status $dbfd $tabuid(p_admin)]

    d urlset "%URLFORMEQ%" $conf(nexteq) {}
    d urlset "%URLFORML2%" $conf(nextl2) {}
    d urlset "%URLFORML3%" $conf(nextl3) {}

    #
    # Get equipment informations from graph
    #

    set cmd [format $conf(dumpgraph) $tabuid(flagsr)]
    if {! [call-topo $cmd msg]} then {
	d error [mc "Error while reading equipments: %s" $msg]
    }
    foreach line [split $msg "\n"] {
	switch [lindex $line 0] {
	    eq {
		set eqname [lindex $line 1]
		if {$eq eq "" || [string match -nocase $eq $eqname]} then {
		    set type  [lindex $line 3]
		    set model [lindex $line 5]
		    set tabeq($eqname) [list $type $model]
		}
	    }
	}
    }

    #
    # Extract wifi statistics for these equipments
    #

    set cmd [format $conf(extractcoll) $tabuid(flagsr)]
    if {! [call-topo $cmd msg]} then {
	d error [mc "Error while reading wifi sensors: %s" $msg]
    }
    foreach line [split $msg "\n"] {
	switch [lindex $line 0] {
	    nbassocwifi -
	    nbauthwifi {
		lassign $line kw id weq iface ssid
		if {[info exists tabeq($weq)]} then {
		    lappend tabwifi($weq) [list $kw $id $ssid]
		    lappend tabwifi($weq:$iface) [list $kw $id $ssid]
		}
	    }
	}
    }

    #
    # If more than one equipment is found, display them in order
    #

    # 1 if no equipment is searched for, 0 if search for equipment name
    set ceq [string equal $eq ""]

    # number of equipment found
    set neq [llength [array names tabeq]]

    switch -glob "$ceq-$neq" {
	*-0 {
	    #
	    # No equipment is found. Proceed as a list, but with an empty list.
	    # No matter whether or not we searched for an equipment.
	    #

	    set list [mc "No equipment found"]

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

	    d result $conf(pagen) [list \
				    [list %MSGSTA% $msgsta] \
				    [list %OBJETS% [mc "equipments"]] \
				    [list %LIST%   $list] \
				    [list %EQ%     $eq] \
				    [list %VLAN%   ""] \
				    [list %ADDR%   ""] \
				    [list %HEADER% ""] \
				    [list %ONLOAD% ""] \
				]
	}
	*-1 {
	    #
	    # We found only one equipment. No matter whether or not
	    # we searched for it. Extract informations from the graph.
	    #

	    set eqname [lindex [array names tabeq] 0]

	    set l [format-one-eq $eqname $iface tabuid]
	    lassign $l title text

	    set eqsta [eq-graph-status $dbfd $eq]

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

	    d result $conf(page1) [list \
				    [list %MSGSTA% $msgsta] \
				    [list %EQSTA% $eqsta] \
				    [list %TITLE% $title] \
				    [list %TEXTE% $text] \
				    [list %EQ%    $eq] \
				    [list %VLAN%  ""] \
				    [list %ADDR%  ""] \
				]
	}
	0-* {
	    #
	    # We search for an equipment (with a regexp for example)
	    # and we found more than one. Sort equipments.
	    #

	    set list ""
	    foreach e [lsort [array names tabeq]] {
		lassign $tabeq($e) type model
		d urlset "" $conf(nexteq) [list [list "eq" $e]]
		set url [d urlget ""]
		set link [::webapp::helem "a" $e "href" $url]
		append list [::webapp::helem "li" "$link $type $model"]
	    }
	    set list [::webapp::helem "ul" $list]

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

	    d result $conf(pagen) [list \
				    [list %MSGSTA% $msgsta] \
				    [list %OBJETS% [mc "equipments"]] \
				    [list %LIST%   $list] \
				    [list %EQ%     $eq] \
				    [list %VLAN%   ""] \
				    [list %ADDR%   ""] \
				    [list %HEADER% ""] \
				    [list %ONLOAD% ""] \
			    	]
	}
	1-* {
	    #
	    # We didn't search for an equipment, we just wanted to
	    # see the list (as a tree).
	    #

	    listeq-to-tree thier [array names tabeq]
	    set tree [display-eq-tree "" thier tabeq tabwifi]
	    set expcoll [list [mc "develop"] [mc "envelop"]]
	    set t [::webapp::interactive-tree "leq" $tree $expcoll]
	    lassign $t head1 head2 onload html
	    set header "$head1\n$head2\n"

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

	    d result $conf(pagen) [list \
				    [list %MSGSTA% $msgsta] \
				    [list %OBJETS% [mc "equipments"]] \
				    [list %LIST%   $html] \
				    [list %EQ%     $eq] \
				    [list %VLAN%   ""] \
				    [list %ADDR%   ""] \
				    [list %HEADER% $header] \
				    [list %ONLOAD% $onload] \
				]
	}
    }
}

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

d cgi-dispatch "topo" ""
