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

#
# Reference tables
#
# Called by: adminindex
#
# Parameters (form or url):
#   - display edit page
#	- action : (empty)
#	- type : org, comm, hinfo, net, domain, view, zone, zone4, zone6,
#		vlan, eq, eqtype, confcmd, dotattr
#   - display graphviz generated image
#	- action : "image"
#	- type : dotattr
#   - display help page
#	- action : "help"
#	- type : see above
#   - store modifications
#	- action : "mod"
#	- type : see above
#	- other fields specific to each type
#
# History
#   2001/11/01 : pda      : design
#   2002/05/03 : pda/jean : re-use in netmagis
#   2002/05/06 : pda/jean : add users
#   2002/05/16 : pda      : conversion to arrgen
#   2002/05/21 : pda/jean : add groups
#   2002/05/21 : pda/jean : add communities
#   2002/07/09 : pda      : add nologin
#   2003/05/13 : pda/jean : use auth base
#   2003/08/12 : pda      : remove users (they go in group edition)
#   2004/01/14 : pda/jean : add IPv6
#   2004/08/06 : pda/jean : add flag dhcp by network
#   2005/04/08 : pda/jean : add table dhcpprofil
#   2007/10/25 : jean     : log modify actions
#   2010/11/16 : pda/jean : add table vlan
#   2010/11/17 : pda      : specifications for help page
#   2010/12/09 : pda      : i18n
#   2010/12/09 : pda      : remove groups
#   2010/12/09 : pda      : rewrite with conf() array
#   2010/12/13 : pda/jean : add eq and eqtype tables
#   2010/12/26 : pda      : use cgi-dispatch
#   2010/12/26 : pda      : use same spec for all store-tabular
#   2011/12/28 : pda      : add dotattr type
#   2012/01/25 : pda      : add confcmd type
#   2012/09/27 : pda/jean : add views
#   2012/10/24 : pda/jean : add view menu in zones
#


#
# Next actions
# 

set conf(next)		"admref"
set conf(nextimg)	"admref"
set conf(nextindex)	"start"
set conf(nextadmindex)	"admindex"

#
# Template pages used by this script
#

set conf(page-edit)	admref-edit.html
set conf(page-mod)	adm-mod.html
# help pages are defined below (for each type)

##############################################################################
# Organizations

set conf(org:ptitle) 	"Organization management"
set conf(org:cols)		{ {100 name {Name} {string 30} {}} }
set conf(org:sql)		"SELECT * FROM dns.organization ORDER BY name ASC"
set conf(org:id)		idorg
set conf(org:help)		help-org.html
set conf(org:return)		"Return to organization modification"
set conf(org:table)		dns.organization
set conf(org:proc)		admref-nop

##############################################################################
# Communities

set conf(comm:ptitle) 	"Community management"
set conf(comm:cols)		{ {100 name {Name} {string 30} {}} }
set conf(comm:sql)		"SELECT * FROM dns.community ORDER BY name ASC"
set conf(comm:id)		idcomm
set conf(comm:help)		help-comm.html
set conf(comm:return)		"Return to community modification"
set conf(comm:table)		dns.community
set conf(comm:proc)		admref-nop

##############################################################################
# Hinfo

set conf(hinfo:ptitle) 	"Host type management"
set conf(hinfo:cols)		{ {60 name {Description} {string 30} {}}
				  {20 sort {Sort} {int 10} 100}
				  {20 present {Present} {bool} 1}
				}
set conf(hinfo:sql)		"SELECT * FROM dns.hinfo ORDER BY sort ASC, name ASC"
set conf(hinfo:id)		idhinfo
set conf(hinfo:help)		help-hinfo.html
set conf(hinfo:return)		"Return to host information modification"
set conf(hinfo:table)		dns.hinfo
set conf(hinfo:proc)		admref-nop

##############################################################################
# Networks

