1#!%TCLSH%
2
3#
4#
5# Analyse un fichier de configuration d'un �quipement r�seau
6# et renvoie la mod�lisation de cet �quipement sous forme de
7# la repr�sentation comprise par buildgraph & co.
8#
9# Syntaxe :
10#   analyser <libdir> <cisco|juniper> <modele> <fichier conf> <eq name> [<debug>]
11#
12# Exemple :
13#   analyser $PWD cisco 4506 \
14#		/local/idr/conf/osiris/configs/crc-ce1.u-strasbg.fr crc-ce1 15
15#
16# Flags de debug : combinaison binaire de :
17#   0x01 (1)   : analyse de syntaxe
18#   0x02 (2)   : affichage du tableau interm�diaire
19#   0x04 (4)   : -
20#   0x08 (8)   : -
21#   0x10 (16)  : -
22#   0x20 (32)  : -
23#
24# Historique :
25#   2007/01/05 : pda      : int�gration dans le CVS
26#   2007/07/13 : pda      : documentation
27#   2007/07/13 : pda      : ajout syntaxe debug
28#   2009/02/11 : pda      : analyse des listes de la forme C24-D2
29#
30
31set debug 0
32
33##############################################################################
34# Fonctions de debug & co
35##############################################################################
36
37proc warning {msg} {
38    puts stderr "$msg"
39}
40
41proc debug {msg} {
42    warning $msg
43}
44
45# inspir� de parray.tcl dans la lib tcl
46# la seule diff�rence est la sortie sur stderr (et non sur stdout)
47proc debug-array {a {pattern *}} {
48    upvar 1 $a array
49    if {![array exists array]} {
50	error "\"$a\" isn't an array"
51    }
52    set maxl 0
53    foreach name [lsort [array names array $pattern]] {
54	if {[string length $name] > $maxl} {
55	    set maxl [string length $name]
56	}
57    }
58    set maxl [expr {$maxl + [string length $a] + 2}]
59    foreach name [lsort [array names array $pattern]] {
60	set nameString [format %s(%s) $a $name]
61	puts stderr [format "%-*s = %s" $maxl $nameString $array($name)]
62    }
63}
64
65##############################################################################
66# Analyse des descriptions d'interfaces
67##############################################################################
68
69proc parse-desc {desc _linkname _statname _descname _msg} {
70    upvar $_linkname linkname
71    upvar $_statname statname
72    upvar $_descname descname
73    upvar $_msg msg
74
75    # exemples de syntaxe admises :
76    # Lnnn vers toto 			ancienne syntaxe
77    # <Lnnn> vers toto			nouvelle syntaxe
78    # <Lnnn MLnnn.crc> vers toto	nouvelle syntaxe avec m�trologie
79    # X rch ulp bidule			ancienne syntaxe
80    # <X> rch ulp bidule		nouvelle syntaxe
81    # <X MXnnn> rch ulp bidule		nouvelle syntaxe avec m�trologie
82
83    set linkname ""
84    set statname ""
85    set descname ""
86
87    #
88    # Retirer les guillemets s'il y en a
89    #
90
91    if {[regexp {^\s*"(.*)"\s*$} $desc bidon ndesc]} then {
92	set desc $ndesc
93    }
94
95    #
96    # Analyser le mini-langage
97    #
98
99    set r 1
100    if {[regexp {([^<]*)<\s*([^<>]+)>(.*)} $desc bidon p1 liste p2]} then {
101	while {[regexp {^(\S+)(\s+(.*))?$} $liste bidon premier bidon liste]} {
102	    switch -glob -- $premier {
103		X* -
104		L* {
105		    if {[string equal $linkname ""]} then {
106			set linkname $premier
107		    } else {
108			set msg "duplicate link name"
109			set r 0
110			break
111		    }
112		}
113		M* {
114		    if {[string equal $statname ""]} then {
115			set statname $premier
116		    } else {
117			set msg "duplicate stat name"
118			set r 0
119			break
120		    }
121		}
122		* {
123		    set msg "invalid interface description '<$premier>'"
124		    set r 0
125		    break
126		}
127	    }
128	}
129	set descname [string trim "[string trim $p1] [string trim $p2]"]
130    } elseif {[regexp {^".*"$} $desc bidon linkname p1]} {
131	set msg "description must not be quoted"
132    } elseif {[regexp {^(\S+)(\s+.*)?$} $desc bidon linkname p1]} {
133	set descname [string trim $p1]
134    } else {
135	set msg "invalid link name"
136	set r 0
137    }
138
139    #
140    # Conversion de la description en cha�ne de chiffres hexa
141    # pour �viter d'avoir � quoter les �l�ments.
142    # Cette cha�ne sera propag�e dans le graphe, et chaque outil
143    # utilisant le graphe devra faire la conversion inverse
144    # avec une commande comme par exemple : "binary format H* $desc"
145    #
146
147    binary scan $descname H* descname
148
149    return $r
150}
151
152##############################################################################
153# Analyse des localisations d'�quipement
154##############################################################################
155
156proc parse-location {desc _location _ipmac _portmac _blablah _msg} {
157    upvar $_location location
158    upvar $_ipmac ipmac
159    upvar $_portmac portmac
160    upvar $_blablah blablah
161    upvar $_msg msg
162
163    # exemples de syntaxe admises :
164    # <CxxBxxLxxAxx> blablah
165    # <CxxBxxLxxAxx I> blablah
166    # <CxxBxxLxxAxx I P> blablah
167    # <I> blablah
168    # <I P> blablah
169    #
170
171    set location ""
172    set portmac 0
173    set ipmac 0
174    set blablah  ""
175
176    set r 1
177    if {[regexp {^["]*X.*} $desc]} {
178	#
179	# Si la description commence par X, on ne fait rien
180	#
181
182    } elseif {[regexp {([^<]*)<\s*([^<>]+)>(.*)} $desc bidon p1 liste p2]} then {
183
184	if {[regexp -nocase {C[0-9]+B[0-9]+L[0-9]+A[0-9]+} $liste]} then {
185	    set location $liste
186	    set blablah [string trim "[string trim $p1] [string trim $p2]"]
187
188	    #
189	    # Conversion de la description en cha�ne de chiffres hexa
190	    # pour �viter d'avoir � quoter les �l�ments.
191	    # Cette cha�ne sera propag�e dans le graphe, et chaque outil
192	    # utilisant le graphe devra faire la conversion inverse
193	    # avec une commande comme par exemple : "binary format H* $desc"
194	    #
195
196	    binary scan $location H* location
197	}
198    	# I -> ipmac
199	if {[regexp -nocase {\yI\y} $liste]} then {
200		set ipmac 1
201	}
202    	# P -> portmac
203	if {[regexp -nocase {\yP\y} $liste]} then {
204		set portmac 1
205	}
206    } else {
207	set msg "invalid location syntax '$desc'"
208	set r 0
209    }
210
211    return $r
212}
213
214##############################################################################
215# Analyse d'une liste d'intervalles
216##############################################################################
217
218#
219# Analyse une liste d'intervalles ou de valeurs
220#
221# Entr�e :
222#   - spec : liste d'intervalles (n-m) ou de valeurs (p) s�par�es par des ","
223#   - expanser : 0 s'il faut retourner une liste d'intervalles,
224#	ou 1 s'il faut retourner une liste de valeurs (intervalles expans�s)
225#   - preflist : une liste de la forme {{A 4} {B 16} ...} o� chaque
226#	lettre est un nom de module et la valeur le nombre de ports du module
227# Sortie :
228#   - valeur de retour : liste au format {{n m} {p p} ...} ou liste au
229#	format {n1 n2 n3 ...}
230#
231# Exemple :
232#	parse-list "17-20,25,27-28" 0
233#		=> {{17 20} {25 25} {27 28}}
234#	parse-list "17-20,25,27-28" 1
235#		=> {17 18 19 20 25 27 28}
236#
237# Historique :
238#   2008/07/07 : pda/jean : conception
239#   2009/02/11 : pda      : ajout de preflist
240#
241
242proc parse-list {spec expanser preflist} {
243    set l {}
244    foreach v [split $spec ","] {
245	set rg [split $v "-"]
246	switch [llength $rg] {
247	    1 {
248		set v [lindex $rg 0]
249		lappend l [list $v $v]
250	    }
251	    2 {
252		lappend l $rg
253	    }
254	    default {
255		warning "Incorrect list specification ($spec)"
256		return {}
257	    }
258	}
259    }
260
261    if {$expanser} then {
262	set l2 {}
263	foreach c $l {
264	    set min [lindex $c 0]
265	    set max [lindex $c 1]
266
267	    if {! [regexp {^([^0-9]*)([0-9]+)} $min bidon prefmin min]} then {
268		warning "Incorrect list specification ($spec)"
269		return {}
270	    }
271	    if {! [regexp {^([^0-9]*)([0-9]+)} $max bidon prefmax max]} then {
272		warning "Incorrect list specification ($spec)"
273		return {}
274	    }
275	    if {[string equal $prefmin $prefmax]} then {
276		# A5-A9
277		for {set i $min} {$i <= $max} {incr i} {
278		    lappend l2 "$prefmin$i"
279		}
280	    } else {
281		# A5-C2
282		if {[llength $preflist] == 0} then {
283		    warning "Incorrect list specification ($spec) : prefix '$prefmin' != '$prefmax'"
284		    return {}
285		} else {
286		    #
287		    # Chercher le nombre de ports de chaque module
288		    # et r�ler si les modules ne sont pas trouv�s
289		    #
290		    set imin [lsearch -index 0 $preflist $prefmin]
291		    if {$imin == -1} then {
292			warning "Incorrect prefix '$prefmin' in '$spec'"
293		    }
294		    set imax [lsearch -index 0 $preflist $prefmax]
295		    if {$imax == -1} then {
296			warning "Incorrect prefix '$prefmax' in '$spec'"
297		    }
298
299		    #
300		    # Expanser la liste
301		    #
302
303		    set i $min
304		    for {set j $imin} {$j <= $imax} {incr j} {
305			set pref   [lindex [lindex $preflist $j] 0]
306			set nports [lindex [lindex $preflist $j] 1]
307
308			# pour les pr�fixes interm�diaires : aller
309			# jusqu'au port max. Quand on arrive au
310			# dernier pr�fixe : prendre la valeur sp�cifi�e.
311			set k [expr "$j < $imax ? $nports : $max"]
312
313			# expanser
314			for {} {$i <= $k} {incr i} {
315			    lappend l2 "$pref$i"
316			}
317
318			# remettre les compteurs � 1 pour la suite
319			set i 1
320		    }
321		}
322	    }
323	}
324	set l $l2
325    }
326
327    return $l
328}
329
330###############################################################################
331# Analyse du fichier de configuration pour les �quipements "type IOS"
332###############################################################################
333
334#
335# Analyse un fichier de configuration de type IOS
336#
337# Entr�e :
338#   - libdir : r�pertoire contenant les greffons d'analyse
339#   - model : mod�le de l'�quipement (ex: M20)
340#   - fdin : descripteur de fichier en entr�e
341#   - fdout : fichier de sortie pour la g�n�ration
342#   - eq = <eqname>
343#   - _kwtab : tableau guidant l'analyse syntaxique (cf note ci-dessous)
344# Remplit :
345#   - tab(eq)	{<eqname> ... <eqname>}
346#   - tab(eq!ios) "unsure|router|switch"
347#
348# Note :
349#   - kwtab est un tableau index� par <chaine-de-mots-clef> et dont
350#     les valeurs sont des <action>
351#   - Une <chaine-de-mots-clef> est la suite de mots-clefs apparaissant sur
352#     la ligne, s�par�s par des "-".
353#   - <action> est soit :
354#     	NEXT : pour continuer l'analyse de la ligne
355#     	{CALL f} : pour appeler la fonction f lorsque cette suite
356#     		est reconnue
357#   - exemple : pour analyser une ligne de type :
358#     	ip address 192.168.1.2 255.255.255.0
359#	il faut indiquer :
360#		ip		NEXT
361#		ip-address	{CALL machin-parse-ip-address}
362#   - cas sp�cial : les commentaires sont sp�cifi�s par la ligne
363#	-COMMENT	<regexp>
364#	o� "-COMMENT" est un mot-clef et <regexp> est une expression
365#	r�guli�re utilis�e pour trouver un commentaire dans la ligne
366#   - exemple :
367#		-COMMENT	^!
368#
369#
370# Historique
371#   2004/03/23 : pda/jean : conception
372#   2004/06/08 : pda/jean : ajout de model
373#   2007/07/12 : pda      : ajout de ios
374#   2008/07/07 : pda/jean : ajout param�tre libdir
375#   2008/07/07 : pda/jean : mise en commun avec HP
376#   2009/01/07 : pda      : ajout du modele dans le tableau
377#   2010/09/07 : pda/jean : ajout de la liste des interfaces "disabled"
378#
379
380proc ios-parse {libdir model fdin fdout tab eq _kwtab} {
381    upvar $tab t
382    upvar $_kwtab kwtab
383
384    set error 0
385
386    set commentaire "^!"
387    if {[info exists kwtab(-COMMENT)]} then {
388	set commentaire $kwtab(-COMMENT)
389    }
390
391    lappend t(eq) $eq
392    set idx "eq!$eq"
393    set t($idx!if) {}
394    set t($idx!if!disabled) {}
395    set t($idx!ios) "unsure"
396    set t($idx!model) $model
397    while {[gets $fdin line] > -1} {
398	if {! [regexp $commentaire $line]} then {
399	    set error [ios-parse-line $line t $idx kwtab]
400	}
401    }
402
403    return $error
404}
405
406#
407# Analyse une ligne de conf IOS
408#
409# Entr�e :
410#   - line : extrait de conf
411#   - tab : tableau contenant les informations r�sultant de l'analyse
412#   - idx : index dans le tableau tab
413#   - variable globale debug : affiche les mots-clefs
414#   - _kwtab : tableau guidant l'analyse syntaxique
415# Sortie :
416#   - valeur de retour : 1 si erreur, 0 sinon
417#
418# Historique
419#   2004/03/26 : pda/jean : conception (ouh la la !)
420#   2008/07/07 : pda/jean : ajout kwtab en param�tre pour g�n�ricit�
421#
422
423proc ios-parse-line {line tab idx _kwtab} {
424    global debug
425    upvar $_kwtab kwtab
426    upvar $tab t
427
428    if {$debug & 0x01} then {
429	debug "$line"
430    }
431
432    set active 1
433    set error 0
434    set first 1
435    set kwlist {}
436    set finished 0
437    while {! $finished} {
438	#
439	# Prendre le premier �l�ment de la ligne
440	#
441	if {[regexp {^\s*(\S+)\s*(.*)$} $line bidon kw line]} then {
442	    #
443	    # cas sp�cial de "no ..." : on passe au suivant
444	    #
445	    if {$first} then {
446		set first 0
447		if {[string equal $kw "no"]} then {
448		    set active 0
449		    continue
450		}
451	    }
452
453	    #
454	    # Chercher
455	    #
456
457	    lappend kwlist $kw
458	    set fullkw [join $kwlist "-"]
459	    if {[info exists kwtab($fullkw)]} then {
460		if {$debug & 0x01} then {
461		    debug "match $fullkw ($line) -> $kwtab($fullkw)"
462		}
463		set action $kwtab($fullkw)
464		switch [lindex $action 0] {
465		    NEXT {
466			# rien
467		    }
468		    CALL {
469			set fct [lindex $action 1]
470			set error [$fct $active $line t $idx]
471			set finished 1
472		    }
473		    default {
474			warning "Unvalid value in kwtab($fullkw) ($action)"
475			set error 1
476			set finished 1
477		    }
478		}
479	    } else {
480		set finished 1
481	    }
482	} else {
483	    set finished 1
484	}
485    }
486
487    return $error
488}
489
490##############################################################################
491# Fonctions d'appel aux greffons
492##############################################################################
493
494proc charger {libdir file} {
495    set error 0
496
497    if {! [string equal $libdir ""]} then {
498	set file "$libdir/$file"
499    }
500
501    if {[file exists $file]} then {
502	uplevel #0 source $file
503    } else {
504	puts stderr "Fichier '$file' inexistant"
505	set error 1
506    }
507
508    return $error
509}
510
511proc parse {libdir type modele fdin fdout tab eq} {
512    upvar $tab t
513
514    set error [charger $libdir "parse-$type.tcl"]
515    if {! $error} then {
516	set error [$type-parse $libdir $modele $fdin $fdout t $eq]
517    }
518
519    return $error
520}
521
522proc initnode {eq} {
523    global numnode fmtnode
524
525    set fmtnode "$eq:%d"
526    set numnode 0
527}
528
529proc newnode {} {
530    global numnode fmtnode
531
532    return [format $fmtnode [incr numnode]]
533}
534
535##############################################################################
536# Fonction principale
537##############################################################################
538
539proc usage {argv0} {
540    puts stderr \
541	"$argv0 libdir cisco|hp|juniper|server modele fichier-conf eq-name \[debug\]"
542}
543
544proc main {argv0 argv} {
545    global debug
546
547    switch [llength $argv] {
548	5 {
549	    # rien
550	}
551	6 {
552	    set debug [lindex $argv 5]
553	}
554	default {
555	    usage $argv0
556	    return 1
557	}
558    }
559
560    set libdir  [lindex $argv 0]
561    set type    [lindex $argv 1]
562    set modele  [lindex $argv 2]
563    set fichier [lindex $argv 3]
564    set eq      [lindex $argv 4]
565
566    initnode $eq
567
568    set fd [open $fichier "r"]
569    set error [parse $libdir $type $modele $fd stdout tab $eq]
570    close $fd
571
572    return 0
573}
574
575
576exit [main $argv0 $argv]
577