#!%TCLSH%


#
# Script pour modifier les attributs d'un RR dans la base
#
# Syntaxe :
#   dnsmodattr <fqdn> <clef> <val> [<clef> <val> ...]
#
# Exemples :
#   dnsmodattr crc.u-strasbg.fr MAC 00:68:fe....
#   dnsmodattr crc.u-strasbg.fr HINFO "PC/Unix"
#   dnsmodattr crc.u-strasbg.fr TTL 3600      # 1 heure
#   dnsmodattr crc.u-strasbg.fr TTL ""        # remettre valeur par dfaut
#
# Les attributs modifiables sont :
#   MAC, HINFO, RESPNOM, RESPMEL, COMMENTAIRE, DHCPPROFIL, TTL
#
# Historique
#   2004/09/29 : pda/jean : spcification
#   2004/10/01 : pda/jean : codage
#   2005/04/08 : pda/jean : ajout du profil DHCP
#   2007/10/25 : jean     : log des actions de modification
#   2008/12/09 : jean     : modification du TTL
#

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%

set conf(attrs)		{mac hinfo respnom respmel commentaire dhcpprofil ttl droitsmtp}

#
# 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} {
    global conf

    regsub {.*/} $argv0 {} argv0
    puts stderr "usage: $argv0 fqdn clef val \[clef val ...\]"
    set attrs [string toupper [join $conf(attrs) ", "]]
    puts stderr "\tclef = $attrs"
    exit 1
}

#
# Valide l'attribut MAC
#
# Entre :
#   - dbfd : accs  la base
#   - mac : l'adresse MAC  tester
#   - tabrr : cf lire-rr-par-id
# Sortie :
#   - valeur de retour : message d'erreur, ou chane vide si ok.
#
# Historique
#   2004/10/01 : pda/jean : conception
#


proc valide-attr-mac {dbfd mac tabrr} {
    upvar $tabrr trr

    #
    # Cas spcial pour supprimer une adresse MAC
    #

    if {[string equal $mac ""]} then {
	return ""
    }

    set msg [syntaxe-mac $dbfd $mac]
    if {! [string equal $msg ""]} then {
	return "Erreur sur l'adresse MAC : $msg"
    }

    set msg [valide-dhcp-statique $dbfd $mac $trr(ip)]
    if {! [string equal $msg ""]} then {
	return  "$msg"
    }

    return ""
}

##############################################################################
# Mise  jour des attributs d'un RR
##############################################################################

#
# Mise  jour des attributs d'un RR dans la base
#
# Entre :
#   - dbfd : accs  la base
#   - idcor : id du correspondant faisant la modification
#   - tabrr : rr  modifier (cf lire-rr-par-id)
#   - tabattr : tableau contenant les attributs  modifier et leur valeur
# Sortie :
#   - valeur de retour : message d'erreur, ou chane vide si ok.
#
# Historique
#   2004/10/01 : pda/jean : conception
#

