#! /usr/bin/perl

# Copyright (C) 2004  Nick Urbanik <nicku(at)vtc.edu.hk>

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.


# TODO (improvements or possible improvements that can be made)

# Read other attributes: year, course, classcode, and update these
# (as options?)
# Provide another subroutine update_entry to implement this.

# Options to create home directories
# Implement all the functionality of migrate-users.

# Provide a fast option where the user "knows" that noone else is
# modifying the directory, so just get the first starting value for
# uidNumber, gidNumber, and increment local copies, then write the
# value to the idPool at the end.  This is because the modify
# operation is rather slow.

# Investigate automating searching for the DN to bind as, perhaps
# searching for the root to create the accounts under, for the
# idPools,...  This may tend to make the tool too specific to one
# structure, but investigate ways to do this in a way that will work
# in many situations.

# $Id: nicks-assign-4.pl,v 1.3 2004/05/11 07:16:30 nicku Exp nicku $

use warnings;
use strict;
use Net::LDAP qw( LDAP_NO_SUCH_OBJECT );
use Net::LDAP::Entry;
use Net::LDAP::LDIF;
use Getopt::Long;
use Carp;

use constant ADMIN_DN => 'uid=nicku,ou=People,ou=sys,o=ICT';
use constant TOP_DN => 'ou=nicku,o=ICT';
use constant LDAP_SERVER => 'ldap1.tyict.vtc.edu.hk';
use constant MAXUID => 65000;
use constant MAXGID => MAXUID;
use constant MIN_UID => 2000;
use constant MIN_GID => MIN_UID;
use constant DEBUG => 1;
use constant CONFIG_DIR => '.ldap';
use constant CHECK_ENTRY_EXISTS => 1;
use constant DO_NOT_CHECK_ENTRY_EXISTS => 0;

sub die_on_error {
    my ( $mesg, $additional_info ) = @_;
    if ( $additional_info ) {
        $additional_info .= ": "
            if index( $additional_info, ':' ) == -1;
    } else {
        $additional_info = '';
    }
    # confess $additional_info, "bad message object\n" unless $mesg;
    confess $additional_info, '[', $mesg->code, ']: ', $mesg->error
        if $mesg->code;
}

# It seems search is quite happy to have an entry as a search base,
# rather than a DN, but I am not yet certain that this is guaranteed
# to always work.  So far I have been calling this with both an entry
# and a DN, and it _seems_ to work for both.
sub entry_exists($$) {
    my ( $ldap, $entry ) = @_;
    my $mesg = $ldap->search(
                             base => $entry,
                             scope => 'base',
                             filter => '(objectClass=*)',
                             attr => [ '1.1' ],
                            );
    return if $mesg->code == LDAP_NO_SUCH_OBJECT;
    die_on_error $mesg;
    return 1;
}

use Term::ReadKey;
# See Recipe 15.10 in Perl Cookbook, 1st edition, page 529
sub read_password() {
    print STDERR "Password: ";
    ReadMode 'noecho';
    my $passwd = ReadLine 0;
    ReadMode 'restore';
    print STDERR "\n";
    chomp $passwd;
    return $passwd;
}

sub bind_as_admin($$) {
    my ( $ldap, $binddn ) = @_;
    my $pw = read_password;
    my $mesg = $ldap->bind( $binddn, 'password' => $pw );
    die "Bad Password\n" if $mesg->code;
}

sub search_for_next_available($$$$) {
    my ( $ldap, $base, $filter, $attribute ) = @_;
    my $search = $ldap->search( 
                               base => $base,
                               scope => 'one',
                               filter => $filter,
                               attrs => [ $attribute ],
                              );
    die_on_error $search;
    my $max = -1;
    foreach my $e ( $search->entries ) {
        $max = $e->get_value( $attribute )
            if $e->get_value( $attribute ) > $max and
               $e->get_value( $attribute ) < MAXUID;
    }
    return $max + 1;
}

sub search_for_next_available_uidNumber(\%) {
    my ( $o ) = @_;
    my $uid = search_for_next_available $o->{ldap}, "ou=People,$o->{suffix}",
        '(objectClass=posixAccount)', 'uidNumber';
    return $uid if $uid > MIN_UID;
    return MIN_UID;
}

