xref: /dports/net-mgmt/netmagis-topo/netmagis-2.3.4/topo/src/toposendd

#! %TCLSH%

#
# Daemon to send interface modifications on equipments
#
# When a user ask, via the Netmagis interface, to change an interface
# on an equipment (VLAN, VoIP VLAN or description), the CGI script
# writes an entry in topo.ifchange table.
# This entry contains:
#   - user's login
#   - date of change request
#   - equipment (resource record id)
#   - interface
#   - description
#   - vlan
#   - voip vlan
# When the change is processed by this daemon, following attributes
# are updated:
#   - modification date
#   - modification log (output from modification command)
#
# To process an interface change, this daemon performs the following
# tasks:
#   - test if equipment is reachable, via fping, without waiting
#	for the TCP timeout
#   - send appropriate commands on equipment (which, in turns, will
#	trigger a modification detection by the topographd daemon)
#   - if no problem was detected, mark the entry as "processed"
#	Notice: error detection is very primitive, since rancid
#	can just detect fatal error (equipment unreachable, etc.)
#	and not tell if commands were successfull. So, it is important
#	to consult log.
#
# History
#  2010/02/16 : pda/jean : design
#  2010/10/15 : pda/jean : splitted in a different daemon
#  2010/12/19 : pda      : rework installation
#  2012/03/27 : pda/jean : daemonization
#

set conf(extracteq)	{extracteq -a %1$s %2$s}

source %LIBNETMAGIS%


##############################################################################
# Send changes to equipments
##############################################################################

#
# Send changes specified in topo.ifchange table to equipements
#
# Input:
#   - _tabeq : array containing equipment types and models
# Output:
#   - return value : 1 if ok, 0 if error
#
# History :
#   2010/10/14 : pda/jean : design
#

proc send-changes {_tabeq} {
    upvar $_tabeq tabeq

    #
    # Find modification requests and build a list {fqdn fqdn...}
    #

    set leq {}
    set sql "SELECT DISTINCT (eq) AS fqdn
    			FROM topo.ifchanges
			WHERE processed = 0"
    if {! [toposqlselect $sql tab { lappend leq $tab(fqdn) }]} then {
	return 0
    }

    foreach eq $leq {
	#
	# Search equipment type and model from fqdn
	#

	if {! [info exists tabeq($eq)]} then {
	    update-modlog $eq "Unknown equipement type for '$eq'"
	    continue
	}
	lassign $tabeq($eq) type model

	#
	# Reachability test
	#

	set msg [test-ping $eq]
	if {$msg ne ""} then {
	    update-modlog $eq $msg
	    continue
	}

	#
	# Equipment is alive. Get all unprocessed modifications for
	# this equipment, translate them in commands, send these
	# commands and mark these modifications as "processed"
	#

	set lcmd [mod-to-conf $eq $type $model lreqdate]
	if {[llength $lcmd] == 0} then {
	    continue
	}

	if {[execute-cmd $eq $type $model $lcmd msg]} then {
	    mark-processed $eq $lreqdate $msg
	} else {
	    update-modlog $eq $msg
	}
    }

    return 1
}

#
# Translate modification requests into commands for this equipment
#
# Input:
#   - eq : equipment fqdn
#   - type : equipment type (ex: cisco, juniper...)
#   - model : equipment model (ex: 3750, M20...)
#   - lreqdate : in return, list of modification requests (dates)
# Output:
#   - return value : list of command lines to send to equipment or
#		empty list if an error occurred
#   - parameter lreqdate : see above
#
# History :
#   2010/10/14 : pda/jean : design
#

