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

#
# Perform DHCP generation for ISC DHCPD
#
# Syntax:
#	mkdhcp [-h][-q][-v][-n][-w <view-name>]
#
# History:
#   2004/08/05 : pda/jean : specification
#   2004/08/06 : pda/jean : design
#   2005/03/31 : pda	  : add DHCP groups
#   2008/07/12 : jean 	  : use profiles in ranges
#   2008/07/16 : jean	  : use failover in ranges
#   2011/04/21 : jean	  : use groups everywhere
#   2011/06/10 : pda      : i18n and re-design
#   2011/07/01 : pda      : add a proper failover configuration
#   2012/10/24 : pda/jean : add views
#

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

#
# Self explanatory
#

set conf(usage) {usage: %1$s [-h]|-q][-v][-n][-w <view>]
    -h : get this help
    -q : keep silent on normal operation
    -v : verbose (show diffs)
    -n : don't perform file installation
    -w <view> : limit generation to this view
}

#
# Default profile
#

set conf(defprofile) {
    option domain-name "%DEFDOMAIN%";
    option domain-name-servers %DEFRESOLV%;
}

#
# Test if DHCP configuration has been modified
#
# Input:
#   - dbfd: database handle
#   - idview: view id if specified, or -1
# Output:
#   - return value: 0 (not modified) or 1 (modified)
#
# History:
#   2004/08/05 : pda/jean : design
#   2012/10/24 : pda/jean : add views
#

proc need-dhcp-generation {dbfd idview} {
    set r 0
    set crit ""
    if {$idview != -1} then {
	set crit "AND idview = $idview"
    }
    set sql "SELECT COUNT(gendhcp) AS cnt FROM dns.view WHERE gendhcp = 1 $crit"
    pg_select $dbfd $sql tab {
	set r [expr {$tab(cnt) > 0}]
    }
    return $r
}

#
# DHCP configuration has been modified
#
# Input:
#   - dbfd: database handle
#   - idview: view id if specified, or -1
# Output:
#   - return value: error string or empty string
#
# History:
#   2011/06/13 : pda      : design
#   2012/10/24 : pda/jean : add views
#

proc record-dhcp-generation {dbfd idview} {
    set crit ""
    if {$idview != -1} then {
	set crit "WHERE idview = $idview"
    }
    set sql "UPDATE dns.view SET gendhcp = 0 $crit"
    if {[::pgsql::execsql $dbfd $sql msg]} then {
	set msg ""
    }
    return $msg
}

#
# Indent a DHCP profile
#
# Input:
#   - prof: profile contents
#   - n: indent level
# Output:
#   - return value: new profile
#
# History:
#   2011/06/10 : pda      : documentation
#

proc indent-profile {prof n} {
    set indent [string repeat "\t" $n]

    set lprof [split $prof "\n"]
    set p [join $lprof "\n$indent"]

    return "$indent$p"
}

#
# Returns DHCP configuration as a text
#
# Input:
#   - dbfd: database handle
#   - idview: view id if specified, or -1
#   - dhcpfailover: failover configuration text, if any
#   - _txt: in return, DHCP configuration
#   - _err: in return, error message (fatal or non-fatal)
# Output:
#   - return value: 1 if ok, 0 if fatal error
#   - parameter _txt: DHCP configuration text
#   - parameter _err: error message (fatal or non-fatal)
#
# History:
#   2004/08/05 : pda/jean : design
#   2005/03/31 : pda	  : add DHCP groups
#   2011/06/10 : pda	  : interface change
#   2011/07/01 : pda	  : re-add failover
#   2012/10/24 : pda/jean : add views
#

proc gen-dhcp {dbfd idview dhcpfailover _txt _err} {
    global conf
    upvar $_txt txt
    upvar $_err err

    set txt {}
    set err {}

    #
    # Useful to let tools (such as vi) match parenthesis in this code
    #

    set lbkt "\{"
    set rbkt "\}"

    #
    # Get default DHCP parameter values from database
    #

    foreach k {default_lease_time
		max_lease_time
		min_lease_time
		dhcpdefdomain
		dhcpdefdnslist} {
	set dhcpdef($k) [dnsconfig get $k]
    }

    #
    # Get range attributes and store them in an array "range" indexed by
    # network address
    # XXX: range selection should depend on the view
    #

    set sql "SELECT HOST(network.addr4) AS addr, domain.name AS dom, dhcprange.*
		    FROM dns.network, dns.dhcprange, dns.domain
		    WHERE network.dhcp > 0
			    AND domain.iddom = dhcprange.iddom
			    AND dhcprange.min <<= network.addr4
			    AND dhcprange.max <<= network.addr4
		    "
    pg_select $dbfd $sql tab {
	if {$tab(default_lease_time) == 0} then {
	    set tab(default_lease_time) $dhcpdef(default_lease_time)
	}
	if {$tab(max_lease_time) == 0} then {
	    set tab(max_lease_time) $dhcpdef(max_lease_time)
	}
	lappend range($tab(addr)) [list $tab(dom) \
					$tab(min) \
					$tab(max) \
					$tab(default_lease_time) \
					$tab(max_lease_time) \
					$tab(iddhcpprof) \
				    ]
    }

    #
    # Get all DHCP profiles (not dependant on the view)
    #

    set sql "SELECT iddhcpprof, name, text FROM dns.dhcpprofile"
    pg_select $dbfd $sql tab {
	set id $tab(iddhcpprof)
	set dhcpprofile($id)      $tab(text)
	set dhcpprofile($id:name) $tab(name)
    }

    #
    # Provide a default profile
    #

    set p $conf(defprofile)
    regsub "%DEFDOMAIN%" $p $dhcpdef(dhcpdefdomain) p
    regsub "%DEFRESOLV%" $p $dhcpdef(dhcpdefdnslist) p
    set l {}
    foreach e [split $p "\n"] {
	set e [string trim $e]
	if {$e ne ""} then {
	    lappend l $e
	}
    }
    set dhcpprofile(:default) [join $l "\n"]
    set dhcpprofile(:default:name) "hosts without a profile"

    #
    # Generates configuration for each DHCP-enabled IPv4 network
    #

    set sql "SELECT HOST(addr4) AS prefix, MASKLEN(addr4) AS masklen,
			    NETMASK(addr4) AS netmask, gw4, name
		    FROM dns.network
		    WHERE dhcp > 0 AND gw4 IS NOT NULL
		    ORDER BY prefix
		    "
    pg_select $dbfd $sql tab {
	set network $tab(prefix)
	set masklen $tab(masklen)

	lappend txt "# $tab(name)"
	lappend txt "subnet $network netmask $tab(netmask) $lbkt"
	lappend txt "\toption routers $tab(gw4);"
	if {[info exists range($network)]} then {
	    foreach pool $range($network) {
		lassign $pool dom min max default_lease_time max_lease_time iddhcpprof

		lappend txt "\tpool $lbkt"

		if {$dhcpfailover ne ""} then {
		    lappend txt "\t\t$dhcpfailover"
		}
		set addprofile ""
		if {[info exists dhcpprofile($iddhcpprof)]} then {
		    set addprofile $dhcpprofile($iddhcpprof)
		    lappend txt [indent-profile $addprofile 2]
		}
		lappend txt "\t\trange $min $max;"
		lappend txt "\t\tdeny dynamic bootp clients;"

		# Add a domain name if profile does not provide one
		if {! [regexp {option\s+domain-name\s+} $addprofile]} then {
		    if {$dom ne ""} then {
			lappend txt "\t\toption domain-name \"$dom\";"
		    } else {
			lappend txt "\t\toption domain-name \"$dhcpdef(dhcpdefdomain)\";"
		    }
		}

		# Add default resolvers if profile does not include them
		if {! [regexp {option\s+domain-name-servers\s+} $addprofile]} then {
		    lappend txt "\t\toption domain-name-servers $dhcpdef(dhcpdefdnslist);"
		}
		if {$max_lease_time < $dhcpdef(min_lease_time)} then {
		    lappend err "Max-lease-time too small ($max_lease_time) for <$min,$max>"
		    lappend txt "\t\t# max-lease-time $max_lease_time;"
		} else {
		    lappend txt "\t\tmax-lease-time $max_lease_time;"
		}
		if {$default_lease_time < $dhcpdef(min_lease_time)} then {
		    lappend err "Default-lease-time too small ($default_lease_time) for <$min,$max>"
		    lappend txt "\t\t# default-lease-time $default_lease_time;"
		} else {
		    lappend txt "\t\tdefault-lease-time $default_lease_time;"
		}

		lappend txt "\t$rbkt"
	    }
	}

	#
	# Generates all host groups: get hosts which have a valid MAC
	# address in current network
	#

	array unset groups
	set sql2 "SELECT rr.name || '.' || domain.name AS host,
			    rr.mac,
			    rr_ip.addr,
			    rr.iddhcpprof
			FROM dns.rr, dns.domain, dns.rr_ip, dns.network
			WHERE ($idview = -1 OR rr.idview = $idview)
			    AND rr.iddom = domain.iddom
			    AND rr.idrr = rr_ip.idrr
			    AND rr_ip.addr <<= '$network/$masklen'
			    AND network.addr4 = '$network/$masklen'
			    AND network.dhcp > 0
			    AND rr.mac IS NOT NULL
			ORDER BY rr.iddhcpprof, rr_ip.addr
			"
	pg_select $dbfd $sql2 tab2 {
	    set ip $tab2(addr)
	    set host $tab2(host)

	    # Empty if no profile
	    set id $tab2(iddhcpprof)
	    if {$id eq ""} then {
		set id ":default"
	    }

	    # Generates a unique name if this host has more than one address
	    set nocc ""
	    if {[info exists occur($host)]} then {
		set nocc $occur($host)
		incr occur($host)
	    } else {
		set occur($host) 1
	    }

	    append groups($id) "\t\thost $host$nocc $lbkt\n"
	    append groups($id) "\t\t\tstash-agent-options true;\n"

	    append groups($id) "\t\t\thardware ethernet $tab2(mac);\n"
	    append groups($id) "\t\t\tfixed-address $ip;\n"
	    append groups($id) "\t\t\toption host-name \"$host\";\n"
	    append groups($id) "\t\t$rbkt\n"
	}

	#
	# Generate groups for this network
	#

	foreach id [lsort [array names groups]] {
	    lappend txt "\tgroup $lbkt # start group for $dhcpprofile($id:name)"
	    if {[info exists dhcpprofile($id)]} then {
		set addprofile $dhcpprofile($id)
		lappend txt [indent-profile $addprofile 2]

		# Add a domain name if profile does not provide one
		if {! [regexp {option\s+domain-name\s+} $addprofile]} then {
		    lappend txt "\t\toption domain-name \"$dhcpdef(dhcpdefdomain)\";"
		}

		# Add default resolvers if profile does not include them
		if {! [regexp {option\s+domain-name-servers\s+} $addprofile]} then {
		    lappend txt "\t\toption domain-name-servers $dhcpdef(dhcpdefdnslist);"
		}
	    } else {
		lappend err "Unknown DHCP profile '$id'"
	    }
	    lappend txt $groups($id)
	    lappend txt "\t$rbkt # end group for $dhcpprofile($id:name)"
	}

	lappend txt "$rbkt # end subnet $tab(name)"
	lappend txt ""
    }

    #
    # End of generation
    #

    set txt [join $txt "\n"]
    set err [join $err "\n"]

    return 1
}

