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

#
# List vlans, or vlan details
#
# Called by: all topo scripts
#
# Parameters (form or url):
#	- eq: equipment name
#	- iface : name of an interface
#	- vlan : vlan-id on this interface, or part of a vlan description
#	- format : nothing, or "pdf" or "png"
#
# History
#   2006/06/05 : pda      : design
#   2006/06/20 : pda      : prologue depends upon format
#   2006/06/22 : pda      : fix a bug on link numbers
#   2006/06/22 : pda      : output depends upon format
#   2006/08/09 : pda      : full path of ps2pdf
#   2006/08/14 : pda      : merge with listl2
#   2007/01/04 : pda      : add parameter uid
#   2007/01/11 : pda      : common initialization
#   2007/01/11 : pda      : uid substitution
#   2010/12/12 : pda      : i18n
#   2010/12/20 : pda      : reworked installation
#   2010/12/25 : pda      : use cgi-dispatch
#

#
# Template pages used by this script
#

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

#
# Next actions
# 

set conf(nexteq)	"eq"
set conf(nextl2)	"l2"
set conf(nextl3)	"l3"

#
# Script parameters
#

set conf(dumpgraph)	"dumpgraph -o vlan %s"
set conf(extractl2)	"extractl2 %s %s %s %d"

set conf(maxdot)	12

#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Utilities
##############################################################################

proc conv-ifname {ifname} {
    foreach p {
		{ GigabitEthernet Gi}
		{ FastEthernet Fa}
		{ Port-channel Po}
		{ (ge-.*)/0$ \\1}
		} {
	lassign $p pattern subst
	regsub -all $pattern $ifname $subst ifname
    }
    return $ifname
}

proc title {vlanlist _tabvlan} {
    upvar $_tabvlan tabvlan

    set vlan0 0
    set vl ""
    foreach v $vlanlist {
	set vlanid   [lindex $v 0]
	if {[info exists tabvlan($v)]} then {
	    set vlandesc [lindex $tabvlan($v) 0]
	} else {
	    set vlandesc [format "(%s)" [mc "no description"]]
	}
	switch -- $vlanid {
	    0 {
		set vlan0 1
	    }
	    1 {
		# rien
	    }
	    default {
		if {$vl ne ""} then {
		    append vl "\\n"
		}
		append vl [mc {Vlan %1$s: %2$s} $vlanid $vlandesc]
	    }
	}
    }
    if {$vl eq "" && $vlan0} then {
	set vl "Vlan 0"
    }
    return $vl
}