sub search_for_next_available_gidNumber(\%) {
    my ( $o ) = @_;
    my $gid = search_for_next_available $o->{ldap}, "ou=Group,$o->{suffix}",
        '(objectClass=posixGroup)', 'gidNumber';
    return $gid if $gid > MIN_GID;
    return MIN_GID;
}

# Assume the entry exists
# Assume bound with permission to write
sub init_id(\%$$) {
    my ( $o, $uid_or_gid, $initial_id ) = @_;
    my $msg = $o->{ldap}->search ( base => $o->{suffix}, scope => 'one',
                            filter => "(objectclass=$uid_or_gid" . 'Pool)' );
    die_on_error $msg;
    die "unable to locate one $uid_or_gid" . "Pool entry"
        unless $msg->count == 1;
    my $entry = $msg->shift_entry;
    $entry->replace( $uid_or_gid . 'Number' => $initial_id );
    $msg = $entry->update( $o->{ldap} );
    die_on_error $msg;
}

sub init_uid(\%$) {
    my ( $o, $uid ) = @_;
    init_id %$o, 'uid', $uid;
}

sub init_gid(\%$) {
    my ( $o, $gid ) = @_;
    init_id %$o, 'gid', $gid;
}

# get the next available id from the idPool Note that it is not really
# an error if an attempt to change the ${uid_or_gid}Number fails: it
# means that two processes are both trying to change it at the same
# time.  It seems okay to be noisy about it, though, since it should
# happen rarely.

# Should only call this if we really are adding the entry, otherwise
# we just waste some ID space.
sub get_next_id(\%$) {
    my ( $o, $uid_or_gid ) = @_;
    my ( $id, $spin_count );
    do {
        print STDERR "spun $spin_count times searching for ${uid_or_gid}",
            "Number\n" if $spin_count++ and $o->{verbose};
        my $msg = $o->{ldap}->search( base => $o->{suffix}, scope => 'one',
                              filter => "(objectclass=${uid_or_gid}Pool)" );
        if ( $msg->code ) {
            warn $msg->error;
            return;
        }
        unless ( $msg->count == 1 ) {
            warn "Unable to locate one ${uid_or_gid}Pool entry!\n";
            return;
        }
        
        my $entry = $msg->entry(0);
        $id = $entry->get_value( "${uid_or_gid}Number" );
        $msg = $o->{ldap}->modify(
           $entry->dn(), 
          'changes' => [
                        delete => [ "${uid_or_gid}Number" => $id ],
                        add    => [ "${uid_or_gid}Number" => $id + 1 ],
                       ]
        );
        print STDERR "Error changing ${uid_or_gid}Number=$id: ", $msg->error
            if $msg->code and $o->{verbose};
        $id = -1 if $msg->code;
    } while ( $id == -1 );
    return $id;
}

{
    # These hold the next available uidNumber, gidNumber if the
    # fast option is enabled.
    my $uid_number = 0;
    my $gid_number = 0;

    sub get_next_uid(\%) {
        my $opt = shift;
        if ( $opt->{fast} ) {
            $uid_number = get_next_id %$opt, 'uid' unless $uid_number;
            return $uid_number++;
        }
        return get_next_id %$opt, 'uid';
    }

    sub get_next_gid(\%) {
        my $opt = shift;
        if ( $opt->{fast} ) {
            $gid_number = get_next_id %$opt, 'gid' unless $gid_number;
            return $gid_number++;
        }
        return get_next_id %$opt, 'gid';
    }

    sub set_id_pools_when_finished(\%) {
        my $opt = shift;
        return if $opt->{fast} or $opt->{delete};
        init_uid %$opt, $uid_number;
        init_gid %$opt, $gid_number;
    }
}

use Crypt::PasswdMD5;

sub ldap_password_hash($) {
    my $hkid = shift;
    my $plain_text = lc substr $hkid, 0, 7;
    my $hashed_password = unix_md5_crypt $plain_text;
    return '{crypt}' . $hashed_password;
}

sub make_pool_entry($$$) {
    my ( $uid_or_gid, $starting_value, $parent ) = @_;
    my $entry = Net::LDAP::Entry->new;
    my $dn = "cn=$uid_or_gid" . 'Pool';
    $dn .= ",$parent" if $parent;
    $entry->dn( $dn );
    $entry->add(
                objectClass => $uid_or_gid . 'Pool',
                cn => $uid_or_gid . 'Pool',
                $uid_or_gid . 'Number' => $starting_value,
                );
    return $entry;
}

