#!%TCLSH%

#
# Modify group permissions
#
# Called by: admin
#
# Parameters (form or url):
#   - group selection
#	- action : (empty)
#   - group edit
#	- action : "edit"
#   - group modification (add, del or mod)
#	- action : "mod"
#	- orggrp : original group name, or "::nouveau"
#	- newgrp : modified group name
#	- p_admin : administration permission (0 or 1)
#	- p_smtp : permission to authorize hosts to emit with SMTP (0 or 1)
#	- p_ttl : permission to modify hosts TTL (0 or 1)
#	- p_mac : permission to use MAC module (0 or 1)
#	- p_genl : permission to generate a link number (0 or 1)
#	- confirm : yes or no
#	- loginN : group members
#	- viewnameN : valid views
#	- viewsortN : view sort class (if empty, we have to remove the view)
#	- viewselN : selected view (0 or 1)
#	- domainN : valid domains
#	- sortdomN : domain sort class (if empty, we have to remove the domain)
#	- mailroleN : permission to edit "mail roles" for this domain (0 or 1)
#	- netN : network ids for this group
#	- sortnetN : network sort class (if empty, we have to remove this network)
#	- dhcpN : permission to edit DHCP ranges for this network (0 or 1)
#	- aclN : permission to edit ACL for this netwok (0 or 1)
#	- addrN et allow_denyN : IP permissions for this group
#	- sortdhcpprofN : DHCP profile sort class (if empty, we have to remove this DHCP profile)
#	- namedhcpprofN : DHCP profile name
#	- eqrwN : type of permission (read:0 or write:1) on equipments
#	- eqallowN : allow/deny for equipments (0 or 1)
#	- eqpatN : regexp giving equipment permission (if empty, we have to remove this permission)
#
# History
#   2002/05/21 : pda/jean : design
#   2002/07/09 : pda      : add nologin
#   2003/05/13 : pda/jean : use auth base
#   2004/01/14 : pda/jean : add IPv6
#   2004/02/12 : pda/jean : add roles
#   2004/08/06 : pda/jean : extend network permissions
#   2005/04/08 : pda/jean : DHCP profiles
#   2007/10/09 : pda/jean : renaming admgrpedit
#   2007/10/10 : pda/jean : centralization of group administration
#   2008/07/23 : pda/jean : add p_smtp
#   2010/10/31 : pda      : add p_ttl
#   2010/11/03 : pda/jean : add p_eq
#   2010/11/30 : pda/jean : add p_mac
#   2010/12/06 : pda      : i18n
#   2010/12/26 : pda      : use cgi-dispatch
#   2012/01/21 : jean     : add p_genl
#

#
# Template pages used by this script
#

set conf(page-sel)	admgrp-sel.html
set conf(page-edit)	admgrp-edit.html
set conf(page-conf)	admgrp-conf.html
set conf(page-confdel)	admgrp-confdel.html
set conf(page-del)	admgrp-del.html
set conf(page-mod)	admgrp-mod.html

#
# Next actions
# 

set conf(next)		"admgrp"

#
# Script parameters
#

# number of lines in listboxes
set conf(height)	20

set conf(form) {
	{orggrp		1 1}
}

set conf(tabuidresp) {
    global {
	chars {12 normal}
	botbar {no}
	columns {50 50}
	align {right}
	format {raw}
    }
    pattern Normal {
	topbar {no}
	vbar {no}
	format {raw}
	column { }
	vbar {no}
	column { 
	    align {left}
	}
	vbar {no}
    }
}

set conf(tabdomains) {
    global {
	chars {12 normal}
	botbar {no}
	columns {33 33 33}
	align {center}
	format {raw}
    }
    pattern Title {
	topbar {no}
	vbar {no}
	chars {bold}
	column { }
	vbar {no}
	column { }
	vbar {no}
	column { }
	vbar {no}
    }
    pattern Normal {
	topbar {no}
	vbar {no}
	format {raw}
	column { }
	vbar {no}
	column { }
	vbar {no}
	column { }
	vbar {no}
    }
}

set conf(tabviews) $conf(tabdomains)

set conf(tabnetworks) {
    global {
	chars {12 normal}
	botbar {no}
	columns {14 58 14 14}
	align {center}
    }
    pattern Title {
	topbar {no}
	vbar {no}
	chars {bold}
	column { }
	vbar {no}
	column { }
	vbar {no}
	column { }
	vbar {no}
	column { }
	vbar {no}
    }
    pattern Normal {
	topbar {no}
	vbar {no}
	format {raw}
	column { }
	vbar {no}
	column { }
	vbar {no}
	column { }
	vbar {no}
	column { }
	vbar {no}
    }
}

set conf(tabpip) {
    global {
	chars {12 normal}
	botbar {no}
	columns {20 80}
	format {raw}
    }
    pattern Normal {
	topbar {no}
	vbar {no}
	column {
	    align {right}
	}
	vbar {no}
	column {
	    align {left}
	}
	vbar {no}
    }
}

set conf(tabpermeq) {
    global {
	chars {12 normal}
	botbar {no}
	columns {10 10 80}
	format {raw}
    }
    pattern Normal {
	topbar {no}
	vbar {no}
	column {
	    align {right}
	}
	vbar {no}
	column {
	    align {right}
	}
	vbar {no}
	column {
	    align {left}
	}
	vbar {no}
    }
}

set conf(tabdhcpprofile) {
    global {
	chars {12 normal}
	botbar {no}
	columns {20 80}
	format {raw}
    }
    pattern Title {
	topbar {no}
	vbar {no}
	chars {bold}
	column {
	    align {center}
	}
	vbar {no}
	column {
	    align {left}
	}
	vbar {no}
    }
    pattern Normal {
	topbar {no}
	vbar {no}
	column {
	    align {center}
	}
	vbar {no}
	column {
	    align {left}
	}
	vbar {no}
    }
}

set conf(tabl2only) {
    global {
	chars {12 normal}
	botbar {no}
	columns {100}
	align {center}
    }
    pattern Title {
	topbar {no}
	vbar {no}
	chars {bold}
	column { }
	vbar {no}
    }
    pattern Normal {
	topbar {no}
	vbar {no}
	column {
	    format {raw}
	}
	vbar {no}
    }
}

