1#!%TCLSH%
2
3#
4# List networks, or network details
5#
6# Called by: all topo scripts
7#
8# Parameters (form or url):
9#	- addr : ip address
10#	- format : nothing, or "pdf" or "png"
11#
12# History
13#   2006/06/05 : pda      : design
14#   2006/06/20 : pda      : prologue depends upon format
15#   2006/06/22 : pda      : fix a bug on link numbers
16#   2006/06/22 : pda      : output depends upon format
17#   2006/08/09 : pda      : full path of ps2pdf
18#   2006/08/14 : pda      : merge with listl2
19#   2007/01/04 : pda      : add parameter uid
20#   2007/01/11 : pda      : common initialization
21#   2007/01/11 : pda      : uid substitution
22#   2010/12/12 : pda      : i18n
23#   2010/12/20 : pda      : reworked installation
24#   2010/12/25 : pda      : use cgi-dispatch
25#
26
27#
28# Template pages used by this script
29#
30
31set conf(page1)		l3.html
32set conf(pagen)		topolist.html
33
34#
35# Next actions
36#
37
38set conf(nexteq)	"eq"
39set conf(nextl2)	"l2"
40set conf(nextl3)	"l3"
41
42
43#
44# Script parameters
45#
46
47set conf(dumpgraph)	"dumpgraph -o rnet %s"
48set conf(extractl3)	"extractl3 %s %s"
49
50#
51# Netmagis general library
52#
53
54source %LIBNETMAGIS%
55
56# ::webapp::cgidebug ; exit
57
58##############################################################################
59# Utilities
60##############################################################################
61
62proc gen-graph {dbfd gv format xl3} {
63    global conf
64
65    dotattr-match-init $dbfd 3 td
66
67    foreach line [split $xl3 "\n"] {
68	switch -- [lindex $line 0] {
69	    selection {
70		$gv title [lreplace $line 0 0]
71	    }
72	    eq {
73		lassign $line kw nodename nodetype
74		set attrlist [dotattr-match-get $nodetype td]
75		switch $nodetype {
76		    router {
77			if {! [regexp -- {([^:]+):(.*)} $nodename bidon eqname rinst]} then {
78			    d error [mc "Invalid router instance '%s'" $nodename]
79			}
80			switch -- $rinst {
81			    _v4 { set label "$eqname\\ndefault" }
82			    _v6 { set label "$eqname\\ndefault (IPv6)" }
83			    default { set label "$eqname\\r$rinst" }
84			}
85			lappend attrlist label=\"$label\"
86		    }
87		    host {
88			set eqname $nodename
89		    }
90		    default {
91			d error [mc {Invalid node type '%1$s' for %2$s} $nodetype $nodename]
92		    }
93		}
94
95		d urlset "" $conf(nexteq) [list [list "eq" $eqname]]
96		set url [d urlget ""]
97		lappend attrlist "href=\"$url\""
98
99		$gv node $nodename $attrlist
100	    }
101	    direct {
102		lassign $line kw eq1 if1 ip1 linkname eq2 if2 ip2
103		set attrlist [list label=\"$linkname\" \
104					headlabel=\"$if2\\n$ip2\" \
105					taillabel=\"$if1\\n$ip1\" \
106				    ]
107		$gv link $eq1 $eq2 $attrlist
108	    }
109	    cloud {
110		lassign $line kw nodename bcastref vlans networks
111		set attrlist [dotattr-match-get "cloud" td]
112		set l {}
113		set vlanid -1
114		foreach vl $vlans {
115		    set v [lindex $vl 0]
116		    lappend l $v
117		    if {$v != 0 && $vlanid == -1} then {
118			set vlanid $v
119		    }
120		}
121		set l [join $l ", "]
122		set label [mc "Vlan"]
123		append label " $l\\n"
124		append label [join $networks "\\n"]
125		lappend attrlist "label=\"$label\""
126
127		if {$vlanid != -1} then {
128		    d urlset "" $conf(nextl2) [list [list "vlan" $vlanid]]
129		    set url [d urlget ""]
130		    lappend attrlist "href=\"$url\""
131		}
132
133		$gv node $nodename $attrlist
134	    }
135	    link {
136		lassign $line kw eqname ifname ipaddr linkname cloud
137		set attrlist [list headlabel=\"$linkname\" \
138					taillabel=\"$ifname\\n$ipaddr\" \
139				    ]
140		$gv link $eqname $cloud $attrlist
141	    }
142	}
143    }
144
145    #
146    # Graph processors
147    #
148
149    set dotcmd [get-local-conf "dot"]
150    set ps2pdf [get-local-conf "ps2pdf"]
151
152    return [$gv graphviz $format "neato" $dotcmd $ps2pdf]
153}
154
155##############################################################################
156# Display L3 parameters
157##############################################################################
158
159d cgi-register {} {
160    {addr	0 1}
161    {format	0 1}
162} {
163    global conf
164
165    #
166    # Initialization
167    #
168
169    set msgsta [topo-status $dbfd $tabuid(p_admin)]
170
171    set tmp /tmp/l3-[pid]
172
173    d urlset "%URLFORMEQ%" $conf(nexteq) {}
174    d urlset "%URLFORML2%" $conf(nextl2) {}
175    d urlset "%URLFORML3%" $conf(nextl3) {}
176
177    #
178    # Get IP networks from the graph
179    #
180
181    set cmd [format $conf(dumpgraph) $tabuid(flagsr)]
182    if {! [call-topo $cmd msg]} then {
183	d error [mc "Error while reading networks: %s" $msg]
184    }
185    foreach line [split $msg "\n"] {
186	if {[regexp {^rnet ([^ ]+)} $line bidon a]} then {
187	    set tabip($a) ""
188	}
189    }
190
191    if {$addr eq ""} then {
192	#
193	# Sort IP addresses
194	#
195
196	set list {}
197	foreach addr [lsort -command compare-ip [array names tabip]] {
198	    d urlset "" $conf(nextl3) [list [list "addr" $addr]]
199	    set url [d urlget ""]
200	    lappend list [::webapp::helem "li" \
201				[::webapp::helem "a" $addr "href" $url]]
202	}
203	set list [::webapp::helem "ul" [join $list "\n"]]
204
205	#
206	# End of script: output page and close database
207	#
208
209	d result $conf(pagen) [list \
210				    [list %MSGSTA% $msgsta] \
211				    [list %OBJETS% [mc "IP networks"]] \
212				    [list %LIST% $list] \
213				    [list %EQ%     ""] \
214				    [list %VLAN%   ""] \
215				    [list %ADDR%   ""] \
216				    [list %HEADER% ""] \
217				    [list %ONLOAD% ""] \
218				]
219    } else {
220	set gv [::gvgraph %AUTO%]
221
222	#
223	# Checks the output format
224	#
225
226	if {$format eq ""} then {
227	    set format "map"
228	}
229	set msg [$gv check-format $format]
230	if {$msg ne ""} then {
231	    d error $msg
232	}
233
234	#
235	# Validate IP address
236	#
237
238	set msg [check-ip-syntax $dbfd $addr "loosecidr"]
239	if {$msg ne ""} then {
240	    d error $msg
241	}
242
243	#
244	# Search given IP and get associated network
245	#
246
247	set lnet {}
248	foreach net [array names tabip] {
249	    if {[ip-in $addr $net]} then {
250		lappend lnet $net
251	    }
252	}
253	if {[llength $lnet] == 0} then {
254	    set lnet $addr
255	}
256
257	#
258	# Get data from graph
259	#
260
261	set cmd [format $conf(extractl3) $tabuid(flagsr) [join $lnet " "]]
262	if {! [call-topo $cmd xl3]} then {
263	    d error [mc "Error while reading networks: %s" $xl3]
264	}
265
266	#
267	# Sketch the resulting data
268	#
269
270	if {[gen-graph $dbfd $gv $format $xl3]} then {
271	    switch -- $format {
272		pdf {
273		    ::webapp::send rawpdf [$gv output]
274		    d end
275		}
276		png {
277		    ::webapp::send png [$gv output]
278		    d end
279		}
280		map {
281		    d urlset "" $conf(nextl3) [list {format png} [list "addr" $addr]]
282		    set urlimg [d urlget ""]
283
284		    d urlset "" $conf(nextl3) [list {format pdf} [list "addr" $addr]]
285		    set urlpdf [d urlget ""]
286
287		    set map [$gv output]
288		    d result $conf(page1) [list \
289						[list %MSGSTA% $msgsta] \
290						[list %EQ%     ""] \
291						[list %VLAN%   ""] \
292						[list %RESEAU% $lnet] \
293						[list %ADDR%   $addr] \
294						[list %URLIMG% $urlimg] \
295						[list %URLPDF% $urlpdf] \
296						[list %MAP%    $map] \
297					    ]
298		}
299		default {
300		    d error "Internal error"
301		}
302	    }
303	} else {
304	    d error [$gv error]
305	}
306    }
307}
308
309##############################################################################
310# Main procedure
311##############################################################################
312
313d cgi-dispatch "topo" ""
314