#!%TCLSH%


#
# Script pour lister les machines d'un ou plusieurs domaines
#
# Appel par : script consulter (page lib/consulter.htgt)
#
# Paramtres (formulaire ou URL) :
#   - critres de slection : 
#	- plages4 : liste de plages IPv4 (idreseau dans tables reseau/plage)
#	- plages6 : liste de plages IPv6 (idreseau dans tables reseau/plage)
#	- cidr : cidr saisi par l'utilisateur
#   - format de sortie
#	- format : "Consulter" ou "Imprimer" ou "Adresses libres"
#
# Historique
#   2002/03/27 : pda/jean : cration
#   2002/05/02 : pda/jean : traitement des hinfo
#   2002/05/06 : pda/jean : ajout du cidr
#   2002/05/06 : pda/jean : ajout des groupes
#   2002/05/16 : pda      : conversion  arrgen
#   2002/07/09 : pda      : ajout de nologin
#   2003/05/13 : pda/jean : utilisation de la base d'authentification
#   2004/01/14 : pda/jean : ajout IPv6
#   2004/08/05 : pda/jean : ajout MAC
#   2004/08/06 : pda/jean : extension des droits sur les rseaux
#   2008/09/24 : pda/jean : ajout droitsmtp
#   2010/10/07 : pda      : dbut ajout adresses libres
#   2010/10/13 : pda      : added dhcp ranges in map
#

set conf(homeurl)	%HOMEURL%

#
# Chemins utiliss par les scripts
#

set conf(pkg)		%PKGTCL%
set conf(lib)		%DESTDIR%/lib
set conf(libdns)	$conf(lib)/libdns.tcl

#
# Dfinition des noms des pages " trous"
#

set conf(liste)		$conf(lib)/liste.html
set conf(listetex)	$conf(lib)/liste.tex
set conf(err)		$conf(lib)/erreur.html

#
# Quelques paramtres du script
#

set conf(auth)		%AUTH%
set conf(base)		%BASE%
set conf(nologin)	%NOLOGIN%
set conf(log)		%LOG%

# scripts cgi
set conf(script-edit)	bin/edit

set conf(form)		{
	{plages		0 99999}
	{cidr		1 99999}
	{format		0 1}
}

# taille max des blocs d'adresses IPv4 dans lesquelles on cherche 
# des adresses non dclares
set conf(limit-unused)	16384
# nb d'adresses par ligne dans une "carte" d'adresses libres
set conf(max-per-row)	16

#
# Le tableau servant  prsenter le rsultat
# Colonnes :
#	- adr IP
#	- nom machine et aliases
#	- adr MAC
#	- profil dhcp
#	- type de machine (hinfo)
#	- informations complmentaires (texte libre)
#	- correspondant (login)
#	- date de dernire modif (%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}
	}
    }
    motif {Gras} {
	title {yes}
	topbar {yes}
	chars {bold}
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
    }
    motif {Normal} {
	vbar {yes}
	colonne {
	    format {raw}
	}
	vbar {yes}
	colonne {
	    format {raw}
	}
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne {
	    align {center}
	}
	vbar {yes}
	colonne {
	    align {center}
	}
	vbar {yes}
	colonne { }
	vbar {yes}
    }
}


#
# Les outils du parfait concepteur de pages Web dynamiques...
#

lappend auto_path $conf(pkg)
package require webapp
package require pgsql
package require arrgen

#
# On y va !
#

# ::webapp::cgidebug ; exit

source $conf(libdns)

##############################################################################
# Fonctions
##############################################################################

