examples/LDAP/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 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+
  34 #
  35 # - Fedora DS bug you need to correct by hand :
  36 #    https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=179956
  37 #
  38 # GPLv3+ license
  39 #
  40
  41 my $optionCount = 0;
  42 my $optionPrint = 0;
  43 my $optionBadEntries = 0;
  44 my $optionHelp = 0;
  45 my $filename = "" ;
  46
  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$/);
  53 }
  54
  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)));
  60
  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"
  66 }
  67
  68 if($optionPrint) {
  69   my $ldapdata = &getSourceFile($filename);
  70   &printit($ldapdata);
  71 }
  72
  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;
  81
  82   foreach (@{$ldapdata->{attributes}}) {
  83     my $attr = $_;
  84
  85     push @{$dup{$attr->{OID}}{attr}}, {NAME => $attr->{NAME}, LINENUMBER => $attr->{LINENUMBER}};
  86
  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/);
 113   }
 114
 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/;
 133
 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/);
 142   }
 143
 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}}) {
 154
 155         print "Attribute : $_->{NAME} (line : $_->{LINENUMBER})\n";
 156       }
 157       foreach (@{$dup{$_}{objc}}) {
 158         print "Object class : $_->{NAME} (line : $_->{LINENUMBER})\n";
 159       }
 160
 161     }
 162   }
 163
 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";
 168
 169 }
 170
 171
 172 sub printit {
 173   my $ldapdata = shift;
 174   &printSeparator;
 175   print "dn: cn=schema\n";
 176   &printSeparator;
 177
 178   # print elements in RFC2252 order
 179
 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;
 198   }
 199
 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});
 206
 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;
 218   }
 219 }
 220
 221 sub printSeparator {
 222   print "#\n";
 223   print "#" x 80 . "\n";
 224   print "#\n";
 225 }
 226
 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
 246
 247     if($at) {
 248       s/ +/ /;                    # remove embedded tabs
 249       s/\t/ /;                    # remove multiple spaces after the $ sign
 250
 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 ")");
 257       }
 258       if($beginParenthesis == $endParenthesis) {
 259         push @allattrs, $at_string;
 260         $at = 0;
 261         $at_string = "";
 262         $endParenthesis = 0;
 263         $beginParenthesis = 0;
 264       }
 265     }
 266
 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 ")");
 273       }
 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;
 281       }
 282     }
 283
 284     #####################################
 285
 286     if($oc) {
 287       s/ +/ /;
 288       s/\t/ /;
 289
 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 ")");
 296       }
 297       if($beginParenthesis == $endParenthesis) {
 298         push @allobjc, $oc_string;
 299         $oc = 0;
 300         $oc_string = "";
 301         $endParenthesis = 0;
 302         $beginParenthesis = 0;
 303       }
 304     }
 305
 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 ")");
 312       }
 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;
 320       }
 321     }
 322   }
 323
 324   # Parsing attribute elements
 325
 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 ++;
 347   }
 348
 349   $idx = 0;
 350
 351   # Parsing object class elements
 352
 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);
 368
 369     $idx++;
 370   }
 371
 372   return $result;
 373 }
 374
 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;
 383 }
 384