#!%TCLSH%

# $Id: traitemodif,v 1.7 2008/02/13 16:46:01 pda Exp $

#
# Script pour enregistrer les modifications demandes par un correspondant.
#
# Appel par : script editmodif (page lib/editmodif-infos.htgt)
#
# Paramtres (formulaire ou URL) :
#   - modifications des informations d'une machine
#	- action : "modif-infos"
#	- nom : nom de la machine  ajouter
#	- domaine : domaine dans lequel elle doit tre ajoute
#	- mac : adresse mac
#	- iddhcpprofil : l'id du profil DHCP, ou 0
#	- hinfo : type de machine (id)
#	- commentaire : informations complmentaires
#	- respnom : nom+prnom du responsable
#	- respmel : ml du responsable
#
# Historique
#   2002/05/03 : pda/jean : cration
#   2002/05/23 : pda/jean : ajout du responsable
#   2002/07/09 : pda      : ajout de nologin
#   2002/07/09 : pda      : conversion des noms en minuscules
#   2003/05/13 : pda/jean : utilisation de la base d'authentification
#   2004/08/05 : pda/jean : ajout mac
#   2005/04/08 : pda/jean : ajout dhcppprofil
#   2007/10/25 : jean     : log des actions de modification
#   2008/02/13 : pda/jean : le responsable est le correspondant si pas prcis
#

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-modif-infos)	$conf(lib)/traitemodif-infos.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%

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

# les champs utiliss pour chacune des actions
set conf(form-modif-infos)	{
	{nom		1 1}
	{domaine	1 1}
	{mac		1 1}
	{iddhcpprofil	1 1}
	{hinfo		1 1}
	{commentaire	1 1}
	{respnom	1 1}
	{respmel	1 1}
}

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

##############################################################################
# Modification des informations
##############################################################################

# Historique
#   2002/05/03 : pda/jean : conception
#
proc traitemodif-infos {dbfd tc ft} {
    global conf
    upvar $ft ftab
    upvar $tc tabcor

    set login $tabcor(login)
    set idcor $tabcor(idcor)

    #
    # Valider les champs du formulaire
    #

    set nom           [string trim [lindex $ftab(nom) 0]]
    set domaine       [string trim [lindex $ftab(domaine) 0]]
    set mac           [string trim [lindex $ftab(mac) 0]]
    set iddhcpprofil  [string trim [lindex $ftab(iddhcpprofil) 0]]
    set hinfo         [string trim [lindex $ftab(hinfo) 0]]
    set commentaire   [string trim [lindex $ftab(commentaire) 0]]
    set respnom       [string trim [lindex $ftab(respnom) 0]]
    set respmel       [string trim [lindex $ftab(respmel) 0]]

    #
    # Vrifier la syntaxe de l'adresse MAC
    #

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

    #
    # Vrifier le profil DHCP
    #

    if {! [check-iddhcpprofil $dbfd $iddhcpprofil dhcpprofil msg]} then {
	::webapp::error-exit $conf(err) "Profil DHCP invalide ($msg)"
    }

    #
    # Rcuprer le type de machine en clair
    #

    set idhinfo [lire-hinfo $dbfd $hinfo]
    if {$idhinfo == -1} then {
	::webapp::error-exit $conf(err) "Le type de machine '$hinfo' n'existe pas."
    }

    #
    # Valider la syntaxe du nom au sens de la RFC ????
    #

    set m [syntaxe-nom $nom]
    if {[string length $m] > 0} then {
	::webapp::error-exit $conf(err) "Erreur sur le nom '$nom': $m"
    }
    set nom [string tolower $nom]

    #
    # Tester si le nom n'est pas un alias, et que le correspondant
    # est bien propritaire de toutes les adresses associes au nom.
    #

    set m [valide-droit-nom $dbfd $idcor $nom $domaine trr "machine-existante"]
    if {! [string equal $m ""]} then {
	::webapp::error-exit $conf(err) "$m.\nModification refuse"
    }

    #
    # Tester si la machine existe
    #

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

    #
    # Tester si la machine doit tre ajoute statiquement comme adresse DHCP
    #

    set m [valide-dhcp-statique $dbfd $mac $trr(ip)]
    if {! [string equal $m  ""]} then {
	::webapp::error-exit $conf(err) "$m.\nModification refuse"
    }

    #
    # Si le responsable n'est pas spcifi, mettre par dfaut le
    # correspondant Tant pis pour lui.
    #

    if {[string equal $respnom ""] && [string equal $respmel ""]} then {
	set respnom "$tabcor(nom) $tabcor(prenom)"
	set respmel $tabcor(mel)
    }

    #
    # Enregistrer les modifications
    #

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

    if {[string equal $mac ""]} then {
	set qmac NULL
    } else {
	set qmac "'[::pgsql::quote $mac]'"
    }
    if {$iddhcpprofil == 0} then {
	set qiddhcpprofil NULL
    } else {
	set qiddhcpprofil $iddhcpprofil
    }

    set qcommentaire [::pgsql::quote $commentaire]
    set qrespnom     [::pgsql::quote $respnom]
    set qrespmel     [::pgsql::quote $respmel]
    set sql "UPDATE rr SET
			    mac = $qmac,
			    iddhcpprofil = $qiddhcpprofil,
			    idhinfo = $idhinfo,
			    commentaire = '$qcommentaire',
			    respnom = '$qrespnom',
			    respmel = '$qrespmel'
			WHERE idrr = $trr(idrr)"
    if {! [::pgsql::execsql $dbfd $sql msg]} then {
       ::pgsql::unlock $dbfd "abort" m
	::webapp::error-exit $conf(err) "Impossible de mettre  jour : $msg"
    }

    set msg [touch-rr $dbfd $trr(idrr) $idcor]
    if {[string length $msg] > 0} then {
       ::pgsql::unlock $dbfd "abort" m
	::webapp::error-exit $conf(err) $msg
    }

    if {! [::pgsql::unlock $dbfd "commit" msg]} then {
       ::pgsql::unlock $dbfd "abort" m
       ::webapp::error-exit $conf(err) "L'insertion a chou. Abandon.\n$msg"
    }

    #
    # Sortie du rsultat
    #

    set commentaire [html-tab-string $commentaire]
    set respnom     [html-tab-string $respnom]
    set respmel     [html-tab-string $respmel]

    set m "modification de $nom.$domaine :"
    foreach c {mac dhcpprofil hinfo commentaire respnom respmel} {
	append m " $c=[set $c]"
    }
    writelog "modifrr" $login $m

    ::webapp::send html [::webapp::file-subst $conf(page-modif-infos) \
				[list \
					[list %NOM% $nom] \
					[list %DOMAINE% $domaine] \
					[list %MAC% $mac] \
					[list %DHCPPROFIL% $dhcpprofil] \
					[list %HINFO% $hinfo] \
					[list %COMMENTAIRE% $commentaire] \
					[list %RESPNOM% $respnom] \
					[list %RESPMEL% $respmel] \
				    ] \
			    ]

}

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

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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