#!%TCLSH%

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

#
# Script pour enregistrer une modification de relais de messagerie
#
# Appel par : admrelsel.htgt
#
# Paramtres (formulaire ou URL) : aucun
#
# Historique
#   2004/03/04 : pda/jean : cration
#   2007/10/25 : jean     : log des actions de modification
#

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

#
# Quelques paramtres du script
#

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

set conf(form) {
	{domaine		1 1}

	{priorite[0-9]+		0 9999}
	{nom[0-9]+		0 9999}
	{domaine[0-9]+		0 9999}

	{prioriten[0-9]+	0 9999}
	{nomn[0-9]+		0 9999}
	{domainen[0-9]+		0 9999}
}

set conf(tableau) {
    global {
	chars {12 normal}
	columns {20 80}
	botbar {yes}
	align {left}
    }
    motif {Titre} {
	title {yes}
	topbar {yes}
	chars {bold}
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
    }
    motif {Normal} {
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
    }
}

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

##############################################################################
# Fonctions utilitaires
##############################################################################

#
# Insre une liste de mx dans la base
#
# Entre :
#   - paramtres :
#	- dbfd : accs  la base
#	- iddom : id du domaine
#	- lrel : liste au format spcifi dans valide-mx
# Sortie :
#   - valeur de retour : chane vide si ok, ou message d'erreur
#
# Historique
#   2004/03/04 : pda/jean : reprise du cas MX
#

proc inserer-relais {dbfd iddom lrel} {
    foreach rel $lrel {
	set prio [lindex $rel 0]
	set idmx [lindex $rel 1]
	set sql "INSERT INTO relais_dom (iddom, priorite, mx)
				    VALUES ($iddom, $prio, $idmx)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    return "Insertion du relais impossible ($msg)"
	}
    }
    return ""
}

##############################################################################
# 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 domaine [lindex $ftab(domaine) 0]

    #
    # Valider le domaine
    #

    set msg [valide-domaine-et-relais $dbfd $tabcor(idcor) $domaine iddom]
    if {! [string equal $msg ""]} then {
	::webapp::error-exit $conf(err) $msg
    }

    #
    # Parcourir la liste des champs de formulaire et constituer une
    # liste de la forme :
    #		{{prio idmx} ... }
    # o :
    #  - prio = priorit numrique (syntaxe entire ok)
    #  - idmx = id d'un RR existant
    #

    set lrel {}
    foreach c [array names ftab] {
	if {[regexp {^priorite(n?)([0-9]+)$} $c bidon n idmx]} then {
	    set idxprio priorite$n$idmx
	    set idxnom  nom$n$idmx
	    set idxdom  domaine$n$idmx
	    if {[info exists ftab($idxprio)] && \
			    [info exists ftab($idxnom)] && \
			    [info exists ftab($idxdom)] \
		    } then {
		set fprio [string trim [lindex $ftab($idxprio) 0]]
		set fnom  [string trim [lindex $ftab($idxnom)  0]]
		set fdom  [string trim [lindex $ftab($idxdom)  0]]
		if {! [string equal $fprio ""]} then {
		    set msg ""
		    set mx [valide-mx $dbfd \
					    $fprio $fnom $fdom \
					    $tabcor(idcor) msg]
		    if {! [string equal $msg ""]} then {
			::webapp::error-exit $conf(err) "$msg pour $fnom.$fdom"
		    }
		    if {[info exists tmx([lindex $mx 1])]} then {
			::webapp::error-exit $conf(err) "$fnom.$fdom spcifi deux fois."
		    }
		    lappend lrel $mx
		}
	    } else {
		::webapp::error-exit $conf(err) "Formulaire non conforme ($idxprio, $idxnom, $idxdom)"
	    }
	}
    }

    #
    # Dbuter la transaction
    #

    if {! [::pgsql::lock $dbfd {} msg]} then {
	::webapp::error-exit $conf(err) "Verrouillage de la base impossible: $msg"
    }

    #
    # Supprimer tous les relais ventuels au pralable.
    #

    set sql "DELETE FROM relais_dom WHERE iddom = $iddom"
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	::pgsql::unlock $dbfd "abort" m
	::webapp::error-exit $conf(err) "Suppression des anciens relais impossible: $msg"
    }

    #
    # Insrer les RR des MX
    #

    set msg [inserer-relais $dbfd $iddom $lrel]
    if {! [string equal $msg ""]} then {
	::pgsql::unlock $dbfd "abort" m
	::webapp::error-exit $conf(err) "Ajout des relais impossible\n$msg"
    }

    #
    # Dverrouillage, et enregistrement des modifications avant la sortie
    #

    if {! [::pgsql::unlock $dbfd "commit" msg]} then {
        ::pgsql::unlock $dbfd "abort" m
        return "Dverrouillage impossible, modification annule ('$msg')"
    }

    #
    # Rcapituler les informations ajoutes dans la base.
    #

    set lm {}
    if {[llength $lrel] > 0} then {
	set donnees {}
	lappend donnees {Titre Priorit Nom}
	foreach mx $lrel {
	    # priorit idmx
	    lire-rr-par-id $dbfd [lindex $mx 1] tabmx
	    lappend donnees [list Normal \
				[lindex $mx 0] \
				$tabmx(nom).$tabmx(domaine) \
			    ]
	    lappend lm "$tabmx(nom).$tabmx(domaine)"
	}
	set tableau [::arrgen::output "html" $conf(tableau) $donnees]
	writelog "modifrelais" $tabcor(login) \
			"remplacement des relais pour $domaine : [join $lm {, }]"
    } else {
	set tableau "Relais de messagerie supprims."
	writelog "modifrelais" $tabcor(login) \
			"suppression des relais pour $domaine"
    }


    #
    # Sortie du rsultat
    #

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

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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