#!/usr/bin/perl -w
# Copyright (c) Dave Horsfall.
# stolen from slapd debian package and extended for skolelinux 
# by Andreas Schuldei <andreas@debian.org>
# License remains GPL
#
# RDNCHK
#
# Given a slapcat input file, check for mismatched DN/RDN pairs etc.
# Optionally make fixes (use with care).
#
# The data structure is a hash of references to hashes of anonymous lists:
#
#   $entries{$dn} =	# $dn has been normalised
#   {
#     origDN => "original DN",
#     attr1 => [ "value1-a", "value1-b" ],
#     attr2 => [ "value2" ]
#   }
#
# which is accessed as (e.g):
#
#   @{entries{$dn}{"attr1"}}
#
# to return an array of the value(s) of $dn's attr1.
#
# Note that this structure is optimised for access to the DNs, *not*
# for searches.
#
# The DN is low-cased and leading/trailing/multiple spaces stripped
# (and the original stored for posterity).
#
# I assume that caseIgnoreMatch applies across the board, as otherwise
# it's too damned difficult.  This only fails, in practice, for encoded
# fields such as passwords, but I'm not looking at those (passwords are
# rarely, if ever, a candidate for being an RDN).  Remember: the specific
# purpose of this program is to perform a quick but reasonably thorough
# check for DN/RDN consistency, and it sorta grew from there.
#
# We can't use Perl Net::LDAP::LDIF, because it's not a core module
# (too hard to maintain our remote branches when upgrading).
#
# TODO:
#	Check custom stuff:
#
#	    ciDefPrinter is single-value per ciPrinterClass.
#	    Fundamentally difficult, because these are keys
#	    into printcap, not LDAP.
#

# Things to add for skolelinux:
# * add lisgroups attributes to the group entries
# * add nextid field
# * set the groupType attribute correctly
# * add a capability field in variables section
# * check if gidNumber and uidNumber are identical for private groups

use Data::Dumper;
use Getopt::Long;
use MIME::Base64;

my $origDN = '.origDN';    # Attribute stores original DN
my $maxID = 0;
my %flags;         # like "have_nextID", "have_capability"
my (%users, %groups);
my %privGroups;    # to keep track of users and their priv groups
my %classGroups;   # for groups that could be classes
my %authGroups;    # for groups that could be authority groups
my @ou_list = qw/people attic pam domains group variables/; # list of organisational units needed
my @authority_list = qw/teachers students admins jradmins/; # list of organisational units needed

my $debug;

&parse_options;
$opt_write = 1 if $opt_fix;