sub make_uid_pool_entry($$) {
    my ( $starting_value, $parent ) = @_;
    return make_pool_entry 'uid', $starting_value, $parent;
}

sub make_gid_pool_entry($$) {
    my ( $starting_value, $parent ) = @_;
    return make_pool_entry 'gid', $starting_value, $parent;
}

# $parent is the DN of the parent entry
sub make_ou_entry($$) {
    my ( $ou_name, $parent ) = @_;
    my $entry = Net::LDAP::Entry->new;
    my $dn = "ou=$ou_name";
    $dn .= ",$parent" if $parent;
    $entry->dn( $dn );
    $entry->add(
                objectClass => 'organizationalUnit',
                ou => $ou_name,
                );
    return $entry;
}

# $parent is the DN of the parent entry
sub make_posix_entry(\%$$$$) {
    my ( $opt, $user_id, $hkid, $family, $given ) = @_;
    my $uidNumber = get_next_uid( %$opt ) or die $!;
    my $gidNumber = get_next_gid( %$opt ) or die $!;
    my $entry = Net::LDAP::Entry->new;
    my $dn = 'uid=' . $user_id . ',ou=People,' . $opt->{suffix};
    $entry->dn( $dn );
    $entry->add(
                objectClass => [ qw/ posixAccount shadowAccount inetOrgPerson / ],
                uid => $user_id,
                userPassword => ldap_password_hash $hkid,
                uidNumber => $uidNumber,
                gidNumber => $gidNumber,
                cn => "$family $given",
                sn => $family,
                givenName => $given,
                gecos => "$family $given",
                homeDirectory => "/home/$user_id",
                loginShell => '/bin/bash',
               );
    return $entry;
}

# $parent is the DN of the parent entry
sub make_posix_group_entry($$$) {
    my ( $group_name, $gidNumber, $parent ) = @_;
    my $entry = Net::LDAP::Entry->new;
    my $dn = 'cn=' . $group_name;
    $dn .= ",$parent" if $parent;
    $entry->dn( $dn );
    $entry->add(
                objectClass => 'posixGroup',
                cn => $group_name,
                gidNumber => $gidNumber,
               );
    return $entry;
}

# Assume have already bound with permission to write
# Assume the entry has changetype of add

# The third parameter is true to check for the entry existing.  It is
# false to suppress the check.  This is to help prevent checking this
# twice when adding a posix_account.  We check for existence of a
# posix account _before_ creating the posixAccount entry to avoid an
# unnecessary check of uid and gid number from idPool, which would
# waste some id numbers, network traffic and processing time.
sub add_entry(\%$$) {
    my ( $o, $entry, $check_exists ) = @_;
    unless ( $check_exists and entry_exists $o->{ldap}, $entry ) {
        if ( $o->{ldif} ) {
            $o->{ldif}->write_entry( $entry );
            die $o->{ldif}->error if $o->{ldif}->error;
            warn 'Added entry ', $entry->dn, "\n" if $o->{verbose};
        } else {
            my $mesg = $entry->update( $o->{ldap} );
            die_on_error $mesg;
            warn 'Added entry ', $entry->dn, "\n" if $o->{verbose};
        }
    }
    return 1;
}

# can call with DN or entry.
# assume have bound beforehand.
sub delete_entry(\%$) {
    my ( $o, $dn ) = @_;
    if ( entry_exists $o->{ldap}, $dn ) {
        if ( $o->{ldif} ) {
            unless ( $dn->isa( 'Net::LDAP::Entry' ) ) {
                my $entry = Net::LDAP::Entry->new;
                $entry->dn( $dn );
                $dn = $entry;
            }
            $dn->changetype( 'delete' );
            $o->{ldif}->write_entry( $dn );
            die $o->{ldif}->error if $o->{ldif}->error;
            warn 'Deleted entry ', $dn->dn, "\n" if $o->{verbose};
        } else {
            my $mesg = $o->{ldap}->delete( $dn );
            die_on_error $mesg;
            warn 'Deleted entry ', $dn, "\n" if $o->{verbose};
        }
    }
}

