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

#
# List all machines within a network/IP range
#
# Parameters (form or url):
#   - selection criteria
#	- plages : list of IP network ids
#	- cidr : cidr given by user
#   - output format
#	- dolist, doprint, docsv or domap
#
# History
#   2002/03/27 : pda/jean : design
#   2002/05/02 : pda/jean : hinfo processing
#   2002/05/06 : pda/jean : add cidr
#   2002/05/06 : pda/jean : add groups
#   2002/05/16 : pda      : conversion to arrgen
#   2002/07/09 : pda      : add nologin
#   2003/05/13 : pda/jean : use auth base
#   2004/01/14 : pda/jean : add IPv6
#   2004/08/05 : pda/jean : add mac
#   2004/08/06 : pda/jean : extend network permissions
#   2008/09/24 : pda/jean : add sendsmtp
#   2010/10/07 : pda      : add free addresses
#   2010/10/13 : pda      : added dhcp ranges in map
#   2010/12/09 : pda      : i18n
#   2010/12/25 : pda      : use cgi-dispatch
#   2012/09/20 : pda/jean : add docsv
#   2012/11/07 : pda/jean : add views
#
#
# Template pages used by this script
#

set conf(page)		net.html
set conf(listhtml)	net-list.html
set conf(listtex)	net-list.tex

#
# Next actions
# 

set conf(next)		"net"
set conf(nextedit)	"edit"
set conf(nextadd)	"add"

#
# Script parameters
#

# maximum number of IP networks without displaying a scroll bar
set conf(maxranges)	10

# max size of IPv4 blocks where we are looking for non-declared addresses
set conf(limit-unused)	16384
# number of addresses per line in a free address map
set conf(max-per-row)	16

#
# tabular specification for result
# Columns:
#	- IP address
#	- host name and aliases
#	- MAC address
#	- DHCP profile
#	- host type (hinfo)
#	- comments
#	- user login
#	- date of last modification (%m/%d/%y)
#

set conf(tableau) {
    global {
	chars {10 normal}
	columns {21 17 12 9 9 13 17 6 6 7}
	botbar {yes}
	align {left}
	latex {
	    linewidth {267}
	}
    }
    pattern Title {
	title {yes}
	topbar {yes}
	chars {bold}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
    }
    pattern Normal {
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
	column {
	    format {raw}
	}
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column { }
	vbar {yes}
	column {
	    align {center}
	}
	vbar {yes}
	column {
	    align {center}
	}
	vbar {yes}
	column { }
	vbar {yes}
    }
}


#
# Netmagis general library
#

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

# ::webapp::cgidebug ; exit

##############################################################################
# Display network selection page
##############################################################################

d cgi-register {
    domap {}
    dolist {}
    docsv {}
    doprint {}
} {
} {
    global conf

    #
    # Initialization
    #


    #
    # Process informations about the user, in case they are changed
    # (user is supposed to signal updates)
    #

    set user	[display-user tabuid]

    #
    # View menu
    #

    set menuview [mc "View"]
    append menuview " "
    lassign [menu-view $dbfd $tabuid(idcor) "idview" {}] disp html
    append menuview $html
    if {$disp} then {
	set dispview "block"
	set dispforallviews [mc "(for all views)"]
	set dispforselview [mc "(for the selected view)"]
    } else {
	set dispview "none"
	set dispforallviews ""
	set dispforselview ""
    }

    #
    # Get IP address ranges
    #

    set lnet [read-networks $dbfd $tabuid(idgrp) "consult"]
    set nnet [llength $lnet]
    if {$nnet == 0} then {
	set ranges [mc "No authorized network"]
    } else {
	if {$nnet > $conf(maxranges)} then {
	    set nnet $conf(maxranges)
	}
	set ranges [::webapp::form-menu "plages" $nnet 1 $lnet {}]
    }

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

    d urlset "%URLFORM%" $conf(next) {}
    d result $conf(page) [list \
				[list %CORRESP%  $user] \
				[list %PLAGES%   $ranges] \
				[list %DISPVIEW% $dispview] \
				[list %MENUVIEW% $menuview] \
				[list %FORALLVIEWS% $dispforallviews] \
				[list %FORSELVIEW% $dispforselview] \
			    ]
}