#
# Process each entry.
# A list (returned in @_) holds each line, with the DN first.
#
while ( @_ = &GetEntry )    # Loop per entry (exit on EOF)
{
    my $dn = shift @_;

    # Check if base64 encoded
    next if !$dn =~ /^dn::? /i;
    if ( $dn =~ /^dn:: /i ) {
        $dn =~ s/dn:: (.*)/$1/;
        $dn = decode_base64($dn);
        $dn =~ s/\s$//;
        $encoded = 1;
    }
    else {
        $dn =~ s/dn: (.*)/$1/;
        $encoded = 0;
    }
    my $cdn = &canon($dn);
    $entries{$cdn}{$origDN} = $dn;
    $entries{$cdn}{"encoded"} = $encoded;

    #
    # Infer the suffix.
    # Assume it's the shortest DN.
    #
    if ( !$opt_suffix ) {
        $suffix = $cdn
          if ( !defined $suffix ) || ( length $cdn < length $suffix );
    }

    #
    # Extract the first component (the RDN)
    # for later tests.
    #
    ( $rdn, undef ) = split ( /,/, $cdn );
    ( $rdnattr, $rdnval ) = split ( /=/, $rdn );

    #
    # Get the attributes/values.
    # Attributes are low-cased.
    #
    for (@_) {
        ( $attr, $val ) = split ( /\s/, $_, 2 );    # In case of "::"
        $attr =~ s/://;
        if ( $attr =~ /:/ )                         # Must be binary (base-64)
        {
            $attr =~ s/://;
            $val = &demime($val);
        }
        push @{ $entries{$cdn}{ lc $attr } }, $val;
    }

    #
    # Does the RDN exist?
    #
    if ( !defined @{ $entries{$cdn}{$rdnattr} } ) {
        print STDERR "dn: $dn\nMissing RDN";
        if ($opt_fix) {
            push @{ $entries{$cdn}{$rdnattr} }, $rdnval;
            print STDERR "; inserted \"$rdnattr=$rdnval\"";
        }
        print STDERR "\n\n";
    }

    #
    # And how many?  Multiples are permitted
    # in some contexts, but not in ours.
    #
    my $attrs = $entries{$cdn}{$rdnattr};    # Actually a reference
    my $nrdn  = @{$attrs};
    if ( $nrdn > 1 ) {
        print STDERR "dn: $dn\nMultiple RDNs: \"@{$attrs}[0]\"";
        for ( my $i = 1 ; $i < $nrdn ; $i++ ) {
            print STDERR ", \"@{$attrs}[$i]\"";
        }
        if ($opt_fix) {
            print STDERR "; using \"$rdnval\"";
            $entries{$cdn}{$rdnattr} = [$rdnval];
        }
        print STDERR "\n\n";
    }

    #
    # Do they match?
    #
    if ( defined @{$attrs} && $rdnval ne &canon( @{$attrs}[0] ) ) {
        print STDERR "dn: $dn\nMismatched RDN: \"$rdnattr=@{$attrs}[0]\"";
        if ($opt_fix) {
            print STDERR "; using \"$rdnval\"";
            $entries{$cdn}{$rdnattr} = [$rdnval];
        }
        print STDERR "\n\n";
    }

    #
    # Check single-value attributes.
    #
    foreach my $attr (@single) {
        my $nval  = 0;
        my $attrs = $entries{$cdn}{ lc $attr };
        $nval = @{$attrs} if defined @{$attrs};
        if ( $nval > 1 ) {
            print STDERR
              "dn: $dn\nMultiple attrs for \"$attr\": \"@{$attrs}[0]\"";
            for ( my $i = 1 ; $i < $nval ; $i++ ) {
                print STDERR ", \"@{$attrs}[$i]\"";
            }
            if ($opt_fix) {
                print STDERR "; using \"@{$attrs}[0]\"";
                $entries{$cdn}{ lc $attr } = [ @{$attrs}[0] ];
            }
            print STDERR "\n\n";
        }
    }

    #
    # Check the objectclass inheritance.
    #
    if ($opt_inheritance)    # Will soon be mandatory
    {
        foreach my $i ( @{ $entries{$cdn}{"objectclass"} } ) {
            next if $i eq "top";    # top is topless :-)
            if ( !defined $sup{$i} ) {
                print STDERR "dn: $dn\nUnknown objectclass: \"$i\"";
                if ($opt_fix) {
                    print STDERR "; ignored";
                    &remove( $i, \@{ $entries{$cdn}{"objectclass"} } );
                }
                print STDERR "\n\n";
            }
            if ( defined $sup{$i}
                && !&present( $sup{$i}, \@{ $entries{$cdn}{"objectclass"} } ) )
            {
                print STDERR "dn: $dn\nNo sup for \"$i\": \"$sup{$i}\"";
                if ($opt_fix) {
                    print STDERR "; inserted";
                    push @{ $entries{$cdn}{"objectclass"} }, $sup{$i};
                }
                print STDERR "\n\n";
            }
        }    # each objectclass
    }    # inheritance

    

    #
    # Check required attributes.
    # Can't do in above loop, because the keys
    # may have changed from inserting new classes.
    #
    foreach my $i ( @{ $entries{$cdn}{"objectclass"} } ) {
        &checkattrs( $cdn, $i );
    }
    
    #
    # check for organisational dn
    #
    if( $cdn =~ /^dc=/ ) {
	$flags{base} = $cdn;
    }

    #
    # check for necessary organisationalUnits
    #
    for my $ou (@ou_list){
        if( $cdn =~ /^ou=$ou,/ ) {
            $flags{$ou} = $cdn;
            last;
        }
    } 

    #
    # check for the used authorityGroups
    #
    for my $auth_group (@authority_list){
        if( $cdn =~ /^cn=$auth_group,ou=group,/i ) {
            $flags{$auth_group} = $cdn;
            last;
        }
    } 

    #
    # check for nextID
    #
    if( $cdn =~ /^cn=nextid,ou=variables,/i ) {
	$flags{nextID} = $cdn;
    }
    
    #
    # check for capabilities
    #
    if( $cdn =~ /^cn=capabilities,ou=variables,/i ) {
	$flags{capabilities} = $cdn;
    }

    #
    # add lisGroup to groups
    # and check group for gidNumber/maxID
    #
    if( $cdn =~ /ou=group/i ) {
        #
        # check for capabilities
        #
        if( $cdn =~ /^cn=genagegp,ou=group,/i and  
            $entries{$cdn}{grouptype}[0] eq "age_group" ) {
            $flags{generic_age_group} = $cdn;
        }
        
 	my %objectclass;
	for my $objclass ( @{$entries{$cdn}{'objectclass'}} ) {
	    $objclass = lc $objclass;
	    $objectclass{$objclass } = 1;
	}

        # make the checks easier, this has no effect if not
        # written back (if the cases below dont apply.
	delete $objectclass{top} if $objectclass{top};
	
        # some old ldif: 
        #   posixGroup switches to lisAclGroup+lisGroup
	if ( $objectclass{posixgroup} and 
	     (1 == keys %objectclass) ) {
	    $entries{$cdn}{"grouptype"} = [ "dontcare" ] 
		unless $entries{$cdn}{"grouptype"}; 
	    $objectclass{lisgroup}    = 1;
	    $objectclass{top}         = 1;
	    $entries{$cdn}{objectclass} = [ ( keys %objectclass ) ];
#	    print STDERR  Dumper( $entries{$cdn} );
	}
	
	if ( $entries{$cdn}{"gidnumber"} ) {
	    # save entry for later
	    $groups{$cdn} = 1;
	    # search for highes ID
	    $maxID = $entries{$cdn}{"gidnumber"}[0] 
		if ( $entries{$cdn}{"gidnumber" }[0] > $maxID ); 
	}
    }

    #
    # check account for uidNumber/maxID
    #
    if( $cdn =~ /ou=people/i ) {
	if ( $entries{$cdn}{"uidnumber"} ) {
	    # save entry for later
	    $users{$entries{$cdn}{"gidnumber"}[0]} = $cdn;
	    # search for highes ID
	    $maxID = $entries{$cdn}{"uidnumber"}[0]
	    if ( $entries{$cdn}{"uidnumber"}[0] > $maxID ); 

	    my %objectclass;
	    for my $objclass ( @{$entries{$cdn}{'objectclass'}} ) {
		$objclass = lc $objclass;
		$objectclass{$objclass } = 1;
	    }
	    $objectclass{top}           = 1;
	    $objectclass{shadowaccount} = 1;
	    delete $objectclass{account};
	    $entries{$cdn}{objectclass} = [ ( keys %objectclass ) ];
	}

    }


}    # main loop

