#!/usr/bin/perl
#
#  $Id: pretty_schema,v 1.2 2004/09/08 20:36:00 dgregor Exp $
#
# Copyright (c) 2002 Daniel J. Gregor, Jr.
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 
#    - Redistributions of source code must retain the above copyright
#      notice, this list of conditions and the following disclaimer.
#    - Redistributions in binary form must reproduce the above
#      copyright notice, this list of conditions and the following
#      disclaimer in the documentation and/or other materials provided
#      with the distribution.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
# COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# 

use Getopt::Std;

$usage = "$0: usage:\n\t$0 -H <objectclass>\n";

if (!getopts('Hd', \%opts)) {
	die $usage;
}

$html = defined($opts{'H'}) ? 1 : 0;
$debug = defined($opts{'d'}) ? 1 : 0;

if (@ARGV != 1) {
	die $usage;
}

$objectclass = lc(shift(@ARGV));

# From RFC 2252
%sy = (
	'1.3.6.1.4.1.1466.115.121.1.1'  => 'ACI Item',
	'1.3.6.1.4.1.1466.115.121.1.2'  => 'Access Point',
	'1.3.6.1.4.1.1466.115.121.1.3'  => 'Attribute Type Description',
	'1.3.6.1.4.1.1466.115.121.1.4'  => 'Audio',
	'1.3.6.1.4.1.1466.115.121.1.5'  => 'Binary',
	'1.3.6.1.4.1.1466.115.121.1.6'  => 'Bit String',
	'1.3.6.1.4.1.1466.115.121.1.7'  => 'Boolean',
	'1.3.6.1.4.1.1466.115.121.1.8'  => 'Certificate',
	'1.3.6.1.4.1.1466.115.121.1.9'  => 'Certificate List',
	'1.3.6.1.4.1.1466.115.121.1.10'  => 'Certificate Pair',
	'1.3.6.1.4.1.1466.115.121.1.11'  => 'Country String',
	'1.3.6.1.4.1.1466.115.121.1.12'  => 'DN',
	'1.3.6.1.4.1.1466.115.121.1.13'  => 'Data Quality Syntax',
	'1.3.6.1.4.1.1466.115.121.1.14'  => 'Delivery Method',
	'1.3.6.1.4.1.1466.115.121.1.15'  => 'Directory String',
	'1.3.6.1.4.1.1466.115.121.1.16'  => 'DIT Content Rule Description',
	'1.3.6.1.4.1.1466.115.121.1.17'  => 'DIT Structure Rule Description',
	'1.3.6.1.4.1.1466.115.121.1.18'  => 'DL Submit Permission',
	'1.3.6.1.4.1.1466.115.121.1.19'  => 'DSA Quality Syntax',
	'1.3.6.1.4.1.1466.115.121.1.20'  => 'DSE Type',
	'1.3.6.1.4.1.1466.115.121.1.21'  => 'Enhanced Guide',
	'1.3.6.1.4.1.1466.115.121.1.22'  => 'Facsimile Telephone Number',
	'1.3.6.1.4.1.1466.115.121.1.23'  => 'Fax',
	'1.3.6.1.4.1.1466.115.121.1.24'  => 'Generalized Time',
	'1.3.6.1.4.1.1466.115.121.1.25'  => 'Guide',
	'1.3.6.1.4.1.1466.115.121.1.26'  => 'IA5 String',
	'1.3.6.1.4.1.1466.115.121.1.27'  => 'INTEGER',
	'1.3.6.1.4.1.1466.115.121.1.28'  => 'JPEG',
	'1.3.6.1.4.1.1466.115.121.1.54'  => 'LDAP Syntax Description',
	'1.3.6.1.4.1.1466.115.121.1.56'  => 'LDAP Schema Definition',
	'1.3.6.1.4.1.1466.115.121.1.57'  => 'LDAP Schema Description',
	'1.3.6.1.4.1.1466.115.121.1.29'  => 'Master And Shadow Access Points',
	'1.3.6.1.4.1.1466.115.121.1.30'  => 'Matching Rule Description',
	'1.3.6.1.4.1.1466.115.121.1.31'  => 'Matching Rule Use Description',
	'1.3.6.1.4.1.1466.115.121.1.32'  => 'Mail Preference',
	'1.3.6.1.4.1.1466.115.121.1.33'  => 'MHS OR Address',
	'1.3.6.1.4.1.1466.115.121.1.55'  => 'Modify Rights',
	'1.3.6.1.4.1.1466.115.121.1.34'  => 'Name And Optional UID',
	'1.3.6.1.4.1.1466.115.121.1.35'  => 'Name Form Description',
	'1.3.6.1.4.1.1466.115.121.1.36'  => 'Numeric String',
	'1.3.6.1.4.1.1466.115.121.1.37'  => 'Object Class Description',
	'1.3.6.1.4.1.1466.115.121.1.40'  => 'Octet String',
	'1.3.6.1.4.1.1466.115.121.1.38'  => 'OID',
	'1.3.6.1.4.1.1466.115.121.1.39'  => 'Other Mailbox',
	'1.3.6.1.4.1.1466.115.121.1.41'  => 'Postal Address',
	'1.3.6.1.4.1.1466.115.121.1.42'  => 'Protocol Information',
	'1.3.6.1.4.1.1466.115.121.1.43'  => 'Presentation Address',
	'1.3.6.1.4.1.1466.115.121.1.44'  => 'Printable String',
	'1.3.6.1.4.1.1466.115.121.1.58'  => 'Substring Assertion',
	'1.3.6.1.4.1.1466.115.121.1.45'  => 'Subtree Specification',
	'1.3.6.1.4.1.1466.115.121.1.46'  => 'Supplier Information',
	'1.3.6.1.4.1.1466.115.121.1.47'  => 'Supplier Or Consumer',
	'1.3.6.1.4.1.1466.115.121.1.48'  => 'Supplier And Consumer',
	'1.3.6.1.4.1.1466.115.121.1.49'  => 'Supported Algorithm',
	'1.3.6.1.4.1.1466.115.121.1.50'  => 'Telephone Number',
	'1.3.6.1.4.1.1466.115.121.1.51'  => 'Teletex Terminal Identifier',
	'1.3.6.1.4.1.1466.115.121.1.52'  => 'Telex Number',
	'1.3.6.1.4.1.1466.115.121.1.53'  => 'UTC Time',
);