##############################################################################
# Utility functions
##############################################################################

proc output-list {dbfd lcidr idview _tabuid format} {
    upvar $_tabuid tabuid
    global conf

    set lines {}
    lappend lines [list "Title" \
			    [mc "IP address"] \
			    [mc "Name and aliases"] \
			    [mc "MAC address"] \
			    [mc "DHCP profile"] \
			    [mc "Host type"] \
			    [mc "Comment"] \
			    [mc "Responsible"] \
			    [mc "SMTP emit right"] \
			    [mc "Login"] \
			    [mc "Date"] \
			]
    set nbhost 0

    #
    # Build next action
    #

    set nextprog "list"
    set nextargs {}
    foreach cidr $lcidr {
	lappend nextargs cidr=$cidr
    }
    lappend nextargs idview=$idview
    set nextargs [join $nextargs "&"]

    #
    # External loop : for each IP range given
    #

    foreach cidrplage $lcidr {
	#
	# These two subselect queries are used to get IP ranges
	# allowed/denied for the user, within network id specified
	# by the CIDR
	# 

	set sqlallow "SELECT addr FROM dns.p_ip WHERE
			    (addr <<= '$cidrplage' OR addr >>= '$cidrplage')
			    AND allow_deny = 1
			    AND idgrp = $tabuid(idgrp)"
	set sqldeny "SELECT addr FROM dns.p_ip WHERE
			    (addr <<= '$cidrplage' OR addr >>= '$cidrplage')
			    AND allow_deny = 0
			    AND idgrp = $tabuid(idgrp)"

	#
	# Extract all aliases related to IP addresses in allowed ranges
	# and put them in an array indexed by IP addresses
	# Example :
	#  cname(172.16.201.129) {aton.example.com diablo.example.com...}
	#

	set sql "SELECT alias.name || '.' || domain.name AS name, rr_ip.addr
		    FROM dns.rr alias, dns.rr canon, dns.rr_ip, dns.rr_cname, dns.domain
		    WHERE canon.idrr = rr_cname.cname
			AND rr_cname.idrr = alias.idrr
			AND rr_ip.idrr = canon.idrr
			AND rr_ip.addr <<= ANY ($sqlallow)
			AND NOT rr_ip.addr <<= ANY ($sqldeny)
			AND rr_ip.addr <<= '$cidrplage'
			AND domain.iddom = alias.iddom
			AND canon.idview = $idview
		    ORDER BY alias.name"
	pg_select $dbfd $sql tab {
	    lappend cname($tab(addr)) $tab(name)
	}

	#
	# Get all DHCP profile names. They could be fetched in the
	# next large request (on RR), but this request would become
	# very complex and not very readable.
	#

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

	#
	# Get all allowed IP address and add them to the array.
	#

	set dayfmt [dnsconfig get "dayfmt"]
	set sql "SELECT DISTINCT rr.name || '.' || domain.name AS name,
			rr_ip.addr,
			rr.comment, rr.respname, rr.respmail, rr.date,
			rr.sendsmtp, rr.mac,
			rr.iddhcpprof AS dhcp1,
			dhcprange.iddhcpprof AS dhcp2,
			hinfo.name AS hinfo, nmuser.login
		    FROM dns.rr, dns.domain, dns.hinfo, global.nmuser,
			dns.rr_ip LEFT OUTER JOIN dns.dhcprange
			    ON (rr_ip.addr >= dhcprange.min
				AND rr_ip.addr <= dhcprange.max)
		    WHERE rr.idrr = rr_ip.idrr
			AND rr_ip.addr <<= ANY ($sqlallow)
			AND NOT rr_ip.addr <<= ANY ($sqldeny)
			AND rr_ip.addr <<= '$cidrplage'
			AND domain.iddom = rr.iddom
			AND rr.idhinfo = hinfo.idhinfo
			AND rr.idcor = nmuser.idcor
			AND rr.idview = $idview
		    ORDER BY rr_ip.addr"
	pg_select $dbfd $sql tab {
	    set primary		$tab(name)
	    set addr		$tab(addr)
	    set mac		$tab(mac)
	    set dhcp1		$tab(dhcp1)
	    set dhcp2		$tab(dhcp2)
	    set hinfo		$tab(hinfo)
	    set comment		$tab(comment)
	    set respname    	$tab(respname)
	    set respmail    	$tab(respmail)
	    set sendsmtp	$tab(sendsmtp)
	    set date		$tab(date)
	    set login		$tab(login)

	    if {[info exists cname($addr)]} then {
		set secondaries $cname($addr)
	    } else {
		set secondaries ""
	    }

	    if {$respmail ne ""} then {
		set resp "$respname <$respmail>"
	    } else {
		set resp $respname
	    }

	    if {[info exists profdhcpname($dhcp2)]} then {
		set dhcp $profdhcpname($dhcp2)
	    } elseif {[info exists profdhcpname($dhcp1)]} then {
		set dhcp $profdhcpname($dhcp1)
	    } else {
		set dhcp ""
	    }

	    set date [clock format [clock scan $date] -format $dayfmt]

	    if {$sendsmtp} then {
		set sendsmtp [mc "Yes"]
	    } else {
		set sendsmtp "-"
	    }

	    switch -- $format {
		html {
		    d urlset "" $conf(nextedit) [list [list "addr" $addr]]
		    d urlsetnext "" $nextprog $nextargs
		    set url [d urlget ""]
		    set name "$primary "
		    append name [::webapp::helem "i" $secondaries]
		    set addr [::webapp::helem "a" $addr "href" $url]
		}
		latex {
		    set name "$primary \\textit \{$secondaries\}"
		}
		csv {
		    set ns [join $secondaries ","]
		    if {$ns eq ""} then {
			set name "$primary"
		    } else {
			set name "$primary,$ns"
		    }
		}
	    }
	    lappend lines [list Normal \
				$addr $name $mac $dhcp \
				$hinfo $comment $resp $sendsmtp \
				$login $date]
	    incr nbhost
	}
    }

    #
    # Generate HTML or CSV code
    #

    set tableau [::arrgen::output $format $conf(tableau) $lines]

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

    set datefmt [dnsconfig get "datefmt"]
    set date  [clock format [clock seconds] -format $datefmt]

    set pline [mc {Declared addresses (IPv4+IPv6) in view '%1$s': %2$s} [u viewname $idview] $nbhost]
    set dhost [mc "List of declared addresses"]

    switch -- $format  {
	html	{
	    set pline [::webapp::helem "p" $pline]
	    set tableau "$pline\n$tableau"

	    d result $conf(listhtml) [list \
					[list %TITLE%	$dhost] \
					[list %TABLEAU%	$tableau] \
					[list %DATE%	$date] \
				    ]
	}
	latex	{
	    set tableau "$pline\n\n$tableau"
	    d result $conf(listtex) [list \
					[list %ORIENTATION% "landscape"] \
					[list %TABLEAU%	$tableau] \
					[list %DATE%	$date] \
				    ]
	}
	csv {
	    ::webapp::send "csv" $tableau
	    d end
	}
    }
}

