1#!%TCLSH% 2 3# 4# Reference tables 5# 6# Called by: adminindex 7# 8# Parameters (form or url): 9# - display edit page 10# - action : (empty) 11# - type : org, comm, hinfo, net, domain, view, zone, zone4, zone6, 12# vlan, eq, eqtype, confcmd, dotattr 13# - display graphviz generated image 14# - action : "image" 15# - type : dotattr 16# - display help page 17# - action : "help" 18# - type : see above 19# - store modifications 20# - action : "mod" 21# - type : see above 22# - other fields specific to each type 23# 24# History 25# 2001/11/01 : pda : design 26# 2002/05/03 : pda/jean : re-use in netmagis 27# 2002/05/06 : pda/jean : add users 28# 2002/05/16 : pda : conversion to arrgen 29# 2002/05/21 : pda/jean : add groups 30# 2002/05/21 : pda/jean : add communities 31# 2002/07/09 : pda : add nologin 32# 2003/05/13 : pda/jean : use auth base 33# 2003/08/12 : pda : remove users (they go in group edition) 34# 2004/01/14 : pda/jean : add IPv6 35# 2004/08/06 : pda/jean : add flag dhcp by network 36# 2005/04/08 : pda/jean : add table dhcpprofil 37# 2007/10/25 : jean : log modify actions 38# 2010/11/16 : pda/jean : add table vlan 39# 2010/11/17 : pda : specifications for help page 40# 2010/12/09 : pda : i18n 41# 2010/12/09 : pda : remove groups 42# 2010/12/09 : pda : rewrite with conf() array 43# 2010/12/13 : pda/jean : add eq and eqtype tables 44# 2010/12/26 : pda : use cgi-dispatch 45# 2010/12/26 : pda : use same spec for all store-tabular 46# 2011/12/28 : pda : add dotattr type 47# 2012/01/25 : pda : add confcmd type 48# 2012/09/27 : pda/jean : add views 49# 2012/10/24 : pda/jean : add view menu in zones 50# 51 52 53# 54# Next actions 55# 56 57set conf(next) "admref" 58set conf(nextimg) "admref" 59set conf(nextindex) "start" 60set conf(nextadmindex) "admindex" 61 62# 63# Template pages used by this script 64# 65 66set conf(page-edit) admref-edit.html 67set conf(page-mod) adm-mod.html 68# help pages are defined below (for each type) 69 70############################################################################## 71# Organizations 72 73set conf(org:ptitle) "Organization management" 74set conf(org:cols) { {100 name {Name} {string 30} {}} } 75set conf(org:sql) "SELECT * FROM dns.organization ORDER BY name ASC" 76set conf(org:id) idorg 77set conf(org:help) help-org.html 78set conf(org:return) "Return to organization modification" 79set conf(org:table) dns.organization 80set conf(org:proc) admref-nop 81 82############################################################################## 83# Communities 84 85set conf(comm:ptitle) "Community management" 86set conf(comm:cols) { {100 name {Name} {string 30} {}} } 87set conf(comm:sql) "SELECT * FROM dns.community ORDER BY name ASC" 88set conf(comm:id) idcomm 89set conf(comm:help) help-comm.html 90set conf(comm:return) "Return to community modification" 91set conf(comm:table) dns.community 92set conf(comm:proc) admref-nop 93 94############################################################################## 95# Hinfo 96 97set conf(hinfo:ptitle) "Host type management" 98set conf(hinfo:cols) { {60 name {Description} {string 30} {}} 99 {20 sort {Sort} {int 10} 100} 100 {20 present {Present} {bool} 1} 101 } 102set conf(hinfo:sql) "SELECT * FROM dns.hinfo ORDER BY sort ASC, name ASC" 103set conf(hinfo:id) idhinfo 104set conf(hinfo:help) help-hinfo.html 105set conf(hinfo:return) "Return to host information modification" 106set conf(hinfo:table) dns.hinfo 107set conf(hinfo:proc) admref-nop 108 109############################################################################## 110# Networks 111 112set conf(net:ptitle) "Network management" 113set conf(net:cols) { {1 name {Name} {string 20} {}} 114 {1 location {Location} {string 10} {}} 115 {1 addr4 {IPv4 address} {string 15} {}} 116 {1 gw4 {IPv4 gateway} {string 12} {}} 117 {1 dhcp {DHCP enabled} {bool} 0} 118 {1 addr6 {IPv6 address} {string 49} {}} 119 {1 gw6 {IPv6 gateway} {string 45} {}} 120 {1 idorg {Organization} {menu {%MENUORG%}} {}} 121 {1 idcomm {Community} {menu {%MENUCOMM%}} {}} 122 {1 comment {Comment} {string 15} {}} 123 } 124set conf(net:sql) "SELECT * FROM dns.network ORDER BY addr4" 125set conf(net:id) idnet 126set conf(net:help) help-net.html 127set conf(net:return) "Return to network modification" 128set conf(net:table) dns.network 129set conf(net:proc) admref-nop 130 131############################################################################## 132# Domains 133 134set conf(domain:ptitle) "Domain management" 135set conf(domain:cols) { {100 name {Domain} {string 30} {}} } 136set conf(domain:sql) "SELECT * FROM dns.domain ORDER BY name ASC" 137set conf(domain:id) iddom 138set conf(domain:help) help-domain.html 139set conf(domain:return) "Return to domain modification" 140set conf(domain:table) dns.domain 141set conf(domain:proc) admref-nop 142 143############################################################################## 144# Views 145 146set conf(view:ptitle) "View management" 147set conf(view:cols) { {100 name {View} {string 50} {}} } 148set conf(view:sql) "SELECT * FROM dns.view ORDER BY name ASC" 149set conf(view:id) idview 150set conf(view:help) help-view.html 151set conf(view:return) "Return to view modification" 152set conf(view:table) dns.view 153set conf(view:proc) admref-nop 154 155############################################################################## 156# Zones 157 158set conf(zone:ptitle) "Zone management" 159set conf(zone:cols) { {15 name {Name} {string 15} {}} 160 {15 selection {Criterion} {string 15} {}} 161 {15 idview {View} {menu {%MENUVIEW%}} {}} 162 {45 prologue {Prolog} {textarea {45 10}} {}} 163 {25 rrsup {Addtl RR} {textarea {30 10}} {}} 164 } 165set conf(zone:sql) "SELECT * FROM dns.zone_forward ORDER BY selection ASC" 166set conf(zone:id) idzone 167set conf(zone:help) help-zone.html 168set conf(zone:return) "Return to zone modification" 169set conf(zone:table) dns.zone_forward 170set conf(zone:proc) admref-nop 171 172############################################################################## 173# Zones reverse IPv4 174 175set conf(zone4:ptitle) $conf(zone:ptitle) 176set conf(zone4:cols) $conf(zone:cols) 177set conf(zone4:sql) "SELECT * FROM dns.zone_reverse4 ORDER BY selection ASC" 178set conf(zone4:id) $conf(zone:id) 179set conf(zone4:help) $conf(zone:help) 180set conf(zone4:return) $conf(zone:return) 181set conf(zone4:table) dns.zone_reverse4 182set conf(zone4:proc) $conf(zone:proc) 183 184############################################################################## 185# Zones reverse IPv6 186 187set conf(zone6:ptitle) $conf(zone:ptitle) 188set conf(zone6:cols) $conf(zone:cols) 189set conf(zone6:sql) "SELECT * FROM dns.zone_reverse6 ORDER BY selection ASC" 190set conf(zone6:id) $conf(zone:id) 191set conf(zone6:help) $conf(zone:help) 192set conf(zone6:return) $conf(zone:return) 193set conf(zone6:table) dns.zone_reverse6 194set conf(zone6:proc) $conf(zone:proc) 195 196############################################################################## 197# DHCP profiles 198 199set conf(dhcpprof:ptitle) "DHCP profile management" 200set conf(dhcpprof:cols) { {20 name {Name} {string 20} {}} 201 {80 text {Directives dhcpd.conf} {textarea {80 10}} {}} 202 } 203set conf(dhcpprof:sql) "SELECT * FROM dns.dhcpprofile ORDER BY name ASC" 204set conf(dhcpprof:id) iddhcpprof 205set conf(dhcpprof:help) help-dhcpprof.html 206set conf(dhcpprof:return) "Return to DHCP profile modification" 207set conf(dhcpprof:table) dns.dhcpprofile 208set conf(dhcpprof:proc) admref-nop 209 210############################################################################## 211# Vlans 212 213set conf(vlan:ptitle) "Vlan management" 214set conf(vlan:cols) { {15 vlanid {Vlan-Id} {int 10} {}} 215 {75 descr {Description} {string 40} {}} 216 {10 voip {VoIP Vlan} {bool} 0} 217 } 218set conf(vlan:sql) "SELECT * FROM topo.vlan ORDER BY vlanid ASC" 219set conf(vlan:id) vlanid 220set conf(vlan:help) help-vlan.html 221set conf(vlan:return) "Return to Vlan modification" 222set conf(vlan:table) topo.vlan 223set conf(vlan:proc) vlan-check 224 225############################################################################## 226# Topo (rancid) equipment types 227 228set conf(eqtype:ptitle) "Equipment type management" 229set conf(eqtype:cols) { {100 type {Type} {string 20} {}} } 230set conf(eqtype:sql) "SELECT * FROM topo.eqtype ORDER BY type ASC" 231set conf(eqtype:id) idtype 232set conf(eqtype:help) help-eqtype.html 233set conf(eqtype:return) "Return to equipment type modification" 234set conf(eqtype:table) topo.eqtype 235set conf(eqtype:proc) admref-nop 236 237############################################################################## 238# Topo equipments 239 240set conf(eq:ptitle) "Equipment management" 241set conf(eq:cols) { {60 eq {Equipment} {string 40} {}} 242 {20 idtype {Type} {menu {%MENUTYPE%}} {}} 243 {20 up {Up/Down} {menu {%MENUUP%}} {}} 244 } 245set conf(eq:sql) "SELECT * FROM topo.eq ORDER BY eq ASC" 246set conf(eq:id) ideq 247set conf(eq:help) help-eq.html 248set conf(eq:return) "Return to equipment modification" 249set conf(eq:table) topo.eq 250set conf(eq:proc) admref-nop 251 252############################################################################## 253# Topo configuration commands for equipments 254 255set conf(confcmd:ptitle) "Configuration commands management" 256set conf(confcmd:cols) { {10 rank {Rank} {int 4} {}} 257 {10 idtype {Type} {menu {%MENUTYPE%}} {}} 258 {10 action {Action} {menu { 259 {epilogue epilogue} 260 {ifaccess ifaccess} 261 {ifdesc ifdesc} 262 {ifdisable ifdisable} 263 {ifenable ifenable} 264 {ifreset ifreset} 265 {ifvoice ifvoice} 266 {prologue prologue} 267 {resetvlan resetvlan} 268 }} {} } 269 {30 model {Model} {string 10} {}} 270 {40 command {Command} {textarea {40 5}} {}} 271 } 272set conf(confcmd:sql) "SELECT * FROM topo.confcmd c, topo.eqtype e 273 WHERE c.idtype = e.idtype 274 ORDER BY e.type, c.action, c.rank ASC" 275set conf(confcmd:id) idccmd 276set conf(confcmd:help) help-confcmd.html 277set conf(confcmd:return) "Return to modification of configuration commands" 278set conf(confcmd:table) topo.confcmd 279set conf(confcmd:proc) admref-nop 280 281############################################################################## 282# Graphviz node attributes 283 284set conf(dotattr:ptitle) "Graphviz node attributes for equipments" 285set conf(dotattr:cols) { {10 rank {Sort} {int 8} {}} 286 {5 type {Type} {menu {{2 L2} {3 L3}}} {}} 287 {20 regexp {Regexp} {string 16} {}} 288 {35 gvattr {Attributes} {textarea {40 4}} {}} 289 {30 png {Image} {image {%URLIMG%}} {}} 290 } 291set conf(dotattr:sql) "SELECT * FROM topo.dotattr ORDER BY rank ASC" 292set conf(dotattr:id) rank 293set conf(dotattr:help) help-dotattr.html 294set conf(dotattr:return) "Return to Graphviz nodes attributes" 295set conf(dotattr:table) topo.dotattr 296set conf(dotattr:proc) dotattr-check 297 298 299# 300# Netmagis general library 301# 302 303source %LIBNETMAGIS% 304 305# ::webapp::cgidebug ; exit 306 307############################################################################## 308# Display edit page 309############################################################################## 310 311d cgi-register {action {}} { 312 {type 1 1} 313} { 314 global conf 315 316 # 317 # Prepare help url 318 # 319 320 d urlset "" $conf(next) [list {action help} [list "type" $type] ] 321 set url [d urlget ""] 322 append url {#%1$s} 323 set urlhelp [::webapp::helem "a" {%2$s} "href" $url] 324 325 # 326 # Analyze type specifications 327 # 328 329 if {! [info exists conf($type:ptitle)]} then { 330 d error [mc "Type '%s' not supported" $type] 331 } 332 333 set ptitle [mc $conf($type:ptitle)] 334 335 set allwidths {} 336 set title {} 337 foreach c $conf($type:cols) { 338 lassign $c width var desc formtype defval 339 340 lappend allwidths $width 341 lappend colspecs [list $var $formtype $defval] 342 lappend title [list "html" [format $urlhelp $var [mc $desc]]] 343 } 344 345 set sql $conf($type:sql) 346 set id $conf($type:id) 347 348 # 349 # Particular cases 350 # 351 352 switch -- $type { 353 net { 354 set menuorg [::pgsql::getcols $dbfd dns.organization "" "name ASC" \ 355 {idorg name}] 356 set menucomm [::pgsql::getcols $dbfd dns.community "" "name ASC" \ 357 {idcomm name}] 358 regsub -- "%MENUORG%" $colspecs "$menuorg" colspecs 359 regsub -- "%MENUCOMM%" $colspecs "$menucomm" colspecs 360 } 361 eq { 362 set menutype [::pgsql::getcols $dbfd topo.eqtype "" "type ASC" \ 363 {idtype type}] 364 set menuup [list [list 1 [mc "Up"]] [list 0 [mc "Down"]]] 365 regsub -- "%MENUTYPE%" $colspecs "$menutype" colspecs 366 regsub -- "%MENUUP%" $colspecs "$menuup" colspecs 367 } 368 confcmd { 369 set menutype [::pgsql::getcols $dbfd topo.eqtype "" "type ASC" \ 370 {idtype type}] 371 regsub -- "%MENUTYPE%" $colspecs "$menutype" colspecs 372 } 373 zone - 374 zone4 - 375 zone6 { 376 set menuview [::pgsql::getcols $dbfd dns.view "" "name ASC" \ 377 {idview name}] 378 regsub -- "%MENUVIEW%" $colspecs "$menuview" colspecs 379 } 380 dotattr { 381 # we can't use a %s in an URL since the "%" character will be posted 382 d urlset "" $conf(nextimg) {{action image} {type dotattr} {id PCENT}} 383 set urlimg [::webapp::helem "img" "" \ 384 "src" [d urlget ""] \ 385 "alt" "Graphviz representation" \ 386 ] 387 # urlimg contains some "&" and the "PCENT" 388 regsub -all -- "&" $urlimg {\\&} urlimg 389 regsub -- "PCENT" $urlimg {%1$s} urlimg 390 regsub -- "%URLIMG%" $colspecs "$urlimg" colspecs 391 } 392 } 393 394 # 395 # Display data 396 # 397 398 set msg [display-tabular $allwidths $title $colspecs $dbfd $sql $id tab] 399 if {$msg ne ""} then { 400 d error $msg 401 } 402 403 # 404 # End of script: output page and close database 405 # 406 407 d urlset "%URLFORM%" $conf(next) [list [list "type" $type]] 408 409 d result $conf(page-edit) [list \ 410 [list %TABLEAU% $tab] \ 411 [list %TITLEPAGE% $ptitle] \ 412 ] 413} 414 415############################################################################## 416# Display graphviz generated image 417############################################################################## 418 419proc dotattr-install-image {dbfd id regexp attr} { 420 # 421 # Generate the bitmap image with graphviz 422 # 423 424 set gv [::gvgraph %AUTO%] 425 set dotcmd [get-local-conf "dot"] 426 $gv node $regexp $attr 427 if {[$gv graphviz "png" "dot" $dotcmd ""]} then { 428 set png [$gv output] 429 binary scan $png "H*" hex 430 set hex "\\x$hex" 431 } else { 432 set png [errimg [$gv error]] 433 set hex "" 434 } 435 $gv destroy 436 437 # 438 # Install the image in database if no error 439 # 440 441 if {$hex ne ""} then { 442 set sql "UPDATE topo.dotattr SET png = '$hex' WHERE rank = $id" 443 if {! [::pgsql::execsql $dbfd $sql msg]} then { 444 set png [errimg $msg] 445 } 446 } 447 448 return $png 449} 450 451# get graphviz image from database. If none exists, generates one from 452# attributes 453 454proc dotattr-get-image {dbfd id} { 455 set sql "SELECT * FROM topo.dotattr WHERE rank = $id" 456 set png "" 457 set found 0 458 pg_select $dbfd $sql tab { 459 if {$tab(png) eq "" || [string range $tab(png) 0 1] ne {\x}} then { 460 set png [dotattr-install-image $dbfd $id $tab(regexp) $tab(gvattr)] 461 } else { 462 set png [binary format "H*" [string range $tab(png) 2 end]] 463 } 464 set found 1 465 } 466 if {! $found} then { 467 set png [errimg "ERROR : cannot find image for rank '$id'"] 468 } 469 return $png 470} 471 472d cgi-register {action image} { 473 {type 1 1} 474 {id 1 1} 475} { 476 global conf 477 478 switch -- $type { 479 dotattr { 480 if {! [regexp {^[0-9]+$} $id]} then { 481 d errimg "'$id' is not an number" 482 } 483 ::webapp::send png [dotattr-get-image $dbfd $id] 484 d end 485 } 486 default { 487 d errimg [mc "Type '%s' not supported" $type] 488 } 489 } 490} 491 492############################################################################## 493# Display help page 494############################################################################## 495 496d cgi-register {action help} { 497 {type 1 1} 498} { 499 global conf 500 501 # 502 # Get table type 503 # 504 505 if {! [info exists conf($type:help)]} then { 506 d error [mc "Type '%s' not supported" $type] 507 } 508 509 # 510 # End of script: output page and close database 511 # 512 513 d result $conf($type:help) {} 514} 515 516############################################################################## 517# Modify data 518############################################################################## 519 520proc admref-nop {args} { 521 # ok 522 return 1 523} 524 525proc dotattr-check {op dbfd _msg id idnum table _tabval} { 526 upvar $_msg msg 527 upvar $_tabval tabval 528 529 set ok 1 530 531 # op = nop, mod, add, del 532 if {$op eq "mod" || $op eq "add"} then { 533 # 534 # Generate the bitmap image with graphviz 535 # 536 537 set dotcmd [get-local-conf "dot"] 538 set gv [::gvgraph %AUTO%] 539 $gv node $tabval(regexp) $tabval(gvattr) 540 if {[$gv graphviz "png" "dot" $dotcmd ""]} then { 541 # we don't use the result since we should use the \x prefix 542 # for binary data, prefix which will be transformed by 543 # the pgsql::quote function 544 set tabval(png) "" 545 } else { 546 set msg [$gv error] 547 set ok 0 548 } 549 $gv destroy 550 } 551 552 return $ok 553} 554 555proc vlan-check {op dbfd _msg id idnum table _tabval} { 556 upvar $_msg msg 557 upvar $_tabval tabval 558 559 set ok 1 560 561 # op = nop, mod, add, del 562 if {$op eq "mod" || $op eq "add"} then { 563 # 564 # Check vlan name 565 # 566 567 if {[info exists tabval(descr)]} then { 568 set ok [check-vlan-name $tabval(descr) msg] 569 } 570 # FIXME: we should also check VLAN id 571 } 572 573 return $ok 574} 575 576d cgi-register {action mod} { 577 {type 1 1} 578} { 579 global conf 580 581 if {! [info exists conf($type:return)]} then { 582 d error [mc "Type '%s' not supported" $type] 583 } 584 set ret [mc $conf($type:return)] 585 586 # 587 # Get form field specification 588 # 589 590 set form {} 591 foreach c $conf($type:cols) { 592 lassign $c width var desc formtype defval 593 lappend form [list "${var}\[0-9\]+" 0 9999] 594 lappend form [list "${var}n\[0-9\]+" 0 9999] 595 } 596 597 if {[llength [::webapp::get-data ftab $form]] == 0} then { 598 d error [mc "Invalid input"] 599 } 600 601 # 602 # Get column specification 603 # 604 605 set spec {} 606 foreach c $conf($type:cols) { 607 lassign $c width var desc formtype defval 608 lappend spec [list $var $formtype $defval] 609 } 610 611 # 612 # Store modifications in database 613 # 614 615 store-tabular $dbfd $spec $conf($type:id) $conf($type:table) ftab $conf($type:proc) 616 d writelog "modref" "modification of reference table $conf($type:table)" 617 618 # 619 # End of script: output page and close database 620 # 621 622 d urlset "%URL1%" $conf(nextindex) {} 623 d urlset "%URL2%" $conf(nextadmindex) {} 624 d urlset "%URL3%" $conf(next) [list [list "type" $type]] 625 626 d result $conf(page-mod) [list \ 627 [list %RETURN% $ret] \ 628 629 ] 630} 631 632############################################################################## 633# Main procedure 634############################################################################## 635 636d cgi-dispatch "admin" "admin" 637