#
# Make sure each entry has a parent.
# For now, we kill orphans on sight...
#
$suffix = $opt_suffix if $opt_suffix;
foreach my $thisdn ( keys %entries ) {

    my $i = $thisdn;
    $i =~ s/[^,]*,//;
    if ( !$entries{$i} && $thisdn ne &canon($suffix) ) {
        print STDERR "dn: $thisdn\nOrphan";
        if ($opt_fix) {
            print STDERR "; deleted";
            delete $entries{$thisdn};
        }
        print STDERR "\n\n";
    }

    # Fix up the suffix dn if it's our mess, adding a structural objectclass.
    if ( $thisdn eq &canon($suffix) ) {
	my %objectclass;
	for my $objclass ( @{$entries{$thisdn}{'objectclass'}} ) {
	    $objclass = lc $objclass;
	    $objectclass{$objclass } = 1;
	}
	if ( ( 1 == keys %objectclass  
	       and $objectclass{dcobject} )
	     or 
	     ( 2 == keys %objectclass  
	       and $objectclass{dcobject} 
	       and $objectclass{top} )
	     )
        {
            if ( defined($opt_org) ) {
                push ( @{ $entries{$thisdn}{'objectclass'} }, 'organization' );
                push ( @{ $entries{$thisdn}{'o'} },           $opt_org );
            }
            else {
                push ( @{ $entries{$thisdn}{'objectclass'} }, 'domain' );
            }
        }

        # check for $classes == dcObject.
    }
}