set conf(net:ptitle)	"Network management"
set conf(net:cols)		{ {1 name	{Name} {string 20} {}}
				  {1 location	{Location} {string 10} {}}
				  {1 addr4	{IPv4 address} {string 15} {}}
				  {1 gw4	{IPv4 gateway} {string 12} {}}
				  {1 dhcp	{DHCP enabled} {bool} 0}
				  {1 addr6	{IPv6 address} {string 49} {}}
				  {1 gw6	{IPv6 gateway} {string 45} {}}
				  {1 idorg	{Organization} {menu {%MENUORG%}} {}}
				  {1 idcomm	{Community} {menu {%MENUCOMM%}} {}}
				  {1 comment	{Comment} {string 15} {}}
				}
set conf(net:sql)		"SELECT * FROM dns.network ORDER BY addr4"
set conf(net:id)		idnet
set conf(net:help)		help-net.html
set conf(net:return)		"Return to network modification"
set conf(net:table)		dns.network
set conf(net:proc)		admref-nop

##############################################################################
# Domains

set conf(domain:ptitle) "Domain management"
set conf(domain:cols)		{ {100 name {Domain} {string 30} {}} }
set conf(domain:sql)		"SELECT * FROM dns.domain ORDER BY name ASC"
set conf(domain:id)		iddom
set conf(domain:help)		help-domain.html
set conf(domain:return)		"Return to domain modification"
set conf(domain:table)		dns.domain
set conf(domain:proc)		admref-nop

##############################################################################
# Views

set conf(view:ptitle)	"View management"
set conf(view:cols)		{ {100 name {View} {string 50} {}} }
set conf(view:sql)		"SELECT * FROM dns.view ORDER BY name ASC"
set conf(view:id)		idview
set conf(view:help)		help-view.html
set conf(view:return)		"Return to view modification"
set conf(view:table)		dns.view
set conf(view:proc)		admref-nop

##############################################################################
# Zones

set conf(zone:ptitle)	"Zone management"
set conf(zone:cols)		{ {15 name	{Name} {string 15} {}}
				  {15 selection	{Criterion} {string 15} {}}
				  {15 idview	{View} {menu {%MENUVIEW%}} {}}
				  {45 prologue	{Prolog} {textarea {45 10}} {}}
				  {25 rrsup	{Addtl RR} {textarea {30 10}} {}}
				}
set conf(zone:sql)		"SELECT * FROM dns.zone_forward ORDER BY selection ASC"
set conf(zone:id)		idzone
set conf(zone:help)		help-zone.html
set conf(zone:return)		"Return to zone modification"
set conf(zone:table)		dns.zone_forward
set conf(zone:proc)		admref-nop

##############################################################################
# Zones reverse IPv4

set conf(zone4:ptitle)		$conf(zone:ptitle)
set conf(zone4:cols)		$conf(zone:cols)
set conf(zone4:sql)		"SELECT * FROM dns.zone_reverse4 ORDER BY selection ASC"
set conf(zone4:id)		$conf(zone:id)
set conf(zone4:help)		$conf(zone:help)
set conf(zone4:return) 		$conf(zone:return)
set conf(zone4:table)		dns.zone_reverse4
set conf(zone4:proc)		$conf(zone:proc)

##############################################################################
# Zones reverse IPv6

set conf(zone6:ptitle)		$conf(zone:ptitle)
set conf(zone6:cols)		$conf(zone:cols)
set conf(zone6:sql)		"SELECT * FROM dns.zone_reverse6 ORDER BY selection ASC"
set conf(zone6:id)		$conf(zone:id)
set conf(zone6:help)		$conf(zone:help)
set conf(zone6:return) 		$conf(zone:return)
set conf(zone6:table)		dns.zone_reverse6
set conf(zone6:proc)		$conf(zone:proc)

##############################################################################
# DHCP profiles

set conf(dhcpprof:ptitle) "DHCP profile management"
set conf(dhcpprof:cols)		{ {20 name {Name} {string 20} {}}
				  {80 text {Directives dhcpd.conf} {textarea {80 10}} {}}
				}
set conf(dhcpprof:sql)		"SELECT * FROM dns.dhcpprofile ORDER BY name ASC"
set conf(dhcpprof:id)		iddhcpprof
set conf(dhcpprof:help)		help-dhcpprof.html
set conf(dhcpprof:return)	"Return to DHCP profile modification"
set conf(dhcpprof:table)	dns.dhcpprofile
set conf(dhcpprof:proc)		admref-nop

