/[A3C]/data/ol-schema-migrate.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /data/ol-schema-migrate.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 95 - (show annotations)
Wed Apr 30 20:28:24 2008 UTC (11 years, 1 month ago) by dpavlin
File MIME type: text/plain
File size: 14877 byte(s)
http://directory.fedoraproject.org/download/ol-schema-migrate.pl
1 #!/usr/bin/perl -w
2 #
3 # Convert OpenLDAP schema files into Fedora DS format with RFC2252 compliant printing
4 #
5 # First Release : Mike Jackson <mj@sci.fi> 14 June 2005
6 # http://www.netauth.com/~jacksonm/ldap/ol-schema-migrate.pl
7 # Professional LDAP consulting for large and small projects
8 #
9 # - 6 Dec 2005
10 # - objectclass element ordering
11 #
12 # Second Release : Alyseo <info@alyseo.com> 05 Februrary 2006
13 # Francois Billard <francois@alyseo.com>
14 # Yacine Kheddache <yacine@alyseo.com>
15 # http://www.alyseo.com
16 #
17 # - 05 Februrary 2006
18 # - parsing improvements to accept schema not RFC compliant like ISPMAN
19 # - adding RFC element : Usage, No-user-modification, collective keywords
20 # - 08 Februrary 2006
21 # - adding help & usage
22 # - now it can beautify your schemas: "-b"
23 # - count attributes and objects class: "-c"
24 # - display items that can not be converted (empty OID...): "-d"
25 # - 15 February 2006
26 # - adding workaround for Fedora DS bug 181465:
27 # https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=181465
28 # - adding duplicated OID check: "-d"
29 # Useful to manually correct nasty schemas like:
30 # https://sourceforge.net/tracker/?func=detail&atid=108390&aid=1429276&group_id=8390
31 #
32 # - Fedora DS bug you need to correct by hang (this script is not taking it into account):
33 # https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=179956
34 #
35 # GPL license
36 #
37
38 my $optionCount = 0;
39 my $optionPrint = 0;
40 my $optionBadEntries = 0;
41 my $optionHelp = 0;
42 my $filename = "" ;
43
44 foreach (@ARGV) {
45 $optionHelp = 1 if ( /^-h$/);
46 $optionCount = 1 if ( /^-c$/);
47 $optionPrint = 1 if ( /^-b$/);
48 $optionBadEntries = 1 if ( /^-d$/);
49 $filename = $_ if ( ! /^-b$/ && ! /^-c$/ && ! /^-d$/);
50 }
51
52 die "Usage : ol-schema-migrate-v2.pl [ -c ] [ -b ] [ -d ] schema\n" .
53 " -c\tcount attribute and object class\n" .
54 " -b\tconvert and beautify your schema\n" .
55 " -d\tdisplay unrecognized elements, find empty and duplicated OID\n" .
56 " -h\tthis help\n" if ($filename eq "" || ($optionHelp || (!$optionCount && !$optionPrint && !$optionBadEntries)));
57
58 if($optionCount) {
59 print "Schema verification counters:\n";
60 my $ldapdata = &getSourceFile($filename);
61 print "".(defined($ldapdata->{attributes}) ? @{$ldapdata->{attributes}} : 0) . " attributes\n";
62 print "".(defined($ldapdata->{objectclass}) ? @{$ldapdata->{objectclass}} : 0) . " object classes\n\n"
63 }
64
65 if($optionPrint) {
66 my $ldapdata = &getSourceFile($filename);
67 &printit($ldapdata);
68 }
69
70 if($optionBadEntries) {
71 print "Display unrecognized entries:\n";
72 my $ldapdata = &getSourceFile($filename);
73 my $errorsAttr = 0;
74 my $errorsObjc = 0;
75 my $errorsDup = 0;
76 my $emptyOid = 0;
77 my %dup;
78
79 foreach (@{$ldapdata->{attributes}}) {
80 my $attr = $_;
81
82 push @{$dup{$attr->{OID}}{attr}}, {NAME => $attr->{NAME}, LINENUMBER => $attr->{LINENUMBER}};
83
84 $attr->{DATA} =~ s/\n/ /g;
85 $attr->{DATA} =~ s/\r//g;
86 $attr->{DATA} =~ s/attribute[t|T]ypes?:?\s*\(//;
87 $attr->{DATA} =~ s/\Q$attr->{OID}// if(defined $attr->{OID});
88 $attr->{DATA} =~ s/NAME\s*\Q$attr->{NAME}// if(defined $attr->{NAME});
89 $attr->{DATA} =~ s/DESC\s*'\Q$attr->{DESC}'// if(defined $attr->{DESC});
90 $attr->{DATA} =~ s/$attr->{OBSOLETE}// if(defined $attr->{OBSOLETE});
91 $attr->{DATA} =~ s/SUP\s*\Q$attr->{SUP}// if(defined $attr->{SUP});
92 $attr->{DATA} =~ s/EQUALITY\s*\Q$attr->{EQUALITY}// if(defined $attr->{EQUALITY});
93 $attr->{DATA} =~ s/ORDERING\s*\Q$attr->{ORDERING}// if(defined $attr->{ORDERING});
94 $attr->{DATA} =~ s/SUBSTR\s*\Q$attr->{SUBSTR}// if(defined $attr->{SUBSTR});
95 $attr->{DATA} =~ s/SYNTAX\s*\Q$attr->{SYNTAX}// if(defined $attr->{SYNTAX});
96 $attr->{DATA} =~ s/SINGLE-VALUE// if(defined $attr->{SINGLEVALUE});
97 $attr->{DATA} =~ s/NO-USER-MODIFICATION// if(defined $attr->{NOUSERMOD});
98 $attr->{DATA} =~ s/COLLECTIVE// if(defined $attr->{COLLECTIVE});
99 $attr->{DATA} =~ s/USAGE\s*\Q$attr->{USAGE}// if(defined $attr->{USAGE});
100 $attr->{DATA} =~ s/\)\s$//;
101 $attr->{DATA} =~ s/^\s+(\S)/\n$1/ ;
102 $attr->{DATA} =~ s/(\S)\s+$/$1\n/;
103 do {
104 $errorsAttr ++;
105 do { $emptyOid ++;
106 print "Warning : no OID for attributes element at line $attr->{LINENUMBER} \n";
107 } if( !defined($attr->{OID}));
108 print "### Unknow element embedded in ATTRIBUTE at line $attr->{LINENUMBER} :\n$attr->{DATA}\n"
109 } if($attr->{DATA} =~ /\w/);
110 }
111
112 foreach (@{$ldapdata->{objectclass}}) {
113 my $objc = $_;
114 push @{$dup{$objc->{OID}}{objc}} , {NAME => $objc->{NAME}, LINENUMBER => $objc->{LINENUMBER}};
115 $objc->{DATA} =~ s/\n/ /g;
116 $objc->{DATA} =~ s/\r//g;
117 $objc->{DATA} =~ s/^object[c|C]lasse?s?:?\s*\(?//;
118 $objc->{DATA} =~ s/\Q$objc->{OID}// if(defined $objc->{OID});
119 $objc->{DATA} =~ s/NAME\s*\Q$objc->{NAME}\E// if(defined $objc->{NAME});
120 $objc->{DATA} =~ s/DESC\s*'\Q$objc->{DESC}\E'// if(defined $objc->{DESC});
121 $objc->{DATA} =~ s/OBSOLETE// if(defined $objc->{OBSOLETE});
122 $objc->{DATA} =~ s/SUP\s*\Q$objc->{SUP}// if(defined $objc->{SUP});
123 $objc->{DATA} =~ s/\Q$objc->{TYPE}// if(defined $objc->{TYPE});
124 $objc->{DATA} =~ s/MUST\s*\Q$objc->{MUST}\E\s*// if(defined $objc->{MUST});
125 $objc->{DATA} =~ s/MUST\s*\(?\s*\Q$objc->{MUST}\E\s*\)?// if(defined $objc->{MUST});
126 $objc->{DATA} =~ s/MAY\s*\Q$objc->{MAY}\E// if(defined $objc->{MAY});
127 $objc->{DATA} =~ s/\)\s$//;
128 $objc->{DATA} =~ s/^\s+(\S)/\n$1/ ;
129 $objc->{DATA} =~ s/(\S)\s+$/$1\n/;
130
131 do {
132 print "#" x 80 ."\n";
133 $errorsObjc ++;
134 do { $emptyOid++ ;
135 print "Warning : no OID for object class element at line $objc->{LINENUMBER} \n";
136 } if( $objc->{OID} eq "");
137 print "### Unknow element embedded in OBJECT CLASS at line $objc->{LINENUMBER} :\n$objc->{DATA}\n"
138 } if($objc->{DATA} =~ /\w/);
139 }
140
141 my $nbDup = 0;
142 foreach (keys %dup) {
143 my $sumOid = 0;
144 $sumOid += @{$dup{$_}{attr}} if(defined (@{$dup{$_}{attr}}));
145 $sumOid += @{$dup{$_}{objc}} if(defined (@{$dup{$_}{objc}}));
146 if( $sumOid > 1 && $_ ne "") {
147 $nbDup ++;
148 print "#" x 80 ."\n";
149 print "Duplicate OID founds : $_\n";
150 foreach (@{$dup{$_}{attr}}) {
151
152 print "Attribute : $_->{NAME} (line : $_->{LINENUMBER})\n";
153 }
154 foreach (@{$dup{$_}{objc}}) {
155 print "Object class : $_->{NAME} (line : $_->{LINENUMBER})\n";
156 }
157
158 }
159 }
160
161 print "\n$errorsAttr errors detected in ATTRIBUTES list\n";
162 print "$errorsObjc errors detected in OBJECT CLASS list\n";
163 print "$nbDup duplicate OID founds\n";
164 print "$emptyOid empty OID fields founds\n\n";
165
166 }
167
168
169 sub printit {
170 my $ldapdata = shift;
171 &printSeparator;
172 print "dn: cn=schema\n";
173 &printSeparator;
174
175 # print elements in RFC2252 order
176
177 foreach (@{$ldapdata->{attributes}}) {
178 my $attr = $_;
179 print "attributeTypes: (\n";
180 print " $attr->{OID}\n";
181 print " NAME $attr->{NAME}\n";
182 print " DESC '$attr->{DESC}'\n" if(defined $attr->{DESC});
183 print " OBSOLETE\n" if(defined $attr->{OBSOLETE});
184 print " SUP $attr->{SUP}\n" if(defined $attr->{SUP});
185 print " EQUALITY $attr->{EQUALITY}\n" if(defined $attr->{EQUALITY});
186 print " ORDERING $attr->{ORDERING}\n" if(defined $attr->{ORDERING});
187 print " SUBSTR $attr->{SUBSTR}\n" if(defined $attr->{SUBSTR});
188 print " SYNTAX $attr->{SYNTAX}\n" if(defined $attr->{SYNTAX});
189 print " SINGLE-VALUE\n" if(defined $attr->{SINGLEVALUE});
190 print " NO-USER-MODIFICATION\n" if(defined $attr->{NOUSERMOD});
191 print " COLLECTIVE\n" if(defined $attr->{COLLECTIVE});
192 print " USAGE $attr->{USAGE}\n" if(defined $attr->{USAGE});
193 print " )\n";
194 &printSeparator;
195 }
196
197 foreach (@{$ldapdata->{objectclass}}) {
198 my $objc = $_;
199 # next 3 lines : Fedora DS space sensitive bug workaround
200 $objc->{SUP} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{SUP});
201 $objc->{MUST} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{MUST});
202 $objc->{MAY} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{MAY});
203
204 print "objectClasses: (\n";
205 print " $objc->{OID}\n";
206 print " NAME $objc->{NAME}\n";
207 print " DESC '$objc->{DESC}'\n" if(defined $objc->{DESC});
208 print " OBSOLETE\n" if(defined $objc->{OBSOLETE});
209 print " SUP $objc->{SUP}\n" if(defined $objc->{SUP});
210 print " $objc->{TYPE}\n" if(defined $objc->{TYPE});
211 print " MUST $objc->{MUST}\n" if(defined $objc->{MUST});
212 print " MAY $objc->{MAY}\n" if(defined $objc->{MAY});
213 print " )\n";
214 &printSeparator;
215 }
216 }
217
218 sub printSeparator {
219 print "#\n";
220 print "#" x 80 . "\n";
221 print "#\n";
222 }
223
224 sub getSourceFile {
225 my @data = &getFile(shift);
226 my %result;
227 my $result = \%result;
228 my @allattrs;
229 my @allattrsLineNumber;
230 my @allobjc;
231 my @allobjcLineNumber;
232 my $at = 0;
233 my $oc = 0;
234 my $at_string;
235 my $oc_string;
236 my $idx = 0;
237 my $beginParenthesis = 0;
238 my $endParenthesis = 0;
239 my $lineNumber = 0;
240 for(@data) {
241 $lineNumber++;
242 next if (/^\s*\#/); # skip comments
243
244 if($at) {
245 s/ +/ /; # remove embedded tabs
246 s/\t/ /; # remove multiple spaces after the $ sign
247
248 $at_string .= $_;
249 $beginParenthesis = 0; # Use best matching elements
250 $endParenthesis = 0;
251 for(my $i=0;$ i < length($at_string); $i++) {
252 $beginParenthesis++ if(substr ($at_string,$i,1) eq "(");
253 $endParenthesis++ if(substr ($at_string,$i,1) eq ")");
254 }
255 if($beginParenthesis == $endParenthesis) {
256 push @allattrs, $at_string;
257 $at = 0;
258 $at_string = "";
259 $endParenthesis = 0;
260 $beginParenthesis = 0;
261 }
262 }
263
264 if (/^attribute[t|T]ype/) {
265 my $line = $_;
266 push @allattrsLineNumber, $lineNumber; # keep starting line number
267 for(my $i=0;$ i < length($line); $i++) {
268 $beginParenthesis++ if(substr ($line, $i, 1) eq "(");
269 $endParenthesis++ if(substr ($line, $i, 1) eq ")");
270 }
271 if($beginParenthesis == $endParenthesis && $beginParenthesis != 0) {
272 push @allattrs, $line;
273 $endParenthesis = 0;
274 $beginParenthesis = 0;
275 } else {
276 $at_string = $line;
277 $at = 1;
278 }
279 }
280
281 #####################################
282
283 if($oc) {
284 s/ +/ /;
285 s/\t/ /;
286
287 $oc_string .= $_;
288 $endParenthesis = 0; # best methode to accept an elements :
289 $beginParenthesis = 0; # left parenthesis sum == right parenthesis sum, so we are sure to
290 for(my $i=0;$ i < length($oc_string); $i++) { # have an element.
291 $beginParenthesis++ if(substr ($oc_string, $i, 1) eq "(");
292 $endParenthesis++ if(substr ($oc_string, $i, 1) eq ")");
293 }
294 if($beginParenthesis == $endParenthesis) {
295 push @allobjc, $oc_string;
296 $oc = 0;
297 $oc_string = "";
298 $endParenthesis = 0;
299 $beginParenthesis = 0;
300 }
301 }
302
303 if (/^object[c|C]lass/) {
304 my $line = $_;
305 push @allobjcLineNumber, $lineNumber; # keep starting line number
306 for(my $i=0;$ i < length($line); $i++) {
307 $beginParenthesis++ if(substr ($line, $i, 1) eq "(");
308 $endParenthesis++ if(substr ($line, $i, 1) eq ")");
309 }
310 if($beginParenthesis == $endParenthesis && $beginParenthesis != 0) {
311 push @allobjc, $line;
312 $endParenthesis = 0;
313 $beginParenthesis = 0;
314 } else {
315 $oc_string = $line;
316 $oc = 1;
317 }
318 }
319 }
320
321 # Parsing attribute elements
322
323 for(@allattrs) {
324 s/\n/ /g;
325 s/\r//g;
326 s/ +/ /g;
327 s/\t/ /g;
328 $result->{attributes}->[$idx]->{DATA} = $_ if($optionBadEntries); # keep original data
329 $result->{attributes}->[$idx]->{LINENUMBER} = $allattrsLineNumber[$idx];
330 $result->{attributes}->[$idx]->{OID} = $1 if (m/^attribute[t|T]ypes?:?\s*\(?\s*([\.\d]*?)\s+/);
331 $result->{attributes}->[$idx]->{NAME} = $1 if (m/NAME\s+('.*?')\s*/ || m/NAME\s+(\(.*?\))/);
332 $result->{attributes}->[$idx]->{DESC} = $1 if (m/DESC\s+'(.*?)'\s*/);
333 $result->{attributes}->[$idx]->{OBSOLETE} = "OBSOLETE" if (m/OBSOLETE/);
334 $result->{attributes}->[$idx]->{SUP} = $1 if (m/SUP\s+(.*?)\s/);
335 $result->{attributes}->[$idx]->{EQUALITY} = $1 if (m/EQUALITY\s+(.*?)\s/);
336 $result->{attributes}->[$idx]->{ORDERING} = $1 if (m/ORDERING\s+(.*?)\s/);
337 $result->{attributes}->[$idx]->{SUBSTR} = $1 if (m/SUBSTR\s+(.*?)\s/);
338 $result->{attributes}->[$idx]->{SYNTAX} = $1 if (m/SYNTAX\s+(.*?)(\s|\))/);
339 $result->{attributes}->[$idx]->{SINGLEVALUE} = "SINGLE-VALUE" if (m/SINGLE-VALUE/);
340 $result->{attributes}->[$idx]->{COLLECTIVE} = "COLLECTIVE" if (m/COLLECTIVE/);
341 $result->{attributes}->[$idx]->{USAGE} = $1 if (m/USAGE\s+(.*?)\s/);
342 $result->{attributes}->[$idx]->{NOUSERMOD} = "NO-USER-MODIFICATION" if (m/NO-USER-MODIFICATION/);
343 $idx ++;
344 }
345
346 $idx = 0;
347
348 # Parsing object class elements
349
350 for(@allobjc) {
351 s/\n/ /g;
352 s/\r//g;
353 s/ +/ /g;
354 s/\t/ /g;
355 $result->{objectclass}->[$idx]->{DATA} = $_ if($optionBadEntries); # keep original data
356 $result->{objectclass}->[$idx]->{LINENUMBER} = $allobjcLineNumber[$idx];
357 $result->{objectclass}->[$idx]->{OID} = $1 if (m/^object[c|C]lasse?s?:?\s*\(?\s*([\.\d]*?)\s+/);
358 $result->{objectclass}->[$idx]->{NAME} = $1 if (m/NAME\s+('.*?')\s*/ || m/NAME\s+(\(.*?\))/);
359 $result->{objectclass}->[$idx]->{DESC} = $1 if (m/DESC\s+'(.*?)'\s*/);
360 $result->{objectclass}->[$idx]->{OBSOLETE} = "OBSOLETE" if (m/OBSOLETE/);
361 $result->{objectclass}->[$idx]->{SUP} = $1 if (m/SUP\s+([^()]+?)\s/ || m/SUP\s+(\(.+?\))\s/);
362 $result->{objectclass}->[$idx]->{TYPE} = $1 if (m/((?:STRUCTURAL)|(?:AUXILIARY)|(?:ABSTRACT))/);
363 $result->{objectclass}->[$idx]->{MUST} = $1 if (m/MUST\s+(\w+)\)?/ || m/MUST\s+(\(.*?\))(\s|\))/s);
364 $result->{objectclass}->[$idx]->{MAY} = $1 if (m/MAY\s+(\w+)\)?/ || m/MAY\s+(\(.*?\))(\s|\))/s);
365
366 $idx++;
367 }
368
369 return $result;
370 }
371
372 sub getFile {
373 my @data;
374 my $file = shift;
375 die "File not found : $file\n" if(! -e $file);
376 open FH, $file;
377 @data = <FH>;
378 close FH;
379 @data;
380 }
381

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26