#! /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  10

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

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

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

# nswmextendeduserprefs: meDraftFolder=Drafts # nswmextendeduserprefs: meSentFolder=Sent # nswmextendeduserprefs: meTrashFolder=Trash # nswmextendeduserprefs: meInitialized=true # classcode: B # objectclass: top # objectclass: person # objectclass: student # objectclass: organizationalPerson

# objectclass: inetOrgPerson  50

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

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

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

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

# 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;  100

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

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-"  120

. 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 $ℓdap server = "ldap.tyict.vtc.edu.hk";

our $kerberos realm = "TYICT.VTC.EDU.HK";

our $home dir base = "/home";  130

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 $oracℓe part time text files = 0; our $grs part time text files = 0; our $uid to add;

our $users full name;  140

our $emaiℓ address; our @other groups; our $passwd; use constant GROUP DEBUG => 3;

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

our $ℓdap ict = Net::LDAP−>new( $ℓdap server ) or die "$@";

our $mesg = $ℓdap ict−>bind( version => 3 ); # use for searches  150

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’.  160

# 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: $!";  170

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.  180

sub gen password($) {

my $pℓain passwd = shift;

my @sub = (); my $word = ''; my $wordℓen = 8; # desired length of the password my $subℓen = 3; # length of the word chunks that create the password my $parts = int ($wordℓen/$subℓen); my $numwords = 100; # number of passwords to print

190

# 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, $subℓen);  200

}

until (length $sub[$i] == $subℓen); $word .= $sub[$i];

}

my $ℓeft = $wordℓen % $subℓen;

$word .= substr (int rand (10∗∗($wordℓen − 1)), 0, $ℓeft); # } while $word =∼ m/[^a-zA-Z0-9/;

$word = $pℓain passwd if $pℓain passwd;

my $md5 hash = ‘slappasswd −h "{MD5}" −s "$word"‘;  210

chomp $md5 hash;

return ( $word, $md5 hash ); }

# Avoid trying to generate GID numbers above nfsnobody:

sub max below GID MAX  max below GID MAX

{ my $max = shift(@ ); foreach my $foo (@ ) {

$max = $foo if $max < $foo and $foo < GID MAX ;  220

}

return $max; }

our $max uid number = 0;

sub get next uid number  get next uid number

{

return ++$max uid number }

230

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

   $cn = "$givenName $sn";

} elsif ( @names == 3 ) {

$sn = shift @names; $sn = ucfirst lc $sn; $givenName = ucfirst lc join '-', @names;

   $cn = "$sn $givenName";

}

elsif ( @names > 3 )  250

{ # Assume that the last name is a western name. $sn = shift @names; $sn = ucfirst lc $sn; my $kwaiℓo name = ucfirst lc pop @names; $givenName = ( ucfirst lc join '-', @names ) . ", $kwailo_name";

   $cn = "$sn $givenName";

} elsif ( @names == 1 )

{  260

$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:  270

$cn =∼ s/,// if $sn =∼ s/,//; return ( $cn, $sn, $givenName );

}

sub get next gid number  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;

}  280

# This is really for adding users to secondary groups. # Assume have already bound to server as admin.

sub add uid to group  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************************************";  290

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

}

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";  310

   print "members of $gid: ",

join( ', ', @{ $group bynumber{$group byname{$gid}}{'members'} } ),

"\n" if $debug > GROUP DEBUG; return;

} my $resuℓt = $ℓdap ict−>modify( $dn, add => { memberUid => $uid } ); if ( $resuℓt−>code ) {

   warn "PROBLEM: failed to add $uid to $dn: ", $resuℓt−>error;

}  320

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  create group
{  330

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************************************";  340

    warn "PROBLEM: group $cn exists with group number $gidNumber, ",
      "but not in \%group_byname!";
   print "************************************\n\n";

return 0; }

my $resuℓt; if ( @memberlist ) {

$resuℓt = $ℓdap ict−>add(  350

                       dn => "cn=$cn,ou=Group,$base",

attr => [

                              cn => "$cn",

objectClass => [ 'posixGroup',

                                           'top' ],

userPassword => '{crypt}x', gidNumber => $gidNumber, memberUid => [ @memberlist ], ]

);  360

} else {

$resuℓt = $ℓdap ict−>add(

                       dn => "cn=$cn,ou=Group,$base",

attr => [

                              cn => "$cn",

objectClass => [ 'posixGroup',

                                           'top' ],

userPassword => '{crypt}x',  370

gidNumber => $gidNumber,

] );

} if ( $resuℓt−>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: ", $resuℓt−>error;  380

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;

}  390