#
# Netmagis general library
#

source %LIBNETMAGIS%

# ::webapp::cgidebug ; exit


##############################################################################
# Utility functions
##############################################################################

#
# Validate group name and get it's group id
#

proc val-group {dbfd group exist} {
    global conf

    set qgroup [::pgsql::quote $group]
    set idgrp -1
    set sql "SELECT idgrp FROM global.nmgroup WHERE name = '$qgroup'"
    pg_select $dbfd $sql tab {
	set idgrp $tab(idgrp)
    }

    if {$exist} then {
	#
	# We want an existing group
	#
	if {$idgrp == -1} then {
	    d error [mc "Group '%s' not found" $group]
	}
    } else {
	#
	# We want a non-existing group
	#
	set msg [check-group-syntax $group]
	if {$msg ne ""} then {
	    d error $msg
	}
	# ... and now, check that the group is unknown
	if {$idgrp != -1} then {
	    d error [mc "Group '%s' already exist" $group]
	}
    }

    return $idgrp
}

#
# Group removal
#

proc del-group {dbfd idgrp idorphan} {
    set ltab {global.nmgroup global.nmuser
		dns.p_network dns.p_ip dns.p_dom
		dns.p_dhcpprofile}
    d dblock $ltab

    #
    # Remove permissions
    #

    foreach table {dns.p_network dns.p_ip dns.p_dom dns.p_dhcpprofile} {
	set sql "DELETE FROM $table WHERE idgrp = $idgrp"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d dbabort [mc "delete %s" $table] $msg
	}
    }

    #
    # Get all users which must become orphans
    #

    set sql "SELECT nmuser.idcor
		FROM global.nmuser, dns.rr
		WHERE nmuser.idgrp = $idgrp AND rr.idcor = nmuser.idcor
		GROUP BY nmuser.idcor"
    
    set lidcor {}
    pg_select $dbfd $sql tab {
	lappend lidcor $tab(idcor)
    }

    # 
    # Reassign them to the group of orphans
    # 

    if {[llength $lidcor] > 0} then {
	set lcor [join $lidcor ","]
	set sql "UPDATE global.nmuser SET idgrp = $idorphan, present = 0
		    WHERE idcor IN ($lcor)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d dbabort [mc "modify %s" "global.nmuser"] $msg
	} 
    }

    #
    # Remove other users and the group itself
    #

    foreach table {global.nmuser global.nmgroup} {
	set sql "DELETE FROM $table WHERE idgrp = $idgrp"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d dbabort [mc "delete %s" $table] $msg
	}
    }

    d dbcommit [mc "delete %s" $idgrp]
}

##############################################################################
# Display group selection page
##############################################################################

d cgi-register {action {}} {} {
    global conf

    #
    # Get group list and convert it to a menu
    #

    set lgroup [::pgsql::getcols $dbfd "global.nmgroup" "name <> ''" \
    						"name ASC" {name name}]
    set lgroup [linsert $lgroup 0 [list "::nouveau" [mc "Create group..."]]]
    set menuorggrp [::webapp::form-menu orggrp 1 0 $lgroup {0}]

    #
    # End of script: output page and close database
    #

    d urlset "%URLFORM%" $conf(next) {}
    d result $conf(page-sel) [list \
				[list %MENUORGGRP% $menuorggrp] \
			    ]
}

##############################################################################
# Display group edit page
##############################################################################