while (<>) {
	chomp();

	if (s/^objectclasses(:|=)\s*//i) {
		if (!
			m/
				^\(\s+
				(\S+)
				\s+NAME\s+'(\S+)'
				(\s+DESC\s+'([^']+)')?
#				(\s+SUP\s+('([^']+)'|\S+))?
#				(\s+ABSTRACT)?
#				(\s+AUXILIARY)?
#				(\s+STRUCTURAL)?
#				(\s+MUST\s+(\(((\s+\S+\s+\$)*\s+\S+\s+)\)|\S+))?
#				(\s+MAY\s+(\(((\s+\S+\s+\$)*\s+\S+\s+)\)|\S+))?
#				(\s+X-ORIGIN\s+(\((\s+('[^']+'\s+)+)\)|('([^']+)'|\S+)))?
#				\s+\)$
			/x
		) {
			print "argh objectclasses: \"$_\"\n";
			next;
		}

		$oid = $1;
		$name = $2;
		$desc = $4 || undef;
		$sup = $7 || $6 || undef;
		$abstract = defined($8) || 0;
		$auxiliary = defined($9) || 0;
		$structural = defined($10) || 0;
		if (defined($13)) {
			$must = [ split(/\$/, $13) ];
		} elsif (defined($12)) {
			$must = [ $12 ];
		} else {
			undef($must);
		}
		if (defined($17)) {
			$may = [ split(/\$/, $17) ];
		} elsif (defined($16)) {
			$may = [ $16 ];
		} else {
			undef($may);
		}
		$x_origin = $21 || $20 || undef;

		foreach $i (@$must) {
			$i =~ s/\s+//g;
		}

		foreach $i (@$may) {
			$i =~ s/\s+//g;
		}

		$oc{lc($name)} = {
			'oid' => $oid,
			'name' => $name,
			'desc' => $desc,
			'sup' => $sup,
			'abstract' => $abstract,
			'auxiliary' => $auxiliary,
			'structural' => $structural,
			'must' => $must,
			'may' => $may,
			'x_origin' => $x_origin,
		};

		if ($debug) {
		print "\n";
		print "oid: ", $oc{lc($name)}{'oid'}, "\n";
		print "name: ", $oc{lc($name)}{'name'}, "\n";
		print "desc: ", $oc{lc($name)}{'desc'}, "\n";
		print "sup: ", $oc{lc($name)}{'sup'}, "\n";
		print "abstract: ", $oc{lc($name)}{'abstract'}, "\n";
		print "auxiliary: ", $oc{lc($name)}{'auxiliary'}, "\n";
		print "structural: ", $oc{lc($name)}{'structural'}, "\n";
		print "must: ", join(" " , @{$oc{lc($name)}{'must'}}), "\n";
		print "may: ", join(" " , @{$oc{lc($name)}{'may'}}), "\n";
		print "x_origin: ", $oc{lc($name)}{'x_origin'}, "\n";
		}

	} elsif (s/^attributetypes(:|=)\s*//i) {
		if (!
			m/
				^\(\s+
				(\S+)
				\s+NAME\s+(\(\s+([^\)]+)\s+\)|\S+)
				(\s+DESC\s+'([^']+)')?
				(\s+SUP\s+'([^']+)')?
				(\s+EQUALITY\s+'([^']+)')?
				(\s+SUBSTR\s+'([^']+)')?
				(\s+ORDERING\s+'([^']+)')?
				(\s+SYNTAX\s+'([^']+)')?
				(\s+SINGLE-VALUE)?
				(\s+NO-USER-MODIFICATION)?
				(\s+USAGE\s+(\S+))?
				(\s+X-ORIGIN\s+'([^']+)')?
