#! /usr/bin/perl -w

# Nick Urbanik <nicku@vtc.edu.hk>

# depends on these external programs:
# /usr/local/bin/mkntpwd
# /usr/sbin/slappasswd
# depends on the passwords stored in the root user's home directory /root

# WARNING: THE LDIF OUTPUT OPTION IS NOT 100% LDIF; IT STILL __DELETES__
# GROUP ENTRIES FROM THE LIVE DIRECTORY, AND "REPLACES THEM" WITH LDIF OUTPUT!
# IT ALSO MODIFIES THE DIRECTORY IN OTHER WAYS.
# FIX IT ASAP!

# STILL TODO on /usr/local/bin/migrate-users:
# 1. Contact HQ and allow a higher limit to the number of records can
#    retrieve;
# 2. Change everything to use a Net::LDAP::Entry object instead of
#    passing arround lots of individual details.  In particular, I need
#    to fix useradd(), import from Oracle and GRS files, and finally,
#    the LDIF output.
# 3. Update code to delete old attributes from last year, and group
#    memberships.

# Migrate student ICT account information from ldap.vtc.edu.hk and 
# produce an LDIF file suitable for slapadd'ing to ictlab.tyict.vtc.edu.hk.
# Algorithm:

# create the group students in tyict if it doesn't exist there
# Read all groups from tyict into a hash %groups
# Read all uidNumbers, gidNumbers into two hashes
# for each student in ldap.vtc.edu.hk
#     start from max_uidNumber, assign uidNumber, gidNumber to user.
#     if course is not in %groups
#         create the group in tyict using next available gidNumber
#         put the group in %groups
#     if 'year' . $year is not in %groups
#         create the group in tyict using next available gidNumber
#         put the group in %groups
#     add the student as a user to tyict
#     add the student to the group students

#  # 000000153,BA,ST,stu,vtc.edu.hk
#  dn: uid=000000153,ou=BA,ou=ST,ou=stu,o=vtc.edu.hk
#  uid: 000000153
#  cn: TONG Chung Man
#  academicyear: 2000
#  year: 1
#  course: 21310
#  courseduration: 3
#  registrationdate: 31-08-2000
#  site: ST
#  department: BA
#  actype: STU
#  acowner: 000000153
#  nsmsgdisallowaccess: imap
#  mailhost: hqmail.vtc.edu.hk
#  mail: 000000153@stu.vtc.edu.hk
#  mailquota: 5242880
#  maildeliveryoption: mailbox
#  nswmextendeduserprefs: meDraftFolder=Drafts
#  nswmextendeduserprefs: meSentFolder=Sent
#  nswmextendeduserprefs: meTrashFolder=Trash
#  nswmextendeduserprefs: meInitialized=true
#  classcode: B
#  objectclass: top
#  objectclass: person
#  objectclass: student
#  objectclass: organizationalPerson
#  objectclass: inetOrgPerson
#  objectclass: mailrecipient
#  objectclass: nsmessagingserveruser
#  objectclass: VTC
#  finalyear: F

#  dn: uid=se4a15,ou=People,dc=tyict,dc=vtc,dc=edu,dc=hk
#  uid: se4a15
#  cn: se4a15
#  sn: se4a15
#  mail: se4a15@vtc.edu.hk
#  objectClass: person
#  objectClass: organizationalPerson
#  objectClass: inetOrgPerson
#  objectClass: account
#  objectClass: posixAccount
#  objectClass: top
#  objectClass: kerberosSecurityObject
#  userPassword: {crypt}gGO6spPkzxB9I
#  krbname: se4a15@VTC.EDU.HK
#  loginShell: /bin/csh
#  uidNumber: 3015
#  gidNumber: 3015
#  homeDirectory: /home/se4a15
# Also telephonenumber: roomnumber: homephone: givenname: sn:
# mail: $user\@$DEFAULT_MAIL_DOMAIN mailHost: $DEFAULT_MAIL_HOST
# objectClass: inetLocalMailRecipient

#  dn: cn=students,ou=Group,dc=tyict,dc=vtc,dc=edu,dc=hk
#  objectClass: posixGroup
#  objectClass: top
#  cn: students
#  userPassword: {crypt}x
#  gidNumber: 528
#  memberUid: stu1
#  memberUid: stu2
#  memberUid: stu3

#  dn: cn=toby,ou=auto.home,dc=tyict,dc=vtc,dc=edu,dc=hk
#  objectClass: automount
#  cn: toby
#  automountInformation: -rw,hard,intr alpha.tycm.vtc.edu.hk:/usr/users/home/staff/toby

#  dn: cn=nicku,ou=auto.home,dc=tyict,dc=vtc,dc=edu,dc=hk
#  objectClass: automount
#  cn: nicku
#  automountInformation: -rw,hard,intr ictlab.tyict.vtc.edu.hk:/home/nicku

# Password generator from ark A. Pors, mark@dreamzpace.com, www.dreamzpace.com

use strict;

use Net::LDAP qw/ :all /;
use Net::LDAP::Util qw/ ldap_error_name ldap_error_text /; # Error handling
use Net::LDAP::LDIF;

use DB_File;
use Getopt::Long;
use File::Basename;
use constant GID_MAX => 60000;
# parameter for import_and_update_accounts_from_vtc_ldap_server():
use constant GET_STUDENTS => 0;
use constant GET_STAFF => 1;

die "You must be root for this program to work properly.\n" unless $< == 0;

# Turn on autoflushing so can watch output with tail:
$|=1;

# Avoid clobbering old password files.
# Probably better to use a database.
our $passwd_info_file = "/root/ldapaccounts/password-info-file-"
    . time . ".txt";
our $passwd_dbm_database = "/root/ldapaccounts/password-database";
# our $max_uid_group_file = "/root/ldapaccounts/max-uid-group_numbers.txt";
our %passwd_dbm_hash;
our $base = "dc=tyict,dc=vtc,dc=edu,dc=hk";
our $automount_options = "-rw,hard,intr";
our $nfs_server = "ictlab.tyict.vtc.edu.hk";
our $ldap_server = "ldap.tyict.vtc.edu.hk";
# our $kerberos_realm = "TYICT.VTC.EDU.HK";
our $home_dir_base = "/home";
our $debug = 1;
# True if you want to generate new passwords for everybody:
# our $gen_new_password = 0;
our $useradd = 0;
our $fix_groups = 0;
our $ldif_output = 0;
our $import_students_from_vtc_ldap = 0;
our $import_staff_from_vtc_ldap = 0;
our $oracle_text_files = 0;
our $grs_part_time_text_files = 0;
our $uid_to_add;
our $users_full_name;
our $email_address;
our @other_groups;
our $passwd;
our $ldif;
our $ldif_output_file = "/home/nicku/ldap-dumps/ldif-dump-" . time() . ".ldif";
our $lock_file = "/root/ldapaccounts/migrate-users.lock";

# We want exclusive access to the password database, since we are writing
# to it.  So ensure only one copy of this program is running at any time.
# See Programming Perl, 3rd edition, page 422.
use Fcntl qw( :DEFAULT :flock );
sysopen LOCK, $lock_file, O_RDONLY | O_CREAT
    or die "cannot open lock file: $!";
flock LOCK, LOCK_EX | LOCK_NB or die "someone else is running this program: $!";
flock LOCK, LOCK_EX or die "Cannot get the lock on $lock_file: $!";

use constant GROUP_DEBUG => 3;

# open OUTPUT, ">&STDOUT" or die "Cannot dup standard output: $!";

our $ldap_ict = Net::LDAP->new( $ldap_server ) or die "$@";
our $mesg = $ldap_ict->bind( version => 3 );  # use for searches

die "Failed to bind: ", $mesg->code(), "\n" if $mesg->code();

our ( %group_byname, %group_bynumber, %group_by_uid, %group_by_user_dn );
# ORIGINALLY (before 6 October 2002):
# %group_byname is a simple hash of gidNumbers indexed by gid.
# %group_bynumber is a hash with key = gidNumber.
# Each entry is a reference to a hash of two entries, one the gid,
# the other the list of members.
# The key for gid is 'gid'.
# The key for members is 'members'.

# NEW (6 October 2002):
# %group_byname is a hash with key gid (the name of the group).
# Each entry is a reference to a hash with three entries:
# first is the gidNumber, indexed by the key 'gidNumber'
# second is a reference to an array of member UIDs; key is 'members'
# third is a reference to an array of member DNs: key is 'dnlist'
# %group_bynumber is a simple hash of gids (names of groups), indexed by
# gidNumbers.

# %group_by_uid is a hash of arrays.  Each hash element is indexed by the
# uid (i.e., the name of the user, not the numerical user ID, e.g., nicku )
# The array contains the names of the groups to which that user belongs.
# The idea is to provide a quick way of finding what groups each user
# belongs to.  It does not tell what groups contain a particular users DN
# (uniqueMember attribute).  Should fix it so these are always consistent.
# %group_by_user_dn is also a hash of arrays.  Each hash element is indexed
# by the user's DN.  The array contains the names of the groups of which that
# user's DN is a uniqueMember.  These two hashes should eventually correspond.

# For generating the passwords:
our @dict;

sub slurp_entire_dictionary()
{
    my $dict = '/usr/share/dict/words'; # path to dict file
    open( DICT, "< $dict" ) || die "Cannot open dict: $!";
    while ( <DICT> )
    {
        chomp;
        push @dict, $_;
    }
    close DICT;
}

