The script! (Was Re: Different CN's for DN and CN.)

[Dave Horsfall <daveh@ci.com.au>]

Due to overwhelming demand, here it is; it will need changes to the
objectClass table, as I couldn't be bothered reading the schema.

I also used it to learn Perl4/Perl5 differences, so the style probably
sucks.

No warranty, no return.  You get what you paid for.  Contents may settle
during transit.  May contain sharp edges.  May contain traces of nuts.
Contents may scald.  Etc...

CUT HERE
----------8<----------8<----------8<----------8<----------
#!/usr/bin/env perl -w
# @(#)$Id: rdnchk.e,v 1.2 2003-03-11 11:17:03+11 daveh Exp $
# $Log: rdnchk.e,v $
# Revision 1.2  2003-03-11 11:17:03+11  daveh
# Look for orphan DNs.
#
# Revision 1.1  2003-02-27 14:28:09+11  daveh
# Initial revision
#
#
# RDNCHK
#
# Given a slapcat input file, check for mismatched DN/RDN pairs etc.
# We can't use Perl Net::LDAP, because it expects compliancy.
#
# Now being extended to look for missing objectClass: top etc.
#

##use Data::Dumper;

while ($_ = &GetLine)	# Loop per entry
{
    chomp;
    next if ! /^dn: /i;
    $dn = $_;
    $dn =~ s/dn: //i;
    $suffix = $dn if ! defined $suffix;
    $suffix = $dn if length $dn < length $suffix; # Assume shortest is suffix
    ($rdn, undef) = split(/,\s*/, $dn);	# RDN is first bit

    while ($_ = &GetLine)	# Loop per attribute
    {
	chomp;
	last if /^$/;		# Empty line delimits entry
	next if /^#/;
	($attr, $val) = split(/: /);	# Wot about userPassword:: ?
	push @{$entry{$dn}{$attr}}, $val;
    }

    ($rdnattr, $rdnval) = split(/=/, $rdn);

    if (!defined @{$entry{$dn}{$rdnattr}})
    {
	printf("dn: $dn\nMissing RDN\n\n");
	next;
    }

    my $nrdn = @{$entry{$dn}{$rdnattr}};
    if ($nrdn > 1)
    {
	printf("dn: $dn\nMultiple RDNs: \"%s\"", @{$entry{$dn}{$rdnattr}}[0]);
	for (my $i = 1; $i < $nrdn; $i++)
	{
	    printf(", \"%s\"", @{$entry{$dn}{$rdnattr}}[$i]);
	}
	printf("\n\n");
    }

    if ($rdnval ne $entry{$dn}{$rdnattr}[0])
    {
	printf("dn: $dn\nMismatched RDN: %s=%s\n\n",
	    $rdnattr, $entry{$dn}{$rdnattr}[0]);
    }

    #
    # Check the objectClass inheritance.
    #
    my $i;
    foreach $i (@{$entry{$dn}{"objectClass"}})	# Need case-insensitivity
    {
	next if $i eq "top";
	die "Undefined objectClass: $i\n"
	    if !defined $sup{$i};
	print("dn: $dn\nMissing superior for objectClass $i: $sup{$i}\n\n")
	    if !&Present(\@{$entry{$dn}{"objectClass"}}, $sup{$i});
    }
}

#
# Make sure each entry has a parent.
#
foreach $thisdn (keys %entry)
{
    my $i = $thisdn;
    $i =~ s/[^,]*,//;
    print("dn: $thisdn\nOrphan\n\n")
	if ! $entry{$i} && $thisdn ne $suffix;
}

##print Dumper(%entry);

#
# Get a possibly-continued NL-terminated line.
# Null string returned on EOF.
#
sub GetLine
{
    my $line = "";

    while ($_ = &FetchOneLine)
    {
	$line .= $_;
	$_ = &FetchOneLine;
	if (/^ /)
	{
	    s/^ //;
	    chomp $line;
	    redo;
	}
	&PushBackLine($_);
	return $line;
    }
    return "";	# EOF
}

#
# Read a (possibly saved) line.
# Returns null string on EOF.
# This and the next ought to be a method.
#
sub FetchOneLine
{
    my $ret;

    if ($SavedLine)
    {
	$ret = $SavedLine;
	$SavedLine = 0;
    }
    else
    {
	$ret = (<>);
	$ret = "" if !defined $ret;
    }
    return $ret;
}

#
# Push back one line.
#
sub PushBackLine
{
    ($SavedLine) = @_;
}

#
# Test for presence of array element.
#
sub Present
{
    my ($element, $array) = @_;
    my ($i, $found);

    $found = 0;
    foreach $i (@$array)
    {
        if ($i eq $element)
        {
            $found = 1;
            last;
        }
    }
    return $found;
}

#
# Initialise some stuff (automatically called).
#
sub INIT
{
    $SavedLine = 0;

    #
    # Initialise the superior objectClasses.
    # Ought to get this from the schema.
    #
    $sup{"dcObject"} = "top";
    $sup{"inetOrgPerson"} = "organizationalPerson";
    $sup{"organizationalPerson"} = "person";
    $sup{"organizationalRole"} = "top";
    $sup{"organizationalUnit"} = "top";
    $sup{"person"} = "top";
    $sup{"posixAccount"} = "top";
    $sup{"room"} = "top";
    $sup{"simpleSecurityObject"} = "top";

    #
    # These are incomplete/wrong/WIP.
    #
    $sup{"ciAdministrator"} = "top";
    $sup{"ciApplication"} = "top";
    $sup{"ciComment"} = "top";
    $sup{"ciEmployee"} = "top";
    $sup{"ciPrinter"} = "top";
    $sup{"ciServer"} = "top";
}
----------8<----------8<----------8<----------8<----------
CUT HERE

-- 
Dave Horsfall  DTM  VK2KFU  daveh@ci.com.au  Ph: +61 2 9906-7866  Fx: 9906-1556
Corinthian Engineering, Level 1, 401 Pacific Hwy, Artarmon, NSW 2064, Australia