proc update-rr {dbfd login idcor tabrr tabattr} {
    upvar $tabrr trr
    upvar $tabattr tattr

    #
    # Valider les attributs qui le ncessitent
    #

    if {[info exists tattr(droitsmtp)]} then {
	set droitsmtp $tattr(droitsmtp)
	if {![string equal $droitsmtp ""] && (![regexp {^[0-1]$} $droitsmtp])} {
	    set msg "Droit SMTP invalide : valeurs possibles : 0 ou 1 "
	    return $msg
	}
    }


    # Valeur maximale pour le TTL = 2^31 - 1
    # Cf. RFC 3181
    # Pour supprimer le TTL, passer une chaine vide
    #
    if {[info exists tattr(ttl)]} then {
	if {[string equal $tattr(ttl) ""]} then {
	    set tattr(ttl) -1
	}  else {
	    set msg [valide-ttl $tattr(ttl)]
	    if {! [string equal $msg ""]} then {
		return $msg
	    }
	}
    }

    if {[info exists tattr(mac)]} then {
	set msg [valide-attr-mac $dbfd $tattr(mac) trr]
	if {! [string equal $msg ""]} then {
	    return $msg
	}
    }

    if {[info exists tattr(hinfo)]} then {
	set idhinfo [lire-hinfo $dbfd $tattr(hinfo)]
	if {$idhinfo == -1} then {
	    return "Hinfo '$tattr(hinfo)' invalide"
	}
	set tattr(hinfo) $idhinfo
    }

    if {[info exists tattr(dhcpprofil)]} then {
	set iddhcpprofil [lire-dhcpprofil $dbfd $tattr(dhcpprofil)]
	if {$iddhcpprofil == -1} then {
	    return "DHCPProfil '$tattr(dhcpprofil)' invalide"
	}
	set tattr(dhcpprofil) $iddhcpprofil
    }

    #
    # Construire et excuter la requte SQL
    #

    set modif {}
    foreach c [array names tattr] {
	set v $tattr($c)
	switch $c {
	    hinfo -
	    droitsmtp {
		# valeur numrique
		lappend modif "$c = $v"
	    }
	    dhcpprofil {
		# valeur numrique ou vide
		if {[string equal $v ""] || $v == 0} then {
		    lappend modif "$c = NULL"
		} else {
		    lappend modif "$c = $v"
		}
	    }
	    ttl {
		# valeur numrique ou vide
		if {[string equal $v ""]} then {
		    lappend modif "$c = -1"
		} else {
		    lappend modif "$c = $v"
		}
	    }
	    default {
		# chane
		if {[string equal $v ""]} then {
		    lappend modif "$c = NULL"
		} else {
		    lappend modif "$c = '[::pgsql::quote $v]'"
		}
	    }
	}
    }

    set modif [join $modif ", "]
    set sql "UPDATE rr SET $modif WHERE idrr = $trr(idrr)"

    if {! [::pgsql::execsql $dbfd $sql msg]} then {
	return "Impossible de modifier : $msg"
    }

    #
    # Mettre  jour la modification du RR
    #

    set msg [touch-rr $dbfd $trr(idrr) $idcor]
    if {! [string equal $msg ""]} then {
	return $msg
    }

    #
    # crire le log
    #

    set m "modification de $trr(nom).$trr(domaine) :"
    foreach c [array names tattr] {
	append m " $c=$tattr($c)"
    }
    writelog "modifrr" $login "$m (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
    #

    set nargs [llength $argv]
    if {[expr $nargs % 2] != 1 || $nargs < 3} then {
	syntax-error $argv0
	return 1
    }

    #
    # Dbut de la modification
    #

    if {! [::pgsql::lock $dbfd {rr rr_ip} msg]} then {
	puts stderr "Transaction impossible : $msg"
	return 1
    }

    #
    # Valider le domaine, le nom (qui ne doit pas tre un alias, un MX, etc)
    #

    set fqdn [string tolower [lindex $argv 0]]
    set msg [syntaxe-fqdn $dbfd $fqdn nom domaine iddom]
    if {! [string equal $msg ""]} then {
	puts stderr $msg
	return 1
    }
    set msg [valide-droit-nom $dbfd $tabcor(idcor) \
			$nom $domaine trr "machine-existante"
]
    if {[string length $msg] > 0} then {
        puts stderr "Modification d'attribut impossible : $msg"
	return 1
    }

    #
    # Positionner un tableau indic par les clefs
    # trouves sur la ligne de commande.
    #
    for {set i 1} {$i < $nargs} {incr i 2} {
	set clef [string tolower [lindex $argv $i]]
	if {[lsearch -exact $conf(attrs) $clef] == -1} then {
	    puts stderr "Clef '$clef' invalide"
	    syntax-error $argv0
	}
	if {[info exists tabattr($clef)]} then {
	    puts stderr "Clef '$clef' dj fournie"
	    syntax-error $argv0
	}
	set tabattr($clef) [lindex $argv [expr $i + 1]]
    }

    #
    # Lancer la modification
    #

    set msg [update-rr $dbfd $tabcor(login) $tabcor(idcor) trr tabattr]
    if {! [string equal $msg ""]} then {
       ::pgsql::unlock $dbfd "abort" m
	puts stderr $msg
	puts stderr "Aborted."
	return 1
    }

    #
    # Fin de la transaction : commit + dconnexion
    #

    if {! [::pgsql::unlock $dbfd "commit" msg]} then {
       ::pgsql::unlock $dbfd "abort" m
       return "La modification a chou ($msg)"
    }
    fermer-base $dbfd

    return 0
}

exit [main $argv0 $argv]
