1#!%TCLSH% 2 3# 4# List all machines within a network/IP range 5# 6# Parameters (form or url): 7# - selection criteria 8# - plages : list of IP network ids 9# - cidr : cidr given by user 10# - output format 11# - dolist, doprint, docsv or domap 12# 13# History 14# 2002/03/27 : pda/jean : design 15# 2002/05/02 : pda/jean : hinfo processing 16# 2002/05/06 : pda/jean : add cidr 17# 2002/05/06 : pda/jean : add groups 18# 2002/05/16 : pda : conversion to arrgen 19# 2002/07/09 : pda : add nologin 20# 2003/05/13 : pda/jean : use auth base 21# 2004/01/14 : pda/jean : add IPv6 22# 2004/08/05 : pda/jean : add mac 23# 2004/08/06 : pda/jean : extend network permissions 24# 2008/09/24 : pda/jean : add sendsmtp 25# 2010/10/07 : pda : add free addresses 26# 2010/10/13 : pda : added dhcp ranges in map 27# 2010/12/09 : pda : i18n 28# 2010/12/25 : pda : use cgi-dispatch 29# 2012/09/20 : pda/jean : add docsv 30# 2012/11/07 : pda/jean : add views 31# 32# 33# Template pages used by this script 34# 35 36set conf(page) net.html 37set conf(listhtml) net-list.html 38set conf(listtex) net-list.tex 39 40# 41# Next actions 42# 43 44set conf(next) "net" 45set conf(nextedit) "edit" 46set conf(nextadd) "add" 47 48# 49# Script parameters 50# 51 52# maximum number of IP networks without displaying a scroll bar 53set conf(maxranges) 10 54 55# max size of IPv4 blocks where we are looking for non-declared addresses 56set conf(limit-unused) 16384 57# number of addresses per line in a free address map 58set conf(max-per-row) 16 59 60# 61# tabular specification for result 62# Columns: 63# - IP address 64# - host name and aliases 65# - MAC address 66# - DHCP profile 67# - host type (hinfo) 68# - comments 69# - user login 70# - date of last modification (%m/%d/%y) 71# 72 73set conf(tableau) { 74 global { 75 chars {10 normal} 76 columns {21 17 12 9 9 13 17 6 6 7} 77 botbar {yes} 78 align {left} 79 latex { 80 linewidth {267} 81 } 82 } 83 pattern Title { 84 title {yes} 85 topbar {yes} 86 chars {bold} 87 vbar {yes} 88 column { } 89 vbar {yes} 90 column { } 91 vbar {yes} 92 column { } 93 vbar {yes} 94 column { } 95 vbar {yes} 96 column { } 97 vbar {yes} 98 column { } 99 vbar {yes} 100 column { } 101 vbar {yes} 102 column { } 103 vbar {yes} 104 column { } 105 vbar {yes} 106 column { } 107 vbar {yes} 108 } 109 pattern Normal { 110 vbar {yes} 111 column { 112 format {raw} 113 } 114 vbar {yes} 115 column { 116 format {raw} 117 } 118 vbar {yes} 119 column { } 120 vbar {yes} 121 column { } 122 vbar {yes} 123 column { } 124 vbar {yes} 125 column { } 126 vbar {yes} 127 column { } 128 vbar {yes} 129 column { 130 align {center} 131 } 132 vbar {yes} 133 column { 134 align {center} 135 } 136 vbar {yes} 137 column { } 138 vbar {yes} 139 } 140} 141 142 143# 144# Netmagis general library 145# 146 147source %LIBNETMAGIS% 148 149# ::webapp::cgidebug ; exit 150 151############################################################################## 152# Display network selection page 153############################################################################## 154 155d cgi-register { 156 domap {} 157 dolist {} 158 docsv {} 159 doprint {} 160} { 161} { 162 global conf 163 164 # 165 # Initialization 166 # 167 168 169 # 170 # Process informations about the user, in case they are changed 171 # (user is supposed to signal updates) 172 # 173 174 set user [display-user tabuid] 175 176 # 177 # View menu 178 # 179 180 set menuview [mc "View"] 181 append menuview " " 182 lassign [menu-view $dbfd $tabuid(idcor) "idview" {}] disp html 183 append menuview $html 184 if {$disp} then { 185 set dispview "block" 186 set dispforallviews [mc "(for all views)"] 187 set dispforselview [mc "(for the selected view)"] 188 } else { 189 set dispview "none" 190 set dispforallviews "" 191 set dispforselview "" 192 } 193 194 # 195 # Get IP address ranges 196 # 197 198 set lnet [read-networks $dbfd $tabuid(idgrp) "consult"] 199 set nnet [llength $lnet] 200 if {$nnet == 0} then { 201 set ranges [mc "No authorized network"] 202 } else { 203 if {$nnet > $conf(maxranges)} then { 204 set nnet $conf(maxranges) 205 } 206 set ranges [::webapp::form-menu "plages" $nnet 1 $lnet {}] 207 } 208 209 # 210 # End of script: output page and close database 211 # 212 213 d urlset "%URLFORM%" $conf(next) {} 214 d result $conf(page) [list \ 215 [list %CORRESP% $user] \ 216 [list %PLAGES% $ranges] \ 217 [list %DISPVIEW% $dispview] \ 218 [list %MENUVIEW% $menuview] \ 219 [list %FORALLVIEWS% $dispforallviews] \ 220 [list %FORSELVIEW% $dispforselview] \ 221 ] 222} 223 224############################################################################## 225# Utility functions 226############################################################################## 227 228proc output-list {dbfd lcidr idview _tabuid format} { 229 upvar $_tabuid tabuid 230 global conf 231 232 set lines {} 233 lappend lines [list "Title" \ 234 [mc "IP address"] \ 235 [mc "Name and aliases"] \ 236 [mc "MAC address"] \ 237 [mc "DHCP profile"] \ 238 [mc "Host type"] \ 239 [mc "Comment"] \ 240 [mc "Responsible"] \ 241 [mc "SMTP emit right"] \ 242 [mc "Login"] \ 243 [mc "Date"] \ 244 ] 245 set nbhost 0 246 247 # 248 # Build next action 249 # 250 251 set nextprog "list" 252 set nextargs {} 253 foreach cidr $lcidr { 254 lappend nextargs cidr=$cidr 255 } 256 lappend nextargs idview=$idview 257 set nextargs [join $nextargs "&"] 258 259 # 260 # External loop : for each IP range given 261 # 262 263 foreach cidrplage $lcidr { 264 # 265 # These two subselect queries are used to get IP ranges 266 # allowed/denied for the user, within network id specified 267 # by the CIDR 268 # 269 270 set sqlallow "SELECT addr FROM dns.p_ip WHERE 271 (addr <<= '$cidrplage' OR addr >>= '$cidrplage') 272 AND allow_deny = 1 273 AND idgrp = $tabuid(idgrp)" 274 set sqldeny "SELECT addr FROM dns.p_ip WHERE 275 (addr <<= '$cidrplage' OR addr >>= '$cidrplage') 276 AND allow_deny = 0 277 AND idgrp = $tabuid(idgrp)" 278 279 # 280 # Extract all aliases related to IP addresses in allowed ranges 281 # and put them in an array indexed by IP addresses 282 # Example : 283 # cname(172.16.201.129) {aton.example.com diablo.example.com...} 284 # 285 286 set sql "SELECT alias.name || '.' || domain.name AS name, rr_ip.addr 287 FROM dns.rr alias, dns.rr canon, dns.rr_ip, dns.rr_cname, dns.domain 288 WHERE canon.idrr = rr_cname.cname 289 AND rr_cname.idrr = alias.idrr 290 AND rr_ip.idrr = canon.idrr 291 AND rr_ip.addr <<= ANY ($sqlallow) 292 AND NOT rr_ip.addr <<= ANY ($sqldeny) 293 AND rr_ip.addr <<= '$cidrplage' 294 AND domain.iddom = alias.iddom 295 AND canon.idview = $idview 296 ORDER BY alias.name" 297 pg_select $dbfd $sql tab { 298 lappend cname($tab(addr)) $tab(name) 299 } 300 301 # 302 # Get all DHCP profile names. They could be fetched in the 303 # next large request (on RR), but this request would become 304 # very complex and not very readable. 305 # 306 307 set sql "SELECT iddhcpprof, name FROM dns.dhcpprofile" 308 pg_select $dbfd $sql tab { 309 set profdhcpname($tab(iddhcpprof)) $tab(name) 310 } 311 312 # 313 # Get all allowed IP address and add them to the array. 314 # 315 316 set dayfmt [dnsconfig get "dayfmt"] 317 set sql "SELECT DISTINCT rr.name || '.' || domain.name AS name, 318 rr_ip.addr, 319 rr.comment, rr.respname, rr.respmail, rr.date, 320 rr.sendsmtp, rr.mac, 321 rr.iddhcpprof AS dhcp1, 322 dhcprange.iddhcpprof AS dhcp2, 323 hinfo.name AS hinfo, nmuser.login 324 FROM dns.rr, dns.domain, dns.hinfo, global.nmuser, 325 dns.rr_ip LEFT OUTER JOIN dns.dhcprange 326 ON (rr_ip.addr >= dhcprange.min 327 AND rr_ip.addr <= dhcprange.max) 328 WHERE rr.idrr = rr_ip.idrr 329 AND rr_ip.addr <<= ANY ($sqlallow) 330 AND NOT rr_ip.addr <<= ANY ($sqldeny) 331 AND rr_ip.addr <<= '$cidrplage' 332 AND domain.iddom = rr.iddom 333 AND rr.idhinfo = hinfo.idhinfo 334 AND rr.idcor = nmuser.idcor 335 AND rr.idview = $idview 336 ORDER BY rr_ip.addr" 337 pg_select $dbfd $sql tab { 338 set primary $tab(name) 339 set addr $tab(addr) 340 set mac $tab(mac) 341 set dhcp1 $tab(dhcp1) 342 set dhcp2 $tab(dhcp2) 343 set hinfo $tab(hinfo) 344 set comment $tab(comment) 345 set respname $tab(respname) 346 set respmail $tab(respmail) 347 set sendsmtp $tab(sendsmtp) 348 set date $tab(date) 349 set login $tab(login) 350 351 if {[info exists cname($addr)]} then { 352 set secondaries $cname($addr) 353 } else { 354 set secondaries "" 355 } 356 357 if {$respmail ne ""} then { 358 set resp "$respname <$respmail>" 359 } else { 360 set resp $respname 361 } 362 363 if {[info exists profdhcpname($dhcp2)]} then { 364 set dhcp $profdhcpname($dhcp2) 365 } elseif {[info exists profdhcpname($dhcp1)]} then { 366 set dhcp $profdhcpname($dhcp1) 367 } else { 368 set dhcp "" 369 } 370 371 set date [clock format [clock scan $date] -format $dayfmt] 372 373 if {$sendsmtp} then { 374 set sendsmtp [mc "Yes"] 375 } else { 376 set sendsmtp "-" 377 } 378 379 switch -- $format { 380 html { 381 d urlset "" $conf(nextedit) [list [list "addr" $addr]] 382 d urlsetnext "" $nextprog $nextargs 383 set url [d urlget ""] 384 set name "$primary " 385 append name [::webapp::helem "i" $secondaries] 386 set addr [::webapp::helem "a" $addr "href" $url] 387 } 388 latex { 389 set name "$primary \\textit \{$secondaries\}" 390 } 391 csv { 392 set ns [join $secondaries ","] 393 if {$ns eq ""} then { 394 set name "$primary" 395 } else { 396 set name "$primary,$ns" 397 } 398 } 399 } 400 lappend lines [list Normal \ 401 $addr $name $mac $dhcp \ 402 $hinfo $comment $resp $sendsmtp \ 403 $login $date] 404 incr nbhost 405 } 406 } 407 408 # 409 # Generate HTML or CSV code 410 # 411 412 set tableau [::arrgen::output $format $conf(tableau) $lines] 413 414 # 415 # End of script: output page and close database 416 # 417 418 set datefmt [dnsconfig get "datefmt"] 419 set date [clock format [clock seconds] -format $datefmt] 420 421 set pline [mc {Declared addresses (IPv4+IPv6) in view '%1$s': %2$s} [u viewname $idview] $nbhost] 422 set dhost [mc "List of declared addresses"] 423 424 switch -- $format { 425 html { 426 set pline [::webapp::helem "p" $pline] 427 set tableau "$pline\n$tableau" 428 429 d result $conf(listhtml) [list \ 430 [list %TITLE% $dhost] \ 431 [list %TABLEAU% $tableau] \ 432 [list %DATE% $date] \ 433 ] 434 } 435 latex { 436 set tableau "$pline\n\n$tableau" 437 d result $conf(listtex) [list \ 438 [list %ORIENTATION% "landscape"] \ 439 [list %TABLEAU% $tableau] \ 440 [list %DATE% $date] \ 441 ] 442 } 443 csv { 444 ::webapp::send "csv" $tableau 445 d end 446 } 447 } 448} 449 450proc output-map {dbfd lcidr _tabuid format} { 451 upvar $_tabuid tabuid 452 global conf 453 454 # 455 # Keep in lcidr only IPv4 ranges (and not IPv6) because 456 # SQL function availip() works only for IPv4. 457 # 458 459 set lcidrv4 {} 460 set m "" 461 foreach cidrplage $lcidr { 462 set r [check-ip-syntax $dbfd $cidrplage "cidr4"] 463 if {$r eq ""} then { 464 lappend lcidrv4 $cidrplage 465 } else { 466 append m "$r<br>" 467 } 468 } 469 470 if {[llength $lcidrv4] == 0} then { 471 d error [mc "No valid CIDR: %s" $m] 472 } 473 474 # 475 # Build next action. 476 # 477 478 set nextprog "map" 479 set nextargs {} 480 foreach cidr $lcidrv4 { 481 lappend nextargs cidr=$cidr 482 } 483 set nextargs [join $nextargs "&"] 484 485 # 486 # Legend 487 # 488 489 for {set i 0} {$i < 5} {incr i} { 490 set legend($i) 0 491 } 492 493 # 494 # Traverse all IP addresses. New line every 16 addresses, and 495 # display appropriate color. 496 # 497 498 set tableau "" 499 set limite $conf(limit-unused) 500 set maxrow $conf(max-per-row) 501 502 foreach cidr $lcidrv4 { 503 set html "" 504 set n 0 505 set navail 0 506 set sql "SELECT * FROM dns.mark_cidr ('$cidr', $limite, $tabuid(idgrp))" 507 if {! [::pgsql::execsql $dbfd $sql msg]} then { 508 d error [mc {Error in CIDR '%1$s': %2$s} $cidr $msg] 509 } 510 511 set sql "SELECT * FROM allip ORDER BY addr" 512 513 # 514 # Explore all addresses (not available, free, or busy) 515 # 516 517 pg_select $dbfd $sql tab { 518 set addr $tab(addr) 519 set avail $tab(avail) 520 set fqdn $tab(fqdn) 521 522 # need this legend 523 incr legend($avail) 524 525 # extract last byte of address 526 set last "" 527 regexp {[^.]*$} $addr last 528 529 if {$n % $maxrow == 0} then { 530 set line [::webapp::helem td $addr] 531 } 532 533 append line "\n" 534 switch -- $avail { 535 0 { 536 # not available (user has not the right, addr does'nt exists) 537 append line [::webapp::helem "td" $last "class" "notav"] 538 } 539 1 { 540 # not declared and not in a dhcp range 541 d urlset "" $conf(nextadd) [list [list "addr" $addr]] 542 d urlsetnext "" $nextprog $nextargs 543 set url [d urlget ""] 544 set h [::webapp::helem "a" $last "href" $url] 545 append line [::webapp::helem "td" $h "class" "noname-nodhcp"] 546 incr navail 547 } 548 2 { 549 # declared and not in a dhcprange 550 d urlset "" $conf(nextedit) [list [list "addr" $addr]] 551 d urlsetnext "" $nextprog $nextargs 552 set url [d urlget ""] 553 set h [::webapp::helem "a" $last "href" $url "title" $fqdn] 554 append line [::webapp::helem "td" $h "class" "name-nodhcp"] 555 } 556 3 { 557 # not declared and in a dhcp range 558 d urlset "" $conf(nextadd) [list [list "addr" $addr]] 559 d urlsetnext "" $nextprog $nextargs 560 set url [d urlget ""] 561 set h [::webapp::helem "a" $last "href" $url] 562 append line [::webapp::helem "td" $h "class" "noname-dhcp"] 563 } 564 4 { 565 # declared and in a dhcprange 566 d urlset "" $conf(nextedit) [list [list "addr" $addr]] 567 d urlsetnext "" $nextprog $nextargs 568 set url [d urlget ""] 569 set h [::webapp::helem "a" $last "href" $url "title" $fqdn] 570 append line [::webapp::helem "td" $h "class" "name-dhcp"] 571 } 572 default { 573 d error [mc {Internal error for '%1$s': avail=%2$s} $addr $avail] 574 } 575 } 576 577 incr n 578 if {$n % $maxrow == 0} then { 579 append html "\n" 580 append html [::webapp::helem "tr" $line] 581 } 582 } 583 if {$n % $maxrow != 0} then { 584 for {set i $n} {$i % $maxrow != 0} {incr i} { 585 append line [::webapp::helem "td" " "] 586 } 587 append html "\n" 588 append html [::webapp::helem "tr" $line] 589 } 590 591 # 592 # Titles, stats & co 593 # 594 595 append tableau "\n" 596 if {[llength $lcidrv4] > 1} then { 597 append tableau [::webapp::helem "h3" [mc "Network '%s'" $cidr]] 598 } 599 600 set p [mc {%1$s available addresses / %2$s total} $navail $n] 601 append p " " 602 603 # 604 # Detail: depends upon the number of available views 605 # 606 607 set idviews [u myviewids] 608 if {[llength $idviews] == 1} then { 609 set t [mc "Detail"] 610 d urlset "" $conf(next) [list \ 611 [list "dolist" "yes"] \ 612 [list "cidr" $cidr] \ 613 [list "idview" [lindex $idviews 0]] \ 614 ] 615 set url [d urlget ""] 616 append p [::webapp::helem "a" "\[$t\]" "href" $url] 617 } else { 618 append p "<br>" 619 append p [mc "Detail"] 620 append p " " 621 foreach id $idviews { 622 set t [u viewname $id] 623 d urlset "" $conf(next) [list \ 624 [list "dolist" "yes"] \ 625 [list "cidr" $cidr] \ 626 [list "idview" $id] \ 627 ] 628 set url [d urlget ""] 629 append p [::webapp::helem "a" "\[$t\]" "href" $url] 630 } 631 } 632 633 append tableau [::webapp::helem "p" $p] 634 append tableau "\n" 635 append tableau [::webapp::helem "table" $html "id" "map"] 636 append tableau "\n" 637 } 638 639 # 640 # Build legend 641 # 642 643 set hlegend "" 644 foreach {i class txt} { 645 0 notav {address not allowed} 646 1 noname-nodhcp {available address in all views} 647 2 name-nodhcp {declared address in at least one view} 648 3 noname-dhcp {non-declared address within a DHCP range} 649 4 name-dhcp {declared address, within a DHCP range} 650 } { 651 if {$legend($i) > 0} then { 652 set l [::webapp::helem "td" " " "class" $class] 653 append l [::webapp::helem "td" [mc $txt]] 654 append l "\n" 655 append hlegend [::webapp::helem "tr" $l] 656 } 657 } 658 set hlegend [::webapp::helem "div" \ 659 [::webapp::helem "table" $hlegend "border" "0"] \ 660 "id" "legend"] 661 set tableau "$hlegend\n$tableau" 662 663 # 664 # Output page and close database 665 # 666 667 set datefmt [dnsconfig get "datefmt"] 668 set date [clock format [clock seconds] -format $datefmt] 669 670 d result $conf(listhtml) [list \ 671 [list %TITLE% [mc "IPv4 address map"]] \ 672 [list %TABLEAU% $tableau] \ 673 [list %DATE% $date] \ 674 ] 675} 676 677# format = latex, map or html 678proc output {dbfd _ftab _tabuid format} { 679 upvar $_ftab ftab 680 upvar $_tabuid tabuid 681 global conf 682 683 # 684 # Argument analysis 685 # 686 687 set lcidr {} 688 set l $ftab(cidr) 689 foreach cidr $l { 690 set cidr [string trim $cidr] 691 if {$cidr ne ""} then { 692 set msg [check-ip-syntax $dbfd $cidr "cidr"] 693 if {$msg ne ""} then { 694 d error $msg 695 } 696 lappend lcidr $cidr 697 } 698 } 699 700 set nranges [llength $ftab(plages)] 701 702 # compatibility between two arguments 703 if {[llength $lcidr] == 0 && $nranges == 0} then { 704 d error [mc "You must choose a CIDR or at least one network"] 705 } 706 if {[llength $lcidr] > 0 && $nranges > 0} then { 707 d error [mc "You can not choose both a CIDR and a network"] 708 } 709 710 # 711 # Check given network ids and CIDR 712 # 713 714 if {$nranges > 0} then { 715 foreach netid $ftab(plages) { 716 set l [check-netid $dbfd $netid $tabuid(idgrp) "consult" {4 6} msg] 717 if {[llength $l] == 0} then { 718 d error $msg 719 } 720 set lcidr [concat $lcidr $l] 721 } 722 } 723 724 # 725 # Perform the action 726 # 727 728 if {$format eq "map"} then { 729 output-map $dbfd $lcidr tabuid $format 730 } else { 731 # 732 # Check access to view 733 # 734 735 set idview [lindex $ftab(idview) 0] 736 set msg [check-views [list $idview]] 737 if {$msg ne ""} then { 738 d error $msg 739 } 740 741 output-list $dbfd $lcidr $idview tabuid $format 742 } 743} 744 745############################################################################## 746# Display network list 747############################################################################## 748 749d cgi-register {dolist .+} { 750 {plages 0 99999} 751 {cidr 1 99999} 752 {idview 1 1} 753} { 754 output $dbfd ftab tabuid "html" 755} 756 757d cgi-register {doprint .+} { 758 {plages 0 99999} 759 {cidr 1 99999} 760 {idview 1 1} 761} { 762 output $dbfd ftab tabuid "latex" 763} 764 765d cgi-register {docsv .+} { 766 {plages 0 99999} 767 {cidr 1 99999} 768 {idview 1 1} 769} { 770 output $dbfd ftab tabuid "csv" 771} 772 773# idview is not used in map output 774d cgi-register {domap .+} { 775 {plages 0 99999} 776 {cidr 1 99999} 777} { 778 output $dbfd ftab tabuid "map" 779} 780 781############################################################################## 782# Main procedure 783############################################################################## 784 785d cgi-dispatch "dns" "" 786