##############################################################################
# Vlans

set conf(vlan:ptitle)	"Vlan management"
set conf(vlan:cols)		{ {15 vlanid {Vlan-Id} {int 10} {}}
				  {75 descr {Description} {string 40} {}}
				  {10 voip {VoIP Vlan} {bool} 0}
				}
set conf(vlan:sql)		"SELECT * FROM topo.vlan ORDER BY vlanid ASC"
set conf(vlan:id)		vlanid
set conf(vlan:help)		help-vlan.html
set conf(vlan:return)		"Return to Vlan modification"
set conf(vlan:table)		topo.vlan
set conf(vlan:proc)		vlan-check

##############################################################################
# Topo (rancid) equipment types

set conf(eqtype:ptitle)	"Equipment type management"
set conf(eqtype:cols)		{ {100 type {Type} {string 20} {}} }
set conf(eqtype:sql)		"SELECT * FROM topo.eqtype ORDER BY type ASC"
set conf(eqtype:id)		idtype
set conf(eqtype:help)		help-eqtype.html
set conf(eqtype:return)		"Return to equipment type modification"
set conf(eqtype:table)		topo.eqtype
set conf(eqtype:proc)		admref-nop

##############################################################################
# Topo equipments

set conf(eq:ptitle)	"Equipment management"
set conf(eq:cols)		{ {60 eq {Equipment} {string 40} {}}
				  {20 idtype {Type} {menu {%MENUTYPE%}} {}}
				  {20 up {Up/Down} {menu {%MENUUP%}} {}}
				}
set conf(eq:sql)		"SELECT * FROM topo.eq ORDER BY eq ASC"
set conf(eq:id)			ideq
set conf(eq:help)		help-eq.html
set conf(eq:return)		"Return to equipment modification"
set conf(eq:table)		topo.eq
set conf(eq:proc)		admref-nop

##############################################################################
# Topo configuration commands for equipments

set conf(confcmd:ptitle) "Configuration commands management"
set conf(confcmd:cols)		{ {10 rank {Rank} {int 4} {}}
				  {10 idtype {Type} {menu {%MENUTYPE%}} {}}
				  {10 action {Action} {menu {
							{epilogue  epilogue}
							{ifaccess  ifaccess}
							{ifdesc    ifdesc}
							{ifdisable ifdisable}
							{ifenable  ifenable}
							{ifreset   ifreset}
							{ifvoice   ifvoice}
							{prologue  prologue}
							{resetvlan resetvlan}
							}} {} }
				  {30 model {Model} {string 10} {}}
				  {40 command {Command} {textarea {40 5}} {}}
				}
set conf(confcmd:sql)		"SELECT * FROM topo.confcmd c, topo.eqtype e
					WHERE c.idtype = e.idtype
					ORDER BY e.type, c.action, c.rank ASC"
set conf(confcmd:id)		idccmd
set conf(confcmd:help)		help-confcmd.html
set conf(confcmd:return)	"Return to modification of configuration commands"
set conf(confcmd:table)		topo.confcmd
set conf(confcmd:proc)		admref-nop

##############################################################################
# Graphviz node attributes

set conf(dotattr:ptitle) "Graphviz node attributes for equipments"
set conf(dotattr:cols)		{ {10 rank {Sort} {int 8} {}}
				  {5  type {Type} {menu {{2 L2} {3 L3}}} {}}
				  {20 regexp {Regexp} {string 16} {}}
				  {35 gvattr {Attributes} {textarea {40 4}} {}}
				  {30 png {Image} {image {%URLIMG%}} {}}
				}
set conf(dotattr:sql)		"SELECT * FROM topo.dotattr ORDER BY rank ASC"
set conf(dotattr:id)		rank
set conf(dotattr:help)		help-dotattr.html
set conf(dotattr:return)	"Return to Graphviz nodes attributes"
set conf(dotattr:table)		topo.dotattr
set conf(dotattr:proc)		dotattr-check


#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Display edit page
##############################################################################