#				\s+\)$
			/x
		) {
			print "argh attributetypes: \"$_\"\n";
			next;
		}

		$oid = $1;
		if (defined($3)) {
			$names = [ split(/\s+/, $3) ];
		} else {
			$names = [ $2 ];
		}
		$desc = $5 || undef;
		$sup = $7 || undef;
		$equality = $9 || undef;
		$substr = $11 || undef;
		$ordering = $13 || undef;
		$syntax = $15 || undef;
		$single_value = defined($16) || 0;
		$no_user_modification = defined($17) || 0;
		$usage = $19 || undef;
		$x_origin = $21 || undef;

		foreach $i (@$names) {
			$i =~ s/^'//;
			$i =~ s/'$//;
		}

		$syntax =~ s/{\d+}//;

		foreach $name (@$names) {
			$at{lc($name)} = {
				'oid' => $oid,
				'names' => $names,
				'desc' => $desc,
				'sup' => $sup,
				'equality' => $equality,
				'substr' => $substr,
				'ordering' => $ordering,
				'syntax' => $syntax,
				'single_value' => $single_value,
				'no_user_modification' => $no_user_modification,
				'x_origin' => $x_origin,
				'usage' => $usage,
			};
		}

		$name = lc($$names[0]);

		if ($debug) {
		print "\n";
		print "oid: ", $at{lc($name)}{'oid'}, "\n";
		print "names: ", join(" ", @{$at{lc($name)}{'names'}}), "\n";
		print "desc: ", $at{lc($name)}{'desc'}, "\n";
		print "sup: ", $at{lc($name)}{'sup'}, "\n";
		print "equality: ", $at{lc($name)}{'equality'}, "\n";
		print "substr: ", $at{lc($name)}{'substr'}, "\n";
		print "ordering: ", $at{lc($name)}{'ordering'}, "\n";
		print "syntax: ", $at{lc($name)}{'syntax'}, "\n";
		print "single_value: ", $at{lc($name)}{'single_value'}, "\n";
		print "no_user_modification: ",
			$at{lc($name)}{'no_user_modification'}, "\n";
		print "x_origin: ", $at{lc($name)}{'x_origin'}, "\n";
		print "usage: ", $at{lc($name)}{'usage'}, "\n";
		}
	} elsif (s/^matchingrules(:|=)\s*//i) {
		if (!
			m/
				^\(\s+
				(\S+)
				\s+NAME\s+'(\S+)'
				(\s*DESC\s+'([^']+)')?
				(\s+SYNTAX\s+'([^']+)')?
				\s+\)$
			/x
		) {
			print "argh: \"$_\"\n";
			next;
		}

		$oid = $1;
		$name = $2;
		$desc = $4 || undef;
		$syntax = $6 || undef;

		$mr{lc($name)} = {
			'oid' => $oid,
			'name' => $name,
			'desc' => $desc,
			'syntax' => $syntax,
		};

		if ($debug) {
		print "\n";
		print "oid: ", $mr{lc($name)}{'oid'}, "\n";
		print "name: ", $mr{lc($name)}{'name'}, "\n";
		print "desc: ", $mr{lc($name)}{'desc'}, "\n";
		print "syntax: ", $mr{lc($name)}{'syntax'}, "\n";
		}

	}
}