# If you pass some string as a parameter, that will be used as the password.
# If parameter is empty, then will use the generated password.
sub gen_password($)
{
    my $plain_passwd = shift;
    my @sub = ();
    my $word = '';
    my $wordlen = 8;                    # desired length of the password
    my $sublen = 3;    # length of the word chunks that create the password
    my $parts = int ($wordlen/$sublen);
    my $numwords = 100;                 # number of passwords to print

    # The outer loop should very seldom execute more than once,
    # but sometimes the dictionary contains apostrophes, which once stuffed up
    # the call to slappasswd before I quoted the word.
    if ( $plain_passwd )
    {
        $word = $plain_passwd;
    }
    else
    {
        # Only slurp the dictionary if it's needed:
        slurp_entire_dictionary() unless @dict;
#    do
#    {
        for ( my $i=0; $i < $parts; $i++)
        {
            do
            {
                $sub[$i] = substr ($dict[int (rand @dict)], 0, $sublen);
            }
            until (length $sub[$i] == $sublen);
            $word .= $sub[$i];
        }

        my $left = $wordlen % $sublen;
        $word .= substr (int rand (10**($wordlen - 1)), 0, $left);
#    } while $word =~ m/[^a-zA-Z0-9/;
    }
    my $md5_hash = `/usr/sbin/slappasswd -h "{MD5}" -s "$word"`;
    chomp $md5_hash;
    my $ntpwd = `/usr/local/bin/mkntpwd '$word'`;
    chomp $ntpwd;
    my $lmpassword = substr( $ntpwd, 0, index( $ntpwd, ':' ) );
    my $ntpassword = substr( $ntpwd, index( $ntpwd, ':' ) + 1 );
    return ( $word, $md5_hash, $lmpassword, $ntpassword );
}

# Avoid trying to generate GID numbers above nfsnobody:
sub max_below_GID_MAX(@)
{
    my $max = shift(@_);
    foreach my $foo (@_) {
        $max = $foo if $max < $foo and $foo < GID_MAX;
    }
    return $max;
}

our $max_uid_number = 0;
sub get_next_uid_number()
{
    return ++$max_uid_number
}

# In array of names, make all lower case except for first letter
# unless it contains dots, in which case leave unchanged.
sub case_convert_names(@)
{
    return map { if ( /\./ ) { $_ } else { ucfirst lc } } @_
}

# ldapsearch -x -h ldap.vtc.edu.hk -b 'ou=ICT,ou=TY,o=vtc.edu.hk' \
# -s one cn -LLL | grep '^cn:' | grep -v '^cn::' | sort | cut -d" " -f2- |
# test-user-names

# Boy, this is much more complicated than I ever bargained for.
# This makes all staff names look okay.

sub get_user_names($)
{
    my $cn = shift;
    $cn =~ s/-/ /g unless $cn =~ /ty-cms/i;
    # Maybe it would be good to remove all commas before we start?
    # $cn =~ s/,//g;
    my $has_kwailo_name_sn_first = $cn =~ /montague|lawrence|seymour/i;
    my $has_kwailo_name_sn_last = $cn =~ /(kit.*ko)|curtis|patrick/i;
    my $has_kwailo_name_put_sn_first = $cn =~ /lawrence/i;
    my $has_kwailo_name
	= $has_kwailo_name_sn_first || $has_kwailo_name_sn_last;
    my @names = split / +/, $cn;
    my ( $sn, $givenName );
    # my $has_kwailo_name
    #   = grep /montague|lawrence|seymour|(kit.*ko)|curtis|patrick/i, @names;
    if ( @names == 2 )
    {
	# Assume name is a kwailo name with sn at end:
        ( $givenName, $sn ) = case_convert_names @names;
        $cn = "$givenName $sn";
    }
    elsif ( @names == 3 )
    {
	@names = case_convert_names @names;
	if ( $has_kwailo_name_sn_last )
	{
	    $sn = pop @names;
	}
	else
	{
	    $sn = shift @names;
	}
	if ( $has_kwailo_name )
	{
	    $givenName = join ' ', @names;
	}
	else
	{
	    $givenName = ucfirst lc join '-', @names;
	}
	$cn = $has_kwailo_name ? "$givenName $sn" : "$sn $givenName";
	$cn = "$sn $givenName" if $has_kwailo_name_put_sn_first;
    }
    elsif ( @names > 3 )
    {
        # Assume that the last name is a western name.
        $sn = shift @names;
        $sn = ucfirst lc $sn;
        my $kwailo_name = ucfirst lc pop @names;
	@names = case_convert_names @names;
	if ( $has_kwailo_name_sn_first )
	{
	    $givenName = join ' ', ( @names, $kwailo_name );
	}
	else
	{
	    $givenName = ( ucfirst lc join '-', @names ) . ", $kwailo_name";
            # If input name has a comma, don't want two commas!
            $givenName =~ tr/,//s;
	}
        $cn = "$sn $givenName";
    }
    elsif ( @names == 1 )
    {
	if ( grep /ootc|ty-|tycmlab|tyicp|ict|esec/i, @names )
	{
	    $cn = $sn = $givenName = uc shift @names;
	}
	else
	{
	    $cn = $sn = ucfirst lc shift @names;
	    $givenName = "(unknown)";
	    warn "PROBLEM: $cn has only one name provided\n";
	}
    }
    else
    {
        $cn = $sn = $givenName = "(unknown)";
        warn "PROBLEM: no name provided\n";
    }
    # The old GRS put a comma between family and given names:
    $cn =~ s/,// if $sn =~ s/,//;
    return ( $cn, $sn, $givenName );
}

# Find all posixGroups that are not groupOfUniqueNames
# Add the objectclass groupOfUniqueNames to them.
# But this won't work, since
# object class 'groupOfUniqueNames' requires attribute 'uniqueMember'
# What a lousy schema design; you can't make an empty group!
# This idiotic junior high school design means need to check whether
# a group has objectClass groupOfUniqueNames __every time__ we add
# a uniqueMember to the group!  What twits!  I should write to the
# standards groups and complain, and suggest the simple fix.
sub ensure_all_groups_are_groupOfUniqueNames()
{
    my $baseDN = "ou=Group,$base";
    my $group_search
        = $ldap_ict->search(
                            base => $baseDN,
                            scope => "one",
                            filter => "(!(objectclass=groupOfUniqueNames))"
                           );

    die "Cannot search for ICT groups not groupOfUniqueNames in ICT LDAP ",
        "server ",
        "(probably increasing sizelimit in /etc/openldap/slapd.conf ",
        "will help): ",
        $group_search->error(), "\n" if $group_search->code();

    print "Found ", $group_search->count(),
    " group entries in ICT server.\n";
    
    foreach my $entry ( $group_search->all_entries )
    {
        my $dn = $entry->dn();
        $entry->add( objectClass => 'groupOfUniqueNames' );
        my ( $result, $error, $error_msg );
        if ( $ldif_output )
        {
            $ldif->write_entry( $entry );
            $error = $error_msg = $ldif->error;
        }
        else
        {
            $result = $entry->update( $ldap_ict );
            $error = $result->code;
            $error_msg = $result->error;
        }
        if ( $error )
        {
            warn "failed to add groupOfUniqueNames objectClass to $dn: ",
            "$error_msg\n";
            return 0;
        }
        print "Successfully updated group $dn with ",
        "oc=groupOfUniqueNames\n" if $debug;
    }
}

sub get_next_gid_number()
{
    my $max = max_below_GID_MAX sort keys %group_bynumber;
    print "Biggest gidnumber is $max\n" if $debug;
    return $max + 1;
}

# See my old program get-year-1-paswords.
# return true if $uid is a member of group.
sub is_a_member_of($$)
{
    my ( $uid, $group ) = @_;
    my $basedn = "ou=Group,$base";
    my $dn = "cn=$group,$basedn";
    my $result = $ldap_ict->compare(
                                    $dn,
                                    attr => 'memberUid',
                                    value => $uid
                                   );
    return $result->code() == LDAP_COMPARE_TRUE;
}

# return true if the user DN is a uniqueMember of the group:
sub user_dn_is_a_unique_member_of($$)
{
    my ( $user_dn, $group ) = @_;
    my $basedn = "ou=Group,$base";
    my $dn = "cn=$group,$basedn";
    my $result = $ldap_ict->compare(
                                    $dn,
                                    attr => 'uniquemember',
                                    value => $user_dn
                                   );
    return $result->code() == LDAP_COMPARE_TRUE;
}

sub has_groupOfUniqueNames_attribute($)
{
    my $dn = shift;
    my $result = $ldap_ict->compare(
                                    $dn,
                                    attr => 'objectClass',
                                    value => 'groupOfUniqueNames',
                                   );
    my $code = $result->code();
    return $code == LDAP_COMPARE_TRUE;
}

# This is really for adding users to secondary groups.
# Assume have already bound to server as admin.
sub add_dn_and_uid_to_group($$$)
{
    my ( $userDN, $uid, $gid ) = @_;
    print "add_dn_and_uid_to_group(dn=$userDN, uid=$uid, gid=$gid)\n"
        if $debug;
    if ( $uid eq $gid )
    {
        print "\n\n************************************";
        warn "PROBLEM: add_dn_and_uid_to_group should be used for adding ",
             "to secondary ",
             "groups, not primary groups.  The subroutine is called in ",
             "the wrong place.\n";
        print "************************************\n\n";
        return; # probably should die.
    }
    if ( not exists $group_byname{$gid} )
    {
        create_group( $gid, get_next_gid_number(), [ $uid ], [ $userDN ] );
        return;
    }
    my $dn = "cn=$gid,ou=Group,$base";
    # We must be adding the user to an existing secondary group:
    # Nick, 13 Sept 2001:
    # I changed this from add, since I want it to succeed even if user is
    # already a member.  See if it works.
    # No, it results in each group having only one member.
    if ( exists $group_byname{$gid}{'members'}
         and grep /$uid/, @{ $group_byname{$gid}{'members'} } )
    {
        print "$uid is already a member of group $gid.\n";
        print "members of $gid: ",
           join( ', ',  @{ $group_byname{$gid}{'members'} } ),
                "\n" if $debug > GROUP_DEBUG;
        return;
    }
    # All due to the stupid design of the groupOfUniqueNames objectClass:
    my $result;
    if ( has_groupOfUniqueNames_attribute( $dn ) )
    {
        $result = $ldap_ict->modify(
                                   $dn,
                                   add => {
                                           memberUid => $uid,
                                           uniquemember => $userDN,
                                          }
                                   );
    }
    else
    {
        $result = $ldap_ict->modify(
                                    $dn,
                                    add => {
                                            memberUid => $uid,
                                            uniquemember => $userDN,
                                       objectClass => 'groupOfUniqueNames',
                                           }
                                   );
    }
    if ( $result->code )
    {
        warn "PROBLEM: failed to add $uid to $dn: ", $result->error;
    }
    else
    {
        push @{ $group_by_uid{$uid} }, $gid;
        push @{ $group_by_user_dn{$userDN} }, $gid;
        push @{ $group_byname{$gid}{'members'} }, $uid;
        push @{ $group_byname{$gid}{'dnlist'} }, $userDN;
        print "Successfully added $uid and $userDN to group name $gid\n"
            if $debug;
    }
}