for my $ou (@ou_list){
    unless( $flags{$ou} ) {
        my $base = $flags{base};
        my $dn = "ou=$ou,$base";
        $entries{$dn}{objectclass} = ['organizationalUnit',"top"];
        $entries{$dn}{ou} = [ $ou ];
        $entries{$dn}{"encoded"} = 0;
        $entries{$dn}{$origDN} = $dn;
    }
} 

unless ($opt_no_auth) {
    for my $auth_group (@authority_list){
	unless( $flags{$auth_group} ) {
	    my $base = $flags{base};
	    my $dn = "cn=$auth_group,ou=Group,$base";
	    $entries{$dn}{objectclass} = ["posixGroup", "top", "lisGroup", "lisAclGroup"];
	    $entries{$dn}{cn} = [ $auth_group ];
	    $entries{$dn}{grouptype} = [ "authority_group" ];
	    $entries{$dn}{member} = [ "" ];
	    $entries{$dn}{gidnumber} = [ ++$maxID ];
	    $entries{$dn}{description} = [ $auth_group ];
	    $entries{$dn}{"encoded"} = 0;
	    $entries{$dn}{$origDN} = $dn;
	}
    } 
}


# unless( $flags{generic_age_group} ) {
#     my $base = $flags{base};
#     my $dn = "cn=genagegp,ou=group,$base";
#     $entries{$dn}{objectclass} = ['posixGroup',"top", "lisGroup" ];
#     $entries{$dn}{description} = [ "generic age group" ];
#     $entries{$dn}{grouptype} = [ "age_group" ];
#     $entries{$dn}{gidNumber} = [ ++$maxID ];
#     $entries{$dn}{"encoded"} = 0;
#     $entries{$dn}{cn} = [ "genagegp" ];
#     $entries{$dn}{$origDN} = $dn;
#     #all users belong to the generic ageGroup
#     for my $gidnumber (keys %users) {
#         push @{$entries{$dn}{memberuid}}, $entries{$users{$gidnumber}}{uid}[0];
#     }
# }

if( $flags{generic_age_group} ) {
    delete $entries{$flags{generic_age_group}};
}


GROUP_LOOP:
foreach my $group (keys %groups) {

    ## newer ldifs with grouptype
    
    if ($entries{$group}{grouptype} eq 'authority_group') {
	upgrade_authority_group ($entries{$group});
	delete $groups{$group}; # remove the solved cases
	next GROUP_LOOP;
    }

    ## older ldifs without grouptype
 
    #dont fiddle with groups that have a valid type allready
    if ($entries{$group}{grouptype} and
	$entries{$group}{grouptype}[0] ne 'dontcare') {
	delete $groups{$group}; # remove the solved cases
#	print STDERR  Dumper( $entries{$group} );
	next GROUP_LOOP;
    }

    # check for private groups
    my $gidnumber = $entries{$group}{gidnumber}[0];
    # check if a user with the same id exists
    if ($users{$gidnumber} and 
	($entries{$users{$gidnumber}}{uid}[0] eq $entries{$group}{cn}[0])){
	$entries{$group}{grouptype} = ["private"]; #set the correct type
	delete $groups{$group}; # remove the solved cases
	next GROUP_LOOP;
    }

    # check for authority groups
    my $cn = $entries{$group}{"cn"}[0];
    if ( ($cn eq "teachers") or
	 ($cn eq "admins") or
	 ($cn eq "jradmins") or
	 ($cn eq "students"))
    {
	$entries{$group}{grouptype} = ["authority_group"]; #set the correct type
	upgrade_authority_group ($entries{$group});
	delete $groups{$group}; # remove the solved cases
	next GROUP_LOOP;
    }

    # and the rest are classes?

}

# set the remaining groups to type school_class 
foreach my $group (keys %groups) {
    $entries{$group}{grouptype} = ["school_class"]; #set the correct type
    delete $groups{$group}; # remove the solved cases
    next;    
} # now we should have no groups left...