# Assume have already bound with permission to write
# put ou immediately under $opt->{suffix}}
sub make_ou(\%$) {
    my ( $opt, $ou_name ) = @_;
    my $entry = make_ou_entry $ou_name, $opt->{suffix};
    add_entry %$opt, $entry, CHECK_ENTRY_EXISTS;
}

# $parent is the DN of the parent of this entry
# Return the gidNumber for this posixAccount.
# Assume have already bound with permission to write
sub make_posix_account(\%$$$$) {
    my ( $opt, $user_id, $hkid, $family, $given ) = @_;
    my $entry = make_posix_entry %$opt, $user_id, $hkid, $family, $given;
    add_entry %$opt, $entry, DO_NOT_CHECK_ENTRY_EXISTS;
    return $entry->get_value( 'gidNumber' );
}

# Assume have already bound with permission to write
sub make_posix_group(\%$$) {
    my ( $o, $group_name, $gidNumber ) = @_;
    my $entry = make_posix_group_entry $group_name, $gidNumber,
        'ou=Group,' . $o->{suffix};
    add_entry %$o, $entry, CHECK_ENTRY_EXISTS;
}

sub make_uid_pool(\%$) {
    my ( $opt, $start_uid ) = @_;
    my $entry = make_uid_pool_entry $start_uid, $opt->{suffix};
    add_entry %$opt, $entry, CHECK_ENTRY_EXISTS;
}

sub make_gid_pool(\%$) {
    my ( $opt, $start_gid ) = @_;
    my $entry = make_gid_pool_entry $start_gid, $opt->{suffix};
    add_entry %$opt, $entry, CHECK_ENTRY_EXISTS;
}

# Assume have already bound with write permission.

# Search for highest uidNumber, gidNumber under ou=People, ou=Group as
# an additional option --verify-pool. This will be rarely used, unless
# there are other systems used to add users which don't update the
# idPool.

# Verify both idPools if one of them fails.  Note: it is not a mistake
# if we search the directory and find an ID which is lower than in the
# pool, since some accounts may have been deleted.  We don't want to
# recyle IDs, especially recently deallocated ones.

# Don't do this if we're deleting user entries, since getting the ids
# from the idPools increments them, but we don't need to do that.  It
# makes sense to only check the idPools before we actually use them.

# Note that this design assumes we are either adding accounts or
# deleting them, not both.
sub verify_id_pool(\%) {
    my $o = shift;
    return if $o->{delete};
    my $uid = get_next_uid %$o;
    my $gid = get_next_gid %$o;
    my ( $searched_uid, $searched_gid );
    if ( $o->{'verify-pool'} or not ( $uid and $gid ) ) {
        $searched_uid = search_for_next_available_uidNumber %$o;
        $searched_gid = search_for_next_available_gidNumber %$o;
        if ( $uid and $searched_uid > $uid ) {
            warn "Directory has UID number $searched_uid, ",
                "but UID pool has $uid!\n";
            init_uid %$o, $searched_uid;
        }
        if ( $gid and $searched_gid > $gid ) {
            warn "Directory has GID number $searched_gid, ",
                "but GID pool has $gid!\n";
            init_gid %$o, $searched_gid;
        }
    }
    unless ( $uid ) {
        warn "No UID pool: creating one starting at $searched_uid\n";
        make_uid_pool %$o, $searched_uid;
    }
    unless ( $gid ) {
        warn "No GID pool: creating one starting at $searched_gid\n";
        make_gid_pool %$o, $searched_gid;
    }
}

# Check whether posixAccount entry exists;
# return the gidNumber if so.
sub get_gid_number_if_account_exists(\%$) {
    my ( $o, $user_id ) = @_;
    my $posix_account_dn = "uid=$user_id,ou=People," . $o->{suffix};
    my $mesg = $o->{ldap}->search(
                                  base => $posix_account_dn,
                                  scope => 'base',
                                  filter => '(objectClass=*)',
                                  attr => [ 'gidNumber' ],
                                 );
    return if $mesg->code == LDAP_NO_SUCH_OBJECT;
    die_on_error $mesg;
    return $mesg->entry(0)->get_value( 'gidNumber' );
}