proc mod-to-conf {eq type model _lreqdate} {
    upvar $_lreqdate lreqdate

    set lreqdate {}
    set lcmd {}

    #
    # Prologue
    #

    set prologue [fetch-cmd $type $model "prologue"]
    set lcmd [concat $lcmd $prologue]

    #
    # Extract all modification requests for this equipment
    #

    set qeq [::pgsql::quote $eq]
    set sql "SELECT *
		FROM topo.ifchanges
		WHERE eq = '$qeq' AND processed = 0
		ORDER BY reqdate ASC"

    set l {}
    if {! [toposqlselect $sql tab { lappend l [list $tab(reqdate) $tab(iface) \
			$tab(ifdesc) $tab(ethervlan) $tab(voicevlan)] }]} then {
	return {}
    }

    foreach e $l {
	lassign $e reqdate iface ifdesc ethervlan voicevlan

	lappend lreqdate $reqdate

	#
	# Interface description
	#

	if {$ifdesc ne ""} then {
	    foreach fmt [fetch-cmd $type $model "ifdesc"] {
		lappend lcmd [format $fmt $iface $ifdesc]
	    }
	}

	#
	# Reset interface in a known state
	#

	set lcmd [concat $lcmd [resetif $eq $type $model $iface]]

	#
	#   Ether	    Voice	Operation
	#   -----------------------------------------------------
	#   -1		    -1		Shutdown interface
	#   -1		    > 0		Voice vlan only
	#   > 0		    -1		Access vlan only
	#   > 0		    > 0		Access vlan + voice vlan
	#

	set ether [expr $ethervlan==-1]
	set voice [expr $voicevlan==-1]

	switch -- "$ether$voice" {
	    11	{
		foreach fmt [fetch-cmd $type $model "ifdisable"] {
		    lappend lcmd [format $fmt $iface]
		}
	    }
	    10	{
		foreach fmt [fetch-cmd $type $model "ifvoice"] {
		    lappend lcmd [format $fmt $iface $voicevlan]
		}
	    }
	    01	{
		foreach fmt [fetch-cmd $type $model "ifaccess"] {
		    lappend lcmd [format $fmt $iface $ethervlan]
		}
	    }
	    00  {
		foreach fmt [fetch-cmd $type $model "ifvoice"] {
		    lappend lcmd [format $fmt $iface $voicevlan]
		}
		foreach fmt [fetch-cmd $type $model "ifaccess"] {
		    lappend lcmd [format $fmt $iface $ethervlan]
		}
	    }
	}
    }

    #
    # Epilogue
    #

    set epilogue [fetch-cmd $type $model "epilogue"]
    set lcmd [concat $lcmd $epilogue]

    return $lcmd
}

#
# Load shell commands use to send configuration commands to equipments
#
# Input:
#    - none
# Output:
#    - return value: 1 if send command are valid in ctxt array, 0 if error
#    - global ctxt(send...): shell commands for each equipment type
#    - global ctxt(send): 1 if send commands are already in ctxt(send...)
#
# History :
#   2012/01/25 : pda/jean : design
#

proc get-send {} {
    global ctxt

    if {! $ctxt(send)} then {
	set lt {}
	set sql "SELECT type FROM topo.eqtype"
    	if {[toposqlselect $sql tab { lappend lt $tab(type) }]} then {
	    foreach t $lt {
		set ctxt(send$t) [get-local-conf "send$t"]
	    }
	    set ctxt(send) 1
	}
    }

    return $ctxt(send)
}

#
# Send commands on an equipment
#
# Input:
#   - fqdn : equipment fqdn
#   - type : equipment type (ex: cisco, juniper...)
#   - model : equipment model (ex: 3750, M20...)
#   - lcmd : list of commands to send
#   - _msg : in return, error message or command output
# Output
#   - return value : 1 if ok, 0 if error
#
# History :
#   2010/02/18 : pda/jean : design
#