d cgi-register {action edit} {
    {orggrp	1 1}
} {
    global conf

    #
    # Check group name, and get group id
    #

    if {$orggrp eq "::nouveau"} then {
	set title [mc "New group creation"]
	set newgrp ""
	set msggrp [mc "Type the name of group to create"]
	set idgrp -1
	set p_admin 0
	set p_smtp 0
	set p_ttl 0
	set p_mac 0
	set p_genl 0
    } else {
	set qgroup [::webapp::html-string $orggrp]
	set title [mc "Edition of group '%s'" $qgroup]
	set newgrp $qgroup
	set msggrp [mc "Modify group name or erase it to remove the group"]
	set pqgroup [::pgsql::quote $orggrp]
	set idgrp -1
	set sql "SELECT idgrp, p_admin, p_smtp, p_ttl, p_mac, p_genl
			FROM global.nmgroup
			WHERE name = '$pqgroup'"
	pg_select $dbfd $sql tab {
	    set idgrp   $tab(idgrp)
	    set p_admin $tab(p_admin)
	    set p_smtp  $tab(p_smtp)
	    set p_ttl   $tab(p_ttl)
	    set p_mac   $tab(p_mac)
	    set p_genl  $tab(p_genl)
	}

	if {$idgrp == -1} then {
	    d error [mc "Group '%s' not found" $orggrp]
	}
    }

    set yes [mc "yes"]
    set no [mc "no"]
    set fmt "%1\$s $yes &nbsp; &nbsp; &nbsp;   %2\$s $no"

    set p_admin [::webapp::form-yesno "p_admin" $p_admin $fmt]
    set p_smtp  [::webapp::form-yesno "p_smtp" $p_smtp $fmt]
    set p_ttl   [::webapp::form-yesno "p_ttl" $p_ttl $fmt]
    set p_mac   [::webapp::form-yesno "p_mac" $p_mac $fmt]
    set p_genl  [::webapp::form-yesno "p_genl" $p_genl $fmt]

    #
    # Extract the list of users belonging to this group
    #

    set lines {}

    set nlogin 1
    foreach login [::pgsql::getcols $dbfd global.nmuser "idgrp = $idgrp" \
    					"login ASC" {login}] {
	set n [read-user $dbfd $login tab comment]
	if {$n == 1} then {
	    set comment "$tab(lastname) $tab(firstname)"
	}
	set hlogin [::webapp::form-text login$nlogin 1 20 50 $login]
	lappend lines [list Normal $hlogin "($comment)"]
	incr nlogin
    }

    for {set i 1} {$i <= 5} {incr i} {
	set hlogin [::webapp::form-text login$nlogin 1 20 50 ""]
	lappend lines [list Normal $hlogin ""]
	incr nlogin
    }

    set listecor [::arrgen::output "html" $conf(tabuidresp) $lines]

    #
    # Extract view list, and select those which are already authorized
    # for this group.
    #

    set lines {}
    lappend lines [list "Title" \
			    [mc "Sort class"] \
			    [mc "Name"] \
			    [mc "Selected by default"] \
			]
    set lview [::pgsql::getcols $dbfd dns.view "" "name ASC" {name name}]
    set sql "SELECT view.name AS name, p_view.sort, p_view.selected
			FROM dns.view, dns.p_view
			WHERE view.idview = p_view.idview
				AND p_view.idgrp = $idgrp
			ORDER BY p_view.sort ASC, view.name ASC"
    set nview 1
    pg_select $dbfd $sql tab {
	set v        $tab(name)
	set sort     $tab(sort)
	set selected $tab(selected)

	set idx [lsearch -exact $lview [list $v $v]]
	if {$idx == -1} then {
	    d error [mc "Group has access to view '%s' which do not exists in database" $v]
	}
	set hsort [::webapp::form-text viewsort$nview 1 5 5 $sort]
	set hview [::webapp::form-menu viewname$nview 1 0 $lview [list $idx]]
	set hsel  [::webapp::form-bool viewsel$nview $selected]
	lappend lines [list Normal $hsort $hview $hsel]
	incr nview
    }

    for {set i 1} {$i <= 5} {incr i} {
	set hsort [::webapp::form-text viewsort$nview 1 5 5 ""]
	set hview [::webapp::form-menu viewname$nview 1 0 $lview {}]
	set hsel  [::webapp::form-bool viewsel$nview 0]
	lappend lines [list Normal $hsort $hview $hsel]
	incr nview
    }

    set listviews [::arrgen::output "html" $conf(tabviews) $lines]

    #
    # Extract domain list, and select those which are already authorized
    # for this group.
    #

    set lines {}
    lappend lines [list "Title" \
			    [mc "Sort class"] \
			    [mc "Domain"] \
			    [mc "Mail role edition"] \
			]
    set ldom [::pgsql::getcols $dbfd dns.domain "" "name ASC" {name name}]
    set sql "SELECT domain.name AS name, p_dom.sort, p_dom.mailrole
			FROM dns.domain, dns.p_dom
			WHERE domain.iddom = p_dom.iddom
				AND p_dom.idgrp = $idgrp
			ORDER BY p_dom.sort ASC, domain.name ASC"
    set ndom 1
    pg_select $dbfd $sql tab {
	set d        $tab(name)
	set sort     $tab(sort)
	set mailrole $tab(mailrole)

	set idx [lsearch -exact $ldom [list $d $d]]
	if {$idx == -1} then {
	    d error [mc "Group has access to domain '%s' which do not exists in database" $d]
	}
	set hsort [::webapp::form-text sortdom$ndom 1 5 5 $sort]
	set hdom  [::webapp::form-menu domain$ndom 1 0 $ldom [list $idx]]
	set hmail [::webapp::form-bool mailrole$ndom $mailrole]
	lappend lines [list Normal $hsort $hdom $hmail]
	incr ndom
    }

    for {set i 1} {$i <= 5} {incr i} {
	set hsort [::webapp::form-text sortdom$ndom 1 5 5 ""]
	set hdom  [::webapp::form-menu domain$ndom 1 0 $ldom {}]
	set hmail [::webapp::form-bool mailrole$ndom 0]
	lappend lines [list Normal $hsort $hdom $hmail]
	incr ndom
    }

    set listdomains [::arrgen::output "html" $conf(tabdomains) $lines]

    #
    # Extract network list and select those which are authorized for the group
    #

    set lines {}
    lappend lines [list "Title" \
			[mc "Sort class"] \
			[mc "Networks"] \
			[mc "DHCP management"] \
			[mc "ACL management"] \
		    ]
    set lnet {}
    set idx 0
    set sql "SELECT idnet, name, addr4, addr6 FROM dns.network
    				ORDER BY addr4, addr6"
    pg_select $dbfd $sql tab {
	set net [format "%s\t%s\t(%s)" \
			    $tab(addr4) $tab(addr6) \
			    $tab(name) \
			]
	lappend lnet [list $tab(idnet) $net]
	set idxnet($tab(idnet)) $idx
	incr idx
    }

    set sql "SELECT p.idnet, p.sort, p.dhcp, p.acl
		FROM dns.network n, dns.p_network p
		WHERE n.idnet = p.idnet AND p.idgrp = $idgrp
		ORDER BY p.sort ASC, n.addr4 ASC, n.addr6 ASC"
    set nnet 1
    pg_select $dbfd $sql tab {
	set idnet  $tab(idnet)
	set sort   $tab(sort)
	set dhcp   $tab(dhcp)
	set acl    $tab(acl)

	if {! [info exists idxnet($idnet)]} then {
	    d error [mc "Group has access to network '%s' which do not exists in database" $idnet]
	}
	set idx $idxnet($idnet)

	set hsort [::webapp::form-text sortnet$nnet 1 5 5 $sort]
	set hnet  [::webapp::form-menu net$nnet 1 0 $lnet [list $idx]]
	set hdhcp [::webapp::form-bool dhcp$nnet $dhcp]
	set hacl  [::webapp::form-bool acl$nnet $acl]

	lappend lines [list Normal $hsort $hnet $hdhcp $hacl]
	incr nnet
    }

    for {set i 1} {$i <= 5} {incr i} {
	set hsort [::webapp::form-text sortnet$nnet 1 5 5 ""]
	set hnet  [::webapp::form-menu net$nnet 1 0 $lnet {}]
	set hdhcp [::webapp::form-bool dhcp$nnet 0]
	set hacl  [::webapp::form-bool acl$nnet  0]
	lappend lines [list Normal $hsort $hnet $hdhcp $hacl]
	incr nnet
    }

    set listnets [::arrgen::output "html" $conf(tabnetworks) $lines]

    #
    # Permissions
    #

    set lines {}
    set n 1
    set sql "SELECT addr, allow_deny \
			FROM dns.p_ip \
			WHERE idgrp = $idgrp \
			ORDER BY addr"
    pg_select $dbfd $sql tab {
	set a $tab(allow_deny)
	set menuallow [::webapp::form-menu allow$n 1 0 \
					{{1 allow} {0 deny}} \
					[list [expr 1 - $a]] \
				    ]
	set textcidr [::webapp::form-text addr$n 1 49 49 $tab(addr)]
	lappend lines [list Normal $menuallow $textcidr]
	incr n
    }

    for {set i 0} {$i < 5} {incr i} {
	set menuallow [::webapp::form-menu allow$n 1 0 \
					{{1 allow} {0 deny}} \
					{0} \
				    ]
	set textcidr [::webapp::form-text addr$n 1 49 49 ""]
	lappend lines [list Normal $menuallow $textcidr]
	incr n
    }

    set listperms [::arrgen::output "html" $conf(tabpip) $lines]

    #
    # Permissions on equipments (topo)
    #

    set lines {}
    set n 1
    set sql "SELECT rw, pattern, allow_deny \
			FROM topo.p_eq \
			WHERE idgrp = $idgrp \
			ORDER BY rw, allow_deny DESC, pattern"
    pg_select $dbfd $sql tab {
	set a $tab(rw)
	set menurw    [::webapp::form-menu eqrw$n 1 0 \
					{{0 read} {1 write}} \
					[list $a] \
				    ]
	set a $tab(allow_deny)
	set menuallow [::webapp::form-menu eqallow$n 1 0 \
					{{1 allow} {0 deny}} \
					[list [expr 1 - $a]] \
				    ]
	set pattern [::webapp::form-text eqpat$n 1 70 200 $tab(pattern)]
	lappend lines [list Normal $menurw $menuallow $pattern]
	incr n
    }

    for {set i 0} {$i < 5} {incr i} {
	set menurw [::webapp::form-menu eqrw$n 1 0 \
					{{0 read} {1 write}} \
					{0} \
				    ]
	set menuallow [::webapp::form-menu eqallow$n 1 0 \
					{{1 allow} {0 deny}} \
					{0} \
				    ]
	set pattern [::webapp::form-text eqpat$n 1 70 200 ""]
	lappend lines [list Normal $menurw $menuallow $pattern]
	incr n
    }

    set listpermeq [::arrgen::output "html" $conf(tabpermeq) $lines]

    #
    # DHCP profiles
    #

    set lines {}
    lappend lines [list "Title" [mc "Sort class"] [mc "DHCP profile"]]
    set lprof [::pgsql::getcols $dbfd dns.dhcpprofile "" "name ASC" {name name}]
    set sql "SELECT d.name, p.sort
			FROM dns.p_dhcpprofile p, dns.dhcpprofile d
			WHERE p.idgrp = $idgrp
			    AND p.iddhcpprof = d.iddhcpprof
			ORDER BY p.sort ASC, d.name ASC"
    set nprof 1
    pg_select $dbfd $sql tab {
	set p        $tab(name)
	set sort     $tab(sort)

	set idx [lsearch -exact $lprof [list $p $p]]
	if {$idx == -1} then {
	    d error [mc "Group has access to DHCP profile '%s' which do not exist in the database" $d]
	}
	set hsort [::webapp::form-text sortdhcpprof$nprof 1 5 5 $sort]
	set hprof [::webapp::form-menu namedhcpprof$nprof 1 0 $lprof [list $idx]]
	lappend lines [list Normal $hsort $hprof]
	incr nprof
    }

    for {set i 1} {$i <= 5} {incr i} {
	set hsort [::webapp::form-text sortdhcpprof$nprof 1 5 5 ""]
	set hprof [::webapp::form-menu namedhcpprof$nprof 1 0 $lprof {}]
	lappend lines [list Normal $hsort $hprof]
	incr nprof
    }

    set listdhcpprof [::arrgen::output "html" $conf(tabdhcpprofile) $lines]

    #
    # L2-only networks
    #

    set lines {}
    set lv [list ""]
    set idx 1
    foreach v [::pgsql::getcols $dbfd topo.vlan "" "vlanid ASC" {vlanid descr}] {
	lassign $v vlanid descr
	lappend lv [list $descr "$vlanid - $descr"]
	lappend tv($vlanid) $idx
	incr idx
    }
    lappend lines [list "Title" [mc "L2-only networks"]]
    set sql "SELECT vlanid AS vlanid
			FROM topo.p_l2only
			WHERE idgrp = $idgrp
			ORDER BY vlanid ASC"
    set nvlan 1
    pg_select $dbfd $sql tab {
	set vlanid $tab(vlanid)
	if {! [info exists tv($vlanid)]} then {
	    d error [mc "Group has access to vlan '%s' which does not exist in the database" $vlanid]
	}
	set idx $tv($vlanid)
	set hvlan  [::webapp::form-menu vlan$nvlan 1 0 $lv [list $idx]]
	lappend lines [list Normal $hvlan]
	incr nvlan
    }

    for {set i 1} {$i <= 5} {incr i} {
	set hvlan  [::webapp::form-menu vlan$nvlan 1 0 $lv [list 0]]
	lappend lines [list Normal $hvlan]
	incr nvlan
    }

    set listl2only [::arrgen::output "html" $conf(tabl2only) $lines]

    #
    # End of script: output page and close database
    #

    d urlset "%URLFORM%" $conf(next) {}
    d result $conf(page-edit) [list \
				[list %TITLE% $title] \
				[list %ORGGRP% $orggrp] \
				[list %NEWGRP% $newgrp] \
				[list %PADMIN% $p_admin] \
				[list %PSMTP% $p_smtp] \
				[list %PTTL% $p_ttl] \
				[list %PMAC% $p_mac] \
				[list %PGENL% $p_genl] \
				[list %MSGGROUP% $msggrp] \
				[list %LISTUSERS% $listecor] \
				[list %LISTVIEWS% $listviews] \
				[list %LISTDOMAINS% $listdomains] \
				[list %LISTNETS% $listnets] \
				[list %LISTPERMS% $listperms] \
				[list %LISTPERMEQ% $listpermeq] \
				[list %LISTDHCPPROF% $listdhcpprof] \
				[list %LISTL2ONLY% $listl2only] \
			    ]
}