sub create basic groups() {

foreach my $group ( ( 'students', 'year1', 'year2', 'year3' ) )

{

create group( $group, get next gid number() ); }

}

sub delete group  delete group
{  401

my $gid = shift;

my $dn = "cn=$gid,ou=Group,$base";

my $resuℓt = $ℓdap ict−>delete( $dn ); if ( $resuℓt−>code ) {

# Don’t call this unless need to!

   warn "PROBLEM: Failed to delete $dn\n";

}

else  410

{

   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.  420

# should be able to be called whether entry exists or not.

sub create auto home entry  create auto home entry

{ my $uid = shift;

my $basedn = "ou=auto.home,$base";

my $autohome search = $ℓdap ict−>search( base => $basedn, scope => 'one',

                                filter => "(cn=$uid)",

);  430

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  440

my $entry = $autohome search−>pop entry; if ( $entry−>get value( 'automountInformation' ) ne $wanted automount ) {

$entry−>replace( 'automountInformation' => $wanted automount ); my $resuℓt = $entry−>update( $ℓdap ict ); if ( $resuℓt−>code ) {

      warn "PROBLEM: failed to update auto.home for $uid: ",

$resuℓt−>error, "\n";

}  450

else {

my $dn = $entry−>dn();

      print "Successfully updated $dn\n" if $debug;

} } else {

   print "$uid already has a good auto.home entry\n";

}  460

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

];  470

my $resuℓt = $ℓdap ict−>add( $dn, attrs => [ @$attributes ] ); if ( $resuℓt−>code ) {

   warn "PROBLEM: failed to add new auto.home for $uid: ",

$resuℓt−>error, "\n"; } else {

   print "Successfully created $dn\n" if $debug;

}  480

} 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.  490

# It could be owned by the wrong uidNumber or gidNumber.

sub create home directory  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 $fiℓe ( split /\s+/, ‘echo /etc/skel/.[^.]∗‘ )  500

{

   next if $fiℓe 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( $fiℓe, "$home_dir_base/$uid" ) or $copy error = 1

}

}  510

# 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”, 520

# “> /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  … l group info from ict server
{  530

my $basedn = "ou=Group,$base";

my $group search = $ℓdap 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): ",  540

$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' )  550

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

} }

560

sub read all uid numbers get greatest  … all uid numbers get greatest

{ my $max uid number = 0;

my $basedn = "ou=People,$base";

my $useridnum search = $ℓdap ict−>search( base => $basedn, scope => "one",

                                filter => "(cn=*)",
                                attrs => [ 'uidNumber' ],

);  570

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' )  580

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  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\": $!"; 590

my $adminpassword = <PW >; chomp $adminpassword; close PW ; $mesg = $ℓdap 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();  600

# 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  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.  610

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

}  620

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  update user

{

my ( $entry, $one ict student, @secondary groups ) = @ ;  630

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

print "For $dn, changetype is $changeType\n";

my $resuℓt = $e−>update( $ℓdap ict ); # my $result = $entry->update( $one ict student ); if ( $resuℓt−>code ) {

   warn "PROBLEM: failed to update $dn: ", $resuℓt−>error;

$e−>dump; return;

}  650

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

}

660

# 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’ );  670

# 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; 680

# 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 ); 690

# }

# 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  add user

