#! /usr/bin/perl -w

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

# 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 );    # use for Error handling
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 $import_students_from_vtc_ldap = 0;
our $import_staff_from_vtc_ldap = 0;
our $oracle_part_time_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;

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_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'.


# 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.
#    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/;
    $word = $plain_passwd if $plain_passwd;
    my $md5_hash = `slappasswd -h "{MD5}" -s "$word"`;
    chomp $md5_hash;
    return ( $word, $md5_hash );
}

# 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
}

sub get_user_names($)
{
    my $cn = shift;
    my @names = split / +/, $cn;
    my ( $sn, $givenName );
    if ( @names == 2 )
    {
        ( $givenName, $sn ) = @names;
        $givenName = ucfirst lc $givenName;
        $sn = ucfirst lc $sn;
        $cn = "$givenName $sn";
    }
    elsif ( @names == 3 )
    {
        $sn = shift @names;
        $sn = ucfirst lc $sn;
        $givenName = ucfirst lc join '-', @names;
        $cn = "$sn $givenName";
    }
    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;
        $givenName = ( ucfirst lc join '-', @names ) . ", $kwailo_name";
        $cn = "$sn $givenName";
    }
    elsif ( @names == 1 )
    {
        $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 );
}

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;
}

# This is really for adding users to secondary groups.
# Assume have already bound to server as admin.
sub add_uid_to_group
{
    my ( $uid, $gid ) = @_;
    print "add_uid_to_group(uid=$uid, gid=$gid)\n" if $debug;
    if ( $uid eq $gid )
    {
        print "\n\n************************************";
        warn "PROBLEM: add_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 ) );
        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 ( grep /$uid/, @{ $group_bynumber{$group_byname{$gid}}{'members'} } )
    {
        print "$uid is already a member of group $gid.\n";
        print "members of $gid: ",
           join( ', ',  @{ $group_bynumber{$group_byname{$gid}}{'members'} } ),
                "\n" if $debug > GROUP_DEBUG;
        return;
    }
    my $result = $ldap_ict->modify( $dn, add => { memberUid => $uid } );
    if ( $result->code )
    {
        warn "PROBLEM: failed to add $uid to $dn: ", $result->error;
    }
    else
    {
        push @{ $group_bynumber{$group_byname{$gid}}{'members'} }, $uid;
        print "Successfully added $uid to group name $gid\n" if $debug;
    }
}

# Assume have already bound to server as admin.
sub create_group
{
    my ( $cn, $gidNumber, @memberlist ) = @_;
    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}";
        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 $result;
    if ( @memberlist )
    {
        $result = $ldap_ict->add(
                                 dn => "cn=$cn,ou=Group,$base",
                                 attr => [
                                          cn => "$cn",
                                          objectClass => [ 'posixGroup',
                                                           'top' ],
                                          userPassword => '{crypt}x',
                                          gidNumber => $gidNumber,
                                          memberUid => [ @memberlist ],
                                         ]
                                );
    }
    else
    {
        $result = $ldap_ict->add(
                                 dn => "cn=$cn,ou=Group,$base",
                                 attr => [
                                          cn => "$cn",
                                          objectClass => [ 'posixGroup',
                                                           'top' ],
                                          userPassword => '{crypt}x',
                                          gidNumber => $gidNumber,
                                         ]
                                );
    }
    if ( $result->code )
    {
        # 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: ", $result->error;
        return 0;
    }
    print "Successfully created group cn=$cn,ou=Group,$base with ",
        "GIDnumber = $gidNumber\n" if $debug;

    $group_byname{$cn} = $gidNumber;
    $group_bynumber{$gidNumber}{'gid'} = $cn;
    $group_bynumber{$gidNumber}{'members'} = [ @memberlist ];
    return 1;
}

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

sub delete_group
{
    my $gid = shift;
    my $dn = "cn=$gid,ou=Group,$base";
    my $result = $ldap_ict->delete( $dn );
    if ( $result->code )
    {
        # Don't call this unless need to!
        warn "PROBLEM: Failed to delete $dn\n";
    }
    else
    {
        print "Successfully deleted $dn\n" if $debug;
        # Remove this entry from both hashes:
        my $gidNumber = $group_byname{$gid};
        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 = $entry->update( $ldap_ict );
            if ( $result->code )
            {
                warn "PROBLEM: failed to update auto.home for $uid: ",
                    $result->error, "\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 $dn = "cn=$uid,$basedn";
        my $attributes = [
                          objectClass => 'automount',
                          cn => $uid,
                          automountInformation => $wanted_automount,
                         ];
        my $result = $ldap_ict->add( $dn, attrs => [ @$attributes ] );
        if ( $result->code )
        {
            warn "PROBLEM: failed to add new auto.home for $uid: ",
                $result->error, "\n";
        }
        else
        {
            print "Successfully created $dn\n" if $debug;
        }
    }
    else
    {
        warn "PROBLEM: more than one auto.home entry for $uid!!\n";
    }
}

use File::Copy;

# Note: this should work even if the directory has been created.
# It could be owned by the wrong uidNumber or gidNumber.
sub create_home_directory
{
    my ( $uid, $uidNumber ) = @_;
    ( mkdir( "$home_dir_base/$uid", 0711 )
      or warn "cannot make $home_dir_base/$uid: $!" )
        unless -d "$home_dir_base/$uid";

    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:
        unless ( -f "$home_dir_base/$uid/$file" )
        {
            print "Copying '$file' to $home_dir_base/$uid...\n"
                if $debug;
            copy( $file, "$home_dir_base/$uid" ) 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_dir_base/$uid\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_dir_base/$uid > /dev/null 2>&1" ) == 0
        or warn "Couldn't copy skel non-dot files and .kde directory to $home_dir_base/$uid\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_dir_base/$uid "
            . "> /dev/null 2>&1" ) == 0 
        or warn "Couldn't let $uidNumber = $uid own $home_dir_base/$uid\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' );
        print "gid=$group_name,\tgidNumber=$group_number,\tmembers="
            . join( ", ", @members ) . "\n";
        $group_byname{$group_name} = $group_number;
        $group_bynumber{$group_number}{'gid'} = $group_name;
        $group_bynumber{$group_number}{'members'} = [ @members ];
    }
}

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_as_admin_to_local_server
{
    my $admin_password_file = "/root/ldapaccounts/ldap-admin-password";
    open PW, "< $admin_password_file" or die "cannot open \"$admin_password_file\": $!";
    my $adminpassword = <PW>;
    chomp $adminpassword;
    close PW;
    $mesg = $ldap_ict->bind(
                            dn => "cn=admin,$base",
                            password => "$adminpassword",
                            version => 3
                           );
    die "Failed to bind as admin to ICT ldap server: ", $mesg->error(), "\n"
        if $mesg->code();
    # Failed to bind as admin to ICT ldap server: I/O Error
    print "Now bound as \"cn=admin,$base\"\n" if $debug;
}

