#!%TCLSH%


#
# Script pour supprimer une adresse IP (voire une machine) dans la base
#
# Syntaxe :
#   dnsdelip <ip>
#
# Historique
#   2004/10/01 : pda/jean : conception
#   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

#
# Quelques paramtres du script
#

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

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

##############################################################################
# Petites fonctions utilitaires
##############################################################################

proc syntax-error {argv0} {
    regsub {.*/} $argv0 {} argv0
    puts stderr "usage: $argv0 ip"
    exit 1
}

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

#
# Suppression d'une adresse dans la base
#
# Entre :
#   - dbfd : accs  la base
#   - idcor : id du correspondant faisant la suppression
#   - adr : adresse IP  supprimer
# Sortie :
#   - valeur de retour : message d'erreur, ou chane vide si ok.
#
# Historique
#   2004/10/01 : pda/jean : conception
#

proc del-ip {dbfd login idcor adr} {
    #
    # Vrifier la syntaxe de l'adresse IP
    #

    set m [syntaxe-ip $dbfd $adr "inet"]
    if {[string length $m] > 0} then {
	return "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 {
	return "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 {
	return "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 {
	return $msg
    }

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

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

    #
    # Verrouiller la base
    #

    if {! [::pgsql::lock $dbfd {} msg]} then {
	return "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
	    return "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::unkock $dbfd "abort" m
	    return "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
	    return "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
       return "La suppression a chou. Abandon.\n$msg"
    }

    #
    # crire le log
    #

    writelog $logevt $login "$logmsg (ligne de commande)"

    return ""
}


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

proc main {argv0 argv} {
    global conf

    #
    # Initialisation des accs
    #

    set errmsg [init-dns-util $conf(nologin) $conf(auth) $conf(base) \
				    dbfd $conf(defuser) tabcor $conf(log)]
    if {! [string equal $errmsg ""]} then {
	puts stderr "$errmsg"
	puts stderr "Aborted."
	return 1
    }

    #
    # Validation des arguments
    #

    if {[llength $argv] != 1} then {
	syntax-error $argv0
	return 1
    }

    set adr [lindex $argv 0]

    set msg [del-ip $dbfd $tabcor(login) $tabcor(idcor) $adr]
    if {! [string equal $msg ""]} then {
	puts stderr $msg
	puts stderr "Aborted."
	return 1
    }

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd

    return 0
}

exit [main $argv0 $argv]
