#!%TCLSH%

# $Id: mailmodif,v 1.5 2007/11/14 15:27:28 pda Exp $

#
# Script pour prsenter la page de saisie de l'hbergeur d'une adresse
# de messagerie (ou la liste des adresses de messagerie existantes)
#
# Appel par : script mailheberg (page lib/mailheberg-edit.htgt)
#
# Paramtres (formulaire ou URL) :
#   - nom : nom (premier constituant) de l'adresse de messagerie
#   - domaine : domaine de l'adresse de messagerie (tous les
#		constituants sauf le premier)
#   - nomh : nom (premier constituant) de l'hbergeur
#   - domaineh : domaine de l'hbergeur (tous les constituants sauf le premier)
#
# Historique
#   2004/02/12 : 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(pageok)	$conf(lib)/mailmodif.html

#
# Quelques paramtres du script
#

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

# les champs du formulaire
set conf(form)		{
	{nom		1 1}
	{domaine	1 1}
	{nomh		1 1}
	{domaineh	1 1}
}

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

lappend auto_path $conf(pkg)
package require webapp
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) "" \
			$conf(form) ftab dbfd login tabcor $conf(log)

    set idcor $tabcor(idcor)

    set nom      [string trim [lindex $ftab(nom) 0]]
    set domaine  [string trim [lindex $ftab(domaine) 0]]
    set nomh     [string trim [lindex $ftab(nomh) 0]]
    set domaineh [string trim [lindex $ftab(domaineh) 0]]

    set toutnom "$nom.$domaine"
    set toutheb "$nomh.$domaineh"

    #
    # Vrifier le droit de dclarer un rle mail
    # et rcuprer les informations sur l'hbergeur ventuel
    #

    set msg [valide-role-mail $dbfd $idcor $nom $domaine trr oldtrrh]
    if {! [string equal $msg ""]} then {
	::webapp::error-exit $conf(err) $msg
    }

    set rrexiste [expr ! [string equal $trr(idrr) ""]]
    set oldnomh $oldtrrh(nom)

    #
    # Valider la syntaxe, l'existence et le droit d'accs au nouvel
    # hbergeur (du moins, si nomh existe, c'est  dire si ce n'est
    # pas une suppression).
    #

    set msg [valide-droit-nom $dbfd $idcor $nomh $domaineh newtrrh "machine"]
    if {! [string equal $msg ""]} then {
	::webapp::error-exit $conf(err) "$msg\nAction refuse."
    }

    #
    # Si nomh existe, l'hbergeur fourni par l'utilisateur doit exister.
    #

    if {! [string equal $nomh ""]} then {
	if {[string equal $newtrrh(idrr) ""]} then {
	    ::webapp::error-exit $conf(err) \
			"Nom d'hbergeur '$toutheb' non valide (n'existe pas)."
	}
    }

    #
    # Insertion des donnes dans la base
    #
    # SELON oldnomh ET nomh
    #   vide     ET vide     => erreur
    #	vide     ET non-vide => cration
    #	non-vide ET vide     => suppression
    #   non-vide ET non-vide => modification
    #

    set videoldnomh [string equal $oldnomh ""]
    set videnewnomh [string equal $nomh ""]

    if {! [::pgsql::lock $dbfd {rr role_mail} msg]} then {
	::webapp::error-exit $conf(err) "Transaction impossible\n$msg"
    }

    set lm ""
    switch "$videoldnomh-$videnewnomh" {
	1-1 {
	    ::webapp::error-exit $conf(err) \
			"Le rle '$toutnom' n'existe pas. Vous ne pouvez pas le supprimer."
	}
	1-0 {
	    #
	    # Cration d'un rle
	    #
	    set action "cre"

	    if {! $rrexiste} then {
		#
		# Le nom de "l'adresse de messagerie" n'existe pas encore.
		# Ajouter le RR correspondant
		#
		set msg [ajouter-rr $dbfd $nom $trr(iddom) "" 0 "" "" "" "" $idcor trr]
		if {! [string equal $msg ""]} then {
		    ::webapp::error-exit $conf(err) \
			    "Insertion de '$toutnom' impossible ($msg)"
		} 
	    }

	    #
	    # Ajouter le rle dans la base
	    #

	    set sql "INSERT INTO role_mail (idrr, heberg)
			    VALUES ($trr(idrr), $newtrrh(idrr))"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "Impossible d'insrer\n$msg"
	    }

	    #
	    # Affecter un droit pour l'hbergement des botes
	    # Ce droit est mis par dfaut pour le groupe du correspondant
	    # faisant cette cration.
	    #

	    set sql "INSERT INTO dr_mbox (idgrp, idmail)
				VALUES ($tabcor(idgrp), $trr(idrr))"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "Impossible d'insrer\n$msg"
	    }

	    set lm "ajout role mail $toutnom -> $toutheb"
	}
	0-1 {
	    #
	    # Suppression d'un rle et des droits associs
	    # On sait que le rle mail prexistait (donc
	    # que trr(idrr) est non vide).
	    #

	    set action "supprime"

	    set idrr $trr(idrr)

	    set sql "DELETE FROM dr_mbox WHERE idmail = $idrr ;
		    DELETE FROM role_mail WHERE idrr = $idrr"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "Impossible de supprimer\n$msg"
	    }

	    #
	    # Suppression du RR lui-mme si possible
	    #
	    set msg [supprimer-rr-si-orphelin $dbfd $idrr]
	    if {! [string equal $msg ""]} then {
		::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "Impossible de supprimer\n$msg"
	    }

	    set lm "suppression du role mail $toutnom"
	}
	0-0 {
	    #
	    # Modification d'un rle. On est sr que le rle mail
	    # prexistait (donc que trr(idrr) est non vide).
	    # On se borne  changer l'hbergeur.
	    #

	    set action "modifie"

	    set idrr $trr(idrr)

	    set sql "UPDATE role_mail
				SET heberg = $newtrrh(idrr)
				WHERE idrr = $idrr"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "Impossible de modifier\n$msg"
	    }
	    set lm "modification du role mail $toutnom -> $toutheb"
	}
    }

    #
    # Les modifications de la base sont termines sans erreur.
    # Procder  la fin de la transaction.
    #

    if {! [::pgsql::unlock $dbfd "commit" msg]} then {
	::pgsql::unlock $dbfd "abort" m
	::webapp::error-exit $conf(err) "L'insertion a chou. Abandon.\n$msg"
    }

    writelog "modifrolemail" $tabcor(login) $lm

    #
    # Sortie du rsultat
    #

    ::webapp::send html [::webapp::file-subst $conf(pageok) \
					[list \
						[list %NOM% $toutnom] \
						[list %ACTION% $action] \
					    ] \
				    ]

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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