sub make_groups_and_home_directory
{
    my ( $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, () ) if not exists $group_byname{$uid};
    create_auto_home_entry( $uid );
    foreach my $group ( @secondary_groups )# ( 'students', $course, 'year' . $year )
    {
        add_uid_to_group( $uid, $group );
    }
    create_home_directory( $uid, $uidNumber );
    # TODO:
    # Write code to remove user from wrong (old) groups.
}

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

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

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

# sub update_user
# {
#     my ( $entry, $one_ict_student, @secondary_groups ) = @_;
#     my $e = $one_ict_student->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_student );
#     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' );
#     make_groups_and_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 ) = 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,
		     uidNumber => $uidNumber,
		     gidNumber => $gidNumber,
		   );
    $entry->changetype( 'add' );
    my $result = $entry->update( $ldap_ict );
    if ( $result->code )
    {
        warn "PROBLEM: failed to add user entry for $dn: ", $result->error;
	# 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";
    make_groups_and_home_directory( $uid, $uidNumber, @secondary_groups );
}

# Would like to make this subroutine apply equally well to staff or students.
# 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_student = $ldap_ict->search(
                                            base => "ou=People,$base",
                                            scope => "one",
                                            filter => "(uid=$uid)"
                                           );
    if ( $one_ict_student->code() )
    {
        warn "PROBLEM: Cannot search for ICT student $uid in ICT LDAP server: ",
        $one_ict_student->error(), "\n";
        return;
    }

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

    if ( $one_ict_student->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.
        print "About to update this record:\n";
        $entry->dump;
        update_user( $entry, $one_ict_student, @secondary_groups );
    }
    elsif ( $one_ict_student->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",
                                    "kerberosSecurityObject",
				    "sambaAccount",
                                    "institute",
                                    $student_or_staff,
                                   ],
               );
}

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

# 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 "$@";
    my $mesg_vtc = $ldap_vtc->bind( version => 3 ); # use for searches

    die "Failed to bind to VTC ldap server: ", $mesg_vtc->code(), "\n"
        if $mesg_vtc->code();

    my $basedn = "ou=ICT,ou=TY,ou=stu,o=vtc.edu.hk";
    $basedn = "ou=ICT,ou=TY,o=vtc.edu.hk" if $get_staff;
    my $alluser_search = $ldap_vtc->search(
                                   base => $basedn,
                                   scope => "one",
                                   # filter => "(|(department=CM)(department=ICT))",
                                   filter => "(uid=*)",
                                   );

    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();

    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 $instituteEmail = $e->get_value( 'mail' )
            || "$uid\@stu.vtc.edu.hk";
        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 $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,
		    site => $e->get_value( 'site' ) || 'TY',
		   );
	if ( ! $get_staff )
	{
	    $entry->add(
			course => $course,
			year => $year,
			instituteEmail => $instituteEmail,
			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 useradd($$$$@)
{
    my ( $uid, $cn, $mail, $passwd, @secondary_groups ) = @_;
    usage() unless $uid;
    $cn = $uid unless $cn;
    $mail = "(unknown)" unless $mail;
    bind_as_admin_to_local_server();

    create_basic_groups();
    add_or_update_user( $uid, $cn, $mail, $passwd, @secondary_groups );
}

sub add_part_time_students_from_oracle_text_files()
{
    my $course;
    my $year;
    
    bind_as_admin_to_local_server();
    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();
    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 $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 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
-g --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
{
    # 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,
                # "invent-passwords!" => \$gen_new_password,
                "o!"         => \$oracle_part_time_text_files,
                "g!"         => \$grs_part_time_text_files,
                "oracle-part-time!" => \$oracle_part_time_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_part_time_text_files or $grs_part_time_text_files;
    # See man Getopt::Long, search for array:
    @other_groups = split( /,/, join( ',', @other_groups ) );
    slurp_entire_dictionary();
    read_all_group_info_from_ict_server();
    $max_uid_number = read_all_uid_numbers_get_greatest();
    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 ( $useradd )
    {
        useradd( $uid_to_add, $users_full_name,
                 $email_address, $passwd, @other_groups );
    }
    elsif ( $oracle_part_time_text_files )
    {
        add_part_time_students_from_oracle_text_files();
    }
    elsif ( $grs_part_time_text_files )
    {
        add_part_time_students_from_grs_text_files();
    }
    else
    {
        usage();
    }
    $ldap_ict->unbind
}

main();