1#
2#
3# Package d'analyse de fichiers de configuration IOS HP
4#
5# Historique
6#   2008/07/07 : pda/jean : d�but de la conception
7#   2009/02/11 : pda      : analyse des listes de la forme C24-D2
8#
9
10#
11# Nombre de ports sur les modules des HP
12#   J4820A XL 10/100-TX module
13#   J4821A XL 100/1000-T module
14#   J4821B XL 100/1000-T module
15#   J4878A XL mini-GBIC module
16#   J4878B XL mini-GBIC module
17#   J4907A XL Gig-T/GBIC module
18#   J8702A 24p Gig-T zl Module
19#
20
21array set hpmodules {
22    J4820A	24
23    J4821A	4
24    J4821B	4
25    J4878A	4
26    J4878B	4
27    J4907A	16
28    J8702A	24
29    j8702a	24
30    j9534a	24
31    J90XXA      48
32    J86yyA      1
33    J86xxA      1
34    J86zzA      1
35    J86wwA      1
36}
37
38###############################################################################
39# Fonctions utilitaires
40###############################################################################
41
42#
43# Entr�e :
44#   - idx = eq!<eqname>
45#   - iface = <iface>
46# Remplit
47#   - tab(eq!<nom eq>!if) {<ifname> ... <ifname>}
48#
49# Historique
50#   2008/07/21 : pda/jean : conception
51#
52
53proc hp-ajouter-iface {tab idx iface} {
54    upvar $tab t
55
56    if {[lsearch -exact $t($idx!if) $iface] == -1} then {
57	lappend t($idx!if) $iface
58	if {! [info exists t($idx!if!$iface!link!name)]} then {
59	    hp-set-ifattr t $idx!if!$iface "name" "X"
60	    hp-set-ifattr t $idx!if!$iface "stat" "-"
61	    hp-set-ifattr t $idx!if!$iface "desc" ""
62	}
63    }
64}
65
66#
67# Input:
68#   iface = interface name
69# Output:
70#   Convert to title case ; example: trk1 -> Trk1
71#
72# Historique
73#   2014/12/21 : jean/sebastien : design
74#
75
76proc hp-normalize-iface-name {iface} {
77  if {[regexp {(.)(.*)} $iface dummy first rest]} {
78    set iface "[string toupper $first][string tolower $rest]"
79  }
80  return $iface
81}
82
83###############################################################################
84# Analyse du fichier de configuration
85###############################################################################
86
87#
88# Entr�e :
89#   - libdir : r�pertoire contenant les greffons d'analyse
90#   - model : mod�le de l'�quipement (ex: M20)
91#   - fdin : descripteur de fichier en entr�e
92#   - fdout : fichier de sortie pour la g�n�ration
93#   - eq = <eqname>
94# Remplit :
95#   - tab(eq)	{<eqname> ... <eqname>}
96#   - tab(eq!ios) "unsure|router|switch"
97#
98# Historique
99#   2008/07/07 : pda/jean : conception
100#
101
102proc hp-parse {libdir model fdin fdout tab eq} {
103    upvar $tab t
104    array set kwtab {
105	-COMMENT			^;
106	module				{CALL hp-parse-module}
107	interface			{CALL hp-parse-interface}
108	vlan				{CALL hp-parse-vlan}
109	exit				{CALL hp-parse-exit}
110	disable				{CALL hp-parse-disable}
111	name				{CALL hp-parse-name}
112	trunk				{CALL hp-parse-trunk}
113	snmp-server			NEXT
114	snmp-server-location		{CALL hp-parse-snmp-location}
115	snmp-server-community		{CALL hp-parse-snmp-community}
116	untagged			{CALL hp-parse-untagged}
117	tagged				{CALL hp-parse-tagged}
118    }
119
120    #
121    # On charge la biblioth�que de fonctions "cisco" pour b�n�ficier
122    # de la meeeeeerveilleuse fonction "post-process"
123    #
124
125    set error [charger $libdir "parse-cisco.tcl"]
126    if {$error} then {
127	return $error
128    }
129
130    #
131    # Analyse du fichier
132    #
133
134    set t(eq!$eq!context) ""
135    set t(eq!$eq!if) {}
136    set t(eq!$eq!if!disabled) {}
137    set t(eq!$eq!modules) {}
138
139    set error [ios-parse $libdir $model $fdin $fdout t $eq kwtab]
140
141    set t(eq!$eq!ios) "switch"
142
143    if {! $error} then {
144	set error [hp-prepost-process $eq t]
145    }
146
147    if {! $error} then {
148	set error [cisco-post-process "hp" $fdout $eq t]
149    }
150    return $error
151}
152
153#
154# Entr�e :
155#   - line = "<position> type <ref>"
156#   - idx = eq!<eqname>
157# Remplit
158#   - tab(eq!<nom eq>!modules) {{A <ports>} {B <nports>} ...}
159#
160# Historique
161#   2009/02/11 : pda      : conception
162#
163
164proc hp-parse-module {active line tab idx} {
165    upvar $tab t
166    global hpmodules
167
168    set line [string trim $line]
169    if {[regexp {^([0-9]+) type (.*)$} $line bidon pos ref]} then {
170	if {[info exists hpmodules($ref)]} then {
171	    #
172	    # les vieilles magouilles sur les codes ASCII sont
173	    # encore les meilleurs moyens de convertir des codes
174	    # num�riques vers des lettres
175	    #
176	    set lettre [format "%c" [expr 64 + $pos]]
177	    lappend t($idx!modules) [list $lettre $hpmodules($ref)]
178	    set t($idx!modules) [lsort -index 0 $t($idx!modules)]
179	} else {
180	    warning "$idx: incorrect 'module' specification (module $line)"
181	}
182    } else {
183	warning "$idx: incorrect 'module' specification (module $line)"
184    }
185
186    return 0
187}
188
189#
190# Entr�e :
191#   - line = "<id>"
192#   - idx = eq!<eqname>
193# Remplit
194#   - tab(eq!<nom eq>!if) {<ifname> ... <ifname>}
195#   - tab(eq!<nom eq>!current!if) <ifname>
196#   - tab(eq!<nom eq>!if!<ifname>!link!name) ""
197#   - tab(eq!<nom eq>!if!<ifname>!link!desc) ""
198#   - tab(eq!<nom eq>!if!<ifname>!link!stat) ""
199#   - tab(eq!<nom eq>!context) iface
200#
201# Historique
202#   2008/07/07 : pda/jean : conception
203#   2008/10/10 : pda      : correction bug si plusieurs occurrences de l'i/f
204#
205
206proc hp-parse-interface {active line tab idx} {
207    upvar $tab t
208
209    set line [string trim $line]
210    if {[regexp {^[-A-Za-z0-9]+$} $line]} then {
211        set iface [hp-normalize-iface-name $line]
212	set t($idx!context) "iface"
213	set t($idx!current!if) $iface
214	#
215	# Il est possible que l'interface apparaisse deux fois
216	# dans le fichier de configuration :
217	#	interface 1
218	#	  name "..."
219	#	  no lacp
220	#	exit
221	#	...
222	#	interface 1
223	#	  mdix-mode mdix
224	#	exit
225	# => ne pas tout mettre � z�ro.
226	#
227	if {! [info exists t($idx!if!$iface!link!name)]} then {
228	    lappend t($idx!if) $iface
229	    set t($idx!if!$iface!link!name) ""
230	    set t($idx!if!$iface!link!desc) ""
231	    set t($idx!if!$iface!link!stat) ""
232
233	    hp-ajouter-iface t $idx $iface
234	}
235    }
236
237    return 0
238}
239
240#
241# Entr�e :
242#   - line = <vlanid>
243#   - idx = eq!<eqname>
244# Remplit
245#   - tab(eq!<nom eq>!lvlan) {<id> ... <id>}
246#   - tab(eq!<nom eq>!lvlan!lastid) <id>
247#   - tab(eq!<nom eq>!lvlan!<id>!desc) ""  (sera remplac� par parse-vlan-name)
248#   - tab(eq!<nom eq>!context) vlan
249#
250# Historique
251#   2008/07/07 : pda/jean : conception
252#
253
254proc hp-parse-vlan {active line tab idx} {
255    upvar $tab t
256
257    set line [string trim $line]
258    if {[regexp {^[0-9]+$} $line]} then {
259	set t($idx!context) "vlan"
260	set idx "$idx!lvlan"
261	lappend t($idx) $line
262	set t($idx!lastid) $line
263	set t($idx!$line!desc) ""
264    }
265
266    return 0
267}
268
269#
270# Entr�e :
271#   - line = <>
272#   - idx = eq!<eqname>
273#   - tab(eq!<nom eq>!context) iface
274# Remplit
275#   - tab(eq!<nom eq>!context) ""
276#
277# Historique
278#   2008/07/07 : pda/jean : conception
279#
280
281proc hp-parse-exit {active line tab idx} {
282    upvar $tab t
283
284    set t($idx!context) ""
285    return 0
286}
287
288#
289# Entr�e :
290#   - line = <>
291#   - idx = eq!<eqname>
292#   - tab(eq!<nom eq>!context) iface
293#   - tab(eq!<nom eq>!current!if) <ifname>
294# Remplit
295#   - tab(eq!<nom eq>!context) ""
296#   - tab(eq!<nom eq>!if!disabled) {... <ifname>}
297#
298# Note : on ne peut pas simplement supprimer l'interface, car elle
299#   r�appara�tra plus tard lors de l'analyse des vlans
300#
301# Historique
302#   2008/07/24 : pda      : conception
303#
304
305proc hp-parse-disable {active line tab idx} {
306    upvar $tab t
307
308    if {[string equal $t($idx!context) "iface"]} then {
309	lappend t($idx!if!disabled) $t($idx!current!if)
310    }
311    return 0
312}
313
314#
315# Entr�e :
316#   - line = <>
317#   - idx = eq!<eqname>
318#   - tab(eq!<nom eq>!context) "iface" ou "vlan"
319#   - tab(eq!<nom eq>!lvlan!lastid) <id>   (si context = "vlan")
320#   - tab(eq!<nom eq>!current!if) <ifname> (si context = "iface")
321# Remplit
322#   - tab(eq!<nom eq>!if!<ifname>!link!desc) <desc>
323#   - tab(eq!<nom eq>!if!<ifname>!link!name) <name>
324#   - tab(eq!<nom eq>!if!<ifname>!link!stat) <stat>
325#	OU
326#   - tab(eq!<nom eq>!lvlan!<id>!desc) <desc>
327#
328# Historique
329#   2008/07/07 : pda/jean : conception
330#
331
332proc hp-parse-name {active line tab idx} {
333    upvar $tab t
334
335    set error 0
336    switch $t($idx!context) {
337	iface {
338	    set ifname $t($idx!current!if)
339
340	    if {[parse-desc $line linkname statname descname msg]} then {
341		if {[string equal $linkname ""]} then {
342		    warning "$idx: no link name found ($line)"
343		    set error 1
344		} else {
345		    set error [hp-set-ifattr t $idx!if!$ifname name $linkname]
346		}
347		if {! $error} then {
348		    set error [hp-set-ifattr t $idx!if!$ifname stat $statname]
349		}
350		if {! $error} then {
351		    set error [hp-set-ifattr t $idx!if!$ifname desc $descname]
352		}
353	    } else {
354		warning "$idx: $msg ($line)"
355		set error 1
356	    }
357	}
358	vlan {
359	    set vlanid $t($idx!lvlan!lastid)
360
361	    regsub {^\s*"?(.*)"?\s*$} $line {\1} line
362
363	    # traduction en hexa : cf analyser, fct parse-desc
364	    binary scan $line H* line
365	    set t($idx!lvlan!$vlanid!desc) $line
366	}
367	default {
368	    warning "Inconsistent context '$t($idx!context)' for name '$line'"
369	}
370    }
371
372    return $error
373}
374
375#
376# Entr�e :
377#   - line = <iface>-<iface>,... <trunkif> <mode>
378#   - idx = eq!<eqname>
379# Remplit
380#   - tab(eq!<nom eq>!if!<iface>!parentif) <trunkif>	(pour toutes les iface)
381#
382# Historique
383#   2008/07/07 : pda/jean : conception
384#
385
386proc hp-parse-trunk {active line tab idx} {
387    upvar $tab t
388
389    if {[regexp {^\s*([-A-Za-z0-9,]+)\s+(\S+)} $line bidon subifs parentif]} then {
390	set parentif [hp-normalize-iface-name $parentif]
391	hp-ajouter-iface t $idx $parentif
392
393	set lsubif [parse-list $subifs yes $t($idx!modules)]
394	foreach subif $lsubif {
395	    set error [hp-set-ifattr t $idx!if!$subif parentif $parentif]
396	    if {$error} then {
397		break
398	    }
399	    hp-ajouter-iface t $idx $subif
400	}
401    } else {
402	warning "Invalid trunk specification ($line)"
403	set error 1
404    }
405
406    return $error
407}
408
409#
410# Entr�e :
411#   - line = <localisation> <blah blah>
412#   - idx = eq!<eqname>
413# Remplit :
414#   - tab(eq!<nom eq>!location) {<localisation> ...}
415#
416# Historique
417#   2012/01/17 : jean : recuperation de cisco-parse-snmp-location
418#
419
420proc hp-parse-snmp-location {active line tab idx} {
421    upvar $tab t
422
423    set error 0
424    set ipmac 0
425    set portmac 0
426    if {[parse-location $line location ipmac portmac blablah msg]} then {
427        if {! [string equal $location ""]} then {
428            set t($idx!location) [list $location $blablah]
429        }
430    } else {
431        warning "$idx: $msg ($line)"
432        set error 1
433    }
434
435    set t($idx!ipmac) $ipmac
436    set t($idx!portmac) $portmac
437
438    return $error
439}
440
441#
442# Entr�e :
443#   - line = <communaute> <blah blah>
444#   - idx = eq!<eqname>
445# Remplit :
446#   - tab(eq!<nom eq>!snmp) {<communaute> ...}
447#
448# Historique
449#   2006/01/06 : pda/jean : conception
450#
451
452proc hp-parse-snmp-community {active line tab idx} {
453    upvar $tab t
454
455    if {[regexp {^\s*"(\S+)"\s*(.*)$} $line bidon comm reste]} then {
456	lappend t($idx!snmp) $comm
457	set error 0
458    } else {
459	warning "Inconsistent SNMP community string ($line)"
460	set error 1
461    }
462    return $error
463}
464
465#
466# Entr�e :
467#   - line = <iflist>
468#   - idx = eq!<eqname>
469#   - tab(eq!<nom eq>!context) "vlan"
470#   - tab(eq!<nom eq>!lvlan!lastid) <id>   (si context = "vlan")
471# Remplit
472#   - tab(eq!<nom eq>!if!<ifname>!link!type) <ether/trunk>
473#   - tab(eq!<nom eq>!if!<ifname>!link!vlans) {vlanid...}
474#
475# Historique
476#   2008/07/21 : pda/jean : conception
477#
478
479proc hp-parse-untagged {active line tab idx} {
480    upvar $tab t
481
482    set error 0
483
484    if {$active} then {
485	set vlanid $t($idx!lvlan!lastid)
486	set liface [parse-list $line yes $t($idx!modules)]
487	foreach iface $liface {
488	    set iface [hp-normalize-iface-name $iface]
489	    set kw "vlan"
490	    if {[info exists t($idx!if!$iface!link!type)]} then {
491		if {[string equal $t($idx!if!$iface!link!type) "trunk"]} then {
492		    # le vlan est natif sur cette interface
493		    set kw "nativevlan"
494		}
495	    }
496
497	    set error [hp-set-ifattr t $idx!if!$iface "type" "ether"]
498	    if {$error} then {
499		break
500	    }
501	    set error [hp-set-ifattr t $idx!if!$iface $kw $vlanid]
502	    if {$error} then {
503		break
504	    }
505	    hp-ajouter-iface t $idx $iface
506	}
507    }
508
509    return $error
510}
511
512proc hp-parse-tagged {active line tab idx} {
513    upvar $tab t
514
515    set error 0
516
517    if {$active} then {
518	set vlanid $t($idx!lvlan!lastid)
519	set liface [parse-list $line yes $t($idx!modules)]
520	foreach iface $liface {
521	    set iface [hp-normalize-iface-name $iface]
522	    set error [hp-set-ifattr t $idx!if!$iface "type" "trunk"]
523	    if {$error} then {
524		break
525	    }
526	    set error [hp-set-ifattr t $idx!if!$iface "vlan" $vlanid]
527	    if {$error} then {
528		break
529	    }
530	    hp-ajouter-iface t $idx $iface
531	}
532    }
533
534    return $error
535}
536
537
538###############################################################################
539# Attributs d'une interface
540###############################################################################
541
542#
543# Sp�cifie les attributs d'une interface
544#
545# Entr�e :
546#   - tab : nom du tableau
547#   - idx : index (jusqu'au nom de l'interface : "eq!<nom eq>!if!<ifname>")
548#   - attr : name, stat, type, ifname, vlan, allowed-vlans
549#   - val : valeur de l'attribut
550#
551# Sortie :
552# - Si lien trunk :
553#   - tab(eq!<nom eq>!if!<ifname>!link!type) trunk
554#   - tab(eq!<nom eq>!if!<ifname>!link!allowedvlans) {{1 1} {3 13} {15 4094}}
555# - Si lien ether :
556#   - tab(eq!<nom eq>!if!<ifname>!link!type) ether
557#   - tab(eq!<nom eq>!if!<ifname>!link!vlans) {<vlan-id>}    (forc�ment 1 seul)
558# - Si lien aggregate : idem trunk ou ether, avec en plus :
559#   - tab(eq!<nom eq>!if!<ifname>!link!parentif) <parent-if-name>
560#
561# Historique
562#   2008/07/21 : pda/jean : conception � partir de la version cisco
563#
564
565proc hp-set-ifattr {tab idx attr val} {
566    upvar $tab t
567
568    set error 0
569    switch $attr {
570	name {
571	    set t($idx!link!name) $val
572	}
573	stat {
574	    set t($idx!link!stat) $val
575	}
576	desc {
577	    set t($idx!link!desc) $val
578	}
579	type {
580	    if {[info exists t($idx!link!type)]} then {
581		switch -- "$t($idx!link!type)-$val" {
582		    trunk-trunk {
583			# rien
584		    }
585		    ether-trunk {
586			set t($idx!link!type) "trunk"
587			if {[info exists t($idx!link!vlans)]} then {
588			    set ov [lindex $t($idx!link!vlans) 0]
589			    set t($idx!link!allowedvlans) [list [list $ov $ov]]
590			    set t($idx!link!native) $ov
591			    unset t($idx!link!vlans)
592			} else {
593			    set t($idx!link!allowedvlans) {}
594			}
595		    }
596		    trunk-ether {
597			# le type trunk ne change pas, on ajoutera
598			# juste un vlan-natif
599		    }
600		    ether-ether {
601			warning "incoherent 'untagged' vlan for $idx"
602		    }
603		    default {
604			warning "incoherent type for $idx"
605		    }
606		}
607	    } else {
608		set t($idx!link!type) $val
609		set error 0
610	    }
611	}
612	parentif {
613	    set t($idx!link!parentif) $val
614	}
615	vlan {
616	    if {[info exists t($idx!link!type)]} then {
617		switch $t($idx!link!type) {
618		    trunk {
619			lappend t($idx!link!allowedvlans) [list $val $val]
620		    }
621		    ether {
622			set t($idx!link!vlans) [list $val]
623		    }
624		    default {
625			warning "incoherent type for $idx"
626		    }
627		}
628	    } else {
629		warning "Unknown transport-type for $idx"
630	    }
631	    set error 0
632	}
633	nativevlan {
634	    if {[info exists t($idx!link!type)]} then {
635		switch $t($idx!link!type) {
636		    trunk {
637			lappend t($idx!link!allowedvlans) [list $val $val]
638			set t($idx!link!native) $val
639		    }
640		    default {
641			warning "incoherent type for $idx"
642		    }
643		}
644	    } else {
645		warning "Unknown transport-type for $idx"
646	    }
647	    set error 0
648	}
649	default {
650	    warning "Incorrect attribute type for $idx (internal error)"
651	    set error 1
652	}
653    }
654    return $error
655}
656
657###############################################################################
658# Post-traitement (ou plus exactement, phase pr�alable au post-traitement)
659###############################################################################
660
661#
662# Traite le tableau avant d'appeler la g�n�ration
663#
664# Entr�e :
665#   - eq : nom de l'�quipement
666#   - tab : nom du tableau
667#
668# Sortie :
669# - suppression des interfaces d�sactiv�es
670#
671# Historique
672#   2008/07/24 : pda      : conception
673#
674
675proc hp-prepost-process {eq tab} {
676    upvar $tab t
677
678    set error 0
679    set idx "eq!$eq"
680
681    #
682    # Supprimer les interfaces marqu�es comme "disable"
683    #
684
685    foreach iface $t($idx!if!disabled) {
686	set error [cisco-remove-if t($idx!if) $iface]
687    }
688
689    #
690    # Sur les HP, on ne peut pas mettre de description sur
691    # les interfaces Trk. Donc, on ne peut y mettre de point
692    # de m�trologie.
693    # Pour y rem�dier, mettre le point de m�trologie que l'on
694    # voit sur toutes les interfaces qui participent au Trk,
695    # ou r�ler si ce point de m�trologie n'est pas le m�me partout.
696    #
697
698    foreach iface $t(eq!$eq!if) {
699	if {[info exists t(eq!$eq!if!$iface!link!parentif)]
700		&& [info exists t(eq!$eq!if!$iface!link!stat)]} then {
701	    set parentif $t(eq!$eq!if!$iface!link!parentif)
702	    lappend tag($parentif) $t(eq!$eq!if!$iface!link!stat)
703	}
704    }
705
706    foreach parentif [array names tag] {
707	set sold ""
708	set ok 0
709	foreach snew $tag($parentif) {
710	    set s1 [string equal $sold ""]
711	    set s2 [string equal $snew ""]
712	    switch -- "$s1/$s2" {
713		1/1 {
714		    # les deux sont vides : on ne fait rien
715		}
716		1/0 {
717		    # le nouveau point de m�tro est le premier valide :
718		    # on initialise le point de m�tro de l'interface
719		    set sold $snew
720		    set ok 1
721		}
722		0/1 {
723		    # le nouveau point de m�tro est vide (et l'ancien
724		    # ne l'est pas) : on ne modifie donc rien.
725		}
726		0/0 {
727		    # le point de m�tro d�j� vu est valide, de m�me
728		    # que le nouveau rencontr� : il faut tester s'ils
729		    # sont identiques.
730		    if {! [string equal $sold $snew]} then {
731			warning "Inconsistent stat names for subinterfaces of $eq/$parentif ($sold != $snew)"
732			set ok 0
733			break
734		    }
735		}
736	    }
737	}
738	if {$ok} then {
739	    set t(eq!$eq!if!$parentif!link!stat) $sold
740	}
741    }
742
743    return $error
744}
745