#!%TCLSH%

#
# Script pour enregistrer les suppressions demandes par un correspondant.
#
# Appel par : script suppr (page lib/suppr.htgt)
#
# Paramtres (formulaire ou URL) :
#   - suppression d'un nom
#	- action : "suppr-nom"
#	- confirm : "non" ou "oui" (si confirmation ok)
#	- nom : nom de l'objet  supprimer
#	- domaine : domaine dans lequel l'objet existait
#   - suppression d'une adresse IP
#	- action : "suppr-ip"
#	- confirm : "non" ou "oui" (si confirmation ok)
#	- adr : adresse IP
#
# Historique
#   2002/04/11 : pda/jean : cration
#   2002/04/19 : pda/jean : ajout de la multi-adresses
#   2002/05/03 : pda/jean : sparation des trois types de modifications
#   2002/07/09 : pda      : ajout de nologin
#   2003/05/13 : pda/jean : utilisation de la base d'authentification
#   2004/01/14 : pda/jean : ajout IPv6
#

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(page-suppr-nom)	$conf(lib)/traitesuppr-nom.html
set conf(page-suppr-alias)	$conf(lib)/traitesuppr-alias.html
set conf(page-suppr-ip-uneip)	$conf(lib)/traitesuppr-ip-uneip.html
set conf(page-suppr-ip-objet)	$conf(lib)/traitesuppr-ip-objet.html
set conf(page-suppr-ok)		$conf(lib)/traitesuppr-ok.html
set conf(err)			$conf(lib)/erreur.html

#
# Quelques paramtres du script
#

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

# le champ discriminant pour la suite
set conf(form)		{
	{action		1 1}
}

# les champs utiliss pour chacune des actions
set conf(form-suppr-nom)	{
	{confirm	1 1}
	{nom		1 1}
	{domaine	1 1}
}

set conf(form-suppr-ip)	{
	{confirm	1 1}
	{adr		1 1}
}

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

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

#
# On y va !
#

# ::webapp::cgidebug ; exit

source $conf(libdns)

##############################################################################
# Suppression d'un nom
##############################################################################