use Carp;

# Assume have already bound to server as admin.
sub create_group($$$$)
{
    my ( $cn, $gidNumber, $memberlist, $dnlist ) = @_;
    if ( ! defined $cn or ! defined $gidNumber )
    {
	confess "cn=$cn, gidNumber=$gidNumber, and ",
                "here is what happened:\n";
    }
    if ( exists $group_byname{$cn} )
    {
        # This is no major problem if the group already exists.
        warn "group $cn exists with group number ",
            $group_byname{$cn}{gidNumber};
        return 0;
    }
    if ( exists $group_bynumber{$gidNumber} )
    {
        print "\n\n************************************";
         warn "PROBLEM: group $cn exists with group number $gidNumber, ",
            "but not in \%group_byname!";
        print "************************************\n\n";
         return 0;
    }

    my $entry = Net::LDAP::Entry->new;
    $entry->dn( "cn=$cn,ou=Group,$base" );
    $entry->add(
                cn => $cn,
                objectClass => [ "top", 'posixGroup' ],
                userPassword => '{crypt}x',
                gidNumber => $gidNumber,
               );
    $entry->add( memberUid => $memberlist ) if $memberlist;
    $entry->add( uniquemember => $dnlist,
                 objectClass => "groupOfUniqueNames" ) if $dnlist;
    $entry->changetype( 'add' );

    my ( $result, $error, $error_msg );
    if ( $ldif_output )
    {
        $ldif->write_entry( $entry );
        $error = $error_msg = $ldif->error;
    }
    else
    {
        $result = $entry->update( $ldap_ict );
        $error = $result->code;
        $error_msg = $result->error;
    }
    if ( $error )
    {
        # If we get here, it really is a problem, since the hash should have
        # indicated if there was already an entry for this group.
        # Would need to invesigate:
        warn "PROBLEM: failed to add entry: $error_msg\n";
        return 0;
    }
    print "Successfully created group cn=$cn,ou=Group,$base with ",
        "GIDnumber = $gidNumber\n" if $debug;

    $group_byname{$cn}{gidNumber} = $gidNumber;
    $group_byname{$cn}{members} = $memberlist if $memberlist;
    $group_byname{$cn}{dnlist} = $dnlist if $dnlist;
    $group_bynumber{$gidNumber} = $cn;
    foreach my $uid ( @{$memberlist} )
    {
        push @{ $group_by_uid{$uid} }, $cn;
    }
    foreach my $dn ( @{$dnlist} )
    {
        push @{ $group_by_user_dn{$dn} }, $cn;
    }
    return 1;
}

# sub create_basic_groups()
# {
#     foreach my $group ( ( 'students', 'year1', 'year2', 'year3' ) )
#     {
#         create_group( $group, get_next_gid_number() );
#     }
# }


# WARNING: THIS IS BROKEN WITH THE LDIF OUTPUT OPTION!!!
# FIXME!!!!
sub delete_group($)
{
    my $gid = shift;
    my $dn = "cn=$gid,ou=Group,$base";
    if ( $ldif_output )
    {
        print "Refusing to delete $dn: LDIF output option selected\n";
        return;
    }
    my $result = $ldap_ict->delete( $dn );

    if ( $result->code )
    {
        # Don't call this unless need to!
        warn "PROBLEM: Failed to delete $dn", $result->error, "\n";
    }
    else
    {
        print "Successfully deleted $dn\n" if $debug;
        my $gidNumber = $group_byname{$gid}{gidNumber};
        # delete this group from all membership lists:
        foreach my $uid ( @{ $group_byname{$gid}{members} })
        {
            my $len = @{ $group_by_uid{$uid} };
            for ( my $i = $len - 1; $i >= 0; --$i )
            {
                splice @{ $group_by_uid{$uid} }, $i, 1
                    if $group_by_uid{$uid}->[$i] eq $gid;
            }
        }
        foreach my $user_dn ( @{ $group_byname{$gid}{dnlist} })
        {
            my $len = @{ $group_by_user_dn{$user_dn} };
            for ( my $i = $len - 1; $i >= 0; --$i )
            {
                splice @{ $group_by_user_dn{$user_dn} }, $i, 1
                    if $group_by_user_dn{$user_dn}->[$i] eq $gid;
            }
        }
        # Delete this entry from both hashes:
        delete $group_byname{$gid};
        delete $group_bynumber{$gidNumber};
    }
}

# Assume have already bound to server as admin.
# should be able to be called whether entry exists or not.
sub create_auto_home_entry($)
{
    my $uid = shift;
    my $basedn = "ou=auto.home,$base";
    my $autohome_search = $ldap_ict->search(
                                             base => $basedn,
                                             scope => 'one',
                                             filter => "(cn=$uid)",
                                           );
    warn "Cannot search for all ICT $uid\'s auto.home entry "
        . "in ICT LDAP server: ",
        $autohome_search->error(), "\n" if $autohome_search->code();

    my $wanted_automount
        = "$automount_options $nfs_server:$home_dir_base/$uid";
    if ( $autohome_search->count() == 1 )
    {
        # We already have an auto.home entry for this user.
        # Make sure the automountInformation is correct, write back if not
        my $entry = $autohome_search->pop_entry;
        if ( $entry->get_value( 'automountInformation' ) ne $wanted_automount )
        {
            $entry->replace( 'automountInformation' => $wanted_automount );
            my ( $result, $error, $error_msg );
            if ( $ldif_output )
            {
                $ldif->write_entry( $entry );
                $error = $error_msg = $ldif->error;
            }
            else
            {
                $result = $entry->update( $ldap_ict );
                $error = $result->code;
                $error_msg = $result->error;
            }
            if ( $error )
            {
                warn
                  "PROBLEM: failed to update auto.home for $uid: $error_msg\n";
            }
            else
            {
                my $dn = $entry->dn();
                print "Successfully updated $dn\n" if $debug;
            }
        }
        else
        {
            print "$uid already has a good auto.home entry\n";
        }
    }
    elsif ( $autohome_search->count() == 0 )
    {
        # Create and add a new auto.home entry:
	my $entry = Net::LDAP::Entry->new;
        my $dn = "cn=$uid,$basedn";
        $entry->dn( $dn );
	$entry->add(
                    objectClass => [ "top", 'automount' ],
                    cn => $uid,
                    automountInformation => $wanted_automount,
                   );
        $entry->changetype( 'add' );
        my ( $result, $error, $error_msg );
        if ( $ldif_output )
        {
            $result = $ldif->write_entry( $entry );
            $error = $error_msg = $ldif->error;
        }
        else
        {
            $result = $entry->update( $ldap_ict );
            $error = $result->code;
            $error_msg = $result->error;
        }
        if ( $result->code )
        {
            warn "PROBLEM: failed to add new auto.home for $uid: $error_msg\n";
        }
        else
        {
            print "Successfully created $dn\n" if $debug;
        }
    }
    else
    {
        warn "PROBLEM: more than one auto.home entry for $uid!!\n";
    }
}

use File::Copy;
use File::Basename;

# Note: this should work even if the directory has been created.
# It could be owned by the wrong uidNumber or gidNumber.
# BUG FIXED:
# BUG WHERE WAS TESTING FOR EXISTENCE OF $home/$file instead of
# $home/$file_basename CAUSED ALL LOGIN SCRIPTS TO BE OVERWRITTEN!
# NOW FIXED.
sub create_home_directory($$)
{
    my ( $uid, $uidNumber ) = @_;
    my $home = "$home_dir_base/$uid";
    ( mkdir( $home, 0711 )
      or warn "cannot make $home: $!" )
        unless -d $home;

    my $copy_error = 0;
    foreach my $file ( split /\s+/, `echo /etc/skel/.[^.]*` )
    {
        next if $file eq "/etc/skel/.kde";
        # Kinder to only copy these files if they don't exist:
        my $file_basename = basename( "$file" );
        unless ( -f "$home/$file_basename" )
        {
            print "Copying '$file' to $home...\n"
                if $debug;
            copy( $file, "$home" ) or $copy_error = 1
        }
    }
    # system( "cp -a /etc/skel/.[^.]* $home_dir_base/$uid > /dev/null 2>&1" )
    #   == 0
        warn "Couldn't copy skel dot files to $home\n"
            if $copy_error;
    # The non-dot files are directories, so better to use cp -a:
    # NOTE: this will destroy people's carefully crafted desktop settings!
    # If that's a problem, test if files exist before copying.
    system( "cp -ua /etc/skel/* /etc/skel/.kde $home > /dev/null 2>&1" ) == 0
        or warn
            "Couldn't copy skel non-dot files and .kde directory to $home\n";
    # system( "chown", "-R", "$uidNumber.$uidNumber", "$home_dir_base/$uid",
    #         "> /dev/null 2>&1" ) == 0 
    # changing the ownership should not hurt any except those who are working
    # on a group project.
    system( "chown -R $uidNumber.$uidNumber $home > /dev/null 2>&1" ) == 0 
        or warn "Couldn't let $uidNumber = $uid own $home\n";
}

