#!%TCLSH%


#
# Script pour consulter les droits associs  un correspondant
#
# Appel par : index.htgt
#
# Paramtres (formulaire ou URL) : aucun
#	- si l'utilisateur est un administrateur
#		- login : nom de login d'un correspondant quelconque
#	- si non : aucun paramtre
#
# Historique
#   2002/05/21 : pda/jean : cration
#   2002/07/09 : pda      : ajout de nologin
#   2003/05/13 : pda/jean : utilisation de la base d'authentification
#   2005/04/06 : pda      : ajout des profils dhcp
#

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(err)		$conf(lib)/erreur.html
set conf(page)		$conf(lib)/droits.html

#
# Quelques paramtres du script
#

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

set conf(form)	{
	{login	0 1}
}

#
# 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)

##############################################################################
# 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)

    #
    # Si l'utilisateur est un administrateur, l'autoriser  consulter
    # les droits d'un autre utilisateur.
    #

    if {[attribut-correspondant $dbfd $tabcor(idcor) admin]} then {
	#
	# A partir de maintenant, on prend le nouveau login qui est
	# fourni dans le formulaire (s'il est fourni)
	#

	if {[llength $ftab(login)] > 0} then {
	    set login [lindex $ftab(login) 0]

	    unset tabcor
	    set msg [lire-correspondant-par-login $dbfd $login tabcor]
	    if {! [string equal $msg ""]} then {
		::webapp::error-exit $conf(err) "'$login' non trouv ($msg)"
	    }
	}
    }

    #
    # Mettre en forme les informations associes au correspondant pour
    # qu'il se les rappelle bien (et pense  nous envoyer les
    # modifications ;-)
    #

    set corresp	[html-correspondant tabcor]

    #
    # Rcupration du code HTML d'affichage des caractristiques
    # du groupe auquel appartient le correspondant
    #

    set grospaquet [info-groupe $dbfd $tabcor(idgrp)]
    set tabreseaux        [lindex $grospaquet 2]
    set tabcidrhorsreseau [lindex $grospaquet 3]
    set tabdomaines       [lindex $grospaquet 4]
    set tabdhcpprofil     [lindex $grospaquet 5]

    if {[string length $tabcidrhorsreseau] == 0} then {
	set titrecidrhorsreseau ""
    } else {
	set titrecidrhorsreseau "Droits non rattachs  des rseaux"
    }

    #
    # Sortie du rsultat
    #

    ::webapp::send html [::webapp::file-subst $conf(page) \
		    [list \
			    [list %CORRESP% $corresp] \
			    [list %TABRESEAUX% $tabreseaux] \
			    [list %TITRECIDRHORSRESEAU% $titrecidrhorsreseau] \
			    [list %TABCIDRHORSRESEAU% $tabcidrhorsreseau] \
			    [list %TABDOMAINES% $tabdomaines] \
			    [list %TABDHCPPROFIL% $tabdhcpprofil] \
			] \
	    ]

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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