# create nextID, or check its value if it exists.
if($flags{nextID}) {
    my $nextid_dn = $flags{nextID};
    my $nextID = $entries{$nextid_dn}{gidnumber}[0];
    unless ( $nextID > $maxID ) {
	$entries{$nextid_dn}{gidnumber}[0] = ++$maxID;
    }
}
else { # create a nextid entry
    my $base = $flags{base};
    my $dn = "cn=nextID,ou=Variables,$base";
    $entries{$dn}{objectclass} = ["posixGroup","top"];
    $entries{$dn}{cn} = ["nextID"];
    $entries{$dn}{structuralObjectClass} = ["posixGroup"];
    $entries{$dn}{gidnumber} = [ ++$maxID ];
    $entries{$dn}{"encoded"} = 0;
    $entries{$dn}{$origDN} = $dn;
}

if ( $flags{capabilities} ){
    # update capabilities if necessary
    my $dn = $flags{capabilities};
    my %caps;
    
    #split up capability array into hash, with version as value
    foreach my $cap ( @{$entries{$dn}{capability}} ) {
	($cap, my $ver) = split(/ /, $cap);
	$caps{$cap} = $ver;
    }
    
    # increase or create the capabilities we know of today...
    $caps{nextID}       = "1" 
	if ( !$caps{nextID}       or $caps{nextID}       < 1);
    $caps{groupType}    = "1" 
	if ( !$caps{groupType}    or $caps{groupType}    < 1);
    $caps{aclGroup}     = "1" 
	if ( !$caps{aclGroup}     or $caps{aclGroup}     < 1);
#    $caps{ageGroup}     = "2" 
#	if ( !$caps{ageGroup}     or $caps{ageGroup}     < 2);
    $caps{attic}     = "1" 
	if ( !$caps{attic}        or $caps{attic}        < 1);
    $caps{capabilities} = "1" 
	if ( !$caps{capabilities} or $caps{capabilities} < 1);
    
    # put the hash into a list again and store the data
    my @capabilities;
    foreach my $key (keys %caps) {
	push @capabilities, "$key " . $caps{$key}; 
    }
    $entries{$dn}{capability} = \@capabilities;
    
}
else { # create a capabilities field from scratch
    my $base = $flags{base};
    my $dn = "cn=capabilities,ou=Variables,$base";
    $entries{$dn}{objectclass} = ["lisLdapCapabilities","top"];
    $entries{$dn}{cn} = ["capabilities"];
    $entries{$dn}{structuralObjectClass} = ["lisLdapCapabilities"];
    $entries{$dn}{capability} = [ "nextID 1", 
				  "groupType 1", 
#				  "ageGroup 2", 
				  "attic 1", 
				  "capabilities 1",
                                  "aclGroup 1",
				 ]; 
    $entries{$dn}{"encoded"} = 0;
    $entries{$dn}{$origDN} = $dn;
}

print STDERR Dumper(%entries) if $opt_dump;

#
# Write out (possibly fixed) file if requested.
#
# The DN keys are sorted by length, which ensures that
# parents come before children.
#
if ($opt_write) {
    foreach my $dn ( sort { length($a) <=> length($b) } keys %entries ) {
        &write_out($dn);
    }
}

exit 0;

###########################################################################

#
# Canonicalise a string.
# Delete leading/trailing blanks around commas, and lowcase.
#
sub canon {
    ($_) = @_;
    s/\s+/ /g;    # Catch tabs as well
    s/ ,/,/g;
    s/, /,/g;
    lc;
}

#
# Check required attributes.
#
sub checkattrs {
    ( my $dn, $class ) = @_;
    foreach my $attr ( @{ $reqd{ lc $class } } ) {
        if ( !defined @{ $entries{$dn}{ lc $attr } } ) {
            my $odn = $entries{$dn}{$origDN};
            print STDERR "dn: $odn\nMissing reqd \"$class\" attr \"$attr\"";
            if ($opt_fix) {

                # Quick hack for CI
                my $fix = "UNKNOWN";
                if ( $attr eq "cn" && $fix ne "" ) {
                    $fix = $entries{$dn}{"givenname"}[0];
                }
                push @{ $entries{$dn}{$attr} }, $fix;
                print STDERR "; inserted \"$fix\"";
            }
            print STDERR "\n\n";
        }
    }
}