proc output-list {dbfd lcidr _tabcor format} {
    upvar $_tabcor tabcor
    global conf

    #
    # Boucle externe : pour chaque plage demande dans le formulaire
    #

    set donnees {}
    lappend donnees {Gras {Adresse IP}
			  {Noms et aliases}
			  {Adresse MAC}
			  {Profil DHCP}
			  {Systme}
			  {Commentaire}
			  {Responsable}
			  {mission SMTP}
			  {Login}
			  {Date}
			}
    set nbmachines 0

    #
    # Construire la suite, c'est  dire l'url que devra suivre
    # le script edit & co une fois la machine ajoute.
    #

    set next {}
    foreach cidr $lcidr {
	lappend next cidr=$cidr
    }
    set next [::webapp::post-string [join $next "&"]]
    set next "nextprog=list&nextargs=$next"

    #
    # Parcourir les plages demandes
    #

    foreach cidrplage $lcidr {
	#
	# Les deux sous-select servent  rcuprer les plages
	# autorises/interdites par le correspondant,  l'intrieur
	# du numro de rseau spcifi par le CIDR obtenu ci-dessus.
	# 

	set sqlallow "SELECT adr FROM dr_ip WHERE
			    (adr <<= '$cidrplage' OR adr >>= '$cidrplage')
			    AND allow_deny = 1
			    AND idgrp = $tabcor(idgrp)"
	set sqldeny "SELECT adr FROM dr_ip WHERE
			    (adr <<= '$cidrplage' OR adr >>= '$cidrplage')
			    AND allow_deny = 0
			    AND idgrp = $tabcor(idgrp)"

	#
	# Rcuprer tous les aliases dont l'adresse IP est
	# dans les plages autorises, et les mettre dans un
	# tableau index par les adresses IP.
	# Exemple :
	#	cname(130.79.201.129) {aton.u-strasbg.fr diablo.u-strasbg.fr...}
	#

	set sql "SELECT alias.nom || '.' || domaine.nom AS nom, rr_ip.adr
		    FROM rr alias, rr canonique, rr_ip, rr_cname, domaine
		    WHERE canonique.idrr = rr_cname.cname
			AND rr_cname.idrr = alias.idrr
			AND rr_ip.idrr = canonique.idrr
			AND rr_ip.adr <<= ANY ($sqlallow)
			AND NOT rr_ip.adr <<= ANY ($sqldeny)
			AND rr_ip.adr <<= '$cidrplage'
			AND domaine.iddom = alias.iddom
		    ORDER BY alias.nom"
	pg_select $dbfd $sql tab {
	    lappend cname($tab(adr)) $tab(nom)
	}

	#
	# Rcuprer tous les noms de profils DHCP.
	# On pourrait les obtenir dans la grande requte
	# suivante sur les rr, mais a la rendrait trs
	# complique, et franchement illisible.
	#

	set sql "SELECT iddhcpprofil, nom FROM dhcpprofil"
	pg_select $dbfd $sql tab {
	    set nomprofildhcp($tab(iddhcpprofil)) $tab(nom)
	}

	#
	# Rcuprer toutes les adresses IP autorises et les
	# ajouter au tableau.
	#

	set jourfmt [dnsconfig get "jourfmt"]
	set sql "SELECT rr.nom || '.' || domaine.nom AS nom,
			rr_ip.adr,
			rr.commentaire, rr.respnom, rr.respmel, rr.date,
			rr.droitsmtp, rr.mac,
			rr.iddhcpprofil AS dhcp1,
			dhcprange.iddhcpprofil AS dhcp2,
			hinfo.texte, corresp.login
		    FROM rr, domaine, hinfo, corresp,
			rr_ip LEFT OUTER JOIN dhcprange
			    ON (rr_ip.adr >= dhcprange.min
				AND rr_ip.adr <= dhcprange.max)
		    WHERE rr.idrr = rr_ip.idrr
			AND rr_ip.adr <<= ANY ($sqlallow)
			AND NOT rr_ip.adr <<= ANY ($sqldeny)
			AND rr_ip.adr <<= '$cidrplage'
			AND domaine.iddom = rr.iddom
			AND rr.idhinfo = hinfo.idhinfo
			AND rr.idcor = corresp.idcor
		    ORDER BY rr_ip.adr"
	pg_select $dbfd $sql tab {
	    set nomprimaire	$tab(nom)
	    set adr		$tab(adr)
	    set mac		$tab(mac)
	    set dhcp1		$tab(dhcp1)
	    set dhcp2		$tab(dhcp2)
	    set hinfo		$tab(texte)
	    set commentaire	$tab(commentaire)
	    set respnom    	$tab(respnom)
	    set respmel    	$tab(respmel)
	    set droitsmtp	$tab(droitsmtp)
	    set date		$tab(date)
	    set login		$tab(login)

	    if {[info exists cname($adr)]} then {
		set nomssecondaires $cname($adr)
	    } else {
		set nomssecondaires ""
	    }

	    if {! [string equal $respmel ""]} then {
		set responsable "$respnom <$respmel>"
	    } else {
		set responsable $respnom
	    }

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

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

	    if {$droitsmtp} then {
		set droitsmtp "Oui"
	    } else {
		set droitsmtp "-"
	    }

	    switch -- $format {
		html {
		    set nom "$nomprimaire "
		    append nom [::webapp::helem "i" $nomssecondaires]
		    set url "$conf(homeurl)/$conf(script-edit)?adr=$adr&$next"
		    set adr [::webapp::helem "a" $adr "href" $url]
		}
		latex {
		    set nom "$nomprimaire \\textit \{$nomssecondaires\}"
		}
	    }
	    lappend donnees [list Normal \
				$adr $nom $mac $dhcp \
				$hinfo $commentaire $responsable \
				$droitsmtp \
				$login $date]
	    incr nbmachines
	}
    }

    #
    # Gnrer le zoli tableau
    #

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

    #
    # Sortie du rsultat
    #

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

    switch -- $format  {
	html	{
	    set tableau "<p>Adresses dclares (IPv4 + IPv6) : $nbmachines</p>$tableau"

	    ::webapp::send html [::webapp::file-subst $conf(liste) \
					[list \
					    [list %TITRE%	"Liste des adresses dclares"] \
					    [list %TABLEAU%	$tableau] \
					    [list %DATE%	$date] \
					    [list %NBADR%	$nbmachines] \
					] \
				]
	}
	latex	{
	    ::webapp::send pdf [::webapp::file-subst $conf(listetex) \
					[list \
					    [list %ORIENTATION%	"landscape"] \
					    [list %TITRE%	"machines"] \
					    [list %TABLEAU%	$tableau] \
					    [list %DATE%	$date] \
					    [list %QUOI%	"dclares"] \
					    [list %NBADR%	$nbmachines] \
					] \
				]
	}
    }
}

