#!%TCLSH%

# $Id: admmxedit,v 1.4 2007/11/13 16:44:05 pda Exp $

#
# Script pour prsenter les informations pour une modification de mx
#
# Appel par : admmxsel.htgt
#
# Paramtres (formulaire ou URL) : aucun
#
# Historique
#   2003/04/24 : pda/jean : cration
#   2003/05/13 : pda/jean : utilisation de la base d'authentification
#

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)/admmxedit.html

#
# Quelques paramtres du script
#

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

set conf(form) {
	{nom		1 1}
	{domaine	1 1}
}

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

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

#
# 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) "admin" \
			$conf(form) ftab dbfd login tabcor $conf(log)

    set nom     [lindex $ftab(nom) 0]
    set domaine [lindex $ftab(domaine) 0]

    #
    # Valider le nom de mx et le domaine
    #

    set msg [syntaxe-nom $nom]
    if {[string length $msg] > 0} then {
	::webapp::error-exit $conf(err) $msg
    }

    set msg [valide-domaine $dbfd $tabcor(idcor) $domaine iddom ""]
    if {[string length $msg] > 0} then {
	::webapp::error-exit $conf(err) $msg
    }

    #
    # Rcuprer les informations sur ce nom s'il existe dans la base
    #

    set existe [lire-rr-par-nom $dbfd $nom $iddom tabrr]

    #
    # S'il existe, vrifier que ce n'est pas dj un A ou un CNAME
    # ou autre chose encore qui ne soit pas des MX
    #

    if {$existe} then {
	if {[llength $tabrr(ip)] > 0} then {
	    ::webapp::error-exit $conf(err) "'$nom' a dj des adresses IP."
	}
	if {[llength $tabrr(cname)] > 0} then {
	    ::webapp::error-exit $conf(err) "'$nom' est un alias."
	}

	#
	# Le MX existe, il faut maintenant vrifier que l'utilisateur
	# a bien accs  tous les domaines des MX rfrencs.
	#
	foreach mx $tabrr(mx) {
	    set idmx [lindex $mx 1]
	    if {[lire-rr-par-id $dbfd $idmx tabmx] == 0} then {
		::webapp::error-exit $conf(err) "ERREUR INTERNE : table rr_mx rfrence le RR $idmx, non trouv dans la table rr"
	    }
	    set iddom $tabmx(iddom)
	    if {! [droit-correspondant-domaine $dbfd $tabcor(idcor) $iddom ""]} then {
		::webapp::error-exit $conf(err) "Le MX '$tabmx(nom).$tabmx(domaine)' rfrence un domaine auquel vous n'avez pas accs"
	    }
	}
    }

    #
    # Prsenter les informations MX en notre possession
    #

    if {$existe} then {
	set idrr $tabrr(idrr)
    } else {
	set idrr -1
    }

    set largeurs {10 50 40}
    set titres {{texte Priorit} {texte Nom} {texte Domaine}}
    set menudom [couple-domaine-par-corresp $dbfd $tabcor(idcor) ""]
    set spec [list \
		{priorite {string 5}  {}} \
		{nom      {string 30} {}} \
		[list domaine [list menu $menudom] {}] \
	    ]
    set sql "SELECT m.mx, m.priorite, r.nom, d.nom AS domaine
		FROM rr_mx m, rr r, domaine d
		WHERE m.idrr = $idrr
			AND m.mx = r.idrr
			AND r.iddom = d.iddom
		ORDER BY m.priorite, d.nom, r.nom
		"
    set idnum "mx"

    set msg [edition-tableau $largeurs $titres $spec $dbfd $sql $idnum tableau]
    if {[string length $msg] > 0} then {
	::webapp::error-exit $conf(err) $msg
    }

    #
    # Sortie du rsultat
    #

    ::webapp::send html [::webapp::file-subst $conf(page) \
				    [list \
					    [list %TABLEAU% $tableau] \
					    [list %NOM%     $nom] \
					    [list %DOMAINE% $domaine] \
					] \
			    ]

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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