proc execute-cmd {fqdn type model lcmd _msg} {
    upvar $_msg msg
    global ctxt

    set-status "Sending command to $fqdn"

    set tmp "/tmp/topod.[pid]"
    set fd [open $tmp "w"]
    puts $fd [join $lcmd "\n"]
    close $fd

    if {![get-send]} then {
	set msg "Unable to read send* commands"
    	return 0
    }

    if {[info exists ctxt(send$type)]} then {
    	set exec $ctxt(send$type)
    } elseif {$ctxt($send$type) eq ""} then {
	set msg "Directive 'send$type' not configured in netmagis.conf"
    	return 0
    } else {
	set msg "Unknown equipment type '$type'"
    	return 0
    }

    if {[catch {exec sh -c "$exec -x $tmp $fqdn"} msg]} then {
	set r 0
    } else {
	set r 1
    }

    file delete -force $tmp

    #
    # Interpret output file
    #
    # Ideas:
    # 1- analyze file by removing all known lines:
    #	(ex: "cisco(Fa1/0)# switchport blablabla" -> remove)
    #	all remaining lines are error lines
    #	-> pb : this strategy is not very sustainable
    # 2- look for error patterns
    #	-> pb : number of unknown errors is not countable
    # 3- ignore output file and detect modifications not in
    #	the rebuilt graph
    #	-> pb : delay between modification and check
    #	-> pb : program to check would be very complex
    # 4- ignore output file and let people detect problems
    #	(eg: display output file in a diagnostic page or in
    #	the Netmagis equipment page)
    #
    # We choose the 4th idea at this time. Experience will say if
    # it is a good idea or no.
    #

    return $r
}

#
# Return the appropriate command for an equipment type
#
# Input:
#   - type : equipment type (ex: cisco, juniper...)
#   - model : equipment model (ex: 3750, M20, ...)
#   - context : action selection (ex: ifaccess, ifenable, ...)
# Output:
#   - return value : list of commands to execute, or empty list if not found
#
# Note:
#     The confcmd table contains commands adapted to each equipment type.
#
#     model may be a regular expression (.*, .*29.0.* etc.)
#     The lowest ranked regexp matched for model is kept.
#
#     "command"  is a list of command lines to send to the equipment.
#
#     Different actions are:
#
#       prologue
#	    enter in configuration mode
#       ifreset
#	    reset interface to a known state (most of the time, by removing
#	    all vlans)
#	    Parameters :
#		%1$ : interface name
#       resetvlan
#	    when an interface cannot be reset in a known state (for example
#	    on HP switches), this is the command to execute for each vlan
#	    to remove it.
#	    Parameters :
#		%1$ : interface name
#		%2$ : vlan-id
#       ifaccess
#	    set an access vlan on an interface
#	    Parameters :
#		%1$ : interface name
#		%2$ : vlan-id
#       ifvoice
#	    set a voip vlan on an interface
#	    Parameters :
#		%1$ : interface name
#		%2$ : vlan-id
#       ifdesc
#	    set interface description
#	    Parameters :
#		%1$ : interface name
#		%2$ : description
#       epilogue
#	    exit configuration mode an commit modification
#
# History :
#   2010/02/16 : pda/jean : design
#   2012/01/25 : pda/jean : adaptation to database
#

proc fetch-cmd {type model context} {
    set qtype [::pgsql::quote $type]
    set qcontext [::pgsql::quote $context]
    set sql "SELECT c.model, c.command
    		FROM topo.confcmd c, topo.eqtype e
		WHERE c.idtype = e.idtype
		    AND e.type = '$qtype'
		    AND c.action = '$qcontext'
    		ORDER BY c.rank ASC
    		"
    set l {}
    if {! [toposqlselect $sql tab { lappend l [list $tab(model) $tab(command)] }]} then {
    	return {}
    }

    set r {}
    foreach elem $l {
	lassign $elem remodel command
	if {[regexp "^$remodel\$" $model]} then {
	    # Translate command as a text into a list such as
	    # complex commands can be built
	    set r [split $command "\n"]
	    break
	}
    }

    return $r
}


#
# Get command list to reset an interface to a known state
#
# Input:
#   - eq : equipment fqdn
#   - type : equipment type (ex: cisco, juniper...)
#   - model : equipment model (ex: 3750, M20...)
#   - iface : interface name
# Output:
#   - return value : list of commands to send
#
# History :
#   2010/09/23 : pda/jean : design
#