proc output-map {dbfd lcidr _tabcor format} {
    upvar $_tabcor tabcor
    global conf

    #
    # Ne conserver dans lcidr que les plages IPv4 (et pas IPv6)
    # car la fonction SQL availip() ne fonctionne qu'en IPv4.
    #

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

    if {[llength $lcidrv4] == 0} then {
	::webapp::error-exit $conf(err) "Aucun CIDR valide ($m)"
    }

    #
    # Construire la suite, c'est  dire l'url que devra suivre
    # le script traiteajout une fois la machine ajoute.
    #

    set next {}
    foreach cidr $lcidrv4 {
	lappend next cidr=$cidr
    }
    set next [::webapp::post-string [join $next "&"]]
    set next "nextprog=map&nextargs=$next"

    #
    # Legend
    #

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

    #
    # Parcourir toutes les adresses
    # - revenir  la ligne toutes les 16 adresses
    # - afficher la bonne couleur
    #

    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 markcidr ('$cidr', $limite, $tabcor(idgrp))"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    ::webapp::error-exit $conf(err) "Erreur dans le cidr '$cidr' ($msg)"
	}

	set sql "SELECT * FROM allip ORDER BY adr"

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

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

	    # need this legend
	    incr legend($avail)

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

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

	    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
		    set h [::webapp::helem "a" $last \
			    "href" "$conf(homeurl)/bin/ajout?adr=$adr&$next"]
		    append line [::webapp::helem "td" $h "class" "noname-nodhcp"]
		    incr navail
		}
		2	{
		    # declared and not in a dhcprange
		    set h [::webapp::helem "a" $last \
			    "href" "$conf(homeurl)/bin/edit?adr=$adr&$next" \
			    "title" $fqdn]
		    append line [::webapp::helem "td" $h "class" "name-nodhcp"]
		}
		3	{
		    # not declared and in a dhcp range
		    set h [::webapp::helem "a" $last \
			    "href" "$conf(homeurl)/bin/ajout?adr=$adr&$next"]
		    append line [::webapp::helem "td" $h "class" "noname-dhcp"]
		}
		4	{
		    # declared and in a dhcprange
		    set h [::webapp::helem "a" $last \
			    "href" "$conf(homeurl)/bin/edit?adr=$adr&$next" \
			    "title" $fqdn]
		    append line [::webapp::helem "td" $h "class" "name-dhcp"]
		}
		default {
		    ::webapp::error-exit $conf(err) "Erreur interne pour '$adr' : avail = $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" "Rseau '$cidr'"]
	}

	set p "$navail adresses disponibles / $n total "
	append p [::webapp::helem "a" {[Dtail]} \
		    "href" "$conf(homeurl)/bin/liste?cidr=$cidr&format=consulter"]

	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 {adresse non accessible}
		1 noname-nodhcp {adresse disponible}
		2 name-nodhcp {adresse dclare}
		3 noname-dhcp {adresse non dclare, figurant dans un intervalle DHCP}
		4 name-dhcp {adresse dclare, figurant dans un intervalle DHCP}
	    } {
	if {$legend($i) > 0} then {
	    set l [::webapp::helem "td" "&nbsp;" "class" $class]
	    append l [::webapp::helem "td" $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"

    #
    # Fioritures
    #

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

    ::webapp::send html [::webapp::file-subst $conf(liste) \
				[list \
				    [list %TITRE%	"Carte des adresses IPv4"] \
				    [list %TABLEAU%	$tableau] \
				    [list %DATE%	$date] \
				] \
			]
}

##############################################################################
# Programme principal
##############################################################################

proc main {} {
    global conf

    #
    # Initialisation
    #

    init-dns $conf(nologin) $conf(auth) $conf(base) $conf(err) "" \
			$conf(form) ftab dbfd login tabcor $conf(log)

    #
    # Analyse et validation des arguments
    #

    # le ou les CIDR(s) demand(s) par le correspondant
    set lcidr {}
    set l $ftab(cidr)
    foreach cidr $l {
	if {! [string eq [string trim $cidr] ""]} then {
	    set m [syntaxe-ip $dbfd $cidr "cidr"]
	    if {[string length $m] > 0} then {
		::webapp::error-exit $conf(err) $m
	    }
	    lappend lcidr $cidr
	}
    }

    # les plages demandes par le correspondant
    set nplages [llength $ftab(plages)]

    # compatibilit entre les deux arguments
    if {[string length $lcidr] == 0 && $nplages == 0} then {
	::webapp::error-exit $conf(err) "Vous devez choisir un CIDR ou au moins une plage"
    }
    if {[string length $lcidr] > 0 && $nplages > 0} then {
	::webapp::error-exit $conf(err) "Vous ne pouvez pas choisir un CIDR et une plage"
    }

    #
    # Valider les idreseaux fournis, et rcuprer les CIDR correspondants
    #

    if {$nplages > 0} then {
	foreach idreseau $ftab(plages) {
	    set l [valide-idreseau $dbfd $idreseau \
					$tabcor(idgrp) "consult" {4 6} msg]
	    if {[llength $l] == 0} then {
		::webapp::error-exit $conf(err) $msg
	    }
	    set lcidr [concat $lcidr $l]
	}
    }

    # format de sortie
    switch -glob -nocase -- [lindex $ftab(format) 0] {
	Carte*		{ set format carte }
	Imprimer	{ set format latex }
	Consulter	-
	*		{ set format html }
    }

    if {[string eq $format "carte"]} then {
	output-map $dbfd $lcidr tabcor $format
    } else {
	output-list $dbfd $lcidr tabcor $format
    }

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

::webapp::cgi-exec main %DEBUG%