# Historique
#   2002/04/19 : pda/jean : conception
#
proc traitesuppr-nom {dbfd idcor ft} {
    global conf
    upvar $ft ftab

    #
    # Valider les champs du formulaire
    #

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

    #
    # Valider le nom fourni
    #

    set msg [valide-droit-nom $dbfd $idcor $nom $domaine trr "supprimer-un-nom"]
    if {[string length $msg] > 0} then {
	::webapp::error-exit $conf(err) $msg
    }

    #
    # Vrifier que le nom demand existe
    #

    if {[string equal $trr(idrr) ""]} then {
	::webapp::error-exit $conf(err) "Le nom '$nom.$domaine' n'existe pas."
    }

    #
    # Noter si c'est un alias
    #

    if {[string equal $trr(cname) ""]} then {
	set alias 0

	#
	# Si ce n'est pas un alias, il doit y avoir au moins une adresse IP
	#
	if {[string equal $trr(ip) ""]} then {
	    ::webapp::error-exit $conf(err) "Le nom '$nom.$domaine' n'est pas une machine."
	}

    } else {
	set alias 1

	#
	# C'est un alias. Lisons les informations pour afficher
	# une page ventuelle de confirmation
	#
	if {! [lire-rr-par-id $dbfd $trr(cname) trrref]} then {
	    ::webapp::error-exit $conf(err) "Erreur interne. Alias non trouv"
	}
    }

    #
    # Demander confirmation  l'utilisateur si ce n'est pas encore
    # fait
    #

    if {! [string equal $confirm "oui"]} then {
	#
	# Envoyer la page de confirmation
	#

	if {$alias} then {
	    #
	    # Sortie de la page de confirmation pour un alias
	    #
	    ::webapp::send html \
		    [::webapp::file-subst \
				$conf(page-suppr-alias) \
				[list \
					[list %NOM% $nom] \
					[list %DOMAINE% $domaine] \
					[list %NOMREF% $trrref(nom)] \
					[list %DOMAINEREF% $trrref(domaine)] \
				    ] \
			    ]
	} else {
	    #
	    # Sortie de la page de confirmation pour une machine
	    # (y compris toutes ses dpendances)
	    #
	    set commentaire [html-tab-string $trr(commentaire)]
	    set respnom     [html-tab-string $trr(respnom)]
	    set respmel     [html-tab-string $trr(respmel)]

	    set hinfo $trr(hinfo)
	    set listeadr [join $trr(ip) " "]
	    set laliases {}
	    foreach a $trr(aliases) {
		lire-rr-par-id $dbfd $a t
		lappend laliases "$t(nom).$t(domaine)"
	    }
	    set aliases [join $laliases " "]
	    if {[string length $aliases] == 0} then {
		set aliases "&nbsp;"
	    }
	    ::webapp::send html \
		    [::webapp::file-subst \
				$conf(page-suppr-nom) \
				[list \
					[list %NOM% $nom] \
					[list %DOMAINE% $domaine] \
					[list %LISTEADR% $listeadr] \
					[list %HINFO% $hinfo] \
					[list %COMMENTAIRE% $commentaire] \
					[list %RESPNOM% $respnom] \
					[list %RESPMEL% $respmel] \
					[list %ALIASES% $aliases] \
				    ] \
			    ]
	}
    } else {
	#
	# La confirmation est acquise. Effectuer la suppression dans
	# la base.
	#
	if {! [::pgsql::lock $dbfd {} msg]} then {
	    ::webapp::error-exit $conf(err) "Transaction impossible : $msg"
	}

	if {$alias} then {
	    if {! [supprimer-alias-par-id $dbfd $trr(idrr) msg]} then {
		::pgsql::unlock $dbfd "abort" m
		 ::webapp::error-exit $conf(err) "La suppression a chou.\n$msg"
	    }
	} else {
	    #
	    # Ce n'est pas un alias. Supprimer toutes les dpendances
	    # du RR
	    # - les aliases pointant vers cet objet
	    # - les MX
	    # - les adresses IP
	    #
	    if {! [supprimer-rr-et-dependances $dbfd trr msg]} then {
		::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "La suppression a chou.\n$msg"
	    }
	}

	#
	# Enregistrer les modifications dans la base
	#
	if {! [::pgsql::unlock $dbfd "commit" msg]} then {
	   ::pgsql::unlock $dbfd "abort" m
	   ::webapp::error-exit $conf(err) "La suppression a chou. Abandon.\n$msg"
	}

	#
	# Sortie du rsultat pour dire que la suppression a t effectue
	# correctement.
	#
	set objet "$nom.$domaine"
	::webapp::send html [::webapp::file-subst $conf(page-suppr-ok) \
					[list \
						[list %OBJET% $objet] \
					    ] \
				    ]
    }
}

##############################################################################
# Suppression d'une adresse IP
##############################################################################