proc resetif {eq type model iface} {
    #
    # Get command list to reset interface
    #

    set lcmd {}
    foreach fmt [fetch-cmd $type $model "ifreset"] {
	lappend lcmd [format $fmt $iface]
    }

    set l2 [fetch-cmd $type $model "resetvlan"]
    if {[llength $l2]>0} then {
	foreach vlan [get-vlans $eq $iface] {
	    foreach fmt $l2 {
		lappend lcmd [format $fmt $iface $vlan]
	    }
	}
    }

    #
    # Get command to enable interface
    #

    foreach fmt [fetch-cmd $type $model "ifenable"] {
	lappend lcmd [format $fmt $iface]
    }

    return $lcmd
}

#
# Get vlan list for an equipment and an interface
#
# Input:
#   - eq : equipment fqdn
#   - iface : interface name
# Sortie
#   - return value : list of found vlanid
#
# History :
#   2010/09/23 : pda/jean : design
#

proc get-vlans {eq iface} {
    global conf

    set lvlans {}

    # XXX remove domain name
    regsub {\..*} $eq "" eqname
    set cmd [format $conf(extracteq) $eqname $iface]

    if {[call-topo $cmd msg]} then {
	foreach line [split $msg "\n"] {
	    if {[lindex $line 0] eq "iface"} then {
		foreach vlan [lreplace $line 0 6] {
		    lappend lvlans [lindex $vlan 0]
		}
	    }
	}
    } else {
	puts stderr "extracteq : $msg"
    }

    return $lvlans
}

#
# Check equipment reachability
#
# Input:
#   - eq : equipment fqdn
# Output:
#   - return value : empty string or error message
#
# History
#   2010/10/14 : pda/jean : split in a function
#

proc test-ping {eq} {
    global ctxt

    set cmd [format $ctxt(fpingcmd) $eq]
    if {[catch {exec sh -c $cmd} msg]} then {
	set r $msg
    } else {
	set r ""
    }

    return $r
}

#
# Keep a log of configuration attempt
#
# Input:
#   - eq : equipment name
#   - msg : error message
# Output:
#   - none
#
# History :
#   2010/10/14 : pda/jean : design
#

proc update-modlog {eq msg} {
    global ctxt

    set qmsg [::pgsql::quote $msg]
    set qeq  [::pgsql::quote $eq]
    set sql "UPDATE topo.ifchanges
		    SET modlog = '$qmsg', moddate = now ()
		    WHERE eq = '$qeq' AND processed = 0"
    if {! [toposqlexec $sql]} then {
	log-error "Cannot update modlog for eq=$eq"
    }

    return
}

#
# Mark modification requests as processed, with log of lines sent to
# the equipment.
#
# Input:
#   - eq : equipment name
#   - lreqdate : list of request dates
#   - msg : log message
# Output:
#   - aucune
#
# History :
#   2010/10/14 : pda/jean : design
#

proc mark-processed {eq lreqdate msg} {
    global ctxt

    set reqdate [join $lreqdate "', '"]

    set qmsg [::pgsql::quote $msg]
    set qeq  [::pgsql::quote $eq]
    set sql "UPDATE topo.ifchanges
		    SET processed = 1, modlog = '$qmsg', moddate = now ()
		    WHERE eq = '$qeq' AND reqdate IN ('$reqdate')"
    if {! [toposqlexec $sql]} then {
	log-error "Cannot update 'processed' flag for eq=$eq"
    }
}

##############################################################################
# Reread network graph
##############################################################################

#
# Read or re-read network graph to get equipment types
#
# Input:
#   - force : force reread
#   - graph : name of file containing network graph
#   - _tabeq : name of array containing, in return, types and models
# Output:
#   - return value: 1 (ok) or 0 (0) error
#   - tabeq : array, indexed by FQDN of equipement, containing:
#	tabeq(<eq>) {<type> <model>}
#
# History
#   2010/12/23 : pda      : design
#