proc output-map {dbfd lcidr _tabuid format} {
    upvar $_tabuid tabuid
    global conf

    #
    # Keep in lcidr only IPv4 ranges (and not IPv6) because
    # SQL function availip() works only for IPv4.
    #

    set lcidrv4 {}
    set m ""
    foreach cidrplage $lcidr {
	set r [check-ip-syntax $dbfd $cidrplage "cidr4"]
	if {$r eq ""} then {
	    lappend lcidrv4 $cidrplage
	} else {
	    append m "$r<br>"
	}
    }

    if {[llength $lcidrv4] == 0} then {
	d error [mc "No valid CIDR: %s" $m]
    }

    #
    # Build next action.
    #

    set nextprog "map"
    set nextargs {}
    foreach cidr $lcidrv4 {
	lappend nextargs cidr=$cidr
    }
    set nextargs [join $nextargs "&"]

    #
    # Legend
    #

    for {set i 0} {$i < 5} {incr i} {
	set legend($i) 0
    }

    #
    # Traverse all IP addresses. New line every 16 addresses, and
    # display appropriate color.
    #

    set tableau ""
    set limite $conf(limit-unused)
    set maxrow $conf(max-per-row)

    foreach cidr $lcidrv4 {
	set html ""
	set n 0
	set navail 0
	set sql "SELECT * FROM dns.mark_cidr ('$cidr', $limite, $tabuid(idgrp))"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d error [mc {Error in CIDR '%1$s': %2$s} $cidr $msg]
	}

	set sql "SELECT * FROM allip ORDER BY addr"

	#
	# Explore all addresses (not available, free, or busy)
	#

	pg_select $dbfd $sql tab {
	    set addr  $tab(addr)
	    set avail $tab(avail)
	    set fqdn  $tab(fqdn)

	    # need this legend
	    incr legend($avail)

	    # extract last byte of address
	    set last ""
	    regexp {[^.]*$} $addr last

	    if {$n % $maxrow == 0} then {
		set line [::webapp::helem td $addr]
	    }

	    append line "\n"
	    switch -- $avail {
		0	{
		    # not available (user has not the right, addr does'nt exists)
		    append line [::webapp::helem "td" $last "class" "notav"]
		}
		1	{
		    # not declared and not in a dhcp range
		    d urlset "" $conf(nextadd) [list [list "addr" $addr]]
		    d urlsetnext "" $nextprog $nextargs
		    set url [d urlget ""]
		    set h [::webapp::helem "a" $last "href" $url]
		    append line [::webapp::helem "td" $h "class" "noname-nodhcp"]
		    incr navail
		}
		2	{
		    # declared and not in a dhcprange
		    d urlset "" $conf(nextedit) [list [list "addr" $addr]]
		    d urlsetnext "" $nextprog $nextargs
		    set url [d urlget ""]
		    set h [::webapp::helem "a" $last "href" $url "title" $fqdn]
		    append line [::webapp::helem "td" $h "class" "name-nodhcp"]
		}
		3	{
		    # not declared and in a dhcp range
		    d urlset "" $conf(nextadd) [list [list "addr" $addr]]
		    d urlsetnext "" $nextprog $nextargs
		    set url [d urlget ""]
		    set h [::webapp::helem "a" $last "href" $url]
		    append line [::webapp::helem "td" $h "class" "noname-dhcp"]
		}
		4	{
		    # declared and in a dhcprange
		    d urlset "" $conf(nextedit) [list [list "addr" $addr]]
		    d urlsetnext "" $nextprog $nextargs
		    set url [d urlget ""]
		    set h [::webapp::helem "a" $last "href" $url "title" $fqdn]
		    append line [::webapp::helem "td" $h "class" "name-dhcp"]
		}
		default {
		    d error [mc {Internal error for '%1$s': avail=%2$s} $addr $avail]
		}
	    }

	    incr n
	    if {$n % $maxrow == 0} then {
		append html "\n"
		append html [::webapp::helem "tr" $line]
	    }
	}
	if {$n % $maxrow != 0} then {
	    for {set i $n} {$i % $maxrow != 0} {incr i} {
		append line [::webapp::helem "td" "&nbsp;"]
	    }
	    append html "\n"
	    append html [::webapp::helem "tr" $line]
	}

	#
	# Titles, stats & co
	#

	append tableau "\n"
	if {[llength $lcidrv4] > 1} then {
	    append tableau [::webapp::helem "h3" [mc "Network '%s'" $cidr]]
	}

	set p [mc {%1$s available addresses / %2$s total} $navail $n]
	append p " "

	#
	# Detail: depends upon the number of available views
	#

	set idviews [u myviewids]
	if {[llength $idviews] == 1} then {
	    set t [mc "Detail"]
	    d urlset "" $conf(next) [list \
						[list "dolist" "yes"] \
						[list "cidr" $cidr] \
						[list "idview" [lindex $idviews 0]] \
					    ]
	    set url [d urlget ""]
	    append p [::webapp::helem "a" "\[$t\]" "href" $url]
	} else {
	    append p "<br>"
	    append p [mc "Detail"]
	    append p " "
	    foreach id $idviews {
		set t [u viewname $id]
		d urlset "" $conf(next) [list \
						    [list "dolist" "yes"] \
						    [list "cidr" $cidr] \
						    [list "idview" $id] \
						]
		set url [d urlget ""]
		append p [::webapp::helem "a" "\[$t\]" "href" $url]
	    }
	}

	append tableau [::webapp::helem "p" $p]
	append tableau "\n"
	append tableau [::webapp::helem "table" $html "id" "map"]
	append tableau "\n"
    }

    #
    # Build legend
    #

    set hlegend ""
    foreach {i class txt} {
		0 notav {address not allowed}
		1 noname-nodhcp {available address in all views}
		2 name-nodhcp {declared address in at least one view}
		3 noname-dhcp {non-declared address within a DHCP range}
		4 name-dhcp {declared address, within a DHCP range}
	    } {
	if {$legend($i) > 0} then {
	    set l [::webapp::helem "td" "&nbsp;" "class" $class]
	    append l [::webapp::helem "td" [mc $txt]]
	    append l "\n"
	    append hlegend [::webapp::helem "tr" $l]
	}
    }
    set hlegend [::webapp::helem "div" \
			[::webapp::helem "table" $hlegend "border" "0"] \
			"id" "legend"]
    set tableau "$hlegend\n$tableau"

    #
    # Output page and close database
    #

    set datefmt [dnsconfig get "datefmt"]
    set date  [clock format [clock seconds] -format $datefmt]

    d result $conf(listhtml) [list \
				[list %TITLE%	[mc "IPv4 address map"]] \
				[list %TABLEAU%	$tableau] \
				[list %DATE%	$date] \
			    ]
}