proc gen-graph {dbfd gv format eq iface vlan xl2 _tabvlan} {
    global conf
    upvar $_tabvlan tabvlan

    set nnodes 0
    foreach line [split $xl2 "\n"] {
	switch [lindex $line 0] {
	    vlans {
		set vlans [lreplace $line 0 0]
	    }
	    eq {
		lassign $line kw eqname typemodel
		set tabeq($eqname) $typemodel
		incr nnodes
	    }
	    link {
		lassign $line kw linkname eq1 iface1 eq2 iface2
		set tablink($linkname) [list $eq1 $iface1 $eq2 $iface2]
	    }
	}
    }

    #
    # Display all these informations
    #

    dotattr-match-init $dbfd 2 td

    $gv title [title $vlans tabvlan]

    foreach eqname [array names tabeq] {
	set attrlist [dotattr-match-get $tabeq($eqname) td]

	d urlset "" $conf(nexteq) [list [list "eq" $eqname]]
	set url [d urlget ""]
	lappend attrlist "href=\"$url\""

	$gv node $eqname $attrlist
    }

    foreach link [array names tablink] {
	set eq1 [lindex $tablink($link) 0]
	set if1 [conv-ifname [lindex $tablink($link) 1]]
	set eq2 [lindex $tablink($link) 2]
	set if2 [conv-ifname [lindex $tablink($link) 3]]

	set attrlist [list label=\"$link\" \
				headlabel=\"$if2\" \
				taillabel=\"$if1\" \
			    ]
	$gv link $eq1 $eq2 $attrlist
    }

    #
    # Select graph processor
    #

    if {$nnodes > $conf(maxdot)} then {
	set engine "neato"
    } else {
	set engine "dot"
    }

    set dot    [get-local-conf "dot" ]
    set ps2pdf [get-local-conf "ps2pdf"]

    #
    # Generates graph
    #

    return [$gv graphviz $format $engine $dot $ps2pdf]
}

proc search-vlan {vlan _tabvlan} {
    upvar $_tabvlan tabvlan

    set r {}
    if {$vlan eq ""} then {
	#
	# Default case: list of all vlans
	#
	set r [lsort -integer [array names tabvlan]]

    } elseif {[catch {expr $vlan+0}]} then {
	#
	# Not an integer: look for given text in vlan descriptions
	#
	set pattern "*${vlan}*"
	foreach v [lsort -integer [array names tabvlan]] {
	    set desc [lindex $tabvlan($v) 0]
	    if {[string match -nocase $pattern $desc]} then {
		lappend r $v
	    }
	}
    } else {
	lappend r $vlan

    }
    return $r
}

##############################################################################
# Display L2 parameters
##############################################################################

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

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

    set tmp /tmp/l2-[pid]

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

    #
    # Extract vlan descriptions
    #

    set cmd [format $conf(dumpgraph) $tabuid(flagsr)]
    if {! [call-topo $cmd msg]} then {
	d error [mc "Error while reading Vlans: %s" $msg]
    }
    foreach line [split $msg "\n"] {
	switch [lindex $line 0] {
	    vlan {
		set id [lindex $line 1]
		set reste [lreplace $line 0 1]
		set desc ""
		set lnet {}
		while {[llength $reste] > 0} {
		    set key [lindex $reste 0]
		    set val [lindex $reste 1]
		    switch $key {
			desc {
			    if {$val eq "-"} then {
				set desc ""
			    } else {
				set desc [binary format H* $val]
			    }
			}
			net {
			    lappend lnet $val
			}
		    }
		    set reste [lreplace $reste 0 1]
		}
		set tabvlan($id) [list $desc $lnet]
	    }
	}
    }

    #
    # Search for vlans
    #

    set lvlans [search-vlan $vlan tabvlan]
    set qvlan [::webapp::html-string $vlan]

    #
    # Do we have to display all vlans, or one in particular?
    #

    set nvlans [llength $lvlans]
    switch $nvlans {
	0 {
	    #
	    # No vlan found
	    #

	    set list [mc "Vlan '%s' not found" $qvlan]
	    d result $conf(pagen) [list \
					[list %MSGSTA% $msgsta] \
					[list %OBJETS% "Vlans"] \
					[list %LIST%   $list] \
					[list %EQ%     ""] \
					[list %VLAN%   $qvlan] \
					[list %ADDR%   ""] \
					[list %HEADER% ""] \
					[list %ONLOAD% ""] \
				    ]
	}
	1 {
	    set gv [::gvgraph %AUTO%]

	    #
	    # Checks the output format
	    #

	    if {$format eq ""} then {
		set format "map"
	    }
	    set msg [$gv check-format $format]
	    if {$msg ne ""} then {
		d error $msg
	    }

	    #
	    # Search vlan name
	    #

	    set v [lindex $lvlans 0]
	    set desc [format "(%s)" [mc "no description"]]
	    if {[info exists tabvlan($v)]} then {
		set desc [lindex $tabvlan($v) 0]
		set nets [join [lindex $tabvlan($v) 1] " "]
		if {$nets ne ""} then {
		    append desc " ($nets)"
		}
	    }
	    set qvlan [::webapp::html-string $vlan]

	    #
	    # Get data from graph
	    #

	    set cmd [format $conf(extractl2) $tabuid(flagsr) $eq $iface $v]
	    if {! [call-topo $cmd xl2]} then {
		set list [mc "Vlan '%s' not found" $qvlan]
		d result $conf(pagen) [list \
					[list %MSGSTA% $msgsta] \
					[list %OBJETS% "Vlans"] \
					[list %LIST%   $list] \
					[list %EQ%     ""] \
					[list %VLAN%   $qvlan] \
					[list %ADDR%   ""] \
					[list %HEADER% ""] \
					[list %ONLOAD% ""] \
				    ]
		exit 0
	    }

	    #
	    # Sketch the resulting data
	    #

	    if {[gen-graph $dbfd $gv $format $eq $iface $v $xl2 tabvlan]} then {
		switch -- $format {
		    pdf {
			::webapp::send rawpdf [$gv output]
			d end
		    }
		    png {
			::webapp::send png [$gv output]
			d end
		    }
		    map {
			d urlset "" $conf(nextl2) [list \
							[list "format" "png"] \
							[list "eq" $eq] \
							[list "iface" $iface] \
							[list "vlan" $vlan] \
						    ]
			set urlimg [d urlget ""]
			d urlset "" $conf(nextl2) [list \
							[list "format" "pdf"] \
							[list "eq" $eq] \
							[list "iface" $iface] \
							[list "vlan" $vlan] \
						    ]
			set urlpdf [d urlget ""]

			set map [$gv output]
			d result $conf(page1) [list \
					    [list %MSGSTA% $msgsta] \
					    [list %DESC%  $desc] \
					    [list %URLIMG% $urlimg] \
					    [list %URLPDF% $urlpdf] \
					    [list %MAP%   $map] \
					    [list %EQ%    ""] \
					    [list %VLAN%  $qvlan] \
					    [list %ADDR%  ""] \
					]
		    }
		    default {
			d error "Internal error"
		    }
		}
	    } else {
		d error [$gv error]
	    }
	}
	default {
	    #
	    # Display vlan list (which is already sorted by search-vlan)
	    #

	    set list {}
	    foreach id $lvlans {
		lassign $tabvlan($id) desc nets
		if {[llength $nets] > 0} then {
		    append desc " : $nets"
		}
		set desc [::webapp::html-string $desc]

		d urlset "" $conf(nextl2) [list [list "vlan" $id]]
		set url [d urlget ""]
		lappend list [webapp::helem "li" \
					[::webapp::helem "a" "$id ($desc)" \
						    "href" $url] ]
	    }
	    set list [::webapp::helem "ul" [join $list "\n"]]

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

	    d result $conf(pagen) [list \
					[list %MSGSTA% $msgsta] \
					[list %OBJETS% "Vlans"] \
					[list %LIST%   $list] \
					[list %EQ%     ""] \
					[list %VLAN%   $qvlan] \
					[list %ADDR%   ""] \
					[list %HEADER% ""] \
					[list %ONLOAD% ""] \
				    ]
	}
    }
}

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

d cgi-dispatch "topo" ""