sub read_all_group_info_from_ict_server()
{
    my $basedn = "ou=Group,$base";
    my $group_search = $ldap_ict->search(
                                         base => $basedn,
                                         scope => "one",
                                         filter => "(cn=*)"
                                        );

    die "Cannot search for all ICT groups in ICT LDAP server ",
        "(probably increasing sizelimit in /etc/openldap/slapd.conf ",
        "will help): ",
        $group_search->error(), "\n" if $group_search->code();

    print "Found ", $group_search->count(),
    " group entries in ICT server.\n";
    
    foreach my $entry ( $group_search->all_entries )
    {
        my $group_name = $entry->get_value( 'cn' )
            || warn "cannot get group name: $!";
        my $group_number = $entry->get_value( 'gidNumber' )
            || warn "cannot get group number: $!";
        my @members = $entry->get_value( 'memberUid' );
        my @dns = $entry->get_value( 'uniqueMember' );
        print "gid=$group_name,\tgidNumber=$group_number";
	print ",\tmembers="
            . join( ", ", @members ) if @members;
	print "\n";
        foreach my $user_dn ( @dns )
        {
            push @{ $group_by_user_dn{$user_dn} }, $group_name;
        }
        foreach my $member ( @members )
        {
            push @{ $group_by_uid{$member} }, $group_name;
        }
        $group_bynumber{$group_number} = $group_name;
        $group_byname{$group_name}{gidNumber} = $group_number;
        $group_byname{$group_name}{'members'} = \@members if @members;
        $group_byname{$group_name}{'dnlist'} = \@dns if @dns;
    }
}

sub read_all_uid_numbers_get_greatest()
{
    my $max_uid_number = 0;
    my $basedn = "ou=People,$base";
    my $useridnum_search = $ldap_ict->search(
                                             base => $basedn,
                                             scope => "one",
                                             filter => "(cn=*)",
                                             attrs => [ 'uidNumber' ],
                                            );

    warn "Cannot search for all ICT userid numbers in ICT LDAP server: ",
        $useridnum_search->error(), "\n" if $useridnum_search->code();

    print "Found ", $useridnum_search->count(),
    " uid entries in ICT server.\n";

    foreach my $entry ( $useridnum_search->entries() )
    {
        $max_uid_number = $entry->get_value( 'uidNumber' )
            if  $max_uid_number < $entry->get_value( 'uidNumber' );
    }
    print "Max UID number = $max_uid_number in ICT server\n";
    return $max_uid_number;
}

sub bind_not_anonymous($$$)
{
    my ( $password_file, $dn, $ldap_object ) = @_;
    open PW, "< $password_file" or die "cannot open \"$password_file\": $!";
    my $password = <PW>;
    chomp $password;
    close PW;
    $mesg = $ldap_object->bind(
                            dn => $dn,
                            password => "$password",
                            version => 3
                           );
    die "Failed to bind as \"$dn\" to ldap server: ", $mesg->error(), "\n"
        if $mesg->code();
    # Failed to bind as admin to ldap server: I/O Error
    print "Now bound as \"$dn\"\n" if $debug;
}

sub bind_as_admin_to_local_server($)
{
    bind_not_anonymous(
                       "/root/ldapaccounts/ldap-admin-password",
                       "cn=admin,$base",
                       shift
                       );
}

sub bind_as_ictldap_to_vtc_server($)
{
    bind_not_anonymous(
                       "/root/ldapaccounts/ldap-ictldap-password",
                       "uid=ictldap,ou=Appl,o=system,dc=vtc.edu.hk",
                       shift
                       );
}

# $gid is a group common name.
sub delete_uid_from_group($$)
{
    my ( $uid, $gid ) = @_;
    unless ( exists $group_by_uid{$uid}
             and grep /$gid/, @{ $group_by_uid{$uid} } )
    {
        print "$uid does not belong to group $gid, so cannot delete it.\n",
            "$uid is a member of these groups: ",
                join( ', ', @{ $group_by_uid{$uid} } ),
                    "\n" if $debug > GROUP_DEBUG;
    }
    my $basedn = "ou=Group,$base";
    my $dn = "cn=$gid,$basedn";
    # Nick, 7am, 6 May 2003.
    # Oh dear, this did not work for two reasons:
    # The attribute name was wrong: I wrote member instead of memberUid
    # The operation was wrong: I wrote remove instead of delete.
    # Probably better to use the Net::LDAP::Entry->delete operation
    # instead, will investigate whether makes code more messy.
    my $result = $ldap_ict->modify(
                                   $dn,
                                   delete => {
                                              memberUid => $uid,
                                             }
                                   );
    if ( $result->code )
    {
        warn "PROBLEM: failed to delete $uid from $dn: ",
            $result->error;
    }
    else
    {
        for ( my $i = @{ $group_by_uid{$uid} } - 1; $i >= 0; --$i )
        {
            splice @{ $group_by_uid{$uid} }, $i, 1
                if $group_by_uid{$uid}->[$i] eq $gid;
        }
        warn "\$group_byname{$gid}{members} does not exist\n" and return
            unless exists $group_byname{$gid}{members};
        warn "\$group_byname{$gid}{members} is not defined\n" and return
            unless defined $group_byname{$gid}{members};
        print "\@{ \$group_byname{$gid}{members} } = ",
            scalar @{ $group_byname{$gid}{members} }, "\n";

        for ( my $i = @{ $group_byname{$gid}{members} } - 1;
              $i >= 0; --$i )
        {
            print "uid = $uid, \$group_byname{$gid}{members}->[$i]=",
                "$group_byname{$gid}{members}->[$i]\n";
            splice @{ $group_byname{$gid}{members} }, $i, 1
                if $group_byname{$gid}{members}->[$i] eq $uid;
        }
        print "Successfully deleted $uid from group name $gid\n" if $debug;
    }
}

# $gid is a group common name.

# I am not implementing the test for the last uniqueMember now.
# Just let it fail for now, as this will be a rare event with
# a full directory.

# Due to the idiotic design of groupOfUniqueNames, this will
# probably fail if trying to delete the last uniqueMember from
# a groupOfUniqueNames.  Need to delete the attribute
# groupOfUniqueNames if the count of unigueMember s is 1.
# Oh, I hope the perpetrator suffers a long pergatory of boring
# penance!
sub delete_dn_from_group($$)
{
    my ( $userDN, $gid ) = @_;
    unless ( exists $group_by_user_dn{$userDN} and
             grep /$gid/, @{ $group_by_user_dn{$userDN} } )
    {
        print "$userDN does not belong to group $gid, so cannot delete it.\n",
            "$userDN is a uniqueMember of these groups: ",
                join( ', ', @{ $group_by_user_dn{$userDN} } ),
                    "\n" if $debug > GROUP_DEBUG;
    }
    my $basedn = "ou=Group,$base";
    my $dn = "cn=$gid,$basedn";
    my $result = $ldap_ict->modify(
                                   $dn,
                                   delete => {
                                           uniquemember => $userDN,
                                          }
                                   );
    if ( $result->code )
    {
        warn "PROBLEM: failed to delete $userDN from $dn: ",
            $result->error;
    }
    else
    {
        for ( my $i = @{ $group_by_user_dn{$userDN} } - 1; $i >= 0; --$i )
        {
            splice @{ $group_by_user_dn{$userDN} }, $i, 1
                if $group_by_user_dn{$userDN}->[$i] eq $gid;
        }
        warn "\$group_byname{$gid}{dnlist} does not exist\n" and return
            unless exists $group_byname{$gid}{dnlist};
        warn "\$group_byname{$gid}{dnlist} is not defined\n" and return
            unless defined $group_byname{$gid}{dnlist};
        print "\@{ \$group_byname{$gid}{dnlist} } = ",
            scalar @{ $group_byname{$gid}{dnlist} }, "\n";
        for ( my $i = @{ $group_byname{$gid}{dnlist} } - 1;
              $i >= 0; --$i )
        {
            splice @{ $group_byname{$gid}{dnlist}}, $i, 1
                if $group_byname{$gid}{dnlist}->[$i] eq $userDN;
        }
        print "Successfully deleted $userDN from group name $gid\n" if $debug;
    }
}

sub delete_dn_and_uid_from_group($$$)
{
    my ( $userDN, $uid, $gid ) = @_;
    print "delete_dn_and_uid_from_group(dn=$userDN, uid=$uid, gid=$gid)\n"
        if $debug;
    if ( $uid eq $gid )
    {
        print "\n\n************************************";
        warn "PROBLEM: delete_dn_and_uid_from_group should be used for ",
             "removing from secondary ",
             "groups, not primary groups.  The subroutine is called in ",
             "the wrong place.\n";
        print "************************************\n\n";
        return; # probably should die.
    }
    delete_uid_from_group( $uid, $gid );
    delete_dn_from_group( $userDN, $gid );
}

# Find elements that are in the first list that are not in the second,
# and return that list.
# The first list is the list of groups to which the user belongs,
# the second is the complete list of groups that the user should belong to.
# See the cookbook, section 4.8, page 106.
# The parameters are references to arrays.
# Do not include the user's private group; in fact, the list of 
# desired groups is the list of secondary groups, and should not
# include the primary group.
sub determine_wrong_groups($$$)
{
    my ( $uid, $actual, $desired ) = @_;
    my ( %desired_groups, @bad );
    foreach my $gid ( @{ $desired })
    {
        ++$desired_groups{$gid};
    }
    foreach my $gid ( @{ $actual } )
    {
        push @bad, $gid unless exists $desired_groups{$gid} or $uid eq $gid;
    }
    return @bad;
}

sub adjust_group_memberships_and_make_home_directory($$$$)
{
    my ( $userDN, $uid, $uidNumber, $secondary_groups ) = @_;
    print "\@secondary_groups: ", join( ', ', @$secondary_groups ), "\n";
    # Delete the primary group if it exists with a gidNumber different from
    # that in the Person entry for this user.
    delete_group( $uid )
        if exists $group_byname{$uid}
            and not exists $group_bynumber{$uidNumber};
    # create the primary private user group if it's not already there:
    create_group( $uid, $uidNumber, undef, [ $userDN ] )
        if not exists $group_byname{$uid};
    create_auto_home_entry( $uid );
    foreach my $group ( @$secondary_groups )
    {
        add_dn_and_uid_to_group( $userDN, $uid, $group );
    }
    create_home_directory( $uid, $uidNumber );
    my @wrong_groups = determine_wrong_groups( $uid, $group_by_uid{$uid},
                                               $secondary_groups );
    foreach my $group ( @wrong_groups )
    {
        delete_dn_and_uid_from_group( $userDN, $uid, $group );
    }

    @wrong_groups = determine_wrong_groups( $uid,
                                            $group_by_user_dn{$userDN},
                                            $secondary_groups );
    foreach my $group ( @wrong_groups )
    {
        delete_dn_and_uid_from_group( $userDN, $uid, $group );
    }
}