# format = latex, map or html
proc output {dbfd _ftab _tabuid format} {
    upvar $_ftab ftab
    upvar $_tabuid tabuid
    global conf

    #
    # Argument analysis
    #

    set lcidr {}
    set l $ftab(cidr)
    foreach cidr $l {
	set cidr [string trim $cidr]
	if {$cidr ne ""} then {
	    set msg [check-ip-syntax $dbfd $cidr "cidr"]
	    if {$msg ne ""} then {
		d error $msg
	    }
	    lappend lcidr $cidr
	}
    }

    set nranges [llength $ftab(plages)]

    # compatibility between two arguments
    if {[llength $lcidr] == 0 && $nranges == 0} then {
	d error [mc "You must choose a CIDR or at least one network"]
    }
    if {[llength $lcidr] > 0 && $nranges > 0} then {
	d error [mc "You can not choose both a CIDR and a network"]
    }

    #
    # Check given network ids and CIDR
    #

    if {$nranges > 0} then {
	foreach netid $ftab(plages) {
	    set l [check-netid $dbfd $netid $tabuid(idgrp) "consult" {4 6} msg]
	    if {[llength $l] == 0} then {
		d error $msg
	    }
	    set lcidr [concat $lcidr $l]
	}
    }

    #
    # Perform the action
    #

    if {$format eq "map"} then {
	output-map $dbfd $lcidr tabuid $format
    } else {
	#
	# Check access to view
	#

	set idview [lindex $ftab(idview) 0]
	set msg [check-views [list $idview]]
	if {$msg ne ""} then {
	    d error $msg
	}

	output-list $dbfd $lcidr $idview tabuid $format
    }
}

##############################################################################
# Display network list
##############################################################################

d cgi-register {dolist .+} {
    {plages	0 99999}
    {cidr	1 99999}
    {idview	1 1}
} {
    output $dbfd ftab tabuid "html"
}

d cgi-register {doprint .+} {
    {plages	0 99999}
    {cidr	1 99999}
    {idview	1 1}
} {
    output $dbfd ftab tabuid "latex"
}

d cgi-register {docsv .+} {
    {plages	0 99999}
    {cidr	1 99999}
    {idview	1 1}
} {
    output $dbfd ftab tabuid "csv"
}

# idview is not used in map output
d cgi-register {domap .+} {
    {plages	0 99999}
    {cidr	1 99999}
} {
    output $dbfd ftab tabuid "map"
}

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

d cgi-dispatch "dns" ""
