1#!%TCLSH%
2
3#
4# Display topod status
5#
6# Called by: admin
7#
8# Parameters (form or url):
9# - refresh : time (in sec) between each page refresh
10# - nrefresh : new refresh time (supplied by the user)
11# - key : "eqmod", "ifchg", "status" or "keepstate"
12# - arg : "" or equipment name or keepstate object name
13#
14# History
15#   2010/11/15 : pda      : design
16#   2010/12/13 : pda      : i18n
17#   2010/12/26 : pda      : use cgi-dispatch (minimal modification)
18#
19
20#
21# Template pages used by this script
22#
23
24set conf(page)		topotop.html
25
26#
27# Next actions
28#
29
30set conf(next)		"topotop"
31set conf(nextpar)	"admpar"
32
33#
34# Script parameters
35#
36
37# maximum number of lines in "processed equipement" cell
38set conf(maxeq)		10
39
40# maximum number of status lines in compact display
41set conf(maxstatus)	10
42
43# maximum size (in characters) of message display
44set conf(maxmsg)	50
45
46set conf(taball) {
47    global {
48	chars {10 normal}
49	align {left}
50	botbar {yes}
51	columns {20 20 60}
52	align {left}
53	format {raw}
54    }
55    pattern Title {
56	topbar {yes}
57	vbar {yes}
58	column {
59	    chars {bold}
60	    align {center}
61	    multicolumn {3}
62	}
63	vbar {yes}
64    }
65    pattern Normal3 {
66	topbar {yes}
67	vbar {yes}
68	column { }
69	vbar {yes}
70	column { }
71	vbar {yes}
72	column { }
73	vbar {yes}
74    }
75    pattern Normal2 {
76	topbar {yes}
77	vbar {yes}
78	column { }
79	vbar {yes}
80	column {
81	    multicolumn {2}
82	}
83	vbar {yes}
84    }
85}
86
87set conf(tabeqmod) {
88    global {
89	chars {10 normal}
90	align {left}
91	botbar {yes}
92	columns {40 20 20 20}
93	align {left}
94	format {cooked}
95    }
96    pattern Title {
97	chars {bold}
98	align {center}
99	topbar {yes}
100	vbar {yes}
101	column { }
102	vbar {yes}
103	column { }
104	vbar {yes}
105	column { }
106	vbar {yes}
107	column { }
108	vbar {yes}
109    }
110    pattern Normal4 {
111	topbar {yes}
112	vbar {yes}
113	column {
114	    format {raw}
115	}
116	vbar {yes}
117	column { }
118	vbar {yes}
119	column { }
120	vbar {yes}
121	column { }
122	vbar {yes}
123    }
124}
125
126# eq
127# iface
128# reqdate
129# login
130# modif (vlan/voip/desc)
131# processed
132# moddate
133# modlog (first characters)
134
135set conf(tabifchg) {
136    global {
137	chars {10 normal}
138	align {left}
139	botbar {yes}
140	columns {20 20 20 10 30 5 20 20}
141	align {left}
142	format {cooked}
143    }
144    pattern Title {
145	chars {bold}
146	align {center}
147	topbar {yes}
148	vbar {yes}
149	column { }
150	vbar {yes}
151	column { }
152	vbar {yes}
153	column { }
154	vbar {yes}
155	column { }
156	vbar {yes}
157	column { }
158	vbar {yes}
159	column { }
160	vbar {yes}
161	column { }
162	vbar {yes}
163	column { }
164	vbar {yes}
165    }
166    pattern Normal8 {
167	topbar {yes}
168	vbar {yes}
169	column {
170	    format {raw}
171	}
172	vbar {yes}
173	column { }
174	vbar {yes}
175	column { }
176	vbar {yes}
177	column { }
178	vbar {yes}
179	column { }
180	vbar {yes}
181	column { }
182	vbar {yes}
183	column { }
184	vbar {yes}
185	column {
186	    format {raw}
187	}
188	vbar {yes}
189    }
190    pattern Bold8 {
191	chars {bold}
192	topbar {yes}
193	vbar {yes}
194	column {
195	    format {raw}
196	}
197	vbar {yes}
198	column { }
199	vbar {yes}
200	column { }
201	vbar {yes}
202	column { }
203	vbar {yes}
204	column { }
205	vbar {yes}
206	column { }
207	vbar {yes}
208	column { }
209	vbar {yes}
210	column {
211	    format {raw}
212	}
213	vbar {yes}
214    }
215}
216
217set conf(tabstatus) {
218    global {
219	chars {10 normal}
220	align {left}
221	botbar {yes}
222	columns {30 70}
223	align {left}
224	format {cooked}
225    }
226    pattern Title {
227	topbar {yes}
228	vbar {yes}
229	column {
230	    multicolumn {2}
231	    chars {bold}
232	    align {center}
233	}
234	vbar {yes}
235    }
236    pattern Normal2 {
237	topbar {yes}
238	vbar {yes}
239	column { }
240	vbar {yes}
241	column { }
242	vbar {yes}
243    }
244}
245
246set conf(tabks) {
247    global {
248	chars {10 normal}
249	align {left}
250	botbar {yes}
251	columns {100}
252	align {left}
253	format {cooked}
254    }
255    pattern Title {
256	topbar {yes}
257	vbar {yes}
258	column {
259	    chars {bold}
260	    align {center}
261	}
262	vbar {yes}
263    }
264    pattern Normal1 {
265	topbar {yes}
266	vbar {yes}
267	column {
268	    format {lines}
269	}
270	vbar {yes}
271    }
272}
273
274set conf(tabmodlog) $conf(tabks)
275
276#
277# Netmagis general library
278#
279
280source %LIBNETMAGIS%
281
282# ::webapp::cgidebug ; exit
283
284##############################################################################
285# Display all elements, compact version
286##############################################################################
287
288proc topotop-all {dbfd datefmt arg} {
289    global conf
290
291    set lines {}
292
293    lappend lines [list "Title" [mc "General"]]
294
295    #
296    # Get "topo active" parameter
297    #
298
299    if {[dnsconfig get "topoactive"]} then {
300	set active [mc "active"]
301    } else {
302	set active [mc "inactive"]
303    }
304    d urlset "" $conf(nextpar) {}
305    set url [d urlget ""]
306    set active [::webapp::helem "a" $active "href" $url]
307    lappend lines [list "Normal2" [mc "Topo module"] $active]
308
309    #
310    # Get date of last full-rancid action
311    #
312
313    set lastfull [mc "(never)"]
314    pg_select $dbfd "SELECT * FROM topo.lastrun" tab {
315	if {$tab(date) ne ""} then {
316	    set lastfull [clock format [clock scan $tab(date)] -format $datefmt]
317	}
318    }
319    lappend donneees [list Normal2 [mc "Last full-rancid"] $lastfull]
320
321    #
322    # Get list of modified equipements and waiting for graph building
323    #
324
325    set unproc {}
326    pg_select $dbfd "SELECT DISTINCT eq FROM topo.modeq WHERE processed=0" tab {
327	d urlset "" $conf(next) [list {key eqmod} [list "arg" $tab(eq)]]
328	set url [d urlget ""]
329	lappend unproc [::webapp::helem "a" $tab(eq) "href" $url]
330    }
331    if {[llength $unproc] == 0} then {
332	set unproc [mc "(none)"]
333    } else {
334	set unproc [join $unproc ", "]
335    }
336
337    d urlset "" $conf(next) [list {key eqmod}]
338    set url [d urlget ""]
339    set msg [::webapp::helem "a" [mc "Modified equipments"] "href" $url]
340    lappend lines [list "Normal2" $msg $unproc]
341
342    #
343    # Get list of waiting interface modifications
344    #
345
346    set unproc {}
347    set sql "SELECT DISTINCT eq FROM topo.ifchanges WHERE processed = 0"
348    pg_select $dbfd $sql tab {
349	d urlset "" $conf(next) [list {key ifchg} [list "arg" $tab(eq)]]
350	set url [d urlget ""]
351	lappend unproc [::webapp::helem "a" $tab(eq) "href" $url]
352    }
353    if {[llength $unproc] == 0} then {
354	set unproc [mc "(none)"]
355    } else {
356	set unproc [join $unproc ", "]
357    }
358
359    d urlset "" $conf(next) [list {key ifchg}]
360    set url [d urlget ""]
361    set msg [::webapp::helem "a" [mc "Waiting changes"] "href" $url]
362    lappend lines [list "Normal2" $msg $unproc]
363
364    #
365    # Last status lines
366    #
367
368    lappend lines [list "Title" [mc "Status"]]
369
370    set status {}
371    set sql "SELECT message FROM topo.keepstate WHERE type = 'status'"
372    pg_select $dbfd $sql tab {
373	set status $tab(message)
374    }
375    d urlset "" $conf(next) [list {key status}]
376    set url [d urlget ""]
377    set statut [::webapp::helem "a" [mc "Status"] "href" $url]
378    set ls {}
379    set i 0
380    foreach s $status {
381	lassign $s date msg
382	set date [clock format [clock scan $date] -format $datefmt]
383	set msg [::webapp::html-string $msg]
384	lappend ls "$date $msg"
385	incr i
386	if {$i >= $conf(maxstatus)} then {
387	    break
388	}
389    }
390    lappend lines [list Normal2 $statut [join $ls "<br>"]]
391
392    #
393    # Get other keepstate messages
394    #
395
396    set sql "SELECT * FROM topo.keepstate
397				WHERE type != 'status'
398				ORDER BY date DESC"
399    pg_select $dbfd $sql tab {
400	set type $tab(type)
401	set date [clock format [clock scan $tab(date)] -format $datefmt]
402	set mess [string range $tab(message) 0 $conf(maxmsg)]
403	regsub "\n" $mess "/" message
404	set message [::webapp::html-string $message]
405	if {$mess ne $tab(message)} then {
406	    append message "..."
407	    d urlset "" $conf(next) [list {key keepstate} [list "arg" $type]]
408	    set url [d urlget ""]
409	    set message [::webapp::helem "a" $message "href" $url]
410	}
411	lappend lines [list "Normal3" $type $date $message]
412    }
413
414    #
415    # Get last processed equipments
416    #
417
418    d urlset "" $conf(next) [list {key eqmod}]
419    set url [d urlget ""]
420    set msg [::webapp::helem "a" [mc "Last processed equipments"] "href" $url]
421    lappend lines [list "Title" $msg]
422
423    set sql "SELECT * FROM topo.modeq
424				WHERE processed != 0
425				ORDER BY date desc
426				LIMIT $conf(maxeq)"
427    set le {}
428    pg_select $dbfd $sql tab {
429	set eq $tab(eq)
430	set date [clock format [clock scan $tab(date)] -format $datefmt]
431	set login $tab(login)
432
433	d urlset "" $conf(next) [list {key eqmod} [list "arg" $eq]]
434	set url [d urlget ""]
435	set eq [::webapp::helem "a" $eq "href" $url]
436
437	lappend lines [list "Normal3" $eq $date $login]
438    }
439
440    return [::arrgen::output "html" $conf(taball) $lines]
441}
442
443##############################################################################
444# Function to display modified equipments
445##############################################################################
446
447# arg = "" or eq
448proc topotop-eqmod {dbfd datefmt arg} {
449    global conf
450
451    set lines {}
452    lappend lines [list "Title" \
453				[mc "�quipment"] \
454				[mc "Date"] \
455				[mc "Login"] \
456				[mc "Processed"] \
457			    ]
458    if {$arg eq ""} then {
459	set where ""
460    } else {
461	set qeq [::pgsql::quote $arg]
462	set where "WHERE eq = '$qeq'"
463    }
464
465    set sql "SELECT * FROM topo.modeq $where ORDER BY date DESC"
466    pg_select $dbfd $sql tab {
467	set date [clock format [clock scan $tab(date)] -format $datefmt]
468	if {$tab(processed)} then {
469	    set procd [mc "Yes"]
470	} else {
471	    set procd [mc "No"]
472	}
473	set eq $tab(eq)
474	if {$arg eq ""} then {
475	    d urlset "" $conf(next) [list {key eqmod} [list "arg" $eq]]
476	    set url [d urlget ""]
477	    set eq [::webapp::helem "a" $eq "href" $url]
478	}
479	lappend lines [list "Normal4" $eq $date $tab(login) $procd]
480    }
481    return [::arrgen::output "html" $conf(tabeqmod) $lines]
482}
483
484##############################################################################
485# Function to display interface changes
486##############################################################################
487
488# arg = "" or eq
489proc topotop-ifchg {dbfd datefmt arg} {
490    global conf
491
492    set lines {}
493    lappend lines [list "Title" \
494			[mc "Equipment"] \
495			[mc "Interface"] \
496			[mc "Date"] \
497			[mc "Login"] \
498			[mc "Change"] \
499			[mc "Processed"] \
500			[mc "Date sent"] \
501			[mc "Log"] \
502		    ]
503    set w ""
504    if {$arg ne ""} then {
505	set qeq [::pgsql::quote $arg]
506	set w "WHERE eq = '$qeq'"
507    }
508    set sql "SELECT * FROM topo.ifchanges $w ORDER BY reqdate DESC"
509
510    pg_select $dbfd $sql tab {
511	set reqdate [clock format [clock scan $tab(reqdate)] -format $datefmt]
512	if {$tab(processed)} then {
513	    set pattern "Normal8"
514	    set procd [mc "Yes"]
515	} else {
516	    set pattern "Bold8"
517	    set procd [mc "No"]
518	}
519
520	d urlset "" $conf(next) [list {key ifchg} [list "arg" $tab(eq)]]
521	set url [d urlget ""]
522	set eq [::webapp::helem "a" $tab(eq) "href" $url]
523
524	set mod [mc {vlan=%1$s, voip=%2$s, desc=%3$s} $tab(ethervlan) $tab(voicevlan) $tab(ifdesc)]
525	set moddate $tab(moddate)
526	if {$moddate ne ""} then {
527	    set moddate [clock format [clock scan $moddate] -format $datefmt]
528	}
529
530	set modlog [string range $tab(modlog) 0 $conf(maxmsg)]
531	regsub "\n" $modlog "/" modlog
532	set modlog [::webapp::html-string $modlog]
533	if {$modlog ne $tab(modlog)} then {
534	    append modlog "..."
535	    set arg "$tab(eq)|$tab(iface)|$tab(reqdate)"
536	    d urlset "" $conf(next) [list {key modlog} [list "arg" $arg]]
537	    set url [d urlget ""]
538	    set modlog [::webapp::helem "a" $modlog "href" $url]
539	}
540
541	lappend lines [list $pattern \
542				$eq $tab(iface) $reqdate $tab(login) \
543				$mod $procd $moddate $modlog]
544    }
545    return [::arrgen::output "html" $conf(tabifchg) $lines]
546}
547
548##############################################################################
549# Function to display interface modification log
550##############################################################################
551
552# arg = "eq|iface|date"
553proc topotop-modlog {dbfd datefmt arg} {
554    global conf
555
556    if {! [regexp {^([^|]+)\|([^|]+)\|([^|]+)$} $arg bidon eq iface date]} then {
557	d error [mc "Invalid argument '%s'" $arg]
558    }
559
560    set qeq [::pgsql::quote $eq]
561    set qif [::pgsql::quote $iface]
562    set qdate [::pgsql::quote $date]
563    set sql "SELECT moddate, modlog FROM topo.ifchanges
564			WHERE eq = '$qeq'
565			    AND iface = '$qif'
566			    AND reqdate = '$qdate'"
567    set lines {}
568    pg_select $dbfd $sql tab {
569	set moddate $tab(moddate)
570	set modlog $tab(modlog)
571    }
572
573    if {$moddate ne ""} then {
574	set moddate [clock format [clock scan $moddate] -format $datefmt]
575    }
576    regsub -all "\n+" $modlog "\n" modlog
577    regsub -all "\b" $modlog "" modlog
578
579    set harg [::webapp::html-string $arg]
580    if {$moddate eq ""} then {
581	set msg [mc "Change of '%s' not yet processed" "$eq/$iface"]
582	lappend lines [list "Title" $msg]
583    } else {
584	set msg [mc {Change log of '%1$s' at %2$s} "$eq/$iface" $moddate]
585	lappend lines [list "Title" $msg]
586	lappend lines [list "Normal1" $modlog]
587    }
588
589    return [::arrgen::output "html" $conf(tabmodlog) $lines]
590}
591
592##############################################################################
593# Function to display detailed status
594##############################################################################
595
596# arg = ""
597proc topotop-status {dbfd datefmt arg} {
598    global conf
599
600    set lines {}
601    lappend lines [list "Title" [mc "Status"]]
602
603    set status {}
604    set sql "SELECT message FROM topo.keepstate WHERE type = 'status'"
605    set status {}
606    pg_select $dbfd $sql tab {
607	set status $tab(message)
608    }
609    foreach s $status {
610	lassign $s date msg
611	set date [clock format [clock scan $date] -format $datefmt]
612	set msg [::webapp::html-string $msg]
613	lappend lines [list "Normal2" $date $msg]
614    }
615
616    return [::arrgen::output "html" $conf(tabstatus) $lines]
617}
618
619##############################################################################
620# Function to display detailed keepstate
621##############################################################################
622
623# arg = type
624proc topotop-keepstate {dbfd datefmt arg} {
625    global conf
626
627    set lines {}
628
629    set qtype [::pgsql::quote $arg]
630    set sql "SELECT date, message FROM topo.keepstate WHERE type = '$qtype'"
631
632    set date ""
633    set message ""
634    pg_select $dbfd $sql tab {
635	set date [clock format [clock scan $tab(date)] -format $datefmt]
636	set message $tab(message)
637    }
638
639    set harg [::webapp::html-string $arg]
640    if {$date eq ""} then {
641	set msg [mc "No message for '%s'" $harg
642	lappend lines [list "Title" $msg]
643    } else {
644	set msg [mc {Last message for '%1$s' at %2$s} $harg $date]
645	lappend lines [list "Title" $msg]
646	lappend lines [list "Normal1" $message]
647    }
648
649    return [::arrgen::output "html" $conf(tabks) $lines]
650}
651
652##############################################################################
653# Display topo*d dashboard
654##############################################################################
655
656d cgi-register {} {
657     {refresh	0 1}
658     {nrefresh	0 1}
659     {key	0 1}
660     {arg	0 1}
661} {
662    global conf
663
664    # nrefresh (text field given by the user) has priority over refresh
665    # value supplied in URL. Thus, the new URL will use nrefresh.
666    if {$nrefresh ne ""} then {
667	set refresh $nrefresh
668    }
669
670    d urlset "%URLFORM%" $conf(next) [list \
671					    [list "key" $key] \
672					    [list "arg" $arg] \
673					    [list "refresh" $refresh] \
674					]
675
676    set datefmt [dnsconfig get "datefmt"]
677
678    set date [clock format [clock seconds] -format $datefmt]
679
680    #
681    # Active refresh
682    #
683
684    set meta ""
685    if {[regexp {^[0-9]+$} $refresh] && $refresh > 0} then {
686	d urlset "" $conf(next) [list \
687					    [list "key" $key] \
688					    [list "arg" $arg] \
689					    [list "refresh" $refresh] \
690					]
691	set u [d urlget ""]
692	append meta "<meta http-equiv=\"refresh\" content=\"$refresh;url=$u\">"
693	append meta "<meta http-equiv=\"pragma\" content=\"no-cache\">"
694    } else {
695	set refresh [::webapp::html-string $refresh]
696    }
697
698
699    #
700    # Specific key?
701    #
702
703    if {$key eq "" || [catch {info args topotop-$key}]} then {
704	set top [topotop-all $dbfd $datefmt ""]
705    } else {
706	set top [topotop-$key $dbfd $datefmt $arg]
707    }
708
709    #
710    # End of script: output page and close database
711    #
712
713    set key [::webapp::html-string $key]
714    set arg [::webapp::html-string $arg]
715
716    d result $conf(page) [list \
717				[list %META% $meta] \
718				[list %REFRESH% $refresh] \
719				[list %DATE% $date] \
720				[list %TOP% $top] \
721			    ]
722}
723
724##############################################################################
725# Main procedure
726##############################################################################
727
728d cgi-dispatch "admin" "admin"
729