#!%TCLSH%

# $Id: mailheberg,v 1.4 2007/11/13 16:44:05 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 mail (page lib/mail.htgt)
#
# Paramtres (formulaire ou URL) :
#   - nom : nom (premier constituant) de l'adresse de
#		messagerie (ou vide si on veut une liste)
#   - domaine : domaine de l'adresse de messagerie (tous les
#		constituants sauf le premier)
#
# Historique
#   2004/02/06 : pda/jean : cration
#

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(pageliste)	$conf(lib)/mailheberg-liste.html
set conf(pageedit)	$conf(lib)/mailheberg-edit.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}
}

#
# Le tableau servant  prsenter la liste des adresses
# de messagerie enregistres dans la base pour dition
# Colonnes :
#	- adresse de messagerie
#	- hbergeur des botes pour cette adresse
#

set conf(tableau) {
    global {
	chars {12 normal}
	columns {50 50}
	botbar {yes}
	align {left}
    }
    pattern {Titre} {
	title {yes}
	topbar {yes}
	chars {bold}
	align {center}
	vbar {yes}
	colonne { }
	vbar {yes}
	colonne { }
	vbar {yes}
    }
    pattern {Normal} {
	title {yes}
	topbar {yes}
	vbar {yes}
	colonne {
	    format {raw}
	}
	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 auxiliaires
##############################################################################

#
# Lit l'ensemble des rles de messagerie associs  un groupe et un
# domaine. Si le nom est fourni, seul le rle associ  l'adresse
# spcifie est retourn.
#
# Entre :
#   - dbfd : accs  la base
#   - idcor : correspondant
#   - nom : nom (premier constituant) de l'adresse de messagerie
#   - domaine : nom de domaine (tous les constituants sauf le premier) de
#	l'adresse de messagerie
# Sortie :
#   - valeur de retour : liste de quadruplets {noma domainea nomh domaineh}
#	o :
#	    - noma : nom de l'adresse de messagerie
#	    - domainea : nom de domaine de l'adresse de messagerie
#	    - nomh : nom de l'hbergeur des botes
#	    - domaineh : nom de domaine de l'hbergeur des botes
#
# Historique
#   2004/02/06 : pda/jean : conception
#   2004/02/27 : pda/jean : utilisation de l'id du correspondant
#   2004/03/01 :     jean : requte de la mort qui tue !
#

proc lire-role-mail {dbfd idcor nom domaine} {
    if {! [string equal $nom ""]} then {
	set nom " AND r1.nom = '$nom' "
    }
    set sql "
	SELECT r1.nom AS noma, d1.nom AS domainea,
		r2.nom AS nomh, d2.nom AS domaineh
	    FROM role_mail, rr r1, domaine d1, rr r2, domaine d2, corresp
	    WHERE corresp.idcor = $idcor
		$nom
		AND role_mail.idrr = r1.idrr
		AND r1.iddom = d1.iddom
		AND d1.nom = '$domaine'
		AND r1.iddom =
			(SELECT dd1.iddom FROM dr_dom dd1
					WHERE dd1.idgrp = corresp.idgrp
					    AND dd1.iddom = r1.iddom
					    AND dd1.rolemail > 0
			    )
		AND role_mail.heberg = r2.idrr
		AND r2.iddom = d2.iddom
		AND r2.iddom =
			(SELECT dd2.iddom FROM dr_dom dd2
					WHERE dd2.idgrp = corresp.idgrp
					    AND dd2.iddom = r2.iddom
			    )
		AND r2.idrr IN
			(SELECT r3.idrr FROM rr_ip r3
					WHERE valide_ip_cor(adr, $idcor)
					    AND r3.idrr = r2.idrr
			    )
		AND r2.idrr NOT IN
			(SELECT r4.idrr FROM rr_ip r4
					WHERE NOT valide_ip_cor(adr, $idcor)
					    AND r4.idrr = r2.idrr
			    )
	    ORDER BY domainea ASC, noma ASC
		"
    set r {}
    pg_select $dbfd $sql tab {
	lappend r [list $tab(noma) $tab(domainea) $tab(nomh) $tab(domaineh)]
    }
    return $r
}

##############################################################################
# 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 toutnom "$nom.$domaine"

    #
    # A-t'on le droit de dclarer des rles mails dans ce domaine ?
    #

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

    #
    # Doit-on gnrer une liste de domaines de messagerie, ou bien
    # l'utilisateur en a-t'il saisi un ?
    #

    set lsubst {}
    if {[string equal $nom ""]} then {
	#
	# Pas de nom saisi : il faut gnrer une liste des
	# rles mails enregistrs dans la base pour les
	# adresses dont le correspondant est propritaire.
	# C'est le cas par dfaut si on utilise le bouton
	# de consultation.
	#

	set page $conf(pageliste)
	set lroles [lire-role-mail $dbfd $idcor "" $domaine]

	if {[llength $lroles] == 0} then {
	    set tableau "Aucun rle de messagerie n'a t trouve pour '$domaine'"
	} else {
	    set baseurl "$conf(homeurl)/bin/mailheberg"
	    set donnees {}
	    lappend donnees [list Titre \
				"Adresse de messagerie" "Hbergeur des botes"]
	    foreach q [lire-role-mail $dbfd $idcor "" $domaine] {
		# lien de la forme "..../mailheberg?nom=...&domaine=.."
		set noma [lindex $q 0] ; set domainea [lindex $q 1]
		set nomh [lindex $q 2] ; set domaineh [lindex $q 3]

		# normalement, il n'y a que des caractres "compatibles RFC"...
		set url "$baseurl?nom=$noma&domaine=$domainea"

		lappend donnees [list Normal \
				    "<A HREF=\"$url\">$noma.$domainea</A>" \
				    "$nomh.$domaineh" \
				    ]
		set tableau [::arrgen::output "html" $conf(tableau) $donnees]
	    }
	}

	lappend lsubst [list %TABLEAU% $tableau]
	lappend lsubst [list %DOMAINE% $domaine]

    } else {

	#
	# Un nom a t fourni. Il faut prsenter la page d'dition
	# de rle de messagerie pour ce nom.
	#
	set page $conf(pageedit)
	set nomh ""
	set domh ""

	#
	# Valider la syntaxe de l'adresse de messagerie
	#

	set msg [syntaxe-nom $nom]
	if {! [string equal $msg ""]} then {
	    ::webapp::error-exit $conf(err) $msg
	}

	#
	# Valider le droit d'diter cette adresse de messagerie
	#

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

	set nomh $trrh(nom)
	set domh $trrh(domaine)
	set domaineh [menu-domaine $dbfd $idcor domaineh "" $domh $conf(err)]

	lappend lsubst [list %NOM%      $nom]
	lappend lsubst [list %DOMAINE%  $domaine]
	lappend lsubst [list %NOMH%	$nomh]
	lappend lsubst [list %DOMAINEH% $domaineh]
    }

    #
    # Sortie du rsultat
    #

    ::webapp::send html [::webapp::file-subst $page $lsubst]

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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