# $suffix is the DN of the entry above ou=People and ou=Group.
# The DN of a user with uid nick will be uid=nick,ou=People,$suffix
# Assume have already bound with permission to write
sub make_ldap_account(\%$$$$) {
    my ( $opt, $user_id, $hkid, $family, $given ) = @_;
    my $gidNum = get_gid_number_if_account_exists %$opt, $user_id;
    # print STDERR "Found gidNumber=$gidNum for uid=$user_id\n" if $gidNum;
    $gidNum = make_posix_account %$opt, $user_id, $hkid, $family, $given
        unless $gidNum;
    make_posix_group %$opt, $user_id, $gidNum;
}

sub delete_ldap_account(\%$) {
    my ( $opt, $user_id ) = @_;
    my $posix_account_dn = "uid=$user_id,ou=People," . $opt->{suffix};
    my $posix_group_dn   =  "cn=$user_id,ou=Group,"  . $opt->{suffix};
    delete_entry %$opt, $posix_account_dn;
    delete_entry %$opt, $posix_group_dn;
}

sub process(\%$$$$) {
    my ( $opt, $user_id, $hkid, $family, $given ) = @_;
    if ( $opt->{delete} ) {
        delete_ldap_account %$opt, $user_id;
    } else {
        make_ldap_account %$opt, $user_id, $hkid, $family, $given;
    }
}

# Assume have bound with permission to create accounts:
sub read_and_process_srs_data(\%) {
    my $opt = shift;
    while ( <> ) {
        if ( m{
                  \s+             # must be space before
                  (\d{9})         # Student ID, captured as $1
                  \s+             # must be space after
                  (               # start capturing HKID in $2
                      [A-Z]\d{6}  # letter, 6 digits
                      \(          # literal opening parenthesis
                      [0-9A]      # check digit
                      \)          # literal closing parenthesis
                  )
                  \s+
                  [MF]            # gender
                  \s+
                  (               # Capture family name in $3
                      [A-Za-z]+
                  )
                  [\s,]+          # I messed up data: only , separates names
                  (               # capture remaining names in $4
                      [()A-Za-z]+,? # some names have parentheses!
                      (?:[\s,]+[()A-Za-z]+)*
                  )
                  \s\s            # Names end in at least two spaces
              }x
           ) {
            my ( $user_id, $hkid, $family, $given ) = ( $1, $2, $3, $4 );
            process %$opt, $user_id, $hkid, $family, $given;
        } elsif ( /\s[A-Za-z]\d{6}\([0-9Aa]\)\s/ ) {
            warn "Unprocessed student: $_"
        }
    }
}

use File::Basename;

# Take care with the configuration file.
# Keep it private; do not let anyone else read or write it.
# Avoid executing it, since security is important for this application.
# See Recipe 8.17. Testing a File for Trustworthiness in Perl Cookbook,
# first edition.
sub config_file_name_mkdir() {
    my $config_file;
    if ( $ENV{HOME} ) {
        $config_file = $ENV{HOME} . '/' . CONFIG_DIR . '/' . basename $0;
        mkdir $ENV{HOME} . '/' . CONFIG_DIR, 0700 or die $!
            unless -d $ENV{HOME} . '/' . CONFIG_DIR;
    } else {
        $config_file = dirname( $0 ) . '/.' . basename( $0 );
        print "\$config_file=$config_file\n";
    }
    my $perms = ( stat $config_file )[ 2 ];
    if ( $perms ) {
        $perms &= 07777;
        printf STDERR "Permissions readable: %04o\n", $perms if $perms & 066;
    }
    return $config_file;
}

sub save_options(\%) {
    my $opt = shift;
    my $config_file = config_file_name_mkdir;
    my $umask = umask;
    umask 077 if $umask;
    open CONFIG, '>', $config_file or die "unable to write to $config_file: $!";
    # Remove the options that we don't want to save, i.e., that are actions
    # rather than a change in behaviour:
    my @options = grep { $_ ne 'help' and $_ ne 'save-config' } keys %$opt;
    foreach my $var ( @options ) {
        printf CONFIG "%-12s = %s\n", $var, $opt->{$var};
        #printf CONFIG "%-12s = %s\n", $var, $opt->{$var} ? $opt->{$var} : '';
    }
    close CONFIG;
    umask $umask if $umask;
}