##############################################################################
# Modify group
##############################################################################

d cgi-register {action mod} {
    {confirm		1 1}
    {orggrp		1 1}
    {newgrp		1 1}
    {p_admin		1 1}
    {p_smtp		1 1}
    {p_ttl		1 1}
    {p_mac		1 1}
    {p_genl		1 1}
    {login[0-9]+	0 9999}
    {viewname[0-9]+	0 9999}
    {viewsort[0-9]+	0 9999}
    {viewsel[0-9]+	0 9999}
    {sortdom[0-9]+	0 9999}
    {domain[0-9]+	0 9999}
    {mailrole[0-9]+	0 9999}
    {sortnet[0-9]+	0 9999}
    {net[0-9]+		0 9999}
    {dhcp[0-9]+		0 9999}
    {acl[0-9]+		0 9999}
    {addr[0-9]+		0 9999}
    {allow[0-9]+	0 9999}
    {sortdhcpprof[0-9]+	0 9999}
    {namedhcpprof[0-9]+	0 9999}
    {eqrw[0-9]+		0 9999}
    {eqallow[0-9]+	0 9999}
    {eqpat[0-9]+	0 9999}
    {vlanid[0-9]+	0 9999}
} {
    global conf
    global ah

    #
    # Create group of orphans if needed
    #

    set idorphan -1
    pg_select $dbfd "SELECT idgrp FROM global.nmgroup WHERE name = ''" tab {
	set idorphan $tab(idgrp)
    }

    if {$idorphan == -1} then {
	set sql "INSERT INTO global.nmgroup
				(name, p_admin, p_smtp, p_ttl, p_mac, p_genl)
			    VALUES ('', 0, 0, 0, 0, 0)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d error [mc "Cannot create group of orphaned users (%s)" $msg]
	} 
	pg_select $dbfd "SELECT idgrp FROM global.nmgroup WHERE name = ''" tab {
	    set idorphan $tab(idgrp)
	}
    }

    #
    # In which case are we?
    #

    set state [string equal $orggrp "::nouveau"][string equal $newgrp ""] 
    switch $state {
	11 {
	    d error [mc "You must type a name for the group"]
	}
	01 {
	    set do "del"
	}
	10 {
	    set do "add"
	    val-group $dbfd $newgrp 0
	    set msgact [mc "creation of group %s" $newgrp]
	    set idgrp -1
	}
	00 {
	    set do "mod"
	    set msgact [mc "modification of group %s" $newgrp]
	    set idgrp [val-group $dbfd $orggrp 1]

	    # Renaming
	    if {$newgrp ne $orggrp} then {
		val-group $dbfd $newgrp 0
	    }
	}
    }

    #
    # Group removal
    #

    if {$do eq "del"} then {
	set idgrp [val-group $dbfd $orggrp 1]
	if {$confirm ne "yes"} then {
	    # Ask for confirmation
	    set ftab(confirm)	{yes}
	    set lfields [array names ftab]
	    set hidden  [::webapp::hide-parameters $lfields ftab]
	    d urlset "%URLFORM%" $conf(next) {}
	    d result $conf(page-confdel) [list \
					[list %ORGGRP%	$orggrp] \
					[list %HIDDEN%	$hidden] \
				    ]
	} else {
	    # Proceed to removal
	    del-group $dbfd $idgrp $idorphan
	    d result $conf(page-del) [list \
					[list %ORGGRP%	$orggrp] \
				    ]
	}
	exit 0
    }

    #
    # Everything which follows is related to group creation or
    # modification of an existing group.
    #
    
    #
    # Test various permissions
    #

    foreach f {p_admin p_smtp p_ttl p_mac p_genl} {
	set $f [set v [string trim [lindex $ftab($f) 0]]]
	if {$v ne "0" && $v ne "1"} then {
	    d error [mc {Invalid value '%1$s' for form variable '%2$s'} $v $f]
	}
    }

    #
    # Test logins:
    # - read all logins
    # - notice orphans to re-assign to this group
    # - signal an error if the login is already belonging to another group
    # - notice logins to create
    # - notice logins to remove
    #
    
    # read all logins from database

    set sql "SELECT nmuser.login, nmgroup.name, nmgroup.idgrp
		FROM global.nmuser, global.nmgroup
		WHERE nmuser.idgrp = nmgroup.idgrp"
    pg_select $dbfd $sql tab {
	if {$tab(name) eq ""} then {
	    set torph($tab(login)) ""
	} else {
	    set tcor($tab(login)) [list $tab(idgrp) $tab(name)]
	}
    }

    set lcorcreate {}
    set lcorassign {}
    set lcordelete {}
    set n 1
    while {[info exists ftab(login$n)]} {
	set login [string trim [lindex $ftab(login$n) 0]]
	if {$login ne ""} then {
	    if {[info exists torph($login)]} then {
		lappend lcorassign $login
	    } elseif {[info exists tcor($login)]} then {
		if {$idgrp != [lindex $tcor($login) 0]} then {
		    set g [lindex $tcor($login) 1]
		    d error [mc {Login '%1$s' already assigned to group '%2$s'} $login $g]
		}
		unset tcor($login)
	    } else {
		lappend lcorcreate $login
	    }
	}
	incr n
    }

    foreach login [array names tcor] {
	if {[lindex $tcor($login) 0] == $idgrp} then {
	    lappend lcordelete $login
	}
    }

    #
    # Test view validity and build the list of view-ids
    #

    foreach lv [::pgsql::getcols $dbfd dns.view "" "" {idview name}] {
	set idview [lindex $lv 0]
	set name   [lindex $lv 1]
	set tabv($name) $idview
    }

    set lidview {}
    set n 1
    while {[info exists ftab(viewsort$n)] && [info exists ftab(viewname$n)]} {
	set sort [string trim [lindex $ftab(viewsort$n) 0]]
	if {[string length $sort] > 0} then {
	    if {! [regexp -- {^[0-9]+$} $sort]} then {
		d error [mc "Invalid view sort class '%s'" $sort]
	    }

	    set viewname [string trim [lindex $ftab(viewname$n) 0]]
	    if {! [info exists tabv($viewname)]} then {
		d error [mc "Invalid view '%s'" $viewname]
	    }

	    if {! [info exists ftab(viewsel$n)]} then {
		set ftab(viewsel$n) 0
	    }
	    set viewsel [string trim [lindex $ftab(viewsel$n) 0]]
	    if {! [regexp -- {^[01]$} $viewsel]} then {
		d error [mc "Invalid selection mode '%s'" $viewsel]
	    }

	    lappend lidview [list $sort $tabv($viewname) $viewsel]
	}

	incr n
    }

    #
    # Test domain validity and build the list of domain-ids
    #

    foreach ld [::pgsql::getcols $dbfd dns.domain "" "" {iddom name}] {
	lassign $ld iddom name
	set tabdom($name) $iddom
    }

    set liddom {}
    set n 1
    while {[info exists ftab(sortdom$n)] && [info exists ftab(domain$n)]} {
	set sort [string trim [lindex $ftab(sortdom$n) 0]]
	if {[string length $sort] > 0} then {
	    if {! [regexp -- {^[0-9]+$} $sort]} then {
		d error [mc "Invalid domain sort class '%s'" $sort]
	    }

	    set domain [string trim [lindex $ftab(domain$n) 0]]
	    if {! [info exists tabdom($domain)]} then {
		d error [mc "Invalid domain '%s'" $domain]
	    }

	    if {! [info exists ftab(mailrole$n)]} then {
		set ftab(mailrole$n) 0
	    }
	    set mailrole [string trim [lindex $ftab(mailrole$n) 0]]
	    if {! [regexp -- {^[01]$} $mailrole]} then {
		d error [mc "Invalid mail role '%s'" $mailrole]
	    }

	    lappend liddom [list $sort $tabdom($domain) $mailrole]
	}

	incr n
    }

    #
    # Test network ids and build a list
    #

    foreach ld [::pgsql::getcols $dbfd dns.network "" "" {idnet addr4 addr6 dhcp}] {
	set idnet [lindex $ld 0]
	set laddr {}
	foreach i {1 2} {
	    set a [lindex $ld $i]
	    if {$a ne ""} then {
		lappend laddr $a
	    }
	}
	set tabnet($idnet) $laddr
	set tabdhcp($idnet) [lindex $ld 3]
    }

    set lidnet {}
    set n 1
    while {[info exists ftab(sortnet$n)] && [info exists ftab(net$n)]} {
	set sort [string trim [lindex $ftab(sortnet$n) 0]]
	if {[string length $sort] > 0} then {
	    if {! [regexp -- {^[0-9]+$} $sort]} then {
		d error [mc "Invalid network sort class '%s'" $sort]
	    }

	    set idnet [string trim [lindex $ftab(net$n) 0]]
	    if {! [info exists tabnet($idnet)]} then {
		d error [mc "Invalid network id '%s'" $idnet]
	    }

	    if {! [info exists ftab(dhcp$n)]} then {
		set ftab(dhcp$n) 0
	    }
	    set dhcp [string trim [lindex $ftab(dhcp$n) 0]]
	    if {! [regexp -- {^[01]$} $dhcp]} then {
		d error [mc "Invalid DHCP permission '%s'" $dhcp]
	    }

	    if {! [info exists ftab(acl$n)]} then {
		set ftab(acl$n) 0
	    }
	    set acl [string trim [lindex $ftab(acl$n) 0]]
	    if {! [regexp -- {^[01]$} $acl]} then {
		d error [mc "Invalid ACL permission '%s'" $dhcp]
	    }

	    lappend lidnet [list $sort $idnet $dhcp $acl]
	}

	incr n
    }

    #
    # Test syntax of IP permissions
    #

    set n 1
    set lpip {}
    set p_allow {}
    while {[info exists ftab(addr$n)] && [info exists ftab(allow$n)]} {
	set allow_deny [lindex $ftab(allow$n) 0]
	if {! [regexp {^[01]$} $allow_deny]} then {
	    d error [mc "Invalid value '%s' for allow/deny" $allow_deny]
	}

	set addr [string trim [lindex $ftab(addr$n) 0]]
	if {$addr ne ""} then {
	    set m [check-ip-syntax $dbfd $addr "cidr"]
	    if {$m ne ""} then {
		d error [mc "Invalid CIDR '%s'" $addr]
	    }
	    lappend lpip [list $allow_deny $addr]
	    if {$allow_deny} then {
		lappend p_allow $addr
	    }
	}

	incr n
    }

    #
    # Test syntax of equipment permissions
    #

    set n 1
    set lpermeq {}
    while {[info exists ftab(eqpat$n)] &&
		[info exists ftab(eqrw$n)] &&
		[info exists ftab(eqallow$n)]} {

	set rw [lindex $ftab(eqrw$n) 0]
	if {!($rw eq "0" || $rw eq "1")} then {
	    d error [mc "Invalid value '%s' for read/write" $rw]
	}

	set allow_deny [lindex $ftab(eqallow$n) 0]
	if {!($allow_deny eq "0" || $allow_deny eq "1")} then {
	    d error [mc "Invalid value '%s' for allow/deny" $allow_deny]
	}

	set pattern [string trim [lindex $ftab(eqpat$n) 0]]
	if {$pattern ne ""} then {
	    if {[catch {regexp $pattern ""} msg]} then {
		d error [mc "Invalid regular expression pattern '%s'" $pattern]
	    }

	    lappend lpermeq [list $rw $allow_deny $pattern]
	}

	incr n
    }

    #
    # Test DHCP profile names
    #

    foreach ld [::pgsql::getcols $dbfd dns.dhcpprofile "" "" {iddhcpprof name}] {
	lassign $ld iddhcpprof name
	set tabdhcpprofile($name) $iddhcpprof
    }

    set lidprof {}
    set n 1
    while {[info exists ftab(sortdhcpprof$n)] && [info exists ftab(namedhcpprof$n)]} {
	set sort [string trim [lindex $ftab(sortdhcpprof$n) 0]]
	if {[string length $sort] > 0} then {
	    if {! [regexp -- {^[0-9]+$} $sort]} then {
		d error [mc "Invalid DHCP profile sort class '%s'" $sort]
	    }

	    set dhcpprofile [string trim [lindex $ftab(namedhcpprof$n) 0]]
	    if {! [info exists tabdhcpprofile($dhcpprofile)]} then {
		d error [mc "Invalid DHCP profile '%s'" $dhcpprofile]
	    }

	    lappend lidprof [list $sort $tabdhcpprofile($dhcpprofile)]
	}

	incr n
    }

    #
    # Test VLAN ids for L2-only networks
    #

    set lvlan {}
    set n 1
    foreach iv [::pgsql::getcols $dbfd topo.vlan "" "vlanid ASC" {vlanid descr}] {
	lassign $iv vlanid descr
	set tvlan($descr) $vlanid
    }
    while {[info exists ftab(vlan$n)]} {
	set descr [string trim [lindex $ftab(vlan$n) 0]]
	if {$descr ne ""} then {
	    if {! [info exists tvlan($descr)]} then {
		d error [mc "Invalid VLAN '%s'" $descr]
	    }

	    set vlanid $tvlan($descr)
	    if {$vlanid < 1 || $vlanid > 4094} then {
		d error [mc "Vlan id '%s' out of range (1..4094)" $vlanid]
	    }
	    lappend lvlan $vlanid
	}
	incr n
    }

    #
    # Test data consistency
    #

    if {$confirm ne "yes"} then {
	#
	# - at least a view
	# - at least a domain
	# - at least a network
	# - each network has one or more IP permissions
	#	which means that a user may access one range in
	#	networks
	# - each IP address permission is within a network
	#	which means that a user do not have larger rights
	#	than allowed networks
	# If one of these conditions is false, we ask for confirmation.
	# This confirmation allow to force rights. A typical example
	# is an administrator which has rights on every network via
	# only one large CIDR.
	#

	set inconsist {}

	# non existant logins

	set u [::webapp::authuser create %AUTO%]
	set n 1
	while {[info exists ftab(login$n)]} {
	    set login [string trim [lindex $ftab(login$n) 0]]
	    if {$login ne ""} then {
		if {[catch {set nb [$ah getuser $login $u]} msg]} then {
		    d error [mc "Authentication base problem: %s" $msg]
		}
		switch $nb {
		    0 {
			lappend inconsist [mc "Login '%s' does not exist" $login]
		    }
		    1 {
			# nothing: it's ok
		    }
		    default {
			d error [mc "Login '%s' found more than once" $login]
		    }
		}
	    }
	    incr n
	}
	
	# at least one view
	if {[llength $lidview] == 0} then {
	    lappend inconsist [mc "No selected view"]
	}

	# at least one domain
	if {[llength $liddom] == 0} then {
	    lappend inconsist [mc "No selected domain"]
	}

	# at least one network
	if {[llength $lidnet] == 0} then {
	    lappend inconsist [mc "No selected network"]
	}

	# authorize DHCP needs that the network be DHCP-enabled
	foreach r $lidnet {
	    set idnet [lindex $r 1]
	    set dhcp [lindex $r 2]
	    if {$dhcp && ! $tabdhcp($idnet)} then {
		lappend inconsist [mc "Network '%s' is not DHCP enabled" $tabnet($idnet)]
	    }
	}

	# every network must at least have a IP address permission
	foreach r $lidnet {
	    set idnet [lindex $r 1]
	    foreach addr $tabnet($idnet) {
		set perm 0
		foreach cidr $p_allow {
		    pg_select $dbfd "SELECT '$addr' >>= '$cidr' AS result" tab {
			set result $tab(result)
		    }
		    if {$result eq "t"} then {
			set perm 1
			break
		    }
		}
		if {! $perm} then {
		    lappend inconsist [mc "No 'allow' permission found for network '%s'" $addr]
		}
	    }
	}

	# no "allow" permission outside allowed networks
	foreach cidr $p_allow {
	    set found 0
	    foreach r $lidnet {
		set idnet [lindex $r 1]
		foreach addr $tabnet($idnet) {
		    # addr = v4 and/or v6
		    set sql "SELECT cidr '$cidr' <<= cidr '$addr' AS result"
		    pg_select $dbfd $sql tab {
			set result $tab(result)
		    }
		    if {$result eq "t"} then {
			set found 1
			break
		    }
		}
	    }

	    if {! $found} then {
		lappend inconsist [mc "'Allow' permission '%s' outside any allowed network" $cidr]
	    }
	}

	#
	# If any inconsistency is detected, announce it/them and ask
	# for confirmation.
	#

	if {[llength $inconsist] > 0} then {
	    set ftab(confirm)	{yes}
	    set lfields [array names ftab]
	    set hidden  [::webapp::hide-parameters $lfields ftab]
	    set message [join $inconsist "<BR>\n"]
	    d urlset "%URLFORM%" $conf(next) {}
	    d result $conf(page-conf) [list \
					[list %MSGACT%	$msgact] \
					[list %ORGGRP%	$orggrp] \
					[list %HIDDEN%	$hidden] \
					[list %MESSAGE%	$message] \
			    ]
	    exit 0
	}
    }

    #
    # If we get here, data are consistent, or we have been confirmed.
    # We must then store data in the database.
    # All modifications are done by removing all elements, and then
    # re-inserting them from input.
    #

    set ltab {global.nmgroup global.nmuser
		dns.p_network dns.p_ip dns.p_dom
		dns.p_dhcpprofile} 
    d dblock $ltab

    # Create group if needed

    if {$do eq "add"} then {
	set qnewgrp [::pgsql::quote $newgrp]
	set sql "INSERT INTO global.nmgroup
				(name, p_admin, p_smtp, p_ttl, p_mac, p_genl)
			VALUES ('$qnewgrp', $p_admin, $p_smtp, $p_ttl, $p_mac, $p_genl)"
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	    d dbabort [mc "add %s" $newgrp] $msg
	} 
    } else {

	# Existing group editing

	set qorggrp [::pgsql::quote $orggrp]

	if {$orggrp ne $newgrp} then {
	    # Group renaming
	    set qnewgrp [::pgsql::quote $newgrp]
	    set sql "UPDATE global.nmgroup SET name = '$qnewgrp' WHERE name = '$qorggrp'"
	    if {! [::pgsql::execsql $dbfd $sql msg]} then {
		d dbabort [mc "rename %s" $orggrp]
	    }
	}
    }

    # Get group id
    set qnewgrp [::pgsql::quote $newgrp]
    set idgrp -1
    set sql "SELECT idgrp FROM global.nmgroup WHERE name = '$qnewgrp'"
    pg_select $dbfd $sql tab {
	set idgrp $tab(idgrp)
    }
    if {$idgrp == -1} then {
	d error [mc "Internal error: group '%s' not found" $newgrp]
    }

    # Update group attributes
    lappend cmd "UPDATE global.nmgroup
		    SET p_admin = $p_admin,
			p_smtp = $p_smtp,
			p_ttl = $p_ttl,
			p_mac = $p_mac,
			p_genl = $p_genl
		    WHERE idgrp = $idgrp"

    # Create or assign users
    if {[llength $lcorcreate] > 0} then {
	foreach login $lcorcreate {
	    set qlogin [::pgsql::quote $login]
	    lappend cmd "INSERT INTO global.nmuser (login,present,idgrp)
			    VALUES ('$qlogin',1,$idgrp)"
	}
    }
    if {[llength $lcorassign] > 0} then {
	foreach login $lcorassign {
	    set qlogin [::pgsql::quote $login]
	    lappend cmd "UPDATE global.nmuser SET idgrp = $idgrp
			    WHERE login = '$qlogin'"
	}
    }

    # Re-assign all deleted users to the group of orphans
    if {[llength $lcordelete] > 0} then {
	foreach login $lcordelete {
	    set qlogin [::pgsql::quote $login]
	    lappend cmd "UPDATE global.nmuser SET idgrp = $idorphan
			    WHERE login = '$qlogin'"
	}
    }

    # Delete all unneeded users
    lappend cmd "DELETE FROM global.nmuser 
			WHERE idgrp = $idorphan 
			    AND idcor NOT IN (SELECT DISTINCT idcor FROM dns.rr)"

    # Authorized views for this group
    lappend cmd "DELETE FROM dns.p_view WHERE idgrp = $idgrp"
    foreach e $lidview {
	lassign $e sort idview selected
	lappend cmd "INSERT INTO dns.p_view (idgrp, idview, sort, selected)
			VALUES ($idgrp, $idview, $sort, $selected)"
    }

    # Authorized domains for this group
    lappend cmd "DELETE FROM dns.p_dom WHERE idgrp = $idgrp"
    foreach e $liddom {
	lassign $e sort iddom mailrole
	lappend cmd "INSERT INTO dns.p_dom (idgrp, iddom, sort, mailrole)
			VALUES ($idgrp, $iddom, $sort, $mailrole)"
    }

    # Authorized networks for this group
    lappend cmd "DELETE FROM dns.p_network WHERE idgrp = $idgrp"
    foreach r $lidnet {
	lassign $r sort idnet dhcp acl
	lappend cmd "INSERT INTO dns.p_network (idgrp, idnet, sort, dhcp, acl)
			VALUES ($idgrp, $idnet, $sort, $dhcp, $acl)"
    }

    # IP permissions associated with the group
    lappend cmd "DELETE FROM dns.p_ip WHERE idgrp = $idgrp"
    foreach e $lpip {
	lassign $e allow_deny addr
	lappend cmd "INSERT INTO dns.p_ip (idgrp, addr, allow_deny)
					VALUES ($idgrp, '$addr', $allow_deny)"
    }

    # Equipment permissions (topo) associated with the group
    lappend cmd "DELETE FROM topo.p_eq WHERE idgrp = $idgrp"
    foreach e $lpermeq {
	lassign $e rw allow_deny pattern
	set pattern [::pgsql::quote $pattern]
	lappend cmd "INSERT INTO topo.p_eq (idgrp, rw, allow_deny, pattern)
				VALUES ($idgrp, $rw, $allow_deny, '$pattern')"
    }

    # DHCP profiles associated with the group
    lappend cmd "DELETE FROM dns.p_dhcpprofile WHERE idgrp = $idgrp"
    foreach e $lidprof {
	lassign $e sort iddhcpprof
	lappend cmd "INSERT INTO dns.p_dhcpprofile (idgrp, iddhcpprof, sort)
			VALUES ($idgrp, $iddhcpprof, $sort)"
    }

    # L2-only VLAN ids authorized for the group
    lappend cmd "DELETE FROM topo.p_l2only WHERE idgrp = $idgrp"
    foreach vlanid $lvlan {
	lappend cmd "INSERT INTO topo.p_l2only (idgrp, vlanid)
			VALUES ($idgrp, $vlanid)"
    }

    #
    # Proceed to database modification
    #

    foreach sql $cmd {
	if {! [::pgsql::execsql $dbfd $sql msg]} then {
	   d dbabort [mc "modify %s" $orggrp] $msg
	}
    }

    d dbcommit [mc "modify %s" $orggrp]

    #
    # Get group characteristics
    #

    set h [display-group $dbfd $idgrp]
    lassign $h \
		tabperms tablogins tabnets tabcidralone \
		tabviews tabdomains tabdhcpprofiles tabpermeq tabl2only

    #
    # End of script: output page and close database
    #

    d result $conf(page-mod) [list \
			    [list %NEWGRP% $newgrp] \
			    [list %TABLOGINS% $tablogins] \
			    [list %TABPERMS% $tabperms] \
			    [list %TABVIEWS% $tabviews] \
			    [list %TABDOMAINS% $tabdomains] \
			    [list %TABNETS% $tabnets] \
			    [list %TABCIDRALONE% $tabcidralone] \
			    [list %TABDHCPPROFILES% $tabdhcpprofiles] \
			    [list %TABPERMEQ% $tabpermeq] \
			    [list %TABL2ONLY% $tabl2only] \
			]
}

##############################################################################
# Main procedure
##############################################################################

d cgi-dispatch "admin" "admin"