# This version of update_user is simpler than the next, but I am not certain
# that old attribute values are being preserved by it.
# I need to test this on a test server first.
# If it works, use this code rather than the older code further below,
# marked with the comment "Replace if code above works properly."


# Do not touch password, uidNumber or gidNumber
# Will do a replace operation.
# sub update_user($$$)
# {
#     my ( $entry, $one_ict_person, $secondary_groups ) = @_;
#     my $dn = $entry->dn;
#     my $uid = $entry->get_value( 'uid' );
#     $entry->changetype( 'modify' );
#     my $changeType = $entry->changetype;
#     print "For $dn, changetype is $changeType\n";

#     my ( $result, $error, $error_msg );
#     if ( $ldif_output )
#     {
#         $ldif->write_entry( $entry );
#         $error = $error_msg = $ldif->error;
#     }
#     else
#     {
#         $result = $entry->update( $ldap_ict );
#         $error = $result->code;
#         $error_msg = $result->error;
#     }

#     if ( $error )
#     {
#         warn "PROBLEM: failed to update $dn: $error_msg\n";
# 	print "Dump of update failure of $dn: $error_msg\n";
# 	$entry->dump;
# 	return;
#     }
#     else
#     {
#         print "successful update of $dn:\n";
#     }
#     $entry->dump() if $debug;

#     my $uidNumber
#         = $one_ict_person->pop_entry()->get_value( 'uidNumber' );
#     adjust_group_memberships_and_make_home_directory( $dn, $uid, $uidNumber,
#                                                       $secondary_groups );
# }

# Do not touch password, uidNumber or gidNumber
# Will do a replace operation.
# Replace if code above works properly.
sub update_user($$$)
{
    my ( $entry, $one_ict_person, $secondary_groups ) = @_;
    # Take the old entry, and replace old attributes with their replacements
    # from the new entry, but don't delete the other old attributes:
    my $e = $one_ict_person->pop_entry;
    # Must specify changetype before making changes!
    $e->changetype( 'modify' );
    # Okay, now make the changes:
    foreach my $attr ( $entry->attributes )
    {
       $e->replace( $attr => [ $entry->get_value( $attr ) ] );
    }

    my $dn = $entry->dn;
    my $uid = $entry->get_value( 'uid' );
    my $changeType = $e->changetype;
    print "For $dn, changetype is $changeType\n";

    my ( $result, $error, $error_msg );
    if ( $ldif_output )
    {
        $ldif->write_entry( $e );
        $error = $error_msg = $ldif->error;
    }
    else
    {
        $result = $e->update( $ldap_ict );
        $error = $result->code;
        $error_msg = $result->error;
    }

    if ( $error )
    {
        warn "PROBLEM: failed to update $dn: $error_msg\n";
	print "Dump of update failure of $dn: $error_msg\n";
	$entry->dump;
	return;
    }
    else
    {
        print "successful update of $dn:\n";
    }
    $e->dump() if $debug;

    my $uidNumber = $e->get_value( 'uidNumber' );
    adjust_group_memberships_and_make_home_directory( $dn, $uid, $uidNumber,
                                                      $secondary_groups );
}

# sub update_user
# {
#     my ( $entry, $one_ict_person, @secondary_groups ) = @_;
#     my $e = $one_ict_person->pop_entry;
#     foreach my $attr ( $entry->attributes )
#     {
# 	$e->replace( $attr => $entry->get_value( $attr );
#     }
    
#     $entry->changetype( 'modify' );
#     my $dn = $entry->dn;
#     my $uid = $entry->get_value( 'uid' );
#     my $changeType = $entry->changetype;
#     print "For $dn, changetype is $changeType\n";

#     # my $result = $entry->update( $ldap_ict );
#     my $result = $entry->update( $one_ict_person );
#     if ( $result->code )
#     {
#         warn "PROBLEM: failed to update $dn: ", $result->error;
# 	return;
#     }
#     else
#     {
#         print "successful update of $dn:\n";
#     }
#     $entry->dump() if $debug;

#     my $uidNumber = $entry->get_value( 'uidNumber' );
#     adjust_group_memberships_and_make_home_directory( $uid, $uidNumber,
#                                                       @secondary_groups );
# }

# The responsibility for the attributes being correct is with the callers.
# This includes the dn, the names, etc.
# This routine determines the uidNumber and gidNumber only.
# if $passwd is an empty string, then generate password,
# else assume this is a plain text password, and generate MD5 password.
sub add_user($$$)
{
    my ( $entry, $passwd, $secondary_groups ) = @_;
    my $dn = $entry->dn;
    my ( $uidNumber, $gidNumber );
    do
    {
        $uidNumber = $gidNumber = get_next_uid_number();
    } while ( exists $group_bynumber{$uidNumber} );
    my ( $plain_text_passwd, $md5_hash_passwd, $lmpassword, $ntpassword )
        = gen_password( $passwd );
    my $uid = $entry->get_value( 'uid' );
    print "UID: $uid; UIDn: $uidNumber; GID: $gidNumber; ",
        "\"$plain_text_passwd\", \"$md5_hash_passwd\"\n"
        if $debug;
    $entry->replace(
                    userPassword => $md5_hash_passwd,
                    lmPassword => $lmpassword,
                    ntPassword => $ntpassword,
                    uidNumber => $uidNumber,
                    gidNumber => $gidNumber,
		   );
    $entry->changetype( 'add' );
    my ( $result, $error, $error_msg );
    if ( $ldif_output )
    {
        $ldif->write_entry( $entry );
        $error = $error_msg = $ldif->error;
    }
    else
    {
        $result = $entry->update( $ldap_ict );
        $error = $result->code;
        $error_msg = $result->error;
    }
    if ( $result->code )
    {
        warn "PROBLEM: failed to add user entry for $dn: $error_msg\n";
	# Do not create home directory, etc if could not add account entry:
	return;
    }
    else
    {
        print "Successfully created entry for $dn\n";
    }
    print PASSWD_INFO "$uid:$plain_text_passwd:$md5_hash_passwd\n";
    $passwd_dbm_hash{$uid} = "$plain_text_passwd:$md5_hash_passwd";
    adjust_group_memberships_and_make_home_directory( $dn, $uid, $uidNumber,
                                                      $secondary_groups );
}

# Is it better to make all modifications to the entry when read it from the
# source or when write it to the target?
# Only can (easily) tell what is missing when read the source.

# Ignoring changes made at the target will overwrite changes made by the user.
# Very nasty behaviour.
# Solution:
# For updates: not change things that user can change.
# For new accounts, there is no problem with destroying existing data.

# This function is very simple:
# Take an entry, send off to modify routine if exists,
# else send to add routine if not exist.
# This routine does no other action.
# Note: it is the responsibility of the caller of this routine to
# ensure that all the attributes are correct.
# This includes the dn itself.
# if this is a new account,
#        if $passwd is an empty string, then
#                  generate password from nothing,
#        else
#                  assume this is a plain text password, and
#                  generate coresponding MD5 password.
# Specificially, if this is an update to existing account, never touch
# password.
# Add default values for new accounts; don't overwrite values for shell,
# home directory for existing accounts.

sub add_or_update_user($$$)
{
    my ( $entry, $passwd, $secondary_groups ) = @_;
    my $uid = $entry->get_value( 'uid' );
    my $one_ict_person = $ldap_ict->search(
                                            base => "ou=People,$base",
                                            scope => "one",
                                            filter => "(uid=$uid)"
                                           );
    if ( $one_ict_person->code() )
    {
        warn "PROBLEM: Cannot search for ICT student $uid in ICT LDAP server: ",
        $one_ict_person->error(), "\n";
        return;
    }

    my $count_of_entries_retrieved = $one_ict_person->count();
    print "\$one_ict_person->count() = $count_of_entries_retrieved\n"
        if $debug;

    if ( $one_ict_person->count() == 1 )
    {
        # The student already has an entry in ICT LDAP server,
        # but some attributes may be out of date.
        # Keep the current GID and UID numbers.  Do not change the password.
        # This program had a bug where new accounts were created without a
        # loginShell attribute.  This was a major problem!
        # Here we add the loginShell attribute if it is missing.
        my $loginShell = $entry->get_value( 'loginShell' ) || "/bin/bash";
        $entry->replace( loginShell => $loginShell );
        print "About to update this record:\n";
        $entry->dump;
        update_user( $entry, $one_ict_person, $secondary_groups );
    }
    elsif ( $one_ict_person->count() == 0 )
    {
        # No person exists with $uid in the local LDAP server,
        # so create and add the new entry:
	add_remaining_default_attributes( $entry );
        print "About to add this NEW record:\n";
        $entry->dump;
        add_user( $entry, $passwd, $secondary_groups );
    }
    else
    {
        warn "PROBLEM: $uid has more than one entry!!\n";
    }
}

sub set_default_classes($$)
{
    my ( $entry, $student_or_staff ) = @_;
    $entry->replace(
                    objectClass => [
                                    "top", "person",
                                    "organizationalPerson",
                                    "inetOrgPerson", "account",
                                    "posixAccount",
				    "shadowAccount",
                                    # "kerberosSecurityObject",
				    "sambaAccount",
                                    "institute",
                                    $student_or_staff,
                                   ],
               );
}