# Historique
#   2002/04/23 : pda/jean : conception
#   2002/04/26 : pda/jean : fin de la conception
#   2002/05/03 : pda/jean : mmoriser la mise  jour par le correspondant
#
proc traitesuppr-ip {dbfd idcor ft} {
    global conf
    upvar $ft ftab

    #
    # Valider les champs du formulaire
    #

    set confirm       [string trim [lindex $ftab(confirm) 0]]
    set adr           [string trim [lindex $ftab(adr) 0]]

    #
    # Vrifier la syntaxe de l'adresse IP
    #

    set m [syntaxe-ip $dbfd $adr "inet"]
    if {[string length $m] > 0} then {
	::webapp::error-exit $conf(err) "Erreur sur l'adresse '$adr': $m"
    }

    #
    # Vrifier que l'adresse IP appartient bien  une des plages
    # autorises pour le correspondant
    #

    if {! [droit-correspondant-ip $dbfd $idcor $adr]} then {
	::webapp::error-exit $conf(err) "Vous n'avez pas accs  l'adresse '$adr'"
    }

    #
    # Vrifier que l'adresse existe, en rcuprant toutes les
    # informations de l'objet.
    #

    if {! [lire-rr-par-ip $dbfd $adr trr]} then {
	::webapp::error-exit $conf(err) "L'adresse '$adr' n'existe pas dans la base."
    }

    #
    # Valider l'accs  ce nom
    #
    set nom     $trr(nom)
    set domaine $trr(domaine)
    set msg [valide-droit-nom $dbfd $idcor $nom $domaine bidon "supprimer-un-nom"]
    if {! [string equal $msg ""]} then {
	::webapp::error-exit $conf(err) $msg
    }

    #
    # Est-ce la dernire adresse IP ou non ?
    #

    if {[llength $trr(ip)] == 1} then {
	set lastadr "oui"
    } else {
	set lastadr "non"
    }

    #
    # Prparer l'affichage des informations  afficher le cas chant
    #

    set objet ""
    set hinfo	    $trr(hinfo)
    set commentaire [html-tab-string $trr(commentaire)]
    set respnom     [html-tab-string $trr(respnom)]
    set respmel     [html-tab-string $trr(respmel)]
    set listeadr [join $trr(ip) " "]
    set laliases {}
    foreach a $trr(aliases) {
	lire-rr-par-id $dbfd $a t
	lappend laliases "$t(nom).$t(domaine)"
    }
    set aliases [join $laliases " "]
    if {[string length $aliases] == 0} then {
	set aliases "&nbsp;"
    }

    #
    # Effectuer l'action de suppression seulement si confirmation
    #

    if {[string equal $confirm "oui"]} then {
	#
	# Verrouiller la base
	#

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

	#
	# Procder  la destruction effective
	#

	if {[string equal $lastadr "non"]} then {
	    #
	    # Suppression d'une adresse seulement
	    #

	    set sql "DELETE FROM rr_ip WHERE adr = '$adr'"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	       ::pgsql::unkock $dbfd "abort" m
		::webapp::error-exit $conf(err) "La suppression a chou.\n$msg"
	    }

	    #
	    # Se rappeler que le correspondant a fait la modification
	    #

	    set date [clock seconds]
	    set sql "UPDATE rr SET date = $date, idcor = $idcor \
			WHERE idrr = $trr(idrr)"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	       ::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "Mise  jour impossible.\n$msg"
	    }

	} else {
	    #
	    # Suppression de l'objet entier
	    #

	    if {! [supprimer-rr-et-dependances $dbfd trr msg]} then {
		::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "La suppression a chou.\n$msg"
	    }
	}

	#
	# Enregistrer les modifications dans la base et la dverrouiller.
	#
	if {! [::pgsql::unlock $dbfd "commit" msg]} then {
	   ::pgsql::unlock $dbfd "abort" m
	   ::webapp::error-exit $conf(err) "La suppression a chou. Abandon.\n$msg"
	}

    }

    #
    # Prparer l'affichage de la page
    #

    switch -- "confirm=$confirm-lastadr=$lastadr" {
	confirm=non-lastadr=non {
	    #
	    # Demander confirmation pour la suppression d'une des adresses
	    # 
	    set page $conf(page-suppr-ip-uneip)
	}
	confirm=non-lastadr=oui {
	    #
	    # Demander confirmation pour la suppression de la dernire
	    # adresse et donc de l'objet entier.
	    # 
	    set page $conf(page-suppr-ip-objet)
	}
	confirm=oui-lastadr=non {
	    #
	    # L'adresse a t supprime
	    #

	    set page $conf(page-suppr-ok)
	    set objet $adr
	}
	confirm=oui-lastadr=oui {
	    #
	    # L'objet entier a t supprim
	    #

	    set page $conf(page-suppr-ok)
	    set objet "$nom.$domaine"
	}
	default {
	    ::webapp::error-exit $conf(err) "Cas impossible : confirm=$confirm, lastadr=$lastadr"
	}
    }

    ::webapp::send html \
	    [::webapp::file-subst \
			$page \
			[list \
				[list %NOM%         $nom] \
				[list %DOMAINE%     $domaine] \
				[list %ADR%         $adr] \
				[list %LISTEADR%    $listeadr] \
				[list %HINFO%       $hinfo] \
				[list %COMMENTAIRE% $commentaire] \
				[list %RESPNOM%     $respnom] \
				[list %RESPMEL%     $respmel] \
				[list %ALIASES%     $aliases] \
				[list %OBJET%       $objet] \
			    ] \
		    ]
}

##############################################################################
# Programme principal
##############################################################################

proc main {} {
    global conf

    #
    # Initialisation
    #

    init-dns $conf(nologin) $conf(auth) $conf(base) $conf(err) "" \
			$conf(form) ftab dbfd login tabcor

    #
    # Valider l'action, lire les autres champs du formulaire,
    # et faire le branchement
    #

    set action [lindex $ftab(action) 0]

    if {! [info exists conf(form-$action)]} then {
	::webapp::error-exit $conf(err) "Champ 'action' non conforme : $action"
    }

    if {[llength [::webapp::get-data ftab $conf(form-$action)]] == 0} then {
	::webapp::error-exit $conf(err) "Formulaire non conforme aux spcifications"
    }

    traite$action $dbfd $tabcor(idcor) ftab

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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