1#!%TCLSH% 2 3# 4# Modify group permissions 5# 6# Called by: admin 7# 8# Parameters (form or url): 9# - group selection 10# - action : (empty) 11# - group edit 12# - action : "edit" 13# - group modification (add, del or mod) 14# - action : "mod" 15# - orggrp : original group name, or "::nouveau" 16# - newgrp : modified group name 17# - p_admin : administration permission (0 or 1) 18# - p_smtp : permission to authorize hosts to emit with SMTP (0 or 1) 19# - p_ttl : permission to modify hosts TTL (0 or 1) 20# - p_mac : permission to use MAC module (0 or 1) 21# - p_genl : permission to generate a link number (0 or 1) 22# - confirm : yes or no 23# - loginN : group members 24# - viewnameN : valid views 25# - viewsortN : view sort class (if empty, we have to remove the view) 26# - viewselN : selected view (0 or 1) 27# - domainN : valid domains 28# - sortdomN : domain sort class (if empty, we have to remove the domain) 29# - mailroleN : permission to edit "mail roles" for this domain (0 or 1) 30# - netN : network ids for this group 31# - sortnetN : network sort class (if empty, we have to remove this network) 32# - dhcpN : permission to edit DHCP ranges for this network (0 or 1) 33# - aclN : permission to edit ACL for this netwok (0 or 1) 34# - addrN et allow_denyN : IP permissions for this group 35# - sortdhcpprofN : DHCP profile sort class (if empty, we have to remove this DHCP profile) 36# - namedhcpprofN : DHCP profile name 37# - eqrwN : type of permission (read:0 or write:1) on equipments 38# - eqallowN : allow/deny for equipments (0 or 1) 39# - eqpatN : regexp giving equipment permission (if empty, we have to remove this permission) 40# 41# History 42# 2002/05/21 : pda/jean : design 43# 2002/07/09 : pda : add nologin 44# 2003/05/13 : pda/jean : use auth base 45# 2004/01/14 : pda/jean : add IPv6 46# 2004/02/12 : pda/jean : add roles 47# 2004/08/06 : pda/jean : extend network permissions 48# 2005/04/08 : pda/jean : DHCP profiles 49# 2007/10/09 : pda/jean : renaming admgrpedit 50# 2007/10/10 : pda/jean : centralization of group administration 51# 2008/07/23 : pda/jean : add p_smtp 52# 2010/10/31 : pda : add p_ttl 53# 2010/11/03 : pda/jean : add p_eq 54# 2010/11/30 : pda/jean : add p_mac 55# 2010/12/06 : pda : i18n 56# 2010/12/26 : pda : use cgi-dispatch 57# 2012/01/21 : jean : add p_genl 58# 59 60# 61# Template pages used by this script 62# 63 64set conf(page-sel) admgrp-sel.html 65set conf(page-edit) admgrp-edit.html 66set conf(page-conf) admgrp-conf.html 67set conf(page-confdel) admgrp-confdel.html 68set conf(page-del) admgrp-del.html 69set conf(page-mod) admgrp-mod.html 70 71# 72# Next actions 73# 74 75set conf(next) "admgrp" 76 77# 78# Script parameters 79# 80 81# number of lines in listboxes 82set conf(height) 20 83 84set conf(form) { 85 {orggrp 1 1} 86} 87 88set conf(tabuidresp) { 89 global { 90 chars {12 normal} 91 botbar {no} 92 columns {50 50} 93 align {right} 94 format {raw} 95 } 96 pattern Normal { 97 topbar {no} 98 vbar {no} 99 format {raw} 100 column { } 101 vbar {no} 102 column { 103 align {left} 104 } 105 vbar {no} 106 } 107} 108 109set conf(tabdomains) { 110 global { 111 chars {12 normal} 112 botbar {no} 113 columns {33 33 33} 114 align {center} 115 format {raw} 116 } 117 pattern Title { 118 topbar {no} 119 vbar {no} 120 chars {bold} 121 column { } 122 vbar {no} 123 column { } 124 vbar {no} 125 column { } 126 vbar {no} 127 } 128 pattern Normal { 129 topbar {no} 130 vbar {no} 131 format {raw} 132 column { } 133 vbar {no} 134 column { } 135 vbar {no} 136 column { } 137 vbar {no} 138 } 139} 140 141set conf(tabviews) $conf(tabdomains) 142 143set conf(tabnetworks) { 144 global { 145 chars {12 normal} 146 botbar {no} 147 columns {14 58 14 14} 148 align {center} 149 } 150 pattern Title { 151 topbar {no} 152 vbar {no} 153 chars {bold} 154 column { } 155 vbar {no} 156 column { } 157 vbar {no} 158 column { } 159 vbar {no} 160 column { } 161 vbar {no} 162 } 163 pattern Normal { 164 topbar {no} 165 vbar {no} 166 format {raw} 167 column { } 168 vbar {no} 169 column { } 170 vbar {no} 171 column { } 172 vbar {no} 173 column { } 174 vbar {no} 175 } 176} 177 178set conf(tabpip) { 179 global { 180 chars {12 normal} 181 botbar {no} 182 columns {20 80} 183 format {raw} 184 } 185 pattern Normal { 186 topbar {no} 187 vbar {no} 188 column { 189 align {right} 190 } 191 vbar {no} 192 column { 193 align {left} 194 } 195 vbar {no} 196 } 197} 198 199set conf(tabpermeq) { 200 global { 201 chars {12 normal} 202 botbar {no} 203 columns {10 10 80} 204 format {raw} 205 } 206 pattern Normal { 207 topbar {no} 208 vbar {no} 209 column { 210 align {right} 211 } 212 vbar {no} 213 column { 214 align {right} 215 } 216 vbar {no} 217 column { 218 align {left} 219 } 220 vbar {no} 221 } 222} 223 224set conf(tabdhcpprofile) { 225 global { 226 chars {12 normal} 227 botbar {no} 228 columns {20 80} 229 format {raw} 230 } 231 pattern Title { 232 topbar {no} 233 vbar {no} 234 chars {bold} 235 column { 236 align {center} 237 } 238 vbar {no} 239 column { 240 align {left} 241 } 242 vbar {no} 243 } 244 pattern Normal { 245 topbar {no} 246 vbar {no} 247 column { 248 align {center} 249 } 250 vbar {no} 251 column { 252 align {left} 253 } 254 vbar {no} 255 } 256} 257 258set conf(tabl2only) { 259 global { 260 chars {12 normal} 261 botbar {no} 262 columns {100} 263 align {center} 264 } 265 pattern Title { 266 topbar {no} 267 vbar {no} 268 chars {bold} 269 column { } 270 vbar {no} 271 } 272 pattern Normal { 273 topbar {no} 274 vbar {no} 275 column { 276 format {raw} 277 } 278 vbar {no} 279 } 280} 281 282# 283# Netmagis general library 284# 285 286source %LIBNETMAGIS% 287 288# ::webapp::cgidebug ; exit 289 290 291############################################################################## 292# Utility functions 293############################################################################## 294 295# 296# Validate group name and get it's group id 297# 298 299proc val-group {dbfd group exist} { 300 global conf 301 302 set qgroup [::pgsql::quote $group] 303 set idgrp -1 304 set sql "SELECT idgrp FROM global.nmgroup WHERE name = '$qgroup'" 305 pg_select $dbfd $sql tab { 306 set idgrp $tab(idgrp) 307 } 308 309 if {$exist} then { 310 # 311 # We want an existing group 312 # 313 if {$idgrp == -1} then { 314 d error [mc "Group '%s' not found" $group] 315 } 316 } else { 317 # 318 # We want a non-existing group 319 # 320 set msg [check-group-syntax $group] 321 if {$msg ne ""} then { 322 d error $msg 323 } 324 # ... and now, check that the group is unknown 325 if {$idgrp != -1} then { 326 d error [mc "Group '%s' already exist" $group] 327 } 328 } 329 330 return $idgrp 331} 332 333# 334# Group removal 335# 336 337proc del-group {dbfd idgrp idorphan} { 338 set ltab {global.nmgroup global.nmuser 339 dns.p_network dns.p_ip dns.p_dom 340 dns.p_dhcpprofile} 341 d dblock $ltab 342 343 # 344 # Remove permissions 345 # 346 347 foreach table {dns.p_network dns.p_ip dns.p_dom dns.p_dhcpprofile} { 348 set sql "DELETE FROM $table WHERE idgrp = $idgrp" 349 if {! [::pgsql::execsql $dbfd $sql msg]} then { 350 d dbabort [mc "delete %s" $table] $msg 351 } 352 } 353 354 # 355 # Get all users which must become orphans 356 # 357 358 set sql "SELECT nmuser.idcor 359 FROM global.nmuser, dns.rr 360 WHERE nmuser.idgrp = $idgrp AND rr.idcor = nmuser.idcor 361 GROUP BY nmuser.idcor" 362 363 set lidcor {} 364 pg_select $dbfd $sql tab { 365 lappend lidcor $tab(idcor) 366 } 367 368 # 369 # Reassign them to the group of orphans 370 # 371 372 if {[llength $lidcor] > 0} then { 373 set lcor [join $lidcor ","] 374 set sql "UPDATE global.nmuser SET idgrp = $idorphan, present = 0 375 WHERE idcor IN ($lcor)" 376 if {! [::pgsql::execsql $dbfd $sql msg]} then { 377 d dbabort [mc "modify %s" "global.nmuser"] $msg 378 } 379 } 380 381 # 382 # Remove other users and the group itself 383 # 384 385 foreach table {global.nmuser global.nmgroup} { 386 set sql "DELETE FROM $table WHERE idgrp = $idgrp" 387 if {! [::pgsql::execsql $dbfd $sql msg]} then { 388 d dbabort [mc "delete %s" $table] $msg 389 } 390 } 391 392 d dbcommit [mc "delete %s" $idgrp] 393} 394 395############################################################################## 396# Display group selection page 397############################################################################## 398 399d cgi-register {action {}} {} { 400 global conf 401 402 # 403 # Get group list and convert it to a menu 404 # 405 406 set lgroup [::pgsql::getcols $dbfd "global.nmgroup" "name <> ''" \ 407 "name ASC" {name name}] 408 set lgroup [linsert $lgroup 0 [list "::nouveau" [mc "Create group..."]]] 409 set menuorggrp [::webapp::form-menu orggrp 1 0 $lgroup {0}] 410 411 # 412 # End of script: output page and close database 413 # 414 415 d urlset "%URLFORM%" $conf(next) {} 416 d result $conf(page-sel) [list \ 417 [list %MENUORGGRP% $menuorggrp] \ 418 ] 419} 420 421############################################################################## 422# Display group edit page 423############################################################################## 424 425d cgi-register {action edit} { 426 {orggrp 1 1} 427} { 428 global conf 429 430 # 431 # Check group name, and get group id 432 # 433 434 if {$orggrp eq "::nouveau"} then { 435 set title [mc "New group creation"] 436 set newgrp "" 437 set msggrp [mc "Type the name of group to create"] 438 set idgrp -1 439 set p_admin 0 440 set p_smtp 0 441 set p_ttl 0 442 set p_mac 0 443 set p_genl 0 444 } else { 445 set qgroup [::webapp::html-string $orggrp] 446 set title [mc "Edition of group '%s'" $qgroup] 447 set newgrp $qgroup 448 set msggrp [mc "Modify group name or erase it to remove the group"] 449 set pqgroup [::pgsql::quote $orggrp] 450 set idgrp -1 451 set sql "SELECT idgrp, p_admin, p_smtp, p_ttl, p_mac, p_genl 452 FROM global.nmgroup 453 WHERE name = '$pqgroup'" 454 pg_select $dbfd $sql tab { 455 set idgrp $tab(idgrp) 456 set p_admin $tab(p_admin) 457 set p_smtp $tab(p_smtp) 458 set p_ttl $tab(p_ttl) 459 set p_mac $tab(p_mac) 460 set p_genl $tab(p_genl) 461 } 462 463 if {$idgrp == -1} then { 464 d error [mc "Group '%s' not found" $orggrp] 465 } 466 } 467 468 set yes [mc "yes"] 469 set no [mc "no"] 470 set fmt "%1\$s $yes %2\$s $no" 471 472 set p_admin [::webapp::form-yesno "p_admin" $p_admin $fmt] 473 set p_smtp [::webapp::form-yesno "p_smtp" $p_smtp $fmt] 474 set p_ttl [::webapp::form-yesno "p_ttl" $p_ttl $fmt] 475 set p_mac [::webapp::form-yesno "p_mac" $p_mac $fmt] 476 set p_genl [::webapp::form-yesno "p_genl" $p_genl $fmt] 477 478 # 479 # Extract the list of users belonging to this group 480 # 481 482 set lines {} 483 484 set nlogin 1 485 foreach login [::pgsql::getcols $dbfd global.nmuser "idgrp = $idgrp" \ 486 "login ASC" {login}] { 487 set n [read-user $dbfd $login tab comment] 488 if {$n == 1} then { 489 set comment "$tab(lastname) $tab(firstname)" 490 } 491 set hlogin [::webapp::form-text login$nlogin 1 20 50 $login] 492 lappend lines [list Normal $hlogin "($comment)"] 493 incr nlogin 494 } 495 496 for {set i 1} {$i <= 5} {incr i} { 497 set hlogin [::webapp::form-text login$nlogin 1 20 50 ""] 498 lappend lines [list Normal $hlogin ""] 499 incr nlogin 500 } 501 502 set listecor [::arrgen::output "html" $conf(tabuidresp) $lines] 503 504 # 505 # Extract view list, and select those which are already authorized 506 # for this group. 507 # 508 509 set lines {} 510 lappend lines [list "Title" \ 511 [mc "Sort class"] \ 512 [mc "Name"] \ 513 [mc "Selected by default"] \ 514 ] 515 set lview [::pgsql::getcols $dbfd dns.view "" "name ASC" {name name}] 516 set sql "SELECT view.name AS name, p_view.sort, p_view.selected 517 FROM dns.view, dns.p_view 518 WHERE view.idview = p_view.idview 519 AND p_view.idgrp = $idgrp 520 ORDER BY p_view.sort ASC, view.name ASC" 521 set nview 1 522 pg_select $dbfd $sql tab { 523 set v $tab(name) 524 set sort $tab(sort) 525 set selected $tab(selected) 526 527 set idx [lsearch -exact $lview [list $v $v]] 528 if {$idx == -1} then { 529 d error [mc "Group has access to view '%s' which do not exists in database" $v] 530 } 531 set hsort [::webapp::form-text viewsort$nview 1 5 5 $sort] 532 set hview [::webapp::form-menu viewname$nview 1 0 $lview [list $idx]] 533 set hsel [::webapp::form-bool viewsel$nview $selected] 534 lappend lines [list Normal $hsort $hview $hsel] 535 incr nview 536 } 537 538 for {set i 1} {$i <= 5} {incr i} { 539 set hsort [::webapp::form-text viewsort$nview 1 5 5 ""] 540 set hview [::webapp::form-menu viewname$nview 1 0 $lview {}] 541 set hsel [::webapp::form-bool viewsel$nview 0] 542 lappend lines [list Normal $hsort $hview $hsel] 543 incr nview 544 } 545 546 set listviews [::arrgen::output "html" $conf(tabviews) $lines] 547 548 # 549 # Extract domain list, and select those which are already authorized 550 # for this group. 551 # 552 553 set lines {} 554 lappend lines [list "Title" \ 555 [mc "Sort class"] \ 556 [mc "Domain"] \ 557 [mc "Mail role edition"] \ 558 ] 559 set ldom [::pgsql::getcols $dbfd dns.domain "" "name ASC" {name name}] 560 set sql "SELECT domain.name AS name, p_dom.sort, p_dom.mailrole 561 FROM dns.domain, dns.p_dom 562 WHERE domain.iddom = p_dom.iddom 563 AND p_dom.idgrp = $idgrp 564 ORDER BY p_dom.sort ASC, domain.name ASC" 565 set ndom 1 566 pg_select $dbfd $sql tab { 567 set d $tab(name) 568 set sort $tab(sort) 569 set mailrole $tab(mailrole) 570 571 set idx [lsearch -exact $ldom [list $d $d]] 572 if {$idx == -1} then { 573 d error [mc "Group has access to domain '%s' which do not exists in database" $d] 574 } 575 set hsort [::webapp::form-text sortdom$ndom 1 5 5 $sort] 576 set hdom [::webapp::form-menu domain$ndom 1 0 $ldom [list $idx]] 577 set hmail [::webapp::form-bool mailrole$ndom $mailrole] 578 lappend lines [list Normal $hsort $hdom $hmail] 579 incr ndom 580 } 581 582 for {set i 1} {$i <= 5} {incr i} { 583 set hsort [::webapp::form-text sortdom$ndom 1 5 5 ""] 584 set hdom [::webapp::form-menu domain$ndom 1 0 $ldom {}] 585 set hmail [::webapp::form-bool mailrole$ndom 0] 586 lappend lines [list Normal $hsort $hdom $hmail] 587 incr ndom 588 } 589 590 set listdomains [::arrgen::output "html" $conf(tabdomains) $lines] 591 592 # 593 # Extract network list and select those which are authorized for the group 594 # 595 596 set lines {} 597 lappend lines [list "Title" \ 598 [mc "Sort class"] \ 599 [mc "Networks"] \ 600 [mc "DHCP management"] \ 601 [mc "ACL management"] \ 602 ] 603 set lnet {} 604 set idx 0 605 set sql "SELECT idnet, name, addr4, addr6 FROM dns.network 606 ORDER BY addr4, addr6" 607 pg_select $dbfd $sql tab { 608 set net [format "%s\t%s\t(%s)" \ 609 $tab(addr4) $tab(addr6) \ 610 $tab(name) \ 611 ] 612 lappend lnet [list $tab(idnet) $net] 613 set idxnet($tab(idnet)) $idx 614 incr idx 615 } 616 617 set sql "SELECT p.idnet, p.sort, p.dhcp, p.acl 618 FROM dns.network n, dns.p_network p 619 WHERE n.idnet = p.idnet AND p.idgrp = $idgrp 620 ORDER BY p.sort ASC, n.addr4 ASC, n.addr6 ASC" 621 set nnet 1 622 pg_select $dbfd $sql tab { 623 set idnet $tab(idnet) 624 set sort $tab(sort) 625 set dhcp $tab(dhcp) 626 set acl $tab(acl) 627 628 if {! [info exists idxnet($idnet)]} then { 629 d error [mc "Group has access to network '%s' which do not exists in database" $idnet] 630 } 631 set idx $idxnet($idnet) 632 633 set hsort [::webapp::form-text sortnet$nnet 1 5 5 $sort] 634 set hnet [::webapp::form-menu net$nnet 1 0 $lnet [list $idx]] 635 set hdhcp [::webapp::form-bool dhcp$nnet $dhcp] 636 set hacl [::webapp::form-bool acl$nnet $acl] 637 638 lappend lines [list Normal $hsort $hnet $hdhcp $hacl] 639 incr nnet 640 } 641 642 for {set i 1} {$i <= 5} {incr i} { 643 set hsort [::webapp::form-text sortnet$nnet 1 5 5 ""] 644 set hnet [::webapp::form-menu net$nnet 1 0 $lnet {}] 645 set hdhcp [::webapp::form-bool dhcp$nnet 0] 646 set hacl [::webapp::form-bool acl$nnet 0] 647 lappend lines [list Normal $hsort $hnet $hdhcp $hacl] 648 incr nnet 649 } 650 651 set listnets [::arrgen::output "html" $conf(tabnetworks) $lines] 652 653 # 654 # Permissions 655 # 656 657 set lines {} 658 set n 1 659 set sql "SELECT addr, allow_deny \ 660 FROM dns.p_ip \ 661 WHERE idgrp = $idgrp \ 662 ORDER BY addr" 663 pg_select $dbfd $sql tab { 664 set a $tab(allow_deny) 665 set menuallow [::webapp::form-menu allow$n 1 0 \ 666 {{1 allow} {0 deny}} \ 667 [list [expr 1 - $a]] \ 668 ] 669 set textcidr [::webapp::form-text addr$n 1 49 49 $tab(addr)] 670 lappend lines [list Normal $menuallow $textcidr] 671 incr n 672 } 673 674 for {set i 0} {$i < 5} {incr i} { 675 set menuallow [::webapp::form-menu allow$n 1 0 \ 676 {{1 allow} {0 deny}} \ 677 {0} \ 678 ] 679 set textcidr [::webapp::form-text addr$n 1 49 49 ""] 680 lappend lines [list Normal $menuallow $textcidr] 681 incr n 682 } 683 684 set listperms [::arrgen::output "html" $conf(tabpip) $lines] 685 686 # 687 # Permissions on equipments (topo) 688 # 689 690 set lines {} 691 set n 1 692 set sql "SELECT rw, pattern, allow_deny \ 693 FROM topo.p_eq \ 694 WHERE idgrp = $idgrp \ 695 ORDER BY rw, allow_deny DESC, pattern" 696 pg_select $dbfd $sql tab { 697 set a $tab(rw) 698 set menurw [::webapp::form-menu eqrw$n 1 0 \ 699 {{0 read} {1 write}} \ 700 [list $a] \ 701 ] 702 set a $tab(allow_deny) 703 set menuallow [::webapp::form-menu eqallow$n 1 0 \ 704 {{1 allow} {0 deny}} \ 705 [list [expr 1 - $a]] \ 706 ] 707 set pattern [::webapp::form-text eqpat$n 1 70 200 $tab(pattern)] 708 lappend lines [list Normal $menurw $menuallow $pattern] 709 incr n 710 } 711 712 for {set i 0} {$i < 5} {incr i} { 713 set menurw [::webapp::form-menu eqrw$n 1 0 \ 714 {{0 read} {1 write}} \ 715 {0} \ 716 ] 717 set menuallow [::webapp::form-menu eqallow$n 1 0 \ 718 {{1 allow} {0 deny}} \ 719 {0} \ 720 ] 721 set pattern [::webapp::form-text eqpat$n 1 70 200 ""] 722 lappend lines [list Normal $menurw $menuallow $pattern] 723 incr n 724 } 725 726 set listpermeq [::arrgen::output "html" $conf(tabpermeq) $lines] 727 728 # 729 # DHCP profiles 730 # 731 732 set lines {} 733 lappend lines [list "Title" [mc "Sort class"] [mc "DHCP profile"]] 734 set lprof [::pgsql::getcols $dbfd dns.dhcpprofile "" "name ASC" {name name}] 735 set sql "SELECT d.name, p.sort 736 FROM dns.p_dhcpprofile p, dns.dhcpprofile d 737 WHERE p.idgrp = $idgrp 738 AND p.iddhcpprof = d.iddhcpprof 739 ORDER BY p.sort ASC, d.name ASC" 740 set nprof 1 741 pg_select $dbfd $sql tab { 742 set p $tab(name) 743 set sort $tab(sort) 744 745 set idx [lsearch -exact $lprof [list $p $p]] 746 if {$idx == -1} then { 747 d error [mc "Group has access to DHCP profile '%s' which do not exist in the database" $d] 748 } 749 set hsort [::webapp::form-text sortdhcpprof$nprof 1 5 5 $sort] 750 set hprof [::webapp::form-menu namedhcpprof$nprof 1 0 $lprof [list $idx]] 751 lappend lines [list Normal $hsort $hprof] 752 incr nprof 753 } 754 755 for {set i 1} {$i <= 5} {incr i} { 756 set hsort [::webapp::form-text sortdhcpprof$nprof 1 5 5 ""] 757 set hprof [::webapp::form-menu namedhcpprof$nprof 1 0 $lprof {}] 758 lappend lines [list Normal $hsort $hprof] 759 incr nprof 760 } 761 762 set listdhcpprof [::arrgen::output "html" $conf(tabdhcpprofile) $lines] 763 764 # 765 # L2-only networks 766 # 767 768 set lines {} 769 set lv [list ""] 770 set idx 1 771 foreach v [::pgsql::getcols $dbfd topo.vlan "" "vlanid ASC" {vlanid descr}] { 772 lassign $v vlanid descr 773 lappend lv [list $descr "$vlanid - $descr"] 774 lappend tv($vlanid) $idx 775 incr idx 776 } 777 lappend lines [list "Title" [mc "L2-only networks"]] 778 set sql "SELECT vlanid AS vlanid 779 FROM topo.p_l2only 780 WHERE idgrp = $idgrp 781 ORDER BY vlanid ASC" 782 set nvlan 1 783 pg_select $dbfd $sql tab { 784 set vlanid $tab(vlanid) 785 if {! [info exists tv($vlanid)]} then { 786 d error [mc "Group has access to vlan '%s' which does not exist in the database" $vlanid] 787 } 788 set idx $tv($vlanid) 789 set hvlan [::webapp::form-menu vlan$nvlan 1 0 $lv [list $idx]] 790 lappend lines [list Normal $hvlan] 791 incr nvlan 792 } 793 794 for {set i 1} {$i <= 5} {incr i} { 795 set hvlan [::webapp::form-menu vlan$nvlan 1 0 $lv [list 0]] 796 lappend lines [list Normal $hvlan] 797 incr nvlan 798 } 799 800 set listl2only [::arrgen::output "html" $conf(tabl2only) $lines] 801 802 # 803 # End of script: output page and close database 804 # 805 806 d urlset "%URLFORM%" $conf(next) {} 807 d result $conf(page-edit) [list \ 808 [list %TITLE% $title] \ 809 [list %ORGGRP% $orggrp] \ 810 [list %NEWGRP% $newgrp] \ 811 [list %PADMIN% $p_admin] \ 812 [list %PSMTP% $p_smtp] \ 813 [list %PTTL% $p_ttl] \ 814 [list %PMAC% $p_mac] \ 815 [list %PGENL% $p_genl] \ 816 [list %MSGGROUP% $msggrp] \ 817 [list %LISTUSERS% $listecor] \ 818 [list %LISTVIEWS% $listviews] \ 819 [list %LISTDOMAINS% $listdomains] \ 820 [list %LISTNETS% $listnets] \ 821 [list %LISTPERMS% $listperms] \ 822 [list %LISTPERMEQ% $listpermeq] \ 823 [list %LISTDHCPPROF% $listdhcpprof] \ 824 [list %LISTL2ONLY% $listl2only] \ 825 ] 826} 827 828############################################################################## 829# Modify group 830############################################################################## 831 832d cgi-register {action mod} { 833 {confirm 1 1} 834 {orggrp 1 1} 835 {newgrp 1 1} 836 {p_admin 1 1} 837 {p_smtp 1 1} 838 {p_ttl 1 1} 839 {p_mac 1 1} 840 {p_genl 1 1} 841 {login[0-9]+ 0 9999} 842 {viewname[0-9]+ 0 9999} 843 {viewsort[0-9]+ 0 9999} 844 {viewsel[0-9]+ 0 9999} 845 {sortdom[0-9]+ 0 9999} 846 {domain[0-9]+ 0 9999} 847 {mailrole[0-9]+ 0 9999} 848 {sortnet[0-9]+ 0 9999} 849 {net[0-9]+ 0 9999} 850 {dhcp[0-9]+ 0 9999} 851 {acl[0-9]+ 0 9999} 852 {addr[0-9]+ 0 9999} 853 {allow[0-9]+ 0 9999} 854 {sortdhcpprof[0-9]+ 0 9999} 855 {namedhcpprof[0-9]+ 0 9999} 856 {eqrw[0-9]+ 0 9999} 857 {eqallow[0-9]+ 0 9999} 858 {eqpat[0-9]+ 0 9999} 859 {vlanid[0-9]+ 0 9999} 860} { 861 global conf 862 global ah 863 864 # 865 # Create group of orphans if needed 866 # 867 868 set idorphan -1 869 pg_select $dbfd "SELECT idgrp FROM global.nmgroup WHERE name = ''" tab { 870 set idorphan $tab(idgrp) 871 } 872 873 if {$idorphan == -1} then { 874 set sql "INSERT INTO global.nmgroup 875 (name, p_admin, p_smtp, p_ttl, p_mac, p_genl) 876 VALUES ('', 0, 0, 0, 0, 0)" 877 if {! [::pgsql::execsql $dbfd $sql msg]} then { 878 d error [mc "Cannot create group of orphaned users (%s)" $msg] 879 } 880 pg_select $dbfd "SELECT idgrp FROM global.nmgroup WHERE name = ''" tab { 881 set idorphan $tab(idgrp) 882 } 883 } 884 885 # 886 # In which case are we? 887 # 888 889 set state [string equal $orggrp "::nouveau"][string equal $newgrp ""] 890 switch $state { 891 11 { 892 d error [mc "You must type a name for the group"] 893 } 894 01 { 895 set do "del" 896 } 897 10 { 898 set do "add" 899 val-group $dbfd $newgrp 0 900 set msgact [mc "creation of group %s" $newgrp] 901 set idgrp -1 902 } 903 00 { 904 set do "mod" 905 set msgact [mc "modification of group %s" $newgrp] 906 set idgrp [val-group $dbfd $orggrp 1] 907 908 # Renaming 909 if {$newgrp ne $orggrp} then { 910 val-group $dbfd $newgrp 0 911 } 912 } 913 } 914 915 # 916 # Group removal 917 # 918 919 if {$do eq "del"} then { 920 set idgrp [val-group $dbfd $orggrp 1] 921 if {$confirm ne "yes"} then { 922 # Ask for confirmation 923 set ftab(confirm) {yes} 924 set lfields [array names ftab] 925 set hidden [::webapp::hide-parameters $lfields ftab] 926 d urlset "%URLFORM%" $conf(next) {} 927 d result $conf(page-confdel) [list \ 928 [list %ORGGRP% $orggrp] \ 929 [list %HIDDEN% $hidden] \ 930 ] 931 } else { 932 # Proceed to removal 933 del-group $dbfd $idgrp $idorphan 934 d result $conf(page-del) [list \ 935 [list %ORGGRP% $orggrp] \ 936 ] 937 } 938 exit 0 939 } 940 941 # 942 # Everything which follows is related to group creation or 943 # modification of an existing group. 944 # 945 946 # 947 # Test various permissions 948 # 949 950 foreach f {p_admin p_smtp p_ttl p_mac p_genl} { 951 set $f [set v [string trim [lindex $ftab($f) 0]]] 952 if {$v ne "0" && $v ne "1"} then { 953 d error [mc {Invalid value '%1$s' for form variable '%2$s'} $v $f] 954 } 955 } 956 957 # 958 # Test logins: 959 # - read all logins 960 # - notice orphans to re-assign to this group 961 # - signal an error if the login is already belonging to another group 962 # - notice logins to create 963 # - notice logins to remove 964 # 965 966 # read all logins from database 967 968 set sql "SELECT nmuser.login, nmgroup.name, nmgroup.idgrp 969 FROM global.nmuser, global.nmgroup 970 WHERE nmuser.idgrp = nmgroup.idgrp" 971 pg_select $dbfd $sql tab { 972 if {$tab(name) eq ""} then { 973 set torph($tab(login)) "" 974 } else { 975 set tcor($tab(login)) [list $tab(idgrp) $tab(name)] 976 } 977 } 978 979 set lcorcreate {} 980 set lcorassign {} 981 set lcordelete {} 982 set n 1 983 while {[info exists ftab(login$n)]} { 984 set login [string trim [lindex $ftab(login$n) 0]] 985 if {$login ne ""} then { 986 if {[info exists torph($login)]} then { 987 lappend lcorassign $login 988 } elseif {[info exists tcor($login)]} then { 989 if {$idgrp != [lindex $tcor($login) 0]} then { 990 set g [lindex $tcor($login) 1] 991 d error [mc {Login '%1$s' already assigned to group '%2$s'} $login $g] 992 } 993 unset tcor($login) 994 } else { 995 lappend lcorcreate $login 996 } 997 } 998 incr n 999 } 1000 1001 foreach login [array names tcor] { 1002 if {[lindex $tcor($login) 0] == $idgrp} then { 1003 lappend lcordelete $login 1004 } 1005 } 1006 1007 # 1008 # Test view validity and build the list of view-ids 1009 # 1010 1011 foreach lv [::pgsql::getcols $dbfd dns.view "" "" {idview name}] { 1012 set idview [lindex $lv 0] 1013 set name [lindex $lv 1] 1014 set tabv($name) $idview 1015 } 1016 1017 set lidview {} 1018 set n 1 1019 while {[info exists ftab(viewsort$n)] && [info exists ftab(viewname$n)]} { 1020 set sort [string trim [lindex $ftab(viewsort$n) 0]] 1021 if {[string length $sort] > 0} then { 1022 if {! [regexp -- {^[0-9]+$} $sort]} then { 1023 d error [mc "Invalid view sort class '%s'" $sort] 1024 } 1025 1026 set viewname [string trim [lindex $ftab(viewname$n) 0]] 1027 if {! [info exists tabv($viewname)]} then { 1028 d error [mc "Invalid view '%s'" $viewname] 1029 } 1030 1031 if {! [info exists ftab(viewsel$n)]} then { 1032 set ftab(viewsel$n) 0 1033 } 1034 set viewsel [string trim [lindex $ftab(viewsel$n) 0]] 1035 if {! [regexp -- {^[01]$} $viewsel]} then { 1036 d error [mc "Invalid selection mode '%s'" $viewsel] 1037 } 1038 1039 lappend lidview [list $sort $tabv($viewname) $viewsel] 1040 } 1041 1042 incr n 1043 } 1044 1045 # 1046 # Test domain validity and build the list of domain-ids 1047 # 1048 1049 foreach ld [::pgsql::getcols $dbfd dns.domain "" "" {iddom name}] { 1050 lassign $ld iddom name 1051 set tabdom($name) $iddom 1052 } 1053 1054 set liddom {} 1055 set n 1 1056 while {[info exists ftab(sortdom$n)] && [info exists ftab(domain$n)]} { 1057 set sort [string trim [lindex $ftab(sortdom$n) 0]] 1058 if {[string length $sort] > 0} then { 1059 if {! [regexp -- {^[0-9]+$} $sort]} then { 1060 d error [mc "Invalid domain sort class '%s'" $sort] 1061 } 1062 1063 set domain [string trim [lindex $ftab(domain$n) 0]] 1064 if {! [info exists tabdom($domain)]} then { 1065 d error [mc "Invalid domain '%s'" $domain] 1066 } 1067 1068 if {! [info exists ftab(mailrole$n)]} then { 1069 set ftab(mailrole$n) 0 1070 } 1071 set mailrole [string trim [lindex $ftab(mailrole$n) 0]] 1072 if {! [regexp -- {^[01]$} $mailrole]} then { 1073 d error [mc "Invalid mail role '%s'" $mailrole] 1074 } 1075 1076 lappend liddom [list $sort $tabdom($domain) $mailrole] 1077 } 1078 1079 incr n 1080 } 1081 1082 # 1083 # Test network ids and build a list 1084 # 1085 1086 foreach ld [::pgsql::getcols $dbfd dns.network "" "" {idnet addr4 addr6 dhcp}] { 1087 set idnet [lindex $ld 0] 1088 set laddr {} 1089 foreach i {1 2} { 1090 set a [lindex $ld $i] 1091 if {$a ne ""} then { 1092 lappend laddr $a 1093 } 1094 } 1095 set tabnet($idnet) $laddr 1096 set tabdhcp($idnet) [lindex $ld 3] 1097 } 1098 1099 set lidnet {} 1100 set n 1 1101 while {[info exists ftab(sortnet$n)] && [info exists ftab(net$n)]} { 1102 set sort [string trim [lindex $ftab(sortnet$n) 0]] 1103 if {[string length $sort] > 0} then { 1104 if {! [regexp -- {^[0-9]+$} $sort]} then { 1105 d error [mc "Invalid network sort class '%s'" $sort] 1106 } 1107 1108 set idnet [string trim [lindex $ftab(net$n) 0]] 1109 if {! [info exists tabnet($idnet)]} then { 1110 d error [mc "Invalid network id '%s'" $idnet] 1111 } 1112 1113 if {! [info exists ftab(dhcp$n)]} then { 1114 set ftab(dhcp$n) 0 1115 } 1116 set dhcp [string trim [lindex $ftab(dhcp$n) 0]] 1117 if {! [regexp -- {^[01]$} $dhcp]} then { 1118 d error [mc "Invalid DHCP permission '%s'" $dhcp] 1119 } 1120 1121 if {! [info exists ftab(acl$n)]} then { 1122 set ftab(acl$n) 0 1123 } 1124 set acl [string trim [lindex $ftab(acl$n) 0]] 1125 if {! [regexp -- {^[01]$} $acl]} then { 1126 d error [mc "Invalid ACL permission '%s'" $dhcp] 1127 } 1128 1129 lappend lidnet [list $sort $idnet $dhcp $acl] 1130 } 1131 1132 incr n 1133 } 1134 1135 # 1136 # Test syntax of IP permissions 1137 # 1138 1139 set n 1 1140 set lpip {} 1141 set p_allow {} 1142 while {[info exists ftab(addr$n)] && [info exists ftab(allow$n)]} { 1143 set allow_deny [lindex $ftab(allow$n) 0] 1144 if {! [regexp {^[01]$} $allow_deny]} then { 1145 d error [mc "Invalid value '%s' for allow/deny" $allow_deny] 1146 } 1147 1148 set addr [string trim [lindex $ftab(addr$n) 0]] 1149 if {$addr ne ""} then { 1150 set m [check-ip-syntax $dbfd $addr "cidr"] 1151 if {$m ne ""} then { 1152 d error [mc "Invalid CIDR '%s'" $addr] 1153 } 1154 lappend lpip [list $allow_deny $addr] 1155 if {$allow_deny} then { 1156 lappend p_allow $addr 1157 } 1158 } 1159 1160 incr n 1161 } 1162 1163 # 1164 # Test syntax of equipment permissions 1165 # 1166 1167 set n 1 1168 set lpermeq {} 1169 while {[info exists ftab(eqpat$n)] && 1170 [info exists ftab(eqrw$n)] && 1171 [info exists ftab(eqallow$n)]} { 1172 1173 set rw [lindex $ftab(eqrw$n) 0] 1174 if {!($rw eq "0" || $rw eq "1")} then { 1175 d error [mc "Invalid value '%s' for read/write" $rw] 1176 } 1177 1178 set allow_deny [lindex $ftab(eqallow$n) 0] 1179 if {!($allow_deny eq "0" || $allow_deny eq "1")} then { 1180 d error [mc "Invalid value '%s' for allow/deny" $allow_deny] 1181 } 1182 1183 set pattern [string trim [lindex $ftab(eqpat$n) 0]] 1184 if {$pattern ne ""} then { 1185 if {[catch {regexp $pattern ""} msg]} then { 1186 d error [mc "Invalid regular expression pattern '%s'" $pattern] 1187 } 1188 1189 lappend lpermeq [list $rw $allow_deny $pattern] 1190 } 1191 1192 incr n 1193 } 1194 1195 # 1196 # Test DHCP profile names 1197 # 1198 1199 foreach ld [::pgsql::getcols $dbfd dns.dhcpprofile "" "" {iddhcpprof name}] { 1200 lassign $ld iddhcpprof name 1201 set tabdhcpprofile($name) $iddhcpprof 1202 } 1203 1204 set lidprof {} 1205 set n 1 1206 while {[info exists ftab(sortdhcpprof$n)] && [info exists ftab(namedhcpprof$n)]} { 1207 set sort [string trim [lindex $ftab(sortdhcpprof$n) 0]] 1208 if {[string length $sort] > 0} then { 1209 if {! [regexp -- {^[0-9]+$} $sort]} then { 1210 d error [mc "Invalid DHCP profile sort class '%s'" $sort] 1211 } 1212 1213 set dhcpprofile [string trim [lindex $ftab(namedhcpprof$n) 0]] 1214 if {! [info exists tabdhcpprofile($dhcpprofile)]} then { 1215 d error [mc "Invalid DHCP profile '%s'" $dhcpprofile] 1216 } 1217 1218 lappend lidprof [list $sort $tabdhcpprofile($dhcpprofile)] 1219 } 1220 1221 incr n 1222 } 1223 1224 # 1225 # Test VLAN ids for L2-only networks 1226 # 1227 1228 set lvlan {} 1229 set n 1 1230 foreach iv [::pgsql::getcols $dbfd topo.vlan "" "vlanid ASC" {vlanid descr}] { 1231 lassign $iv vlanid descr 1232 set tvlan($descr) $vlanid 1233 } 1234 while {[info exists ftab(vlan$n)]} { 1235 set descr [string trim [lindex $ftab(vlan$n) 0]] 1236 if {$descr ne ""} then { 1237 if {! [info exists tvlan($descr)]} then { 1238 d error [mc "Invalid VLAN '%s'" $descr] 1239 } 1240 1241 set vlanid $tvlan($descr) 1242 if {$vlanid < 1 || $vlanid > 4094} then { 1243 d error [mc "Vlan id '%s' out of range (1..4094)" $vlanid] 1244 } 1245 lappend lvlan $vlanid 1246 } 1247 incr n 1248 } 1249 1250 # 1251 # Test data consistency 1252 # 1253 1254 if {$confirm ne "yes"} then { 1255 # 1256 # - at least a view 1257 # - at least a domain 1258 # - at least a network 1259 # - each network has one or more IP permissions 1260 # which means that a user may access one range in 1261 # networks 1262 # - each IP address permission is within a network 1263 # which means that a user do not have larger rights 1264 # than allowed networks 1265 # If one of these conditions is false, we ask for confirmation. 1266 # This confirmation allow to force rights. A typical example 1267 # is an administrator which has rights on every network via 1268 # only one large CIDR. 1269 # 1270 1271 set inconsist {} 1272 1273 # non existant logins 1274 1275 set u [::webapp::authuser create %AUTO%] 1276 set n 1 1277 while {[info exists ftab(login$n)]} { 1278 set login [string trim [lindex $ftab(login$n) 0]] 1279 if {$login ne ""} then { 1280 if {[catch {set nb [$ah getuser $login $u]} msg]} then { 1281 d error [mc "Authentication base problem: %s" $msg] 1282 } 1283 switch $nb { 1284 0 { 1285 lappend inconsist [mc "Login '%s' does not exist" $login] 1286 } 1287 1 { 1288 # nothing: it's ok 1289 } 1290 default { 1291 d error [mc "Login '%s' found more than once" $login] 1292 } 1293 } 1294 } 1295 incr n 1296 } 1297 1298 # at least one view 1299 if {[llength $lidview] == 0} then { 1300 lappend inconsist [mc "No selected view"] 1301 } 1302 1303 # at least one domain 1304 if {[llength $liddom] == 0} then { 1305 lappend inconsist [mc "No selected domain"] 1306 } 1307 1308 # at least one network 1309 if {[llength $lidnet] == 0} then { 1310 lappend inconsist [mc "No selected network"] 1311 } 1312 1313 # authorize DHCP needs that the network be DHCP-enabled 1314 foreach r $lidnet { 1315 set idnet [lindex $r 1] 1316 set dhcp [lindex $r 2] 1317 if {$dhcp && ! $tabdhcp($idnet)} then { 1318 lappend inconsist [mc "Network '%s' is not DHCP enabled" $tabnet($idnet)] 1319 } 1320 } 1321 1322 # every network must at least have a IP address permission 1323 foreach r $lidnet { 1324 set idnet [lindex $r 1] 1325 foreach addr $tabnet($idnet) { 1326 set perm 0 1327 foreach cidr $p_allow { 1328 pg_select $dbfd "SELECT '$addr' >>= '$cidr' AS result" tab { 1329 set result $tab(result) 1330 } 1331 if {$result eq "t"} then { 1332 set perm 1 1333 break 1334 } 1335 } 1336 if {! $perm} then { 1337 lappend inconsist [mc "No 'allow' permission found for network '%s'" $addr] 1338 } 1339 } 1340 } 1341 1342 # no "allow" permission outside allowed networks 1343 foreach cidr $p_allow { 1344 set found 0 1345 foreach r $lidnet { 1346 set idnet [lindex $r 1] 1347 foreach addr $tabnet($idnet) { 1348 # addr = v4 and/or v6 1349 set sql "SELECT cidr '$cidr' <<= cidr '$addr' AS result" 1350 pg_select $dbfd $sql tab { 1351 set result $tab(result) 1352 } 1353 if {$result eq "t"} then { 1354 set found 1 1355 break 1356 } 1357 } 1358 } 1359 1360 if {! $found} then { 1361 lappend inconsist [mc "'Allow' permission '%s' outside any allowed network" $cidr] 1362 } 1363 } 1364 1365 # 1366 # If any inconsistency is detected, announce it/them and ask 1367 # for confirmation. 1368 # 1369 1370 if {[llength $inconsist] > 0} then { 1371 set ftab(confirm) {yes} 1372 set lfields [array names ftab] 1373 set hidden [::webapp::hide-parameters $lfields ftab] 1374 set message [join $inconsist "<BR>\n"] 1375 d urlset "%URLFORM%" $conf(next) {} 1376 d result $conf(page-conf) [list \ 1377 [list %MSGACT% $msgact] \ 1378 [list %ORGGRP% $orggrp] \ 1379 [list %HIDDEN% $hidden] \ 1380 [list %MESSAGE% $message] \ 1381 ] 1382 exit 0 1383 } 1384 } 1385 1386 # 1387 # If we get here, data are consistent, or we have been confirmed. 1388 # We must then store data in the database. 1389 # All modifications are done by removing all elements, and then 1390 # re-inserting them from input. 1391 # 1392 1393 set ltab {global.nmgroup global.nmuser 1394 dns.p_network dns.p_ip dns.p_dom 1395 dns.p_dhcpprofile} 1396 d dblock $ltab 1397 1398 # Create group if needed 1399 1400 if {$do eq "add"} then { 1401 set qnewgrp [::pgsql::quote $newgrp] 1402 set sql "INSERT INTO global.nmgroup 1403 (name, p_admin, p_smtp, p_ttl, p_mac, p_genl) 1404 VALUES ('$qnewgrp', $p_admin, $p_smtp, $p_ttl, $p_mac, $p_genl)" 1405 if {! [::pgsql::execsql $dbfd $sql msg]} then { 1406 d dbabort [mc "add %s" $newgrp] $msg 1407 } 1408 } else { 1409 1410 # Existing group editing 1411 1412 set qorggrp [::pgsql::quote $orggrp] 1413 1414 if {$orggrp ne $newgrp} then { 1415 # Group renaming 1416 set qnewgrp [::pgsql::quote $newgrp] 1417 set sql "UPDATE global.nmgroup SET name = '$qnewgrp' WHERE name = '$qorggrp'" 1418 if {! [::pgsql::execsql $dbfd $sql msg]} then { 1419 d dbabort [mc "rename %s" $orggrp] 1420 } 1421 } 1422 } 1423 1424 # Get group id 1425 set qnewgrp [::pgsql::quote $newgrp] 1426 set idgrp -1 1427 set sql "SELECT idgrp FROM global.nmgroup WHERE name = '$qnewgrp'" 1428 pg_select $dbfd $sql tab { 1429 set idgrp $tab(idgrp) 1430 } 1431 if {$idgrp == -1} then { 1432 d error [mc "Internal error: group '%s' not found" $newgrp] 1433 } 1434 1435 # Update group attributes 1436 lappend cmd "UPDATE global.nmgroup 1437 SET p_admin = $p_admin, 1438 p_smtp = $p_smtp, 1439 p_ttl = $p_ttl, 1440 p_mac = $p_mac, 1441 p_genl = $p_genl 1442 WHERE idgrp = $idgrp" 1443 1444 # Create or assign users 1445 if {[llength $lcorcreate] > 0} then { 1446 foreach login $lcorcreate { 1447 set qlogin [::pgsql::quote $login] 1448 lappend cmd "INSERT INTO global.nmuser (login,present,idgrp) 1449 VALUES ('$qlogin',1,$idgrp)" 1450 } 1451 } 1452 if {[llength $lcorassign] > 0} then { 1453 foreach login $lcorassign { 1454 set qlogin [::pgsql::quote $login] 1455 lappend cmd "UPDATE global.nmuser SET idgrp = $idgrp 1456 WHERE login = '$qlogin'" 1457 } 1458 } 1459 1460 # Re-assign all deleted users to the group of orphans 1461 if {[llength $lcordelete] > 0} then { 1462 foreach login $lcordelete { 1463 set qlogin [::pgsql::quote $login] 1464 lappend cmd "UPDATE global.nmuser SET idgrp = $idorphan 1465 WHERE login = '$qlogin'" 1466 } 1467 } 1468 1469 # Delete all unneeded users 1470 lappend cmd "DELETE FROM global.nmuser 1471 WHERE idgrp = $idorphan 1472 AND idcor NOT IN (SELECT DISTINCT idcor FROM dns.rr)" 1473 1474 # Authorized views for this group 1475 lappend cmd "DELETE FROM dns.p_view WHERE idgrp = $idgrp" 1476 foreach e $lidview { 1477 lassign $e sort idview selected 1478 lappend cmd "INSERT INTO dns.p_view (idgrp, idview, sort, selected) 1479 VALUES ($idgrp, $idview, $sort, $selected)" 1480 } 1481 1482 # Authorized domains for this group 1483 lappend cmd "DELETE FROM dns.p_dom WHERE idgrp = $idgrp" 1484 foreach e $liddom { 1485 lassign $e sort iddom mailrole 1486 lappend cmd "INSERT INTO dns.p_dom (idgrp, iddom, sort, mailrole) 1487 VALUES ($idgrp, $iddom, $sort, $mailrole)" 1488 } 1489 1490 # Authorized networks for this group 1491 lappend cmd "DELETE FROM dns.p_network WHERE idgrp = $idgrp" 1492 foreach r $lidnet { 1493 lassign $r sort idnet dhcp acl 1494 lappend cmd "INSERT INTO dns.p_network (idgrp, idnet, sort, dhcp, acl) 1495 VALUES ($idgrp, $idnet, $sort, $dhcp, $acl)" 1496 } 1497 1498 # IP permissions associated with the group 1499 lappend cmd "DELETE FROM dns.p_ip WHERE idgrp = $idgrp" 1500 foreach e $lpip { 1501 lassign $e allow_deny addr 1502 lappend cmd "INSERT INTO dns.p_ip (idgrp, addr, allow_deny) 1503 VALUES ($idgrp, '$addr', $allow_deny)" 1504 } 1505 1506 # Equipment permissions (topo) associated with the group 1507 lappend cmd "DELETE FROM topo.p_eq WHERE idgrp = $idgrp" 1508 foreach e $lpermeq { 1509 lassign $e rw allow_deny pattern 1510 set pattern [::pgsql::quote $pattern] 1511 lappend cmd "INSERT INTO topo.p_eq (idgrp, rw, allow_deny, pattern) 1512 VALUES ($idgrp, $rw, $allow_deny, '$pattern')" 1513 } 1514 1515 # DHCP profiles associated with the group 1516 lappend cmd "DELETE FROM dns.p_dhcpprofile WHERE idgrp = $idgrp" 1517 foreach e $lidprof { 1518 lassign $e sort iddhcpprof 1519 lappend cmd "INSERT INTO dns.p_dhcpprofile (idgrp, iddhcpprof, sort) 1520 VALUES ($idgrp, $iddhcpprof, $sort)" 1521 } 1522 1523 # L2-only VLAN ids authorized for the group 1524 lappend cmd "DELETE FROM topo.p_l2only WHERE idgrp = $idgrp" 1525 foreach vlanid $lvlan { 1526 lappend cmd "INSERT INTO topo.p_l2only (idgrp, vlanid) 1527 VALUES ($idgrp, $vlanid)" 1528 } 1529 1530 # 1531 # Proceed to database modification 1532 # 1533 1534 foreach sql $cmd { 1535 if {! [::pgsql::execsql $dbfd $sql msg]} then { 1536 d dbabort [mc "modify %s" $orggrp] $msg 1537 } 1538 } 1539 1540 d dbcommit [mc "modify %s" $orggrp] 1541 1542 # 1543 # Get group characteristics 1544 # 1545 1546 set h [display-group $dbfd $idgrp] 1547 lassign $h \ 1548 tabperms tablogins tabnets tabcidralone \ 1549 tabviews tabdomains tabdhcpprofiles tabpermeq tabl2only 1550 1551 # 1552 # End of script: output page and close database 1553 # 1554 1555 d result $conf(page-mod) [list \ 1556 [list %NEWGRP% $newgrp] \ 1557 [list %TABLOGINS% $tablogins] \ 1558 [list %TABPERMS% $tabperms] \ 1559 [list %TABVIEWS% $tabviews] \ 1560 [list %TABDOMAINS% $tabdomains] \ 1561 [list %TABNETS% $tabnets] \ 1562 [list %TABCIDRALONE% $tabcidralone] \ 1563 [list %TABDHCPPROFILES% $tabdhcpprofiles] \ 1564 [list %TABPERMEQ% $tabpermeq] \ 1565 [list %TABL2ONLY% $tabl2only] \ 1566 ] 1567} 1568 1569############################################################################## 1570# Main procedure 1571############################################################################## 1572 1573d cgi-dispatch "admin" "admin" 1574