# See Recipe 8.16. Reading Configuration Files, Perl Cookbook,
# first edition.
sub load_options(\%) {
    my $opt = shift;
    my $config_file = config_file_name_mkdir;
    open CONFIG, '<', $config_file
        or warn "unable to read $config_file\n" and return;
    while ( <CONFIG> ) {
        chomp;                  # no newline
        s/#.*//;                # no comments
        s/^\s+//;               # no leading white
        s/\s+$//;               # no trailing white
        next unless length;     # anything left?
        my ( $var, $value ) = split(/\s*=\s*/, $_, 2);
        $opt->{$var} = $value;
    }
    close CONFIG;
}

sub start_tls($){
    my $ldap = shift;
    my $mesg = $ldap->start_tls;
    die_on_error $mesg;
}


sub usage(\%) {
    my $o = shift;
    my $prog = basename $0;
    print STDERR <<EOF;
Usage: $prog [OPTIONS] [student_registration_file...]
OPTIONS:
--ldif\t\tWrite LDIF instead of making changes on the server
\t\t\t\t(default: $o->{ldif})
--outfile\tWrite LDIF to filename instead of standard output
\t\t\t\t(implies --ldif; no default)
--delete\tDelete user accounts rather than create them\t(default: $o->{delete})
--host=HOST\tThe ldap server\t(default: $o->{host})
--admindn=DN\tThe DN by which the admin will bind
\t\t\t\t(default: $o->{admindn})
--suffix=DN\tThe DN by under which ou=People and ou=Group will be put
\t\t\t\t(default: $o->{suffix})
--verbose, --noverbose\tBe/Don't be verbose\t\t\t(default: $o->{verbose})
--verify-pool\tSearch for highest uidNumber, highest gidNumber and verify that
\t\tthe idPool entries contain the correct value.\t(default: $o->{'verify-pool'})
--save-config\tSave configuration file; put this as the last option.
--ssl, --nossl\tUse/Don't use start_tls to connect to a server\t(default: $o->{ssl})
--fast, --nofast\tUse/Don't use the idPools method of ensuring no uidNumbers
\t\tand no gidNumbers conflict.  If there is any possibility of two copies
\t\tof this program running simultaneously under the same suffix,
\t\tthen do not use --fast.\t\t\t\t(Default: $o->{fast})

Contact HOST, connect via tls, and bind via ADMINDN, prompt for the password,
then read student_registration_file(s), creating or deleting accounts from
the LDAP directory on HOST.  It will create ou=People and ou=Group if they
do not exist.

If --ldif or --outfile are specified, will write LDIF instead of
writing the changes directly to the server.  If outfile is specified,
write to OUTFILE instead of STDOUT.  Only specify one.

The LDIF is consistent with what the program would have done if it wrote the
changes directly to the LDAP directory, so that if some of the accounts in
student_registration_file(s) already exist, the LDIF will only contain
information required to create the accounts that do not exist in the directory.
EOF
    exit 1;
}

sub main() {
    our %opt = ( ldif => 0, outfile => '', delete => 0, host => LDAP_SERVER,
                 ssl => 1, suffix => TOP_DN, admindn => ADMIN_DN,
                 verbose => DEBUG, help => \&help, 'verify-pool' => 0,
                 'save-config' => 0, 'fast' => 0 );
    sub help { usage %opt };
    load_options %opt;
    GetOptions( \%opt, qw( ldif outfile=s delete host=s ssl! verbose! fast!
           save-config  verify-pool suffix=s admindn=s help ) ) or usage %opt;
    usage %opt if $opt{ldif} and $opt{outfile};
    save_options( %opt ) and exit( 0 ) if $opt{'save-config'};
    my $ldap = Net::LDAP->new( $opt{host} )
        or die "Unable to connect to $opt{host}: $!";
    start_tls $ldap if $opt{ssl};
    my $ldif;
    $ldif = Net::LDAP::LDIF->new( \*STDOUT, 'w', change => $opt{delete} )
        or die $! if $opt{ldif};
    $ldif = Net::LDAP::LDIF->new( $opt{outfile}, 'w', change => $opt{delete} )
        or die $! if $opt{outfile};
    $opt{ldap} = $ldap;
    $opt{ldif} = $ldif;
    bind_as_admin $ldap, $opt{admindn};
    make_ou %opt, 'People';
    make_ou %opt, 'Group';
    verify_id_pool %opt;
    read_and_process_srs_data %opt;
    set_id_pools_when_finished %opt;
    $ldap->unbind;
    $ldif->done if $ldif;
}

main;