if (!exists($oc{$objectclass})) {
	die "objectclass \"$objectclass\" not found in schema\n";
}

@objectclasses = ( $objectclass );

while (defined($oc{$objectclasses[0]}{'sup'})) {
	unshift(@objectclasses, lc($oc{$objectclasses[0]}{'sup'}));
}

if ($html) {
	print "<HTML>\n";
	print "<HEAD>\n";
	print "  <TITLE>LDAP schema attribute report for $objectclass</TITLE>\n";
	print "</HEAD>\n";
	print "<BODY BGCOLOR=\"#ffffff\">\n";
	print "  <H1>LDAP schema attribute report for $objectclass</H1>\n";
	print "  <TABLE BORDER=\"2\">\n";
}

output(
	"--heading",
	"Description",
	"Name(s)",
	"Required",
	"Object Class",
	"Syntax",
	"Single-value",
);

foreach $i (@objectclasses) {
	if (defined($oc{$i}{'may'})) {
		foreach $a (@{$oc{$i}{'may'}}) {
			output(
				$at{lc($a)}{'desc'},
				join("/", @{$at{lc($a)}{'names'}}),
				"no",
				$oc{$i}{'name'},
				$sy{$at{lc($a)}{'syntax'}},
				($at{lc($a)}{'single_value'} ?
					"yes" : "no"),
			);
		}
	}
	if (defined($oc{$i}{'must'})) {
		foreach $a (@{$oc{$i}{'must'}}) {
			output(
				$at{lc($a)}{'desc'},
				join("/", @{$at{lc($a)}{'names'}}),
				"yes",
				$oc{$i}{'name'},
				$sy{$at{lc($a)}{'syntax'}},
				($at{lc($a)}{'single_value'} ?
					"yes" : "no"),
			);
		}
	}
}

if ($html) {
	print "</TABLE>\n";
	print "</BODY>\n";
	print "</HTML>\n";
}

sub output {
	if ($html) {
		if (@_ > 0 && $html && $_[0] eq "--heading") {
			shift(@_);
			$datatag = "TH";
		} else {
			$datatag = "TD";
		}

		print("    <TR>\n");
		foreach $q (@_) {
			print("      <$datatag>", $q , "</$datatag>\n");
		}
		print("    </TR>\n");
	} else {
		print(join(",", @_), "\n");
	}
}