#
# Write an entry to standard output.
#
# Ought to wrap at 78 cols as well.
#
sub write_out {
    my ($dn) = @_;
    my $odn = $entries{$dn}{$origDN};
    if ( $entries{$dn}{"encoded"} == 1 ) {
        $encoded = encode_base64( $odn, "" );
        print "dn:: $encoded\n";
    }
    else {
        print "dn: $odn\n";
#	print STDERR  "dn: $odn\n";
    }
    foreach my $attr ( keys %{ $entries{$dn} } ) {
        next if $attr eq $origDN;
        foreach my $value ( @{ $entries{$dn}{$attr} } ) {
            print "$attr:";
#       	    print STDERR  " $attr";
            if ( $value and ( $attr =~ /userpassword/i
                || $value =~ /(^[ :]|[\x00-\x1f\x7f-\xff])/ )  )
            {
                print ": ", &enmime( $value, "" );
            }
            elsif ( $value ) { 
                print " $value";
            }
            print "\n";

        }
    }
#    print STDERR  "\n";
    print "\n";
}

#
# Test for presence of element in list.
#
sub present {
    my ( $element, $list ) = @_;
    my $found = 0;

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

#
# Remove specified element from list.
# It's a unique element, but multiple
# occurances will be removed.  It will
# change the order of the list.
#
sub remove {
    my ( $element, $list ) = @_;

    for ( my $i = 0 ; $i < @$list ; $i++ ) {
        if ( $element eq @$list[$i] ) {
            @$list[$i] = @$list[$#$list];
            pop @$list;
        }
    }
}

#
# Initialise some stuff (automatically called).
#
sub INIT {

    #
    # 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{"lisAclGroup"}          = "top";
    $sup{"room"}                 = "top";
    $sup{"simpleSecurityObject"} = "top";

    #
    # These are incomplete/wrong/WIP.
    #
    $sup{"ciAdministrator"} = "top";
    $sup{"ciApplication"}   = "top";
    $sup{"ciEmployee"}      = "inetOrgPerson";
    $sup{"ciLdapConfig"}    = "top";
    $sup{"ciPrinter"}       = "top";
    $sup{"ciServer"}        = "top";

    #
    # Required attributes.
    #
    $reqd{"person"} = [ "sn", "cn" ];    # Special - can be autofixed
    $reqd{"ciadministrator"} = [ "uid", "userPassword" ];
    $reqd{"ciapplication"} =
      [ "ciApp", "ciAppType", "ciHost", "ciStatus", "ciPortNum" ];
    $reqd{"ciemployee"} = [ "employeeNumber", "sn" ];
    $reqd{"cildapconfig"} = ["ciHost"];
    $reqd{"ciprinter"}    = ["ciPrinterName"];
    $reqd{"ciserver"}     = ["name"];

    #
    # Single-value attributes.
    #
    @single = (
        "ciAppType",    "ciDBPath", "ciDomainName", "ciLdapEnabled",
        "ciLdapServer", "ciOSType", "ciPortNum",    "ciPrinterClass",
        "ciRegion",     "ciStatus",
    );

    #
    # Random stuff.
    #
    $/ = "";    # Read input in paragraph mode
}

#
# Process options.
#
sub parse_options {
    $SIG{'__WARN__'} = sub { die $_[0] };    # Exit on bad options

    Getopt::Long::Configure("bundling");     # Old-style (-xyz, --word)
    GetOptions(
        "--dump" => \$opt_dump,    # Dump data structure
        "-D"     => \$opt_dump,

        "--fix" => \$opt_fix,      # Fix errors if possible
        "-f"    => \$opt_fix,      # (also implies "write")

        "--inheritance" => \$opt_inheritance,    # Check obj inheritance
        "-i"            => \$opt_inheritance,    # (too many false alarms)

        "--suffix=s" => \$opt_suffix,            # Specify directory suffix
        "-s=s"       => \$opt_suffix,

        "--write" => \$opt_write,                # Write ordered file
        "-w"      => \$opt_write,

        "--no-add-auth-groups" => \$opt_no_auth, # dont add authority groups
        "-n"      => \$opt_no_auth,

        "--org=s" => \$opt_org,                  # Organization to use for
        "-o=s"    => \$opt_org,                  # fixing up the suffix
    );
}

#
# Get a complete entry as a list of lines.
# We use the trick of setting the input delimiter
# to "", to read a paragraph at a time, so we can
# join continued lines.
#
sub GetEntry {
    my @a;
    do {
        $_ = (<>);
        return () if !defined;    # EOF
        s/$/\n/;                  # In case we strip last newline below
        s/#.*\n//g;               # Comments
        chomp;                    # Always strips >= 2 newlines
        s/\n //g;                 # Join lines
        @a = split /\n/;
    } while ( @a < 2 );    # Skips phantom entries (caused by comments)
    return @a;
}

#
# Given a string, return a de-mimed version.
# Can't use MIME::Base64 because it's not a core module.
# Instead, I pinched the code from it...
#
sub demime {
    local ($^W) = 0;    # unpack("u",...) gives bogus warning in 5.00[123]

    my $str = shift;
    $str =~ tr|A-Za-z0-9+=/||cd;    # remove non-base64 chars
    if ( length($str) % 4 ) {
        require Carp;
        Carp::carp("Length of base64 data not a multiple of 4");
    }
    $str =~ s/=+$//;                # remove padding
    $str =~ tr|A-Za-z0-9+/| -_|;    # convert to uuencoded format

    return join '',
      map( unpack( "u", chr( 32 + length($_) * 3 / 4 ) . $_ ),
      $str =~ /(.{1,60})/gs );
}

#
# En-mime same.
# I didn't write this bletcherous code either.
#
sub enmime {
    my $res = "";
    my $eol = $_[1];
    $eol = "\n" unless defined $eol;
    pos( $_[0] ) = 0;    # ensure start at the beginning

    $res = join '',
      map( pack( 'u', $_ ) =~ /^.(\S*)/, ( $_[0] =~ /(.{1,45})/gs ) );

    $res =~ tr|` -_|AA-Za-z0-9+/|;    # `# help emacs
                                      # fix padding at the end
    my $padding = ( 3 - length( $_[0] ) % 3 ) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;

    # break encoded string into lines of no more than 76 characters each
    if ( length $eol ) {
        $res =~ s/(.{1,76})/$1$eol/g;
    }
    return $res;
}

sub upgrade_authority_group {
    my ($group_ref) = @_;

    my %objectclass;
    for my $objclass ( @{$group_ref->{'objectclass'}} ) {
	$objclass = lc $objclass;
	$objectclass{$objclass } = 1;
    }
    # make the checks easier:
    delete $objectclass{top} if $objectclass{top};

    # some old ldif: 
    #   posixGroup switches to lisAclGroup+lisGroup
    if ( $objectclass{posixgroup} and
	 $objectclass{lisgroup} and 
	 ( 2 == keys %objectclass) ) {
	delete $objectclass{posixgroup};
	$objectclass{lisaclgroup} = 1;
	$objectclass{lisgroup}    = 1;
	$objectclass{top}         = 1;
	$group_ref->{objectclass} = [ (keys %objectclass) ]; 
	for my $memberUid ( @{$group_ref->{memberuid}} ) {
	    push ( @{ $group_ref->{member} }
		   , "uid=$memberUid,ou=People," . $flags{base} );
        }
        unless ( defined $group_ref->{member} ) {
            $group_ref->{member} = [ "" ]
        }
    } 
    elsif ( $objectclass{lisaclgroup} and
	    $objectclass{lisgroup} and 
	    ( 2 == keys %objectclass) ) {
	# check if we have members 
	unless ( $group_ref->{member} ) {
	    for my $memberUid ( @{$group_ref->{memberuid}} ) {
		push ( @{ $group_ref->{'member'} }
		       , "uid=$memberUid,ou=People," . $flags{base} );
	    }
	}
        unless ( $group_ref->{member} ) {
            $group_ref->{member} = [ "" ]
        }
    }
    else {
	die "unknown ldif configuration in $! " . Dumper ($group_ref); 
    }
    $group_ref->{structuralobjectclass} = [ "lisaclgroup" ];
}

sub check {
    if ( defined $debug->{objectclass} ) {
	my $Ref = ref ( $debug->{objectclass} ); 
	print STDERR "$Ref\n" . Dumper($debug);
	my @c    = caller(1);
	die "objectclass currupted! Line ".$c[2]." Function ".$c[3]."\n" if ($Ref ne "ARRAY"); 
    }
}
