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

#
# Display page to edit one or more equipment interfaces
#
# Called by: eq
#
# Parameters (form or url):
#   - display page
#	- mode : (empty)
#	- eq: equipment name
#	- iface : interface name, or empty for all interfaces of an equipement
#   - process modifications
#	- mode : "mono" or "multi" (single or multiple interfaces)
#	- eq: equipment name
#	- iface : interface name (may be given more than once)
#	- vlan : vlan-id or -1 to shutdown the interface
#	- voip : vlan-id or -1 to shutdown the interface
#	- desc : description (or empty, notably if multiple interfaces)
#	- stat : sensors (or empty)
#
# History
#   2010/11/03 : pda      : design
#   2010/11/26 : pda/jean : add modification processing
#   2010/11/30 : pda/jean : add sensor
#   2010/12/11 : pda      : i18n
#   2010/12/25 : pda      : use cgi-dispatch
#

#
# Template pages used by this script
#

set conf(page-sel)	ifchg-sel.html
set conf(page-mod)	ifchg-mod.html

#
# Next actions
# 

set conf(next)		"ifchg"

#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Display page
##############################################################################

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

    #
    # Read equipment information from graph.
    #

    set l [eq-iflist $eq tabuid]

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

    #
    # 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 " "]
	d error [mc "Inconsistent permissions on interfaces: %s" $l]
    }

    #
    # Prepare Vlan list for menus
    # Note : a Vlan is either a standard Vlan or a VoIP vlan
    #

    set lvlan [list [list -1 [mc "Shutdown interface"]]]
    set lvoip [list [list -1 [mc "Shutdown VoIP on this interface"]]]
    foreach id [lsort -integer [array names tabvlan]] {
	lassign $tabvlan($id) desc voip
	if {$desc eq "-"} then {
	    set desc ""
	} else {
	    set desc [binary format H* $desc]
	}
	if {$voip} then {
	    lappend lvoip [list $id "$id ($desc)"]
	} else {
	    lappend lvlan [list $id "$id ($desc)"]
	}
    }

    set nvoip [llength $lvoip]

    #
    # Do we have to display all interfaces, or just one?
    #

    if {$iface ne ""} then {
	#
	# There is a name. Just display this one.
	#

	if {! [info exists tabiface($iface)]} then {
	    d error [mc {Interface '%1$s' not found on %2$s} $iface $eq]
	}

	#
	# Get status information relative to this equipment and this
	# interface.
	#

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

	#
	# Get interface characteristics
	#

	lassign $tabiface($iface) name edit radio ifstat ifmode desc lien natif
	set trunk [lreplace $tabiface($iface) 0 7]

	if {$edit ne "edit"} then {
	    d error [mc {You can't modify interface %1$s on %2$s} $iface $eq]
	}

	#
	# Prepare informations
	#

	set mode "mono"
	set title [mc {Edit interface %1$s on %2$s} $iface $eq]
	set menuif [::webapp::form-hidden iface $iface]

	# display option "multiple interfaces" if there is more than one
	# writable interface
	set nifmod 0
	foreach i $iflist {
	    if {[lindex $tabiface($i) 1] eq "edit"} then {
		incr nifmod
	    }
	}
	if {$nifmod > 1} then {
	    d urlset "" $conf(next) [list [list "eq" $eq]]
	    set url [d urlget ""]
	    set multi [::webapp::helem "p" \
			    [mc {You can also <a href="%s">edit more than one interfaces</a> simultaneously} $url] \
			]
	} else {
	    set multi ""
	}

	# interface description menu
	if {$desc eq "-"} then {
	    set desc ""
	} else {
	    set desc [::webapp::html-string [binary format H* $desc]]
	}
	set libifordesc [mc "Description"]
	set menuifordesc [::webapp::form-text desc 1 40 40 $desc]
	append menuifordesc " ("
	append menuifordesc [mc "authorized special characters: -+/()&.:#_"]
	append menuifordesc ")"

	append libifordesc [::webapp::form-hidden "iface" $iface]

	# vlan menu
	if {$ifmode eq "Disabled"} then {
	    set pos -1
	} else {
	    set pos [lsearch -index 0 $lvlan $natif]
	}
	if {$pos == -1} then {
	    set lsel {}
	} else {
	    set lsel [list $pos]
	}
	set menuvlan [::webapp::form-menu "vlan" 1 0 $lvlan $lsel]

	# voip vlan menu if needed
	if {$nvoip > 1} then {
	    set pos -1
	    if {$ifmode eq "Trunk"} then {
		# search voip vlan amon tagged vlans
		foreach v $trunk {
		    lassign $v id desc stat
		    # search for the vlan in the menu list
		    set pos [lsearch -index 0 $lvoip $id]
		    if {$pos != -1} then {
			break
		    }
		}
	    }
	    if {$pos == -1} then {
		set lsel {}
	    } else {
		set lsel [list $pos]
	    }
	    set libvoip [mc "VoIP"]
	    set menuvoip [::webapp::form-menu "voip" 1 0 $lvoip $lsel]
	} else {
	    set libvoip ""
	    set menuvoip [::webapp::form-hidden "voip" -1]
	}

	# sensor menu
	if {$tabuid(p_admin)} then {
	    if {$ifstat eq "-"} then {
		set ifstat ""
	    }
	    set libstat [mc "Sensors"]
	    set menustat [::webapp::form-text "stat" 1 40 40 $ifstat]
	} else {
	    set libstat ""
	    set menustat ""
	}
    } else {
	#
	# Display all interfaces
	#

	set title [mc "Edit interfaces on %s" $eq]
	set mode "multi"

	#
	# Get status information relative to this equipment and all
	# its interfaces.
	#
	set eqsta [eq-graph-status $dbfd $eq]

	# interface list
	set lif {}
	foreach i $iflist {
	    set edit [lindex $tabiface($i) 1]
	    if {$edit eq "edit"} then {
		lappend lif [list $i $i]
	    }
	}
	set nif [llength $lif]
	set libifordesc [mc "Interfaces"]
	set menuifordesc [::webapp::form-menu "iface" $nif 1 $lif {}]
	set multi ""

	# vlan menu
	set menuvlan [::webapp::form-menu "vlan" 1 0 $lvlan {}]

	# voip vlan menu if needed
	if {$nvoip > 1} then {
	    set libvoip [mc "VoIP"]
	    set menuvoip [::webapp::form-menu "voip" 1 0 $lvoip {}]
	} else {
	    set libvoip ""
	    set menuvoip [::webapp::form-hidden "voip" -1]
	}

	# sensor menu is empty
	set libstat ""
	set menustat ""
    }

    #
    # Next script
    #

    d urlset "%URLFORM%" $conf(next) {}

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

    d result $conf(page-sel) [list \
			    [list %EQSTA%        $eqsta] \
			    [list %EQ%           $eq] \
			    [list %TITLE%        $title] \
			    [list %MODE%         $mode] \
			    [list %MULTI%        $multi] \
			    [list %LIBIFORDESC%  $libifordesc] \
			    [list %MENUIFORDESC% $menuifordesc] \
			    [list %MENUVLAN%     $menuvlan] \
			    [list %LIBVOIP%      $libvoip] \
			    [list %MENUVOIP%     $menuvoip] \
			    [list %LIBSTAT%      $libstat] \
			    [list %MENUSTAT%     $menustat] \
			]

}

##############################################################################
# Commit modifications
##############################################################################

d cgi-register {mode .+} {
    {eq		1 1}
    {iface	0 999999}
    {vlan	1 1}
    {voip	1 1}
    {desc	0 1}
    {stat	0 1}
} {
    global conf

    #
    # Read equipment information from the graph
    #

    set l [eq-iflist $eq tabuid]

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

    #
    # If there is an error, exit immediately
    # This case means than one (or more) interfaces are writable, but
    # not readable: this does not make sense.
    #

    if {[llength $liferr] > 0} then {
	d error [mc "Inconsistency in access rights for following interfaces: %s" [join $liferr ", "]]
    }

    #
    # If no interface is given, there is nothing to do
    #

    if {[llength $iface] == 0} then {
	d error [mc "You did not selected any interface"]
    }

    #
    # Check write consistency for interfaces
    #

    foreach i $iface {
	if {! ([info exists tabiface($i)] &&
				[lindex $tabiface($i) 1] eq "edit")} then {
	    d error [mc {You don't have write access to interface '%1$s' on '%2$s'} $i $eq]
	}
    }

    #
    # Check parameters
    #

    # vlan
    if {$vlan eq "-1"} then {
	# shutdown interface
    } elseif {[regexp {^[0-9]+$} $vlan] && [info exists tabvlan($vlan)]} then {
	lassign $tabvlan($vlan) vlandesc isvoip
	if {$isvoip} then {
	    d error [mc "Vlan '%s' is a voice Vlan" $vlan]
	}
    } else {
	d error [mc "Vlan '%s' not found" $vlan]
    }

    # voip
    if {$voip eq "-1"} then {
	# disable voip
    } elseif {[regexp {^[0-9]+$} $voip] && [info exists tabvlan($voip)]} then {
	lassign $tabvlan($voip) vlandesc isvoip
	if {! $isvoip} then {
	    d error [mc "Vlan '%s' is not a voice Vlan" $voip]
	}
    } else {
	d error [mc "Vlan '%s' not found" $voip]
    }

    # description
    switch -- $mode {
	multi {
	    # nothing: we'll do the test in the next loop
	}
	mono {
	    # check special characters and add "X"
	    if {[regexp {[^- a-zA-Z0-9+/()&.:#_]} $desc match]} then {
		d error [mc "Special character '%s' is not allowed" $match]
	    }
	    # if user is admin, use the given sensor, else use the old sensor
	    if {! $tabuid(p_admin)} then {
		set i [lindex $iface 0]
		set stat [lindex $tabiface($i) 3]
	    }
	    set stat [string trim $stat]
	    if {$stat eq "" || $stat eq "-"} then {
		set desc "X $desc"
	    } else {
		if {! [regexp {^M\S+$} $stat]} then {
		    d error [mc "Invalid sensor name '%s' (should be M...)" $stat]
		}
		set desc "$desc <X $stat>"
	    }
	    set qifdesc [::pgsql::quote $desc]
	}
    }

    #
    # Insert changes in spool
    #

    # the real user (not the substituted one)
    set qlogin [::pgsql::quote [lindex [d euid] 0]]
    # equipment name
    set fqdn [format "%s.%s" $eq [dnsconfig get "defdomain"]]
    set qeq [::pgsql::quote $fqdn]

    set sql {}
    foreach i $iface {
	set qiface [::pgsql::quote $i]
	switch $mode {
	    multi {
		if {[info exists tabiface($i)]} then {
		    # put back old values
		    lassign $tabiface($i) oname oedit oradio ostat omode odesc rem
		    set qifdesc "<X"
		    if {$ostat ne "-"} then {
			append qifdesc " $ostat"
		    }
		    append qifdesc ">"
		    if {$odesc ne "-"} then {
			append qifdesc " "
			append qifdesc [binary format H* $odesc]
		    }
		} else {
		    set qifdesc "X"
		}
	    }
	    mono {
		# nothing: qifdesc has been filled above
	    }
	}
	lappend sql "INSERT INTO topo.ifchanges
			    (login, eq, iface, ifdesc, ethervlan, voicevlan)
			VALUES ('$qlogin', '$qeq', '$qiface',
					'$qifdesc', $vlan, $voip)"
    }
    set sql [join $sql ";"]
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	d error [mc "Error during spool insertion: %s" $msg]
    }

    #
    # Get status for graph building and spooled equipment modifications
    #

    if {[llength $iface] == 1} then {
	set eqsta [eq-graph-status $dbfd $eq $iface]
    } else {
	set eqsta [eq-graph-status $dbfd $eq]
    }

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

    d result $conf(page-mod) [list \
				[list %EQSTA%        $eqsta] \
			    ]
}

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

d cgi-dispatch "topo" ""
