#!%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
#	- nextprog, nextargs : suite du parcours (en cas d'dition depuis
#		la carte ou depuis la recherche de plage conscutive)
#   - suppression d'une adresse IP
#	- action : "suppr-ip"
#	- confirm : "non" ou "oui" (si confirmation ok)
#	- adr : adresse IP
#	- nextprog, nextargs : suite du parcours (en cas d'dition depuis
#		la carte ou depuis la recherche de plage conscutive)
#
# 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
#   2004/08/05 : pda/jean : ajout MAC
#   2005/04/08 : pda/jean : ajout dhcpprofil
#   2007/10/25 : jean     : log des actions de modification
#   2008/07/24 : pda/jean : ajout droitsmtp
#   2008/07/29 : pda      : utilisation presenter-rr
#   2010/10/15 : pda      : ajout parcours
#

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%
set conf(log)		%LOG%

# scripts cgi
set conf(script-map)	bin/liste
set conf(script-liste)	bin/liste
set conf(script-suppr)	bin/suppr

# 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}
	{nextprog	0 1}
	{nextargs	0 1}
}

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

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

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

# Historique
#   2002/04/19 : pda/jean : conception
#
proc traitesuppr-nom {dbfd idcor login 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]]
    set nextprog      [string trim [lindex $ftab(nextprog) 0]]
    set nextargs      [string trim [lindex $ftab(nextargs) 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 {
	    #
	    # Sortir 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)] \
					[list %NEXTPROG% $nextprog] \
					[list %NEXTARGS% $nextargs] \
				    ] \
			    ]
	} else {
	    #
	    # Sortir la page de confirmation pour une machine
	    #
	    set machine [presenter-rr $dbfd -1 trr]
	    ::webapp::send html \
		    [::webapp::file-subst $conf(page-suppr-nom) \
				[list \
					[list %NOM% $nom] \
					[list %DOMAINE% $domaine] \
					[list %MACHINE% $machine] \
					[list %NEXTPROG% $nextprog] \
					[list %NEXTARGS% $nextargs] \
				    ] \
			    ]
	}
    } 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"
	    }

	    set p "$trrref(nom).$trrref(domaine)"
	    set logevt "suppralias"
	    set logmsg "suppression de l'alias $nom.$domaine -> $p"
	} 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"
	    }
	    set logevt "supprnom"
	    set logmsg "suppression totale de $nom.$domaine"
	}

	#
	# 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"
	}

	writelog $logevt $login $logmsg

	#
	# Prparer la suite du parcours
	#

	switch -- $nextprog {
	    map {
		set suite "$conf(homeurl)/$conf(script-map)?format=carte&$nextargs"
	    }
	    list {
		set suite "$conf(homeurl)/$conf(script-liste)?format=consulter&$nextargs"
	    }
	    default {
		set suite "$conf(homeurl)/$conf(script-suppr)"
	    }
	}

	#
	# 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] \
						[list %SUITE% $suite] \
					    ] \
				    ]
    }
}

##############################################################################
# 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 login 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]]
    set nextprog      [string trim [lindex $ftab(nextprog) 0]]
    set nextargs      [string trim [lindex $ftab(nextargs) 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 machine [presenter-rr $dbfd -1 trr]

    #
    # 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::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "La suppression a chou.\n$msg"
	    }

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

	    set msg [touch-rr $dbfd $trr(idrr) $idcor]
	    if {! [string equal $msg ""]} then {
	       ::pgsql::unlock $dbfd "abort" m
		::webapp::error-exit $conf(err) "Mise  jour impossible.\n$msg"
	    }

	    set logevt "suppradr"
	    set logmsg "suppression de l'adresse $adr de $nom.$domaine"

	} 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"
	    }

	    set logevt "suppradr"
	    set logmsg "suppression de l'adresse $adr -> suppression totale de $nom.$domaine"
	}

	#
	# 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"
	}
    
	writelog $logevt $login $logmsg

    }

    #
    # Prparer la suite du parcours
    #

    switch -- $nextprog {
	map {
	    set suite "$conf(homeurl)/$conf(script-map)?format=carte&$nextargs"
	}
	list {
	    set suite "$conf(homeurl)/$conf(script-liste)?format=consulter&$nextargs"
	}
	default {
	    set suite "$conf(homeurl)/$conf(script-suppr)"
	}
    }

    #
    # 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 %MACHINE%     $machine] \
				[list %OBJET%       $objet] \
				[list %NEXTPROG%    $nextprog] \
				[list %NEXTARGS%    $nextargs] \
				[list %SUITE%       $suite] \
			    ] \
		    ]
}

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

    #
    # 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) $tabcor(login) ftab

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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