proc reread-eq-type {force graph _tabeq} {
    upvar $_tabeq tabeq

    set fmod [detect-filemod $graph]
    switch [lindex $fmod 0] {
	{} {
	    set msg ""
	}
	err {
	    set msg [lindex $fmod 2]
	    set force 0
	}
	del {
	    set msg "$graph disappeared"
	    set force 0
	}
	default {
	    set force 1
	}
    }

    if {$force} then {
	set msg [read-eq-type tabeq]
	if {$msg eq ""} then {
	    sync-filemonitor [list $fmod]
	}
    }

    if {$msg eq ""} then {
	set r 1
	set msg "Resuming normal operation"
    } else {
	set r 0
    }

    keep-state-mail "graphread" $msg

    return $r
}

##############################################################################
# Main program
##############################################################################

# The -z option is reserved for internal use
set usage {usage: %1$s [-h][-f][-v <n>]
    -h         : display this text
    -f         : run in foreground
    -v <n>     : verbose level (0 = none, 1 = minimum, 99 = max)
}

proc usage {argv0} {
    global usage

    puts stderr [format $usage $argv0]
}

#
# Main program
#

proc main {argv0 argv} {
    global ctxt

    set ctxt(dbfd1) ""
    set ctxt(dbfd2) ""
    set ctxt(send) 0
    set verbose 0
    set foreground 0
    set daemonized 0

    #
    # Get configuration values from local file
    #

    set-log [get-local-conf "logger"]

    set ctxt(fpingcmd) [get-local-conf "fpingcmd"]

    set graph [get-local-conf "topograph"]

    #
    # Get configuration values from database
    #

    config ::dnsconfig
    lazy-connect

    set delay [dnsconfig get "toposendddelay"]
    set delay [expr $delay*1000]

    set ctxt(maxstatus) [dnsconfig get "topomaxstatus"]

    set ctxt(ifchangeexpire) [dnsconfig get "ifchangeexpire"]

    #
    # Argument analysis
    #

    while {[llength $argv] > 0} {
	switch -glob -- [lindex $argv 0] {
	    -h {
		usage $argv0
		return 0
	    }
	    -f {
		set foreground 1
		set argv [lreplace $argv 0 0]
	    }
	    -z {
	    	# This option is not meant to be used by a human
		# It implies that the program is being rerun in order to be
		# daemonized
		set daemonized 1
		set argv [lreplace $argv 0 0]
	    }
	    -v {
		set verbose [lindex $argv 1]
		set argv [lreplace $argv 0 1]

	    }
	    -* {
		usage $argv0
		return 1
	    }
	    default {
		break
	    }
	}
    }

    if {[llength $argv] != 0} then {
	usage $argv0
	return 1
    }

    if {! $foreground && ! $daemonized} then {
    	set argstr {}
	if {$verbose > 0} then {
	    lappend argstr -v $verbose
	}
	lappend argstr "-z"
	run-as-daemon $argv0 [join $argstr " "]
    }

    reset-status
    set-status "Starting toposendd"

    #
    # Default values
    #

    topo-set-verbose $verbose

    if {$verbose > 0} then {
	set-trace {toposqlselect toposqlexec toposqllock toposqlunlock
		    keep-state-mail
		    read-eq-type send-changes mod-to-conf
		    execute-cmd fetch-cmd resetif get-vlans test-ping
		    update-modlog mark-processed}
    }

    #
    # Daemon loop
    #

    set first 1
    set forcereread 1

    while {true} {
	#
	# Except first time, wait for the delay
	#

	topo-verbositer "delay : first=$first delay=$delay" 10
	if {! $first} then {
	    after $delay
	}
	set first 0

	#
	# Check if equipment types must be (re)read
	#

	if {! [reread-eq-type $forcereread $graph tabeq]} then {
	    continue
	}
	set forcereread 0

	#
	# Get modification requests from Web interface and send them
	#

	send-changes tabeq
    }
}

exit [main $argv0 $argv]