sub add_remaining_default_attributes($)
{
    my $entry = shift;
    my $uid = $entry->get_value( 'uid' )
        or warn "PROBLEM: Bad entry no uid" and return;
    my $cn = $entry->get_value( 'cn' )
        or warn "PROBLEM: Bad entry: no cn for $uid";
    my $loginShell = $entry->get_value( 'loginShell' ) || "/bin/bash";
    $entry->replace(
		    # krbname => "$uid\@$kerberos_realm",
		    homeDirectory => "$home_dir_base/$uid",
		    gecos => $cn,
                    loginShell => $loginShell,
		   );
    # userPassword => $md5_hash_passwd,
    # TODO: SAMBA PASSWORDS: put in gen_password routine.
    # samba lm and nt passwords
    # other samba attributes.
}

# sub create_new_entry
# {
#     my %attr = (
# 		acType => 'STU',
# 		department => 'ICT',
# 		site => 'TY',
# 		@_
# 	       );
#     my $default_email = "$attr{uid}\@vtc.edu.hk";
#     if ( $attr{acType} eq 'STU' )
#     {
# 	$default_email = "$attr{uid}\@stu.vtc.edu.hk";
# 	$attr{fullPartTime} = 'F' unless $attr{fullPartTime};
# 	if ( defined $attr{courseduration} and defined $attr{year} )
# 	{
# 	    $attr{finalyear} = $attr{courseduration} == $attr{year}
# 		? "T" : "F"; unless $attr{finalyear};
# 	}
#     }
#     $attr{instituteEmail} = $default_email unless $attr{instituteEmail};
#     my $entry = Net::LDAP::Entry->new;
#     $entry->dn( "uid=$attr{uid},ou=People,$base" );
#     set_default_classes( $entry,
# 			 $attr{acType} eq 'STU' ? 'staff' : 'student' );
#     $attr{acOwner} = $attr{uid} unless $attr{acOwner};
#     $entry->add( %attr );
#     return $entry;
# }

# There is an increasingly great number of acTypes:
#ldapsearch -x -LLL -h ldap.vtc.edu.hk -b 'ou=ict,ou=ty,o=vtc.edu.hk' actype | grep -i acType | sort -dfu
#actype: DEPT
#actype: STF
#actype: TMP


# The difference between students and staff is (on vtc ldap server):
# base dn of staff    is ou=ICT,ou=TY,       o=vtc.edu.hk
# base dn of students is ou=ICT,ou=TY,ou=stu,o=vtc.edu.hk
# Both have a filter of (uid=*)
#
# also there are some attributes that are different.

# Original idea was to read each entry, delete the ones we don't want,
# then do a replace operation.
# But this places us at the mercy of any changes to the VTC ldap server.
# Smarter: just get the values we want, and put them into a new entry.

sub import_and_update_accounts_from_vtc_ldap_server($)
{
    my $get_staff = shift;
    my $ldap_vtc = Net::LDAP->new( "ldap.vtc.edu.hk" ) or die "$@";
    bind_as_ictldap_to_vtc_server( $ldap_vtc );

    # my $basedn = "ou=ICT,ou=TY,ou=stu,o=vtc.edu.hk";
    my $basedn = "ou=ICT,ou=TY,o=ftstudent,dc=vtc.edu.hk";
    my $filter = "(uid=*)";
    my $scope = "one";
    if ( $get_staff )
    {
        # $basedn = "ou=ICT,ou=TY,o=vtc.edu.hk";
        # I am in uid=nicku,ou=ICT,ou=TY,o=staff,dc=vtc.edu.hk
        # No, PTE staff are in locations such as:
        # uid=0901485,ou=PTE,ou=TY,o=staff,dc=vtc.edu.hk
        # (before was uid=0901485,ou=PTE,ou=TY,o=vtc.edu.hk)
        $basedn = "ou=TY,o=staff,dc=vtc.edu.hk";
        $scope = "sub";
        $filter = "(&(|(acType=STF)(acType=STF_P)(acType=TMP))"
            . "(|(department=ICT)"
            . "(&(department=CSEC)(|(uid=chuwh)(uid=evachung)(uid=cjoycec)"
            . "(uid=ytleung)(uid=josewan)))))";
    }
    my $alluser_search = $ldap_vtc->search(
                                   base => $basedn,
                                   scope => $scope,
                                   filter => $filter,
                                   );

    warn "PROBLEM: Cannot search for all ICT members in VTC LDAP server: ",
      $alluser_search->code(), "\n" if $alluser_search->code();

    print "Found ", $alluser_search->count(), " entries in VTC LDAP server.\n";

    bind_as_admin_to_local_server( $ldap_ict );

    # create_basic_groups();

    open PASSWD_INFO, ">> $passwd_info_file"
        or die "cannot open $passwd_info_file: $!";
    dbmopen( %passwd_dbm_hash, $passwd_dbm_database, 0600 )
        or die "Cannot open password database: $!";

    foreach my $e ( $alluser_search->all_entries() )
    {
        my ( $sn, $givenName );
        my $cn = $e->get_value( 'cn' );
        ( $cn, $sn, $givenName ) = get_user_names( $cn );
        print "$cn\n";
        my $uid = $e->get_value( 'uid' );
        my $default_email
            = $get_staff ? "$uid\@vtc.edu.hk" : "$uid\@stu.vtc.edu.hk";
        my $instituteEmail = $e->get_value( 'mail' )
            || $default_email;
        my $course = $e->get_value( 'course' );
        my $year = $e->get_value( 'year' );
	# Computer Centre have acType of STU_X for students who have not
	# "Activated" their accounts, and STU for those who have.
	my $acType = $e->get_value( 'acType' );
	$acType =~ s/_X$//;
# 	my %attr = (
# 		    uid => $uid,
# 		    cn => $cn,
# 		    sn => $sn,
# 		    givenName => $givenName,
# 		    acOwner => $e->get_value( 'acOwner' ),
# 		    acType => $acType,
# 		    instituteEmail => $instituteEmail,
#                     department => ( $e->get_value( 'department' ) || 'ICT' ),
# 		    site => ( $e->get_value( 'site' ) || 'TY' ),
# 		   );

	my $entry = Net::LDAP::Entry->new;
        $entry->dn( "uid=$uid,ou=People,$base" );
        set_default_classes( $entry, $get_staff ? 'staff' : 'student' );
	$entry->add(
		    uid => $uid,
		    cn => $cn,
		    sn => $sn,
		    givenName => $givenName,
		    acOwner => $e->get_value( 'acOwner' ),
		    acType => $acType,
		    instituteEmail => $instituteEmail,
                    department => ( $e->get_value( 'department' ) || 'ICT' ),
		    site => ( $e->get_value( 'site' ) || 'TY' ),
		   );
	if ( ! $get_staff )
	{
	    $entry->add(
			course => $course,
			year => $year,
			courseduration => $e->get_value( 'courseduration' ),
			registrationdate =>
			                $e->get_value( 'registrationdate' ),
			classcode => $e->get_value( 'classcode' ),
			finalyear => $e->get_value( 'finalyear' ),
			fullPartTime => 'F', # only f/t in ldap.vtc.edu.hk 2002
		       );
	}
        # $e->dump() if $debug;
        # $entry->dump() if $debug;
        my $secondary_groups;
	
	if ( $get_staff )
	{
	    $secondary_groups = [ "staff" ];
	}
	else
	{
	    $secondary_groups = [ "students", $course, "year" . $year ];
	}

	# stuff that is not in the entry yet, but must be present
	# (but not necessarily with these values):
	# loginShell => "/bin/bash",
	# krbname => "$uid\@$kerberos_realm",
	# homeDirectory => "$home_dir_base/$uid"
	# userPassword => $md5_hash_passwd,
	# gecos => $cn,
	# samba lm and nt passwords
	# other samba attributes.

        # Effect of next line is to generate passwords on new accounts,
        # and to leave any existing passwords on existing accounts unchanged.
        my $passwd = "";
        add_or_update_user( $entry, $passwd, $secondary_groups );
    }
    close PASSWD_INFO;
    dbmclose %passwd_dbm_hash;

    # Probably unnessary, but C programmers are cautious that way:
    $ldap_vtc->unbind;
}

sub fix_groups()
{
    bind_as_admin_to_local_server( $ldap_ict );
    ensure_all_groups_are_groupOfUniqueNames();
}

# WARNING: This will replace an original entry with a new one
# Should test this on existing accounts.
# Would clobber an existing account with the same user name, without
# much ceremony.
sub useradd($$$$$)
{
    my ( $uid, $name, $mail, $passwd, $secondary_groups ) = @_;
    usage() unless $uid;
    $name = $uid unless $name;
    my ( $cn, $sn, $givenName ) = get_user_names( $name );


    $mail = "(unknown)" unless $mail;
    bind_as_admin_to_local_server( $ldap_ict );
    my $entry = Net::LDAP::Entry->new;
    $entry->dn( "uid=$uid,ou=People,$base" );
    print STDERR "secondary groups = @{$secondary_groups}\n";
    if ( grep /staff/, @$secondary_groups )
    {
        print STDERR "Found staff\n";
        set_default_classes( $entry, 'staff' );
    }
    else
    {
        print STDERR "Found no staff, assuming student.\n";
        set_default_classes( $entry, 'student' );
    }
    $entry->add(
                uid => $uid,
                cn => $cn,
                sn => $sn,
                givenName => $givenName,
                mail => $mail,
               );

    open PASSWD_INFO, ">> $passwd_info_file"
        or die "cannot open $passwd_info_file: $!";
    dbmopen( %passwd_dbm_hash, $passwd_dbm_database, 0600 )
        or die "Cannot open password database: $!";
    add_or_update_user( $entry, $passwd, $secondary_groups );
    close PASSWD_INFO;
    dbmclose %passwd_dbm_hash;
}

# delete the user account with userid $uid.

# delete user from all groups
# delete the user's private group
# delete the user's automount entry
# move the home directory to a special location.

