#!%TCLSH%

#
# Script pour faire la gestion des utilisateurs
#
# Appel par : script accueil, et ce script lui-mme sous diverses
#	facettes
#
# Paramtres (formulaire ou URL) :
#   - si appel par script accueil : aucun
#   - si appel par script
#
# Historique
#   2003/07/29 : pda     : cration
#

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(auth)		%AUTH%
set conf(base)		%BASE%
set conf(nologin)	%NOLOGIN%

#
# Dfinition des noms des pages " trous" et de l'environnement
# d'excution en gnral
#

set e(page-menu)	$conf(lib)/admutimenu.html
set e(page-ok)		$conf(lib)/admutiok.html
set e(page-erreur)	$conf(lib)/erreur.html
set e(page-ajoutinit)	$conf(lib)/admutiajoutinit.html
set e(page-choix)	$conf(lib)/admutichoix.html
set e(page-modif)	$conf(lib)/admutimodif.html
set e(page-suppr)	$conf(lib)/admutisuppr.html
set e(page-passwd)	$conf(lib)/admutipasswd.html
set e(page-liste)	$conf(lib)/admutiliste.html
set e(page-listetex)	$conf(lib)/admutiliste.tex
set e(page-sel)		$conf(lib)/admutisel.html

set e(maxgroupes)	0
set e(groupes)		{}
# XXX : il y a un problme dans la spcification du groupe
set e(specif)		{
    {{Prsent}       {yesno {%1$s&nbsp;Oui&nbsp;&nbsp;&nbsp;%2$s&nbsp;Non}} 1}
    {{Groupe DNS}    {menu A-REMPLIR} 0}
}


set conf(err)		$e(page-erreur)

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

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

#
# On y va !
#

# ::webapp::cgidebug ; exit

source $conf(libdns)

##############################################################################
# Fonctions pour ...
##############################################################################

proc dns-getuser {dbfd login} {
    # valeurs par dfaut {prsent groupe}
    set r {1 0}

    set m [lire-correspondant-par-login $dbfd $login tabcor]
    if {[string equal $m ""]} then {
	set grp {}
	set sql "SELECT nom FROM groupe WHERE idgrp = $tabcor(idgrp)"
	pg_select $dbfd $sql tab {
	    set grp $tab(nom)
	}
	set i [lsearch -exact [::pgsql::getcols $dbfd groupe "" "nom ASC" nom] $grp]
	set r [list $tabcor(present) $i]
    }
    return $r
}

proc dns-deluser {dbfd login} {
    set qlogin [::pgsql::quote $login]
    set sql "DELETE FROM corresp WHERE login = '$qlogin'"
    if {[::pgsql::execsql $dbfd $sql msg]} then {
	set msg ""
    }

    return $msg
}

proc dns-setuser {dbfd login attr} {
    set qlogin [::pgsql::quote $login]

    set present	[lindex $attr 0]
    set groupe	[lindex $attr 1]

    if {! [regexp {^[01]$} $present]} then {
	return "Champ 'present' invalide"
    }

    set qgroupe [::pgsql::quote $groupe]
    set idgrp -1
    set sql "SELECT idgrp FROM groupe WHERE nom = '$qgroupe'"
    pg_select $dbfd $sql tab {
	set idgrp $tab(idgrp)
    }
    if {$idgrp == -1} then {
	return "Champ 'Groupe DNS' invalide"
    }

    set m [lire-correspondant-par-login $dbfd $login tabcor]
    if {[string equal $m ""]} then {
	#
	# Le correspondant existe dans la base
	#
	set sql "UPDATE corresp \
			SET idgrp = $idgrp, present = $present \
			WHERE login = '$qlogin'"
    } else {
	#
	# Il y a eu erreur. On suppose que c'est parce que le
	# correspondant n'existe pas encore.
	#
	set sql "INSERT INTO corresp (login, idgrp, present) \
				VALUES ('$qlogin', $idgrp, $present)"
    }
    if {[::pgsql::execsql $dbfd $sql msg]} then {
	set msg ""
    }

    return $msg
}

proc dns-chkuser {dbfd loginadmin loginuser} {
    # vide car le droit admin est vrifi par init-dns, et tous
    # les admin ont le droit de modifier les utilisateurs
    return ""
}

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

proc main {} {
    global conf
    global e

    #
    # Initialisation
    #

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

    #
    # Prparation de l'environnement
    #

    set e(script-getuser) [list dns-getuser $dbfd %1\$s]
    set e(script-deluser) [list dns-deluser $dbfd %1\$s]
    set e(script-setuser) [list dns-setuser $dbfd %1\$s %2\$s]
    set e(script-chkuser) [list dns-chkuser $dbfd $login %1\$s]

    set e(url)		$conf(homeurl)/bin/admutil

    set e(groupes)	[getconfig $dbfd "groupes"]

    foreach p {from replyto cc bcc subject body} {
	set param mail$p
	set authparam auth$param
	if {[string equal [getconfig $dbfd $authparam] "1"]} then {
	    set val [::auth::getconfig $param]
	} else {
	    set val [getconfig $dbfd $param]
	}
	set e($param) $val
    }

    #
    # Cas spcial pour le menu des groupes DNS
    #
    set ns {}
    foreach s $e(specif) {
	set type [lindex $s 1]
	if {[string equal [lindex $type 1] "A-REMPLIR"]} then {
	    set menu [::pgsql::getcols $dbfd groupe "" "nom ASC" {nom nom}]
	    set s [list [lindex $s 0] \
			[linsert $menu 0 "menu"] \
			[lindex $s 2] \
		    ]
	}
	lappend ns $s
    }
    set e(specif) $ns

    #
    # Tout le travail est effectu l
    #

    ::auth::usermanage e

    #
    # Dconnexion de la base
    #

    fermer-base $dbfd
}

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