{

my ( $entry, $passwd, @secondary groups ) = @ ;  700

my $dn = $entry−>dn;

my ( $uidNumber, $gidNumber );

do {

$uidNumber = $gidNumber = get next uid number(); } while ( exists $group bynumber{$uidNumber} ); my ( $pℓain 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"  710

if $debug; $entry−>replace( userPassword => $md5 hash passwd,

uidNumber => $uidNumber, gidNumber => $gidNumber,

); $entry−>changetype( 'add' ); my $resuℓt = $entry−>update( $ℓdap ict ); if ( $resuℓt−>code ) {

      warn "PROBLEM: failed to add user entry for $dn: ", $resuℓt−>error;  720

# 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 );  730

}

# 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:  740

# 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.  750

# 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.  760
sub add or update user  add or update user

{ my ( $entry, $passwd, @secondary groups ) = @ ; my $uid = $entry−>get value( 'uid' ); my $one ict student = $ℓdap ict−>search(

                                  base => "ou=People,$base",

scope => "one",

                            filter => "(uid=$uid)"

);  770

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

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

}  790

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  800

{

warn "PROBLEM: $uid has more than one entry!!\n";

} }

sub set default classes($$) {

my ( $entry, $student or staff ) = @ ; $entry−>replace(

objectClass => [  810

                      "top", "person",
                      "organizationalPerson",
                      "inetOrgPerson", "account",
                      "posixAccount",
                      "kerberosSecurityObject",
                      "sambaAccount",

                            "institute",

$student or staff, ],

);  820

}

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",  830

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 840

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

850

sub import and update accounts from vtc ldap server($) {

my $get staff = shift;

my $ℓdap vtc = Net::LDAP−>new( "ldap.vtc.edu.hk" ) or die "$@"; my $mesg vtc = $ℓdap 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";  860

   $basedn = "ou=ICT,ou=TY,o=vtc.edu.hk" if $get staff ;

my $aℓℓuser search = $ℓdap 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: ",

$aℓℓuser search−>code(), "\n" if $aℓℓuser search−>code();  870

print "Found ", $aℓℓuser 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 )  880

or die "Cannot open password database: $!";

foreach my $e ( $aℓℓuser 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 $instituteEmaiℓ = $e−>get value( 'mail' )  890

   | | "$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' );  900

$entry−>add( uid => $uid, cn => $cn, sn => $sn, givenName => $givenName, acOwner => $e−>get value( 'acOwner' ), acType => $acType, instituteEmail => $instituteEmaiℓ, site => $e−>get value( 'site' ) | | 'TY',

);  910

if ( ! $get staff ) { $entry−>add(

course => $course, year => $year, instituteEmail => $instituteEmaiℓ, courseduration => $e−>get value( 'courseduration' ), registrationdate =>

                         $e−>get value( 'registrationdate' ),

classcode => $e−>get value( 'classcode' ),  920

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 )

{  930

@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”,  940

# 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 = "";  950

add or update user( $entry, $passwd, @secondary groups ); } close PASSWD INFO; dbmclose %passwd dbm hash;

# Probably unnessary, but C programmers are cautious that way: $ℓdap vtc−>unbind;

}

sub useradd($$$$@)  960

{ my ( $uid, $cn, $maiℓ, $passwd, @secondary groups ) = @ ; usage() unless $uid; $cn = $uid unless $cn; $maiℓ = "(unknown)" unless $maiℓ; bind as admin to local server();

create basic groups(); add or update user( $uid, $cn, $maiℓ, $passwd, @secondary groups );

}  970

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 )  980

   or die "Cannot open password database: $!";

while ( <> ) {

chomp;

if ( /^\s∗Course :\s(\d+)\s/ )

{ $course = $1; undef $year;

next;  990

}

elsif ( m!^\s∗Course :\s(\d+)/(\d)\s! )

{ $course = $1; $year = $2; next;

} if (

my ( $name, $gender, $student id, $hk id )

= m{  1000

\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 1010

([a−zA−Z]\d{6}\([\dA−Z]\)) # HK ID }x )

{ # my $mail = “$student id\@stu.vtc.edu.hk”;

my $maiℓ = "(unknown)";

my $passwd = $hk id; my @secondary groups = ( "students", $course ); push @secondary groups, "year" . $year if $year;

1020

add or update user( $student id, $name, $maiℓ, $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;  1030

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"  1040

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

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

)  1060

\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”;  1070

         my $maiℓ = "(unknown)";

my $passwd = $hk id;

my @secondary groups = ( "students", $course ); push @secondary groups, "year" . $year if $year;

add or update user( $student id, $name, $maiℓ, $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;  1080

next; }

      warn "POSSIBLE UNMATCHED STUDENT: $_\n" if m!^\s∗\d+\s+!;

}

close PASSWD INFO;

dbmclose %passwd dbm hash; }

sub usage()

{  1090

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  1100

−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.  1110

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

exit 0; }

sub main  main

{ # Getopt::Long::Configure( “bundling” );

GetOptions( "useradd!" => \$useradd,  1120

"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" => \$emaiℓ address, 1130

"g=s" => \@other groups, "p=s" => \$passwd, # “invent-passwords!” => \$gen new password, "o!" => \$oracℓe part time text files, "g!" => \$grs part time text files, "oracle-part-time!" => \$oracℓe part time text files, "grs-part-time!" => \$grs part time text files,

) or usage();

usage() unless $useradd or $import students from vtc ldap  1140

or $import staff from vtc ldap

or $oracℓe 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 );  1150

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

$emaiℓ address, $passwd, @other groups );

}  1160

elsif ( $oracℓe 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

{  1170

usage(); } $ℓdap ict−>unbind

}

main();