sub userdel($)
{
    my $uid = shift;
    my $user_homedir = "/home/$uid";
    my $dir_for_deleted_accounts = "/home/deleted";
    my $user_dn = "uid=$uid,ou=People,$base";
    my $autohome_dn = "cn=$uid,ou=auto.home,$base";
    bind_as_admin_to_local_server( $ldap_ict );
    delete_group( $uid );
    my $result = $ldap_ict->delete( $autohome_dn );
    if ( $result->code )
    {
        warn "PROBLEM: Failed to delete $autohome_dn ", $result->error, "\n";
    }
    else
    {
        print "Successfully deleted $autohome_dn\n" if $debug;
    }
    foreach my $gid ( @{ $group_by_uid{$uid} } )
    {
        delete_uid_from_group( $uid, $gid )
    }
    foreach my $gid ( @{ $group_by_user_dn{$user_dn} } )
    {
        delete_dn_from_group( $user_dn, $gid )
    }
    $result = $ldap_ict->delete( $user_dn );
    if ( $result->code )
    {
        warn "PROBLEM: Failed to delete $user_dn ", $result->error, "\n";
    }
    else
    {
        print "Successfully deleted $user_dn\n" if $debug;
    }
    mkdir $dir_for_deleted_accounts, 0700 unless -d $dir_for_deleted_accounts;
    move $user_homedir, "$dir_for_deleted_accounts/$uid"
        or warn "failed to move $user_homedir to ",
            "$dir_for_deleted_accounts/$uid: $!";
}

# Note: the last parameter, $full_part_time, has a value of the
# form "FT" or "PT"
sub process_parsed_oracle_record($$$$$$$$$$)
{
    my ( $student_id, $hk_id, $course, $name, $year, $registrationDate,
         $effectiveDate, $homePhone, $full_part_time, $classCode ) = @_;
    return unless defined $student_id;
    my ( $cn, $sn, $givenName ) = get_user_names( $name );
    $year = 0 unless defined $year;
    $classCode = '?' unless defined $classCode;

    my $final_year = "?";
    my $course_duration = "?";
    # If not a MAC mode course, then can tell if final year
    # and determine course duration:
    if ( $year > 0 )
    {
        # This seems correct now, but can change in the future!
        # course duration is 3 year unless the course code ends in a letter:
        $course_duration = $course =~ /[A-Z]$/ ? 2 : 3;
        $final_year = $year == $course_duration ? "T" : "F";
    }
    my $full_or_part_time_attribute = substr $full_part_time, 0, 1;
    my $entry = Net::LDAP::Entry->new;
    $entry->dn( "uid=$student_id,ou=People,$base" );
    set_default_classes( $entry, 'student' );
    $entry->add(
                uid => $student_id,
                cn => $cn,
                sn => $sn,
                givenName => $givenName,
                acOwner => $student_id,
                acType => 'STU',
                instituteEmail => "$student_id\@stu.vtc.edu.hk",
                department => 'ICT',
                site => 'TY',
                course => $course,
                year => $year,
                courseduration => $course_duration,
                registrationdate => $registrationDate,
                classcode => $classCode,
                finalyear => $final_year,
                fullPartTime => $full_or_part_time_attribute,
               );
    
    my $secondary_groups = [ "students", $course, "year" . $year ];
    $secondary_groups = [ "students", $course ] if $year == 0;
    my $passwd = $hk_id;
    add_or_update_user( $entry, $passwd, $secondary_groups );

    print "$student_id $hk_id $course/"
        . ( defined $year ? $year : 0 )
        . ( defined $registrationDate
            ? " $registrationDate" : " no regdat" )
        . ( defined $effectiveDate ? " $effectiveDate" : " no effdat" )
        . ( defined $homePhone ? " $homePhone" : " no phone" )
        . " $full_or_part_time_attribute"
        . " $course_duration"
        . " $final_year"
        . " ${name}\n" if $debug;
}

# $ grep Course FT.txt | awk '{print $3}' | sort -u | column -c 80
# 41300/1W        41300/2Y        41303/2         41304A/1        41350/3
# 41300/1X        41300/2Z        41303/3         41304A/1A       71303/3(1)
# 41300/1Y        41300/3W        41304/2         41304A/1B       71303/3(2)
# 41300/1Z        41300/3X        41304/2A        41304A/1C       71303/3A(1)
# 41300/2         41300/3Y        41304/2B        41304A/1D       71303/3B(1)
# 41300/2W        41300/3Z        41304/2C        41350/1         71303/3C(1)
# 41300/2X        41303/1         41304/2D        41350/2         71303/3D(1)

# 2 changes:
# 1. parse the Course info properly
# 2. simplify: consider we have a complete record as soon as we have the
#    $registrationDate, $effectiveDate, $reason_code, $homePhone.
#    Previously, I waited until the start of a new student record before
#    processing the previous, but this resulted in the course being incorrect
#    for the first and last student of each class!  The code was horrible too.
#    This makes the code simmpler.  But:
#  WARNING: NOT TESTED YET IN THIS APPLICATION!
#  TESTED ONLY IN A TEST PROGRAM, NOT ON CREATING ACCOUNTS!

sub add_students_from_oracle_text_files()
{
    my ( $course, $year, $classCode );
    my $campus;
    my $current_academic_year;
    my $full_time_part_time;
    my ( $registrationDate, $effectiveDate, $reason_code, $homePhone );
    my ( $name, $gender, $student_id, $hk_id );
    my ( $newname, $newgender, $newstudent_id, $newhk_id );
   
    bind_as_admin_to_local_server( $ldap_ict );
    open PASSWD_INFO, ">> $passwd_info_file"
        or die "cannot open $passwd_info_file: $!";
    dbmopen( %passwd_dbm_hash, $passwd_dbm_database, 0600 )
        or die "Cannot open password database: $!";
    while ( <> )
    {
        chomp;
        
        if ( m!^\s*Campus\s:\s(\S+)\s+(2\d\d\d/\d\d)\s+Mode\s:\s(\S+)! )
        {
            ( $campus, $current_academic_year, $full_time_part_time )
		= ( $1, $2, $3 );
        }
        # Match Course : 41304A or Course : 41304
        if ( /^\s*Course :\s(\d+[A-Z]?)\s/ )
        {
            $course = $1;
            undef $year;
            undef $classCode;
            next;
        }
        # Match Course : 41304A/1   or Course : 41304/2
        # or    Course : 71303/3(1) or Course : 71303/3(2)
        elsif ( m!^\s*Course :\s(\d+[A-Z]?)/(\d)(?:\(\d\))?\s! )
        # elsif ( m!^\s*Course :\s(\d+[A-Z]?)/(\d)\s! )
        {
            $course = $1;
            $year = $2;
            undef $classCode;
            next;
        }
        # Match Course : 41300/1W   or Course : 41304/2A
        # or    Course : 71303/3A(1) or Course : 71303/3D(2)
        elsif ( m!^\s*Course :\s(\d+[A-Z]?)/(\d)(\w)(?:\(\d\))?\s! )
        # elsif ( m!^\s*Course :\s(\d+[A-Z]?)/(\d)([A-Z])\s! )
        {
            $course = $1;
            $year = $2;
            $classCode = $3;
            next;
        }
        if (
            m{
	         ^\s\d+\s                   # the "No." after one space
		 .*                         # the weird characters
                 \s\s+                      # at least 2 spaces
                 (                          # this matches $name
                     [A-Za-z]+            # family name is (usually) upper case
                     (?:\s[A-Za-z]+)+     # one or more given names
                 )
                 \s\s+                      # at leaset 2 spaces
                 ([MF])                     # gender
                 \s+                        # at least one space
                 (\d{9})                    # student id is 9 digits
                 \s\s+                      # at leaset 2 spaces
                 ([a-zA-Z]\d{6}\([\dA]\))   # HK ID
            }x
            )
        {
            ( $name, $gender, $student_id, $hk_id )
                = ( $1, $2, $3, $4 );
            # print "$student_id $hk_id $course/"
            #     . ( defined $year ? $year : "M" )
            #     . ( defined $registrationDate
            #         ? " $registrationDate" : " no regdat" )
            #     . ( defined $effectiveDate
            #         ? " $effectiveDate" : " no effdat" )
            #     . ( defined $homePhone ? " $homePhone" : " no phone" )
            #     . " $name\n";
            
            # print "\nsex=$gender, student ID = $student_id\n",
            # "hkID = $hk_id, course = $course, name=$name\n",
            # defined $year ? "year = $year\n" : "year undefined\n";
            # print "registrationDate = $registrationDate\n",
            # "effectiveDate = $effectiveDate\n",
            # "homePhone = $homePhone\n\n";
	    next;
	}
	if (
            m{
                 ^\s+                          # 12 spaces
		 (\d\d-[A-Z]{3}-(?:\d\d){1,2}) # dd-MON-yy(yy)
		 \s+                           # around 11 spaces
		 (\d\d-[A-Z]{3}-(?:\d\d){1,2}) # should be effective date
                 (?:
                 \s+
                 (\(\d+\))                     # optional "Reason Code"
                 )?                            # zero or one Reason Codes
                 (?:
                 \s+
		 (\d{8})                       # the optional phone number
                 )?                            # zero or one of them
                 .*                            # Some phone numbers followed
                                               # by addresses, space, Chinese
                 # Anchor to the end of the line to force recognition
                 # of the optional parts:
                 $                             
            }x
	    )
	{
            ( $registrationDate, $effectiveDate, $reason_code, $homePhone )
                = ( $1, $2, $3, $4 );
            # Now we have a complete record to process:
            # my $mail = "$student_id\@stu.vtc.edu.hk";
            my $mail = "(unknown)";
            my $passwd = $hk_id;
            my $secondary_groups = [ "students", $course ];
            push @$secondary_groups, "year" . $year if $year;
            
            process_parsed_oracle_record(
                                         $student_id, $hk_id, $course,
                                         $name, $year, $registrationDate,
                                         $effectiveDate, $homePhone,
                                         $full_time_part_time,
                                         $classCode,
                                         );
                
            print STDERR "Reason Code = $reason_code\n$_\n" if $reason_code;

	    print STDERR "BAD: homePhone = $homePhone\n$_\n"
	        unless defined $homePhone and $homePhone =~ /^\d{8}$/;
	    print STDERR "BAD: effectiveDate = $effectiveDate\n$_\n"
	        unless $effectiveDate =~ /^\d\d-[A-Z]{3}-(?:\d\d){1,2}$/;
            next;
        }
        warn "POSSIBLE UNMATCHED STUDENT: $_\n" if m!^\s{1,20}\d+\s+!
          and $debug;
	warn "LEFTOVER: $_\n" if $debug > 1;
    }
    # Need to process the last record (unless all records are empty):
    # Need sanity check: is Hong Kong ID defined?
    #process_parsed_oracle_record(
    #                             $student_id, $hk_id, $course,
    #                             $name, $year, $registrationDate,
    #                             $effectiveDate, $homePhone,
    #                             $full_time_part_time,
    #                             $classCode,
    #                             ) if defined $hk_id;
    # print "$student_id $hk_id $course/"
    #    . ( defined $year ? $year : "M" )
    #    . ( defined $registrationDate
    #        ? " $registrationDate" : " no regdat" )
    #    . ( defined $effectiveDate ? " $effectiveDate" : " no effdat" )
    #    . ( defined $homePhone ? " $homePhone" : " no phone" )
    #    . " ${name}<==last\n" if defined $hk_id;
    close PASSWD_INFO;
    dbmclose %passwd_dbm_hash;
}