d cgi-register {action {}} {
    {type	1 1}
} {
    global conf

    #
    # Prepare help url
    #

    d urlset "" $conf(next) [list {action help} [list "type" $type] ]
    set url [d urlget ""]
    append url {#%1$s}
    set urlhelp [::webapp::helem "a" {%2$s} "href" $url]

    #
    # Analyze type specifications
    #

    if {! [info exists conf($type:ptitle)]} then {
	d error [mc "Type '%s' not supported" $type]
    }

    set ptitle [mc $conf($type:ptitle)]

    set allwidths {}
    set title {}
    foreach c $conf($type:cols) {
	lassign $c width var desc formtype defval

	lappend allwidths $width
	lappend colspecs [list $var $formtype $defval]
	lappend title [list "html" [format $urlhelp $var [mc $desc]]]
    }

    set sql $conf($type:sql)
    set id $conf($type:id)

    #
    # Particular cases
    #

    switch -- $type {
	net	{
	    set menuorg [::pgsql::getcols $dbfd dns.organization "" "name ASC" \
						{idorg name}]
	    set menucomm [::pgsql::getcols $dbfd dns.community "" "name ASC" \
						{idcomm name}]
	    regsub -- "%MENUORG%" $colspecs "$menuorg" colspecs
	    regsub -- "%MENUCOMM%" $colspecs "$menucomm" colspecs
	}
	eq {
	    set menutype [::pgsql::getcols $dbfd topo.eqtype "" "type ASC" \
						{idtype type}]
	    set menuup [list [list 1 [mc "Up"]] [list 0 [mc "Down"]]]
	    regsub -- "%MENUTYPE%" $colspecs "$menutype" colspecs
	    regsub -- "%MENUUP%" $colspecs "$menuup" colspecs
	}
	confcmd {
	    set menutype [::pgsql::getcols $dbfd topo.eqtype "" "type ASC" \
						{idtype type}]
	    regsub -- "%MENUTYPE%" $colspecs "$menutype" colspecs
	}
	zone -
	zone4 -
	zone6 {
	    set menuview [::pgsql::getcols $dbfd dns.view "" "name ASC" \
						{idview name}]
	    regsub -- "%MENUVIEW%" $colspecs "$menuview" colspecs
	}
	dotattr {
	    # we can't use a %s in an URL since the "%" character will be posted
	    d urlset "" $conf(nextimg) {{action image} {type dotattr} {id PCENT}}
	    set urlimg [::webapp::helem "img" "" \
				"src" [d urlget ""] \
				"alt" "Graphviz representation" \
			    ]
	    # urlimg contains some "&" and the "PCENT"
	    regsub -all -- "&" $urlimg {\\&} urlimg
	    regsub -- "PCENT" $urlimg {%1$s} urlimg
	    regsub -- "%URLIMG%" $colspecs "$urlimg" colspecs
	}
    }

    #
    # Display data
    #

    set msg [display-tabular $allwidths $title $colspecs $dbfd $sql $id tab]
    if {$msg ne ""} then {
	d error $msg
    }

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

    d urlset "%URLFORM%" $conf(next) [list [list "type" $type]]

    d result $conf(page-edit) [list \
				[list %TABLEAU% $tab] \
				[list %TITLEPAGE% $ptitle] \
			    ]
}

##############################################################################
# Display graphviz generated image
##############################################################################

proc dotattr-install-image {dbfd id regexp attr} {
    #
    # Generate the bitmap image with graphviz
    #

    set gv [::gvgraph %AUTO%]
    set dotcmd [get-local-conf "dot"]
    $gv node $regexp $attr
    if {[$gv graphviz "png" "dot" $dotcmd ""]} then {
	set png [$gv output]
	binary scan $png "H*" hex
	set hex "\\x$hex"
    } else {
	set png [errimg [$gv error]]
	set hex ""
    }
    $gv destroy

    #
    # Install the image in database if no error
    #

    if {$hex ne ""} then {
	set sql "UPDATE topo.dotattr SET png = '$hex' WHERE rank = $id"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    set png [errimg $msg]
	}
    }

    return $png
}

# get graphviz image from database. If none exists, generates one from
# attributes

