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" "&nbsp;"]
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" "&nbsp;" "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