# sub add_part_time_students_from_oracle_text_files()
# {
#     my $course;
#     my $year;
    
#     print "Sorry, not implemented properly yet.  ",
#     "Tell Nick if you need this.\n"; return;
#     bind_as_admin_to_local_server( $ldap_ict );
#     open PASSWD_INFO, ">> $passwd_info_file"
#         or die "cannot open $passwd_info_file: $!";
#     dbmopen( %passwd_dbm_hash, $passwd_dbm_database, 0600 )
#         or die "Cannot open password database: $!";
#     while ( <> )
#     {
#         chomp;
        
#         if ( /^\s*Course :\s(\d+)\s/ )
#         {
#             $course = $1;
#             undef $year;
#             next;
#         }
#         elsif ( m!^\s*Course :\s(\d+)/(\d)\s! )
#         {
#             $course = $1;
#             $year = $2;
#             next;
#         }
#         if (
#             my ( $name, $gender, $student_id, $hk_id )
#          = m{
#                  \s\s+                      # at leaset 2 spaces
#                  (                          # this matches $name
#                      [A-Z]+                 # family name is upper case
#                      (?:\s[A-Z][a-z]*)+     # one or more given names
#                  )
#                  \s\s+                      # at leaset 2 spaces
#                  ([MF])                     # gender
#                  \s+                        # at least one space
#                  (\d{9})                    # student id is 9 digits
#                  \s\s+                      # at leaset 2 spaces
#                  ([a-zA-Z]\d{6}\([\dA-Z]\)) # HK ID
#             }x
#             )
#         {
#             # my $mail = "$student_id\@stu.vtc.edu.hk";
#             my $mail = "(unknown)";
#             my $passwd = $hk_id;
#             my $secondary_groups = [ "students", $course ];
#             push @$secondary_groups, "year" . $year if $year;
           
#             #add_or_update_user( $student_id, $name, $mail, $passwd,
#             #                    $secondary_groups );
#             print "sex=$gender, student ID = $student_id, ",
#             "hkID = $hk_id, course = $course, name=$name, ",
#             defined $year ? "year = $year\n" : "\n" if $debug;
#             next;
#         }
#         warn "POSSIBLE UNMATCHED STUDENT: $_\n" if m!^\s*\d+\s+!;
#     }
#     close PASSWD_INFO;
#     dbmclose %passwd_dbm_hash;
# }

sub add_part_time_students_from_grs_text_files()
{
    my $course;
    my $year;

    bind_as_admin_to_local_server( $ldap_ict );
    open PASSWD_INFO, ">> $passwd_info_file"
        or die "cannot open $passwd_info_file: $!";
    dbmopen( %passwd_dbm_hash, $passwd_dbm_database, 0600 )
        or die "Cannot open password database: $!";
    while ( <> )
    {
        chomp;
        if ( m!^(\d+)/(\d)\s! )
        {
            $course = $1;
            $year = $2;
            next;
        }
        if (
            my ( $name, $gender, $student_id, $hk_id )
            = m{
                 \s+                        # at leaset 1 space
                 (                          # this matches $name
                     [A-Z]+,?               # family name is upper case with comma
                     (?:\s[A-Z][a-z]*)+     # one or more given names
                 )
                 \s\s+                      # at leaset 2 spaces
                 ([MF])                     # gender
                 \s+                        # at least one space
                 (\d{9})                    # student id is 9 digits
                 \s\s+                      # at leaset 2 spaces
                 ([a-zA-Z]\d{6}\([\dA-Z]\)) # HK ID
               }x
            )
        {
            # my $mail = "$student_id\@stu.vtc.edu.hk";
            my ( $cn, $sn, $givenName ) = get_user_names( $name );
            my $passwd = $hk_id;
            my $secondary_groups = [ "students", $course ];
            push @$secondary_groups, "year" . $year if $year;

            my $entry = Net::LDAP::Entry->new;
            $entry->dn( "uid=$student_id,ou=People,$base" );
            set_default_classes( $entry, 'student' );
            $entry->add(
                        uid => $student_id,
                        cn => $cn,
                        sn => $sn,
                        givenName => $givenName,
                        acOwner => $student_id,
                        acType => 'STU',
                        instituteEmail => "$student_id\@stu.vtc.edu.hk",
                        department => 'ICT',
                        site => 'TY',
                        course => $course,
                        year => $year,
                        fullPartTime => 'P',
                       );
            add_or_update_user( $entry, $passwd, $secondary_groups );
           
           
            #add_or_update_user( $student_id, $name, $mail, $passwd,
            #                    $secondary_groups );
            print "sex=$gender, student ID = $student_id, ",
            "hkID = $hk_id, course = $course, name=$name, ",
            defined $year ? "year = $year\n" : "\n" if $debug;
            next;
        }
        warn "POSSIBLE UNMATCHED STUDENT: $_\n" if m!^\s*\d+\s+!;
    }
    close PASSWD_INFO;
    dbmclose %passwd_dbm_hash;
}

sub usage()
{
    my $prog = basename( $0 );
    print STDERR <<USAGE;
Usage:\t$prog [OPTIONS] [oracle-or-GRS-text-files...]
-d --debug\tenable more messages about what is happening
-a --useradd\tadd a single user.  These next options only useful for that:
\t\t-u userID
\t\t-c users full name
\t\t-m email address
\t\t-p password
\t\t-g group1,group2,...\tcomma-separated list of secondary groups
-t --studentsfromldap\t\timport/update student user accounts from VTC ldap server
-f --stafffromldap\t\timport/update staff user accounts from VTC ldap server
--invent-passwords\tGenerate new passwords for all existing accounts
\t\t\tthat are tupdated.  Use with caution!!
-o --oracle-part-time\timport/update part-time user acounts from Oracle
\t\t\ttext files
-s --grs-part-time\timport/update part-time user acounts from grs text files

Should be able to be run many times as VTC ldap server is updated without
hurting existing accounts.

Any problems: Nick Urbanik <nicku\@vtc.edu.hk>, tel. 2436 8576
USAGE
    exit 0;
}

sub main()
{
    my $user_to_delete = 0;
    # Getopt::Long::Configure( "bundling" );
    GetOptions( "useradd!"   => \$useradd,
                "a!"         => \$useradd,
                "d:i"        => \$debug,
                "debug:i"    => \$debug,
                "studentsfromldap!" => \$import_students_from_vtc_ldap,
                "t!"                => \$import_students_from_vtc_ldap,
                "stafffromldap!" => \$import_staff_from_vtc_ldap,
                "f!"             => \$import_staff_from_vtc_ldap,
                "u=s"        => \$uid_to_add,
                "c=s"        => \$users_full_name,
                "m=s"        => \$email_address,
                "g=s"        => \@other_groups,
                "p=s"        => \$passwd,
                "r=s"        => \$user_to_delete,
                "userdel=s"  => \$user_to_delete,
                # "invent-passwords!" => \$gen_new_password,
                "l!"         => \$ldif_output,
                "ldif-output!" => \$ldif_output,
                "n!"         => \$fix_groups,
                "fix-groups!" => \$fix_groups,
                "o!"         => \$oracle_text_files,
                "s!"         => \$grs_part_time_text_files,
                "oracle-text-file!" => \$oracle_text_files,
                "grs-part-time!"    => \$grs_part_time_text_files,
              ) or usage();

    usage() unless $useradd or $import_students_from_vtc_ldap
	or $import_staff_from_vtc_ldap
	    or $oracle_text_files or $grs_part_time_text_files
                or $user_to_delete or $fix_groups;
    # See man Getopt::Long, search for array:
    @other_groups = split( /,/, join( ',', @other_groups ) );
    read_all_group_info_from_ict_server();
    $max_uid_number = read_all_uid_numbers_get_greatest();
    $ldif = Net::LDAP::LDIF->new( $ldif_output_file, "w", onerror => 'undef' )
        if $ldif_output;
    if ( $ldif_output )
    {
        warn "This does not work properly yet\n";
    }
    if ( $import_students_from_vtc_ldap )
    {
        import_and_update_accounts_from_vtc_ldap_server( GET_STUDENTS );
    }
    elsif ( $import_staff_from_vtc_ldap )
    {
        import_and_update_accounts_from_vtc_ldap_server( GET_STAFF );
    }
    elsif ( $fix_groups )
    {
        fix_groups();
    }
    elsif ( $useradd )
    {
        print STDERR "other_groups = @other_groups\n";
        useradd( $uid_to_add, $users_full_name,
                 $email_address, $passwd, \@other_groups );
    }
    elsif ( $user_to_delete )
    {
        userdel( $user_to_delete );
    }
    elsif ( $oracle_text_files )
    {
        add_students_from_oracle_text_files();
    }
    elsif ( $grs_part_time_text_files )
    {
        add_part_time_students_from_grs_text_files();
    }
    else
    {
        usage();
    }
    $ldif->done if $ldif_output;
    $ldap_ict->unbind;
}

main();

close LOCK;