librpc: Shorten dcerpc_binding_handle_call a bit
[Samba/gebeck_regimport.git] / examples / LDAP / ol-schema-migrate.pl
blob12392cb4cd00a3cd9efef97f3d54073cb5bc3d5c
1 #!/usr/bin/perl -w
3 # Convert OpenLDAP schema files into Fedora DS format with RFC2252 compliant printing
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
9 # - 6 Dec 2005
10 # - objectclass element ordering
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/
17 # - 05 Februrary 2006
18 # - parsing improvement to accept non-RFC compliant schemas (like ISPMAN)
19 # - adding RFC element : Usage, No-user-modification, collective keywords
20 # - 08 Februrary 2006
21 # - adding help & usage
22 # - now this script can also 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 # - 13 September 2007
32 # Based on Samba Team GPL Compliance Officer request, license has been updated from
33 # GPL to GPLv3+
35 # - Fedora DS bug you need to correct by hand :
36 # https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=179956
38 # GPLv3+ license
41 my $optionCount = 0;
42 my $optionPrint = 0;
43 my $optionBadEntries = 0;
44 my $optionHelp = 0;
45 my $filename = "" ;
47 foreach (@ARGV) {
48 $optionHelp = 1 if ( /^-h$/);
49 $optionCount = 1 if ( /^-c$/);
50 $optionPrint = 1 if ( /^-b$/);
51 $optionBadEntries = 1 if ( /^-d$/);
52 $filename = $_ if ( ! /^-b$/ && ! /^-c$/ && ! /^-d$/);
55 die "Usage : ol-schema-migrate-v2.pl [ -c ] [ -b ] [ -d ] schema\n" .
56 " -c\tcount attribute and object class\n" .
57 " -b\tconvert and beautify your schema\n" .
58 " -d\tdisplay unrecognized elements, find empty and duplicated OID\n" .
59 " -h\tthis help\n" if ($filename eq "" || ($optionHelp || (!$optionCount && !$optionPrint && !$optionBadEntries)));
61 if($optionCount) {
62 print "Schema verification counters:\n";
63 my $ldapdata = &getSourceFile($filename);
64 print "".(defined($ldapdata->{attributes}) ? @{$ldapdata->{attributes}} : 0) . " attributes\n";
65 print "".(defined($ldapdata->{objectclass}) ? @{$ldapdata->{objectclass}} : 0) . " object classes\n\n"
68 if($optionPrint) {
69 my $ldapdata = &getSourceFile($filename);
70 &printit($ldapdata);
73 if($optionBadEntries) {
74 print "Display unrecognized entries:\n";
75 my $ldapdata = &getSourceFile($filename);
76 my $errorsAttr = 0;
77 my $errorsObjc = 0;
78 my $errorsDup = 0;
79 my $emptyOid = 0;
80 my %dup;
82 foreach (@{$ldapdata->{attributes}}) {
83 my $attr = $_;
85 push @{$dup{$attr->{OID}}{attr}}, {NAME => $attr->{NAME}, LINENUMBER => $attr->{LINENUMBER}};
87 $attr->{DATA} =~ s/\n/ /g;
88 $attr->{DATA} =~ s/\r//g;
89 $attr->{DATA} =~ s/attribute[t|T]ypes?:?\s*\(//;
90 $attr->{DATA} =~ s/\Q$attr->{OID}// if(defined $attr->{OID});
91 $attr->{DATA} =~ s/NAME\s*\Q$attr->{NAME}// if(defined $attr->{NAME});
92 $attr->{DATA} =~ s/DESC\s*'\Q$attr->{DESC}'// if(defined $attr->{DESC});
93 $attr->{DATA} =~ s/$attr->{OBSOLETE}// if(defined $attr->{OBSOLETE});
94 $attr->{DATA} =~ s/SUP\s*\Q$attr->{SUP}// if(defined $attr->{SUP});
95 $attr->{DATA} =~ s/EQUALITY\s*\Q$attr->{EQUALITY}// if(defined $attr->{EQUALITY});
96 $attr->{DATA} =~ s/ORDERING\s*\Q$attr->{ORDERING}// if(defined $attr->{ORDERING});
97 $attr->{DATA} =~ s/SUBSTR\s*\Q$attr->{SUBSTR}// if(defined $attr->{SUBSTR});
98 $attr->{DATA} =~ s/SYNTAX\s*\Q$attr->{SYNTAX}// if(defined $attr->{SYNTAX});
99 $attr->{DATA} =~ s/SINGLE-VALUE// if(defined $attr->{SINGLEVALUE});
100 $attr->{DATA} =~ s/NO-USER-MODIFICATION// if(defined $attr->{NOUSERMOD});
101 $attr->{DATA} =~ s/COLLECTIVE// if(defined $attr->{COLLECTIVE});
102 $attr->{DATA} =~ s/USAGE\s*\Q$attr->{USAGE}// if(defined $attr->{USAGE});
103 $attr->{DATA} =~ s/\)\s$//;
104 $attr->{DATA} =~ s/^\s+(\S)/\n$1/ ;
105 $attr->{DATA} =~ s/(\S)\s+$/$1\n/;
106 do {
107 $errorsAttr ++;
108 do { $emptyOid ++;
109 print "Warning : no OID for attributes element at line $attr->{LINENUMBER} \n";
110 } if( !defined($attr->{OID}));
111 print "### Unknow element embedded in ATTRIBUTE at line $attr->{LINENUMBER} :\n$attr->{DATA}\n"
112 } if($attr->{DATA} =~ /\w/);
115 foreach (@{$ldapdata->{objectclass}}) {
116 my $objc = $_;
117 push @{$dup{$objc->{OID}}{objc}} , {NAME => $objc->{NAME}, LINENUMBER => $objc->{LINENUMBER}};
118 $objc->{DATA} =~ s/\n/ /g;
119 $objc->{DATA} =~ s/\r//g;
120 $objc->{DATA} =~ s/^object[c|C]lasse?s?:?\s*\(?//;
121 $objc->{DATA} =~ s/\Q$objc->{OID}// if(defined $objc->{OID});
122 $objc->{DATA} =~ s/NAME\s*\Q$objc->{NAME}\E// if(defined $objc->{NAME});
123 $objc->{DATA} =~ s/DESC\s*'\Q$objc->{DESC}\E'// if(defined $objc->{DESC});
124 $objc->{DATA} =~ s/OBSOLETE// if(defined $objc->{OBSOLETE});
125 $objc->{DATA} =~ s/SUP\s*\Q$objc->{SUP}// if(defined $objc->{SUP});
126 $objc->{DATA} =~ s/\Q$objc->{TYPE}// if(defined $objc->{TYPE});
127 $objc->{DATA} =~ s/MUST\s*\Q$objc->{MUST}\E\s*// if(defined $objc->{MUST});
128 $objc->{DATA} =~ s/MUST\s*\(?\s*\Q$objc->{MUST}\E\s*\)?// if(defined $objc->{MUST});
129 $objc->{DATA} =~ s/MAY\s*\Q$objc->{MAY}\E// if(defined $objc->{MAY});
130 $objc->{DATA} =~ s/\)\s$//;
131 $objc->{DATA} =~ s/^\s+(\S)/\n$1/ ;
132 $objc->{DATA} =~ s/(\S)\s+$/$1\n/;
134 do {
135 print "#" x 80 ."\n";
136 $errorsObjc ++;
137 do { $emptyOid++ ;
138 print "Warning : no OID for object class element at line $objc->{LINENUMBER} \n";
139 } if( $objc->{OID} eq "");
140 print "### Unknow element embedded in OBJECT CLASS at line $objc->{LINENUMBER} :\n$objc->{DATA}\n"
141 } if($objc->{DATA} =~ /\w/);
144 my $nbDup = 0;
145 foreach (keys %dup) {
146 my $sumOid = 0;
147 $sumOid += @{$dup{$_}{attr}} if(defined (@{$dup{$_}{attr}}));
148 $sumOid += @{$dup{$_}{objc}} if(defined (@{$dup{$_}{objc}}));
149 if( $sumOid > 1 && $_ ne "") {
150 $nbDup ++;
151 print "#" x 80 ."\n";
152 print "Duplicate OID founds : $_\n";
153 foreach (@{$dup{$_}{attr}}) {
155 print "Attribute : $_->{NAME} (line : $_->{LINENUMBER})\n";
157 foreach (@{$dup{$_}{objc}}) {
158 print "Object class : $_->{NAME} (line : $_->{LINENUMBER})\n";
164 print "\n$errorsAttr errors detected in ATTRIBUTES list\n";
165 print "$errorsObjc errors detected in OBJECT CLASS list\n";
166 print "$nbDup duplicate OID founds\n";
167 print "$emptyOid empty OID fields founds\n\n";
172 sub printit {
173 my $ldapdata = shift;
174 &printSeparator;
175 print "dn: cn=schema\n";
176 &printSeparator;
178 # print elements in RFC2252 order
180 foreach (@{$ldapdata->{attributes}}) {
181 my $attr = $_;
182 print "attributeTypes: (\n";
183 print " $attr->{OID}\n";
184 print " NAME $attr->{NAME}\n";
185 print " DESC '$attr->{DESC}'\n" if(defined $attr->{DESC});
186 print " OBSOLETE\n" if(defined $attr->{OBSOLETE});
187 print " SUP $attr->{SUP}\n" if(defined $attr->{SUP});
188 print " EQUALITY $attr->{EQUALITY}\n" if(defined $attr->{EQUALITY});
189 print " ORDERING $attr->{ORDERING}\n" if(defined $attr->{ORDERING});
190 print " SUBSTR $attr->{SUBSTR}\n" if(defined $attr->{SUBSTR});
191 print " SYNTAX $attr->{SYNTAX}\n" if(defined $attr->{SYNTAX});
192 print " SINGLE-VALUE\n" if(defined $attr->{SINGLEVALUE});
193 print " NO-USER-MODIFICATION\n" if(defined $attr->{NOUSERMOD});
194 print " COLLECTIVE\n" if(defined $attr->{COLLECTIVE});
195 print " USAGE $attr->{USAGE}\n" if(defined $attr->{USAGE});
196 print " )\n";
197 &printSeparator;
200 foreach (@{$ldapdata->{objectclass}}) {
201 my $objc = $_;
202 # next 3 lines : Fedora DS space sensitive bug workaround
203 $objc->{SUP} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{SUP});
204 $objc->{MUST} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{MUST});
205 $objc->{MAY} =~ s/^\(\s*(.*?)\s*\)$/\( $1 \)/ if (defined $objc->{MAY});
207 print "objectClasses: (\n";
208 print " $objc->{OID}\n";
209 print " NAME $objc->{NAME}\n";
210 print " DESC '$objc->{DESC}'\n" if(defined $objc->{DESC});
211 print " OBSOLETE\n" if(defined $objc->{OBSOLETE});
212 print " SUP $objc->{SUP}\n" if(defined $objc->{SUP});
213 print " $objc->{TYPE}\n" if(defined $objc->{TYPE});
214 print " MUST $objc->{MUST}\n" if(defined $objc->{MUST});
215 print " MAY $objc->{MAY}\n" if(defined $objc->{MAY});
216 print " )\n";
217 &printSeparator;
221 sub printSeparator {
222 print "#\n";
223 print "#" x 80 . "\n";
224 print "#\n";
227 sub getSourceFile {
228 my @data = &getFile(shift);
229 my %result;
230 my $result = \%result;
231 my @allattrs;
232 my @allattrsLineNumber;
233 my @allobjc;
234 my @allobjcLineNumber;
235 my $at = 0;
236 my $oc = 0;
237 my $at_string;
238 my $oc_string;
239 my $idx = 0;
240 my $beginParenthesis = 0;
241 my $endParenthesis = 0;
242 my $lineNumber = 0;
243 for(@data) {
244 $lineNumber++;
245 next if (/^\s*\#/); # skip comments
247 if($at) {
248 s/ +/ /; # remove embedded tabs
249 s/\t/ /; # remove multiple spaces after the $ sign
251 $at_string .= $_;
252 $beginParenthesis = 0; # Use best matching elements
253 $endParenthesis = 0;
254 for(my $i=0;$ i < length($at_string); $i++) {
255 $beginParenthesis++ if(substr ($at_string,$i,1) eq "(");
256 $endParenthesis++ if(substr ($at_string,$i,1) eq ")");
258 if($beginParenthesis == $endParenthesis) {
259 push @allattrs, $at_string;
260 $at = 0;
261 $at_string = "";
262 $endParenthesis = 0;
263 $beginParenthesis = 0;
267 if (/^attribute[t|T]ype/) {
268 my $line = $_;
269 push @allattrsLineNumber, $lineNumber; # keep starting line number
270 for(my $i=0;$ i < length($line); $i++) {
271 $beginParenthesis++ if(substr ($line, $i, 1) eq "(");
272 $endParenthesis++ if(substr ($line, $i, 1) eq ")");
274 if($beginParenthesis == $endParenthesis && $beginParenthesis != 0) {
275 push @allattrs, $line;
276 $endParenthesis = 0;
277 $beginParenthesis = 0;
278 } else {
279 $at_string = $line;
280 $at = 1;
284 #####################################
286 if($oc) {
287 s/ +/ /;
288 s/\t/ /;
290 $oc_string .= $_;
291 $endParenthesis = 0; # best methode to accept an elements :
292 $beginParenthesis = 0; # left parenthesis sum == right parenthesis sum, so we are sure to
293 for(my $i=0;$ i < length($oc_string); $i++) { # have an element.
294 $beginParenthesis++ if(substr ($oc_string, $i, 1) eq "(");
295 $endParenthesis++ if(substr ($oc_string, $i, 1) eq ")");
297 if($beginParenthesis == $endParenthesis) {
298 push @allobjc, $oc_string;
299 $oc = 0;
300 $oc_string = "";
301 $endParenthesis = 0;
302 $beginParenthesis = 0;
306 if (/^object[c|C]lass/) {
307 my $line = $_;
308 push @allobjcLineNumber, $lineNumber; # keep starting line number
309 for(my $i=0;$ i < length($line); $i++) {
310 $beginParenthesis++ if(substr ($line, $i, 1) eq "(");
311 $endParenthesis++ if(substr ($line, $i, 1) eq ")");
313 if($beginParenthesis == $endParenthesis && $beginParenthesis != 0) {
314 push @allobjc, $line;
315 $endParenthesis = 0;
316 $beginParenthesis = 0;
317 } else {
318 $oc_string = $line;
319 $oc = 1;
324 # Parsing attribute elements
326 for(@allattrs) {
327 s/\n/ /g;
328 s/\r//g;
329 s/ +/ /g;
330 s/\t/ /g;
331 $result->{attributes}->[$idx]->{DATA} = $_ if($optionBadEntries); # keep original data
332 $result->{attributes}->[$idx]->{LINENUMBER} = $allattrsLineNumber[$idx];
333 $result->{attributes}->[$idx]->{OID} = $1 if (m/^attribute[t|T]ypes?:?\s*\(?\s*([\.\d]*?)\s+/);
334 $result->{attributes}->[$idx]->{NAME} = $1 if (m/NAME\s+('.*?')\s*/ || m/NAME\s+(\(.*?\))/);
335 $result->{attributes}->[$idx]->{DESC} = $1 if (m/DESC\s+'(.*?)'\s*/);
336 $result->{attributes}->[$idx]->{OBSOLETE} = "OBSOLETE" if (m/OBSOLETE/);
337 $result->{attributes}->[$idx]->{SUP} = $1 if (m/SUP\s+(.*?)\s/);
338 $result->{attributes}->[$idx]->{EQUALITY} = $1 if (m/EQUALITY\s+(.*?)\s/);
339 $result->{attributes}->[$idx]->{ORDERING} = $1 if (m/ORDERING\s+(.*?)\s/);
340 $result->{attributes}->[$idx]->{SUBSTR} = $1 if (m/SUBSTR\s+(.*?)\s/);
341 $result->{attributes}->[$idx]->{SYNTAX} = $1 if (m/SYNTAX\s+(.*?)(\s|\))/);
342 $result->{attributes}->[$idx]->{SINGLEVALUE} = "SINGLE-VALUE" if (m/SINGLE-VALUE/);
343 $result->{attributes}->[$idx]->{COLLECTIVE} = "COLLECTIVE" if (m/COLLECTIVE/);
344 $result->{attributes}->[$idx]->{USAGE} = $1 if (m/USAGE\s+(.*?)\s/);
345 $result->{attributes}->[$idx]->{NOUSERMOD} = "NO-USER-MODIFICATION" if (m/NO-USER-MODIFICATION/);
346 $idx ++;
349 $idx = 0;
351 # Parsing object class elements
353 for(@allobjc) {
354 s/\n/ /g;
355 s/\r//g;
356 s/ +/ /g;
357 s/\t/ /g;
358 $result->{objectclass}->[$idx]->{DATA} = $_ if($optionBadEntries); # keep original data
359 $result->{objectclass}->[$idx]->{LINENUMBER} = $allobjcLineNumber[$idx];
360 $result->{objectclass}->[$idx]->{OID} = $1 if (m/^object[c|C]lasse?s?:?\s*\(?\s*([\.\d]*?)\s+/);
361 $result->{objectclass}->[$idx]->{NAME} = $1 if (m/NAME\s+('.*?')\s*/ || m/NAME\s+(\(.*?\))/);
362 $result->{objectclass}->[$idx]->{DESC} = $1 if (m/DESC\s+'(.*?)'\s*/);
363 $result->{objectclass}->[$idx]->{OBSOLETE} = "OBSOLETE" if (m/OBSOLETE/);
364 $result->{objectclass}->[$idx]->{SUP} = $1 if (m/SUP\s+([^()]+?)\s/ || m/SUP\s+(\(.+?\))\s/);
365 $result->{objectclass}->[$idx]->{TYPE} = $1 if (m/((?:STRUCTURAL)|(?:AUXILIARY)|(?:ABSTRACT))/);
366 $result->{objectclass}->[$idx]->{MUST} = $1 if (m/MUST\s+(\w+)\)?/ || m/MUST\s+(\(.*?\))(\s|\))/s);
367 $result->{objectclass}->[$idx]->{MAY} = $1 if (m/MAY\s+(\w+)\)?/ || m/MAY\s+(\(.*?\))(\s|\))/s);
369 $idx++;
372 return $result;
375 sub getFile {
376 my @data;
377 my $file = shift;
378 die "File not found : $file\n" if(! -e $file);
379 open FH, $file;
380 @data = <FH>;
381 close FH;
382 @data;