#!/usr/bin/perl

#
# schema2ldif: Tool for converting OpenLDAP-style schemas to the LDIF format
# -----------
#
# The LDIF-formated LDAP schemas are difficult to edit and maintain. OpenLDAP
# defined a similar schema format that is more free-form and easier to edit.
# This tool converts the OpenLDAP-formatted schema files to the LDIF.
#
# Usage
# -----
#
# schema2ldif < foo.schema > foo.ldif
#
# OpenLDAP schema format
# ----------------------
#
# objectIdentifier nLight 1.3.6.1.4.1.23611
# objectIdentifier nLightLdap nLight:1
#
# attributetype ( oid-my-attr-1
#	NAME 'my-attr-1'
#	DESC 'description of my-attr-1 attribute'
#	SYNTAX 1.3.6.1.4.1.1466.115.121.1.15
# )
#
# attributetype ( nLightLdap:2
#	NAME 'my-attr-2'
#	DESC 'description of my-attr-2 attribute'
#	SYNTAX 1.3.6.1.4.1.1466.115.121.1.15
# )
#
# objectclass ( oid-my-person
#	NAME 'my-person'
#	DESC 'description of my-person attribute'
#	SUP 'inetOrgPerson'
#	MAY ( my-attr-1 )
# )
#
# LDIF schema format
# ------------------
#
# dn: cn=schema
# objectClass: top
# objectClass: ldapSubentry
# objectClass: subschema
# cn: schema
# attributeTypes: ( oid-my-attr-1 NAME 'my-attr-1' DESC 'description of my-attr-1 attribute' SYNTAX 1.3.6.1.4.1.1466.115.121.1.15 X-ORIGIN 'user defined' )
# attributeTypes: ( 1.3.6.1.4.1.23611.1.2 NAME 'my-attr-2' DESC 'description of my-attr-2 attribute' SYNTAX 1.3.6.1.4.1.1466.115.121.1.15 X-ORIGIN 'user defined' )
# objectClasses: ( oid-my-person NAME 'my-person' DESC 'description of my-person attribute' SUP 'inetOrgPerson' MAY ( my-attr-1 ) X-ORIGIN 'user defined' )
#
# schema2ldif, Version 1.3.1, (c) 2005-2011 Radovan Semancik
#
# Changes:
#
# v1.0.1: Added X-ORIGIN injection
# v1.1: Added support for "modify" LDIF format (changetype: modify operation)
# v1.1.1: Fixed "last line" bug
# v1.2: Added support for objectIdentifier macro
# v1.3: Added support for OpenLDAP slapd.d config style schema files
# v1.3.1: Warn if SINGLE-VALUE is not the last clause (except for ORIGIN)

use strict;

my $mode = "static";
my $flavor = "schema";
my $flavorName = undef;
my $origin = 'user defined';

# Turns on debug mode (for development purposes only)
my $debug = 0;

# Process command-line

while ($ARGV[0] =~ /^-/) {
	my $arg = shift;
	if ($arg eq "-h") {
		usage();
		exit();
	} elsif ($arg eq "-m") {
		$mode = "modify";
	} elsif ($arg eq "-s") {
		$flavor = "openldap";
		$flavorName = shift;
	} elsif ($arg eq "-o") {
		$origin = shift;
	} else {
		print STDERR "Unknown option $arg\n";
		usage();
		exit(-1);
	}
}


my $attrNameMap = undef;

my %ldifAttrNameMap = (
	'attributetype'	=> 'attributeTypes',
	'objectclass'	=> 'objectClasses',
);

my %openLdapAttrNameMap = (
	'attributetype'	=> 'olcAttributeTypes',
	'objectclass'	=> 'olcObjectClasses',
);

my @definitionOrder = qw(attributetype objectclass);

my %oidMapping = ();
my %definitions = ();

# Print proper LDIF header 

if ($flavor eq "openldap") {

	print "dn: cn=".$flavorName.",cn=schema,cn=config\n";

	if ($mode eq "modify") {
		print "changetype: add\n";
	}
	
	print "objectClass: olcSchemaConfig\n";
	print "cn: ".$flavorName."\n";
	
	$attrNameMap = \%openLdapAttrNameMap;
	
	
} else {

	# schema (pure) flavor
	
	if ($mode eq "static") {
		# Header for static schema 
		# used to drop into a file that server picks up on start
		print "dn: cn=schema\n";
		print "objectClass: top\n";
		print "objectClass: ldapSubentry\n";
		print "objectClass: subschema\n";
		print "cn: schema\n";
	
		} elsif ($mode eq "modify") {
		# Header for schema that is being uploaded to running server
		print "dn: cn=schema\n";
		print "changetype: modify\n";
	
	} else {
		die ("Unknown mode $mode\n");
	}

	$attrNameMap = \%ldifAttrNameMap;
	
}

# Reading the input schema file in loop
# processing definitions