##############################################################################
# main
##############################################################################

proc usage {argv0} {
    global conf

    regsub ".*/" $argv0 "" argv0
    puts -nonewline stderr [format $conf(usage) $argv0]
    exit 1
}

proc main {argv0 argv} {
    global conf

    #
    # Initialization : Netmagis database access and file queue
    #

    set msg [d init-script dbfd $argv0 true tabcor]
    if {$msg ne ""} then {
	puts stderr $msg
	return 1
    }

    set fq [::fileinst create %AUTO%]

    #
    # Argument checking
    #

    set verbose 0
    set doit 1
    set view ""

    while {[llength $argv] > 0} {
	set a [lindex $argv 0]
	switch -glob -- $a {
	    -h {
		usage $argv0
	    }
	    -q {
		set verbose -1
		set argv [lreplace $argv 0 0]
	    }
	    -v {
		set verbose 1
		set argv [lreplace $argv 0 0]
	    }
	    -n {
		set doit 0
		set argv [lreplace $argv 0 0]
	    }
	    -w {
		set view [lindex $argv 1]
		set argv [lreplace $argv 0 1]
	    }
	    -* {
		warning "Unknown option '$a'"
		usage $argv0
	    }
	    default {
		break
	    }
	}
    }

    if {[llength $argv] > 0} then {
	usage $argv0
    }

    #
    # Get configuration values
    #

    foreach o {diff dhcpfile dhcpfailover dhcptest dhcpcmd} {
	set $o [get-local-conf $o]
    }

    #
    # Lock tables such as we do not miss some modification
    #

    set msg [d dblock {dns.view dns.rr dns.network dns.dhcprange}]
    if {$msg ne ""} then {
	d error $msg
    }

    #
    # Check view name
    #

    set idview -1
    if {$view ne ""} then {
	set qview [::pgsql::quote $view]
	set sql "SELECT idview FROM dns.view WHERE name = '$qview'"
	pg_select $dbfd $sql tab {
	    set idview $tab(idview)
	}
	if {$idview == -1} then {
	    d error "View '$view' not found"
	}
    }

    #
    # Generate DHCP configuration
    #

    if {[need-dhcp-generation $dbfd $idview]} then {

	#
	# Perform DHCP configuration
	#

	if {[gen-dhcp $dbfd $idview $dhcpfailover txt err]} then {
	    #
	    # Generation succeeded, even with some small errors
	    #

	    # display small errors (if empty, does not display anything)
	    puts -nonewline stdout $err

	    # display diffs
	    if {$verbose == 1} then {
		show-diff-file-text stdout $diff $dhcpfile $txt
	    }

	    if {$doit} then {
		#
		# Install file, test configuration file and restart daemon
		#

		set msg [$fq add $dhcpfile $txt]
		if {$msg ne ""} then {
		    set msg [d dbabort "DHCP generation" $msg]
		    d error $msg
		}

		set msg [$fq commit]
		if {$msg ne ""} then {
		    set msg [d dbabort "DHCP generation" $msg]
		    d error $msg
		}

		# test configuration
		if {$dhcptest ne ""} then {
		    if {[catch {exec -ignorestderr sh -c $dhcptest} msg]} then {
			set msg "Cannot run command '$dhcptest'\n$msg"
			set m [$fq uncommit]
			if {$m ne ""} then {
			    append msg "\n$m"
			}
			d dbabort "DHCP generation" ""
			d error $msg
		    }
		}

		# now that configuration is tested, register that
		# DHCP configuration was generated
		set msg [record-dhcp-generation $dbfd $idview]
		if {$msg ne ""} then {
		    set m [$fq uncommit]
		    if {$m ne ""} then {
			append msg "\n$m"
		    }
		    d dbabort "DHCP generation" ""
		    d error $msg
		}

		# restart daemon
		if {$dhcpcmd ne ""} then {
		    if {[catch {exec -ignorestderr sh -c $dhcpcmd} msg]} then {
			set msg "Cannot run command '$dhcpcmd'\n$msg"
			set m [$fq uncommit]
			if {$m ne ""} then {
			    append msg "\n$m"
			}
			d dbabort "DHCP generation" ""
			d error $msg
		    }
		}

		# commit modifications
		set msg [d dbcommit "DHCP generation"]
		if {$msg ne ""} then {
		    d error $msg
		}
	    }

	} else {
	    #
	    # Error during generation
	    #
	    set msg [d dbabort "DHCP generation" $txt]
	    d error $msg
	}

    } else {
	if {$verbose >= 1} then {
	    puts stderr "No DHCP generation"
	}
    }

    #
    # End of work
    #

    $fq destroy

    d end
    return 0
}

exit [main $argv0 $argv]