proc dotattr-get-image {dbfd id} {
    set sql "SELECT * FROM topo.dotattr WHERE rank = $id"
    set png ""
    set found 0
    pg_select $dbfd $sql tab {
	if {$tab(png) eq "" || [string range $tab(png) 0 1] ne {\x}} then {
	    set png [dotattr-install-image $dbfd $id $tab(regexp) $tab(gvattr)]
	} else {
	    set png [binary format "H*" [string range $tab(png) 2 end]]
	}
	set found 1
    }
    if {! $found} then {
	set png [errimg "ERROR : cannot find image for rank '$id'"]
    }
    return $png
}

d cgi-register {action image} {
    {type	1 1}
    {id		1 1}
} {
    global conf

    switch -- $type {
	dotattr {
	    if {! [regexp {^[0-9]+$} $id]} then {
		d errimg "'$id' is not an number"
	    }
	    ::webapp::send png [dotattr-get-image $dbfd $id]
	    d end
	}
	default {
	    d errimg [mc "Type '%s' not supported" $type]
	}
    }
}

##############################################################################
# Display help page
##############################################################################

d cgi-register {action help} {
    {type	1 1}
} {
    global conf

    #
    # Get table type
    #

    if {! [info exists conf($type:help)]} then {
	d error [mc "Type '%s' not supported" $type]
    }

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

    d result $conf($type:help) {}
}

##############################################################################
# Modify data
##############################################################################

proc admref-nop {args} {
    # ok
    return 1
}

proc dotattr-check {op dbfd _msg id idnum table _tabval} {
    upvar $_msg msg
    upvar $_tabval tabval

    set ok 1

    # op = nop, mod, add, del
    if {$op eq "mod" || $op eq "add"} then {
	#
	# Generate the bitmap image with graphviz
	#

	set dotcmd [get-local-conf "dot"]
	set gv [::gvgraph %AUTO%]
	$gv node $tabval(regexp) $tabval(gvattr)
	if {[$gv graphviz "png" "dot" $dotcmd ""]} then {
	    # we don't use the result since we should use the \x prefix
	    # for binary data, prefix which will be transformed by
	    # the pgsql::quote function
	    set tabval(png) ""
	} else {
	    set msg [$gv error]
	    set ok 0
	}
	$gv destroy
    }

    return $ok
}

proc vlan-check {op dbfd _msg id idnum table _tabval} {
    upvar $_msg msg
    upvar $_tabval tabval

    set ok 1

    # op = nop, mod, add, del
    if {$op eq "mod" || $op eq "add"} then {
	#
	# Check vlan name
	#

	if {[info exists tabval(descr)]} then {
	    set ok [check-vlan-name $tabval(descr) msg]
	}
	# FIXME: we should also check VLAN id
    }

    return $ok
}

d cgi-register {action mod} {
    {type	1 1}
} {
    global conf

    if {! [info exists conf($type:return)]} then {
	d error [mc "Type '%s' not supported" $type]
    }
    set ret [mc $conf($type:return)]

    #
    # Get form field specification
    #

    set form {}
    foreach c $conf($type:cols) {
	lassign $c width var desc formtype defval
	lappend form [list "${var}\[0-9\]+" 0 9999]
	lappend form [list "${var}n\[0-9\]+" 0 9999]
    }

    if {[llength [::webapp::get-data ftab $form]] == 0} then {
	d error [mc "Invalid input"]
    }

    #
    # Get column specification
    #

    set spec {}
    foreach c $conf($type:cols) {
	lassign $c width var desc formtype defval
	lappend spec [list $var $formtype $defval]
    }

    #
    # Store modifications in database
    #

    store-tabular $dbfd $spec $conf($type:id) $conf($type:table) ftab $conf($type:proc)
    d writelog "modref" "modification of reference table $conf($type:table)"

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

    d urlset "%URL1%" $conf(nextindex) {}
    d urlset "%URL2%" $conf(nextadmindex) {}
    d urlset "%URL3%" $conf(next) [list [list "type" $type]]

    d result $conf(page-mod) [list \
				[list %RETURN% $ret] \

			    ]
}

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

d cgi-dispatch "admin" "admin"