READLOOP:
while (<>) {

	# Comments
	if (/^\s*#/) {
		# In static mode pass the comments to output file
		print if ($mode eq "static");
		# the comments are ignored in other modes as they make
		# problems when used with some LDAP clients
		next;
	}
	
	chomp;
	
	if ( /^\s*objectIdentifier\s+(\S+)\s+(\S+)\s*$/) {
		# We have got objectIdentifier macro here.
		# Parse it and process to the %oidMapping map
		
		my ($name,$oidExpression) = ($1,$2);
		print STDERR "[P] objectIdentifier: $name -> $oidExpression\n" if $debug;
		
		if (isOid($oidExpression)) {
			$oidMapping{$name} = $oidExpression;
			print STDERR "  adding mapping $name -> $oidExpression\n" if $debug;
		} else {
			my $oid = expandOidMacro($oidExpression);
			if (defined $oid) {
				$oidMapping{$name} = $oid;
				print STDERR "  adding mapping $name -> $oid\n" if $debug;
			} else {
				print STDERR "Error processing objectIdentifier macro: $_\n";
			}
		}
	}
	
	if ( /^\s*(attributetype)\s*\(/i ||
	     /^\s*(objectclass)\s*\(/i ) {

	     	my $type = lc($1);
		my $ldifLine = $attrNameMap->{$type}.": (";
		
		$_ = $';
		my $level = 1;
		my $foundOrigin = undef;
		my $oid = undef;
		
		while ($level) {
		
			# raise or lower parenthesis level as necessary
			
			while ( /\(/g ) { $level++ }
			while ( /\)/g ) { $level-- }
			
			
			# OID expression should be the very first token
			# therefore process if it was not processed yet
			
			if (! defined $oid && /^\s*(\S+)\s*/) {
				my $oidExpression = $1;
				
				if (isOid($oidExpression)) {
					# OID expression is OID, no transformation needed
					$oid = $oidExpression;
					
				} else {
					# Try if OID expression is macro
					$oid = expandOidMacro($oidExpression);
					
					if (! defined $oid) {
						# OID expression is not macro, copy it verbatim to output
						# This is used if symbolic names are used instead of OIDs
						$oid = $oidExpression;
					}
				}
				
				$ldifLine .= " $oid";
				$_ = $';
			}
			
			# find X-ORIGIN clause in the input
			
			if (/X\-ORIGIN\s+\'([^\'*])\'/) {
				$foundOrigin = $1;
			}
			
			# if we are at the end (level 0) and there was no
			# X-ORIGIN clause, insert the default one
			# just before the last parenthesis
			
			if ($level == 0 && !defined($foundOrigin)) {
				s/\)\s*$/ X-ORIGIN \'$origin\' \)/;
			}
			
			$ldifLine .= $_;
			
			# is we are at the end, check if the SINGLE-VALUE is in correct place
			if ($level == 0) {
				if ($ldifLine =~ /SINGLE-VALUE/ && $ldifLine !~ /SINGLE-VALUE\s+X-ORIGIN/) {
					warn("The SINGLE-VALUE must be the last clause before X-ORIGIN (oid $oid)\n");
				}
			}
			
			$_ = <>;
			last unless defined $_;
			
			# trim whitespaces
			chomp;
			s/^\s+/ /;
			s/\s+$//;
			
		}
		
		print STDERR "[P] $type: $oid\n" if $debug;

		
		if ($mode eq "static") {
			print $ldifLine . "\n";
		} else {
			if (!$definitions{$type}) {
				$definitions{$type} = [];
			}
			
			push @{$definitions{$type}},$ldifLine;
		}
		
		last unless defined $_;
	}
}

if ($mode eq "modify") {
	my $first = 1;
	foreach my $type (@definitionOrder) {
	
		next unless ($definitions{$type});
	
		if ($flavor eq "schema") {
			if ($first) {
				$first = 0;
			} else {
				print "-\n";
			}
			print "add: ".$attrNameMap->{$type}."\n";
		}
	
		foreach my $line (@{$definitions{$type}}) {
			print $line."\n";
		}
	}
}

sub isOid {
	my ($s) = @_;
	
	return ($s =~ /^[\.\d]+$/);
}

sub expandOidMacro {
	my ($macro) = @_;
	
	if ($macro =~ /:/) {
		my $key = $`;
		my $suffix = $';
		if (exists $oidMapping{$key}) {
			return $oidMapping{$key}.".".$suffix;
		} else {
			return undef;
		}
	}
	return $oidMapping{$macro};
}

sub usage {
	print STDERR "Usage: $0 [-h ] [-m] [-o <origin> ] in.schema > out.ldif\n";
	print STDERR "\t-h\t\tThis help message.\n";
	print STDERR "\t-m\t\tGenerate \"modify\" LDIF instead of \"static\"\n";
	print STDERR "\t-s <name>\t\tGenerate OpenLDAP LDIF flavor\n";
	print STDERR "\t-o <origin>\tSpecify X-ORIGIN to inject (default: user defined)\n";
	print STDERR "(c) 2000-2011 Radovan Semancik (http://storm.alert.sk/)\n";
}