#! /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 /; # 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():  110

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

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

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

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 $ℓdif output = 0; our $import students from vtc ldap = 0; our $import staff from vtc ldap = 0;

our $oracℓe part time text files = 0;  140

our $grs part time text files = 0; our $uid to add; our $users full name; our $emaiℓ address; our @other groups; our $passwd;

our $ℓdif output file = "/home/nicku/ldap-dumps/ldif-dump-" . time() . ".ldif";

use constant GROUP DEBUG => 3;

150

# 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

die "Failed to bind: ", $mesg−>code(), "\n" if $mesg−>code(); our $ℓdif = Net::LDAP::LDIF −>new( $ℓdif output file, "w", onerror => 'undef' );

our ( %group byname, %group bynumber );

# %group byname is a simple hash of gidNumbers indexed by gid.  160

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

170

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

}

# 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 $pℓain passwd = shift;

my @sub = (); my $word = '';

my $wordℓen = 8; # desired length of the password 190

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

# 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++)  200
{

do {

$sub[$i] = substr ($dict[int (rand @dict)], 0, $subℓen); } until (length $sub[$i] == $subℓen); $word .= $sub[$i];

}

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

$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"‘;

chomp $md5 hash;

return ( $word, $md5 hash ); }

# Avoid trying to generate GID numbers above nfsnobody:

sub max below GID MAX (@)  220

{ 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()  230

{

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

}  240

# 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($)

{  250

my $cn = shift; $cn =∼ s/−/ /g unless $cn =∼ /ty−cms/i; 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  260

# = 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;  270

if ( $has kwailo name sn last ) {

$sn = pop @names; } else {

$sn = shift @names; } if ( $has kwailo name )

{  280

$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 )  290

{ # Assume that the last name is a western name. $sn = shift @names; $sn = ucfirst lc $sn; my $kwaiℓo name = ucfirst lc pop @names; @names = case convert names @names; if ( $has kwailo name sn first ) {

$givenName = join ' ', ( @names, $kwaiℓo name );

}  300

else {

$givenName = ( ucfirst lc join '-', @names ) . ", $kwailo_name"; }

$cn = "$sn $givenName";

} elsif ( @names == 1 ) {

if ( grep /ootc|ty−|tycmlab|tyicp|ict|esec/i, @names )

{  310

$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  320

{ $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  330

# Add the objectclass groupOfUniqueNames to them. # But this won’t work, since # object class ’groupOfUniqueNames’ requires attribute ’uniqueMember’ sub ensure all groups are groupOfUniqueNames() {

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

my $group search

= $ℓdap ict−>search( base => $baseDN,

scope => "one",  340

                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(),  350

" group entries in ICT server.\n";

foreach my $entry ( $group search−>all entries ) {

my $dn = $entry−>dn(); $entry−>add( objectClass => 'groupOfUniqueNames' ); my ( $resuℓt, $error, $error msg ); if ( $ℓdif output ) {

$ℓdif−>write entry( $entry );  360

$error = $error msg = $ℓdif−>error; } else {

$resuℓt = $entry−>update( $ℓdap ict );

$error = $resuℓt−>code; $error msg = $resuℓt−>error;

} if ( $error )

{  370

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

{ 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 dn and uid to group($$$)

{  390

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

   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:  410

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

return; } my $resuℓt = $ℓdap ict−>modify(

$dn,

add => { memberUid => $uid, uniquemember => $userDN,

                             objectClass => 'groupOfUniqueNames',

}

);  430

if ( $resuℓt−>code ) {

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

} else {

push @{ $group bynumber{$group byname{$gid}}{'members'} }, $uid; push @{ $group bynumber{$group byname{$gid}}{'dnlist'} }, $userDN;

   print "Successfully added $uid to group name $gid\n" if $debug;

}  440

}

use Carp;

# Assume have already bound to server as admin. sub create group($$$$) {

my ( $cn, $gidNumber, $memberℓist, $dnℓist ) = @ ; if ( ! defined $cn or ! defined $gidNumber )

{  450

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

return 0; }

if ( exists $group bynumber{$gidNumber} )  460

{

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

$entry−>add(

         objectClass => [ "top", 'posixGroup' ],

userPassword => '{crypt}x', gidNumber => $gidNumber, );

$entry−>add( memberUid => $memberℓist ) if $memberℓist; $entry−>add( uniquemember => $dnℓist,

objectClass => "groupOfUniqueNames" ) if $dnℓist;

$entry−>changetype( 'add' ); my ( $resuℓt, $error, $error msg ); if ( $ℓdif output ) {

$ℓdif−>write entry( $entry );

$error = $error msg = $ℓdif−>error; } else {

$resuℓt = $entry−>update( $ℓdap ict );

$error = $resuℓt−>code;  490

$error msg = $resuℓt−>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;

}  500

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'} = $memberℓist if $memberℓist; $group bynumber{$gidNumber}{'dnlist'} = $dnℓist if $dnℓist; return 1;

}

510

# sub create basic groups() # { # foreach my $group ( ( ’students’, ’year1’, ’year2’, ’year3’ ) ) # { # create group( $group, get next gid number() ); # } # }

sub delete group($)

{  520

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

{  530

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

sub 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)",

);

warn "Cannot search for all ICT $uid\'s auto.home entry "  550

. "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;  560

if ( $entry−>get value( 'automountInformation' ) ne $wanted automount ) {

$entry−>replace( 'automountInformation' => $wanted automount ); my ( $resuℓt, $error, $error msg ); if ( $ℓdif output ) {

$ℓdif−>write entry( $entry );

$error = $error msg = $ℓdif−>error; }

else  570
{

$resuℓt = $entry−>update( $ℓdap ict ); $error = $resuℓt−>code; $error msg = $resuℓt−>error;

}

if ( $error )

{

warn

        "PROBLEM: failed to update auto.home for $uid: $error_msg\n";

}  580

else {

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

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

} } else {

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

}  590

} elsif ( $autohome search−>count() == 0 ) {

# Create and add a new auto.home entry: my $entry = Net::LDAP::Entry−>new;

my $dn = "uid=$uid,$basedn";

$entry−>dn( $dn ); $entry−>add(

objectClass => [ "top", 'automount' ],

cn => $uid,  600

automountInformation => $wanted automount,

);

$entry−>changetype( 'add' ); my ( $resuℓt, $error, $error msg ); if ( $ℓdif output ) {

$resuℓt = $ℓdif−>write entry( $entry ); $error = $error msg = $ℓdif−>error;

}

else  610

{ $resuℓt = $entry−>update( $ℓdap ict ); $error = $resuℓt−>code; $error msg = $resuℓt−>error;

} if ( $resuℓt−>code ) {

   warn "PROBLEM: failed to add new auto.home for $uid: $error_msg\n";

}

else  620

{

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

} } else {

   warn "PROBLEM: more than one auto.home entry for $uid!!\n";

} }

630

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. sub create home directory($$) {

my ( $uid, $uidNumber ) = @ ;

my $home = "$home_dir_base/$uid";

( mkdir( $home, 0711 )  640

  or warn "cannot make $home: $!" )

unless −d $home;

my $copy error = 0; foreach my $fiℓe ( split /\s+/, ‘echo /etc/skel/.[^.]∗‘ ) {

   next if $fiℓe eq "/etc/skel/.kde";

# Kinder to only copy these files if they don’t exist:

my $fiℓe basename = basename( "$file" );

   unless ( −f "$home/$file_basename" )  650

{

      print "Copying '$file' to $home...\n"

if $debug; copy( $fiℓe, "$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;  660

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

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 = $ℓdap ict−>search( base => $basedn,

scope => "one",  680

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

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

print ",\tmembers="

. join( ", ", @members ) if @members; print "\n"; $group byname{$group name} = $group number; $group bynumber{$group number}{'gid'} = $group name; $group bynumber{$group number}{'members'} = [ @members ]; $group bynumber{$group number}{'dnlist'} = [ @dns ];

} }

710

sub read 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' ],

);  720

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

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

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

# 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 ( $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.  760

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

} 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($$$)

{  780

my ( $entry, $one ict student, $secondary groups ) = @ ; my $dn = $entry−>dn; my $uid = $entry−>get value( 'uid' ); my $changeType = $entry−>changetype; $entry−>changetype( 'modify' );

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

my ( $resuℓt, $error, $error msg ); if ( $ℓdif output )

{  790

$ℓdif−>write entry( $entry );

$error = $error msg = $ℓdif−>error; } else {

$resuℓt = $entry−>update( $ℓdap ict );

$error = $resuℓt−>code; $error msg = $resuℓt−>error;

}

800

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

} $entry−>dump() if $debug;

my $uidNumber

= $one ict student−>pop entry()−>get value( 'uidNumber' ); make groups and home directory( $dn, $uid, $uidNumber, $secondary groups ); }

# THIS WORKED, BUT IT IS UGLY. CODE ABOVE IS MORE BEAUTIFUL.

# sub update user  820

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

# # $e->changetype( ’modify’ ); # my $changeType = $e->changetype; # print “For $dn, changetype is $changeType\n”;

# my $result = $e->update( $ldap ict );

# if ( $result->code ) # { # warn “PROBLEM: failed to update $dn: ”, $result->error;

# print “Dump of update failure of $dn: ”, $result->error; 840

# $e->dump; # return; # } # else # { # print “successful update of $dn:\n”; # } # $e->dump() if $debug;

#  my $uidNumber = $e->get value( ’uidNumber’ );  850

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

# }

# $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 ); 870

# if ( $result->code ) # { # warn “PROBLEM: failed to update $dn: ”, $result->error; # return; # } # else # { # print “successful update of $dn:\n”; # }

#  $entry->dump() if $debug;  880

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

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 ( $pℓain text passwd, $md5 hash passwd ) = gen password( $passwd );  900

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 ( $resuℓt, $error, $error msg );  910

if ( $ℓdif output )

{ $ℓdif−>write entry( $entry ); $error = $error msg = $ℓdif−>error;

} else {

$resuℓt = $entry−>update( $ℓdap ict );

$error = $resuℓt−>code;

$error msg = $resuℓt−>error;  920

}

if ( $resuℓt−>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";  930

}

   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( $dn, $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.  940

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

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

# 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 = $ℓdap ict−>search(  970

                               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;

}  980

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

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

$entry−>dump;

add user( $entry, $passwd, $secondary groups ); } else {

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

} }

sub set default classes($$)  1010

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

objectClass => [

                            "top", "person",
                            "organizationalPerson",
                            "inetOrgPerson", "account",
                            "posixAccount",
                            "shadowAccount",

                            "kerberosSecurityObject",  1020

                            "sambaAccount",
                            "institute",

$student or staff,

],

);

}

sub add remaining default attributes($) {

my $entry = shift;  1030

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  1040

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

1050

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

my $mesg vtc = $ℓdap vtc−>bind( version => 3 ); # use for searches  1060

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 $aℓℓuser search = $ℓdap vtc−>search( base => $basedn, scope => "one",

# filter => “(|(department=CM)(department=ICT))”, 1070

                     filter => "(uid=*)",

);

warn "PROBLEM: Cannot search for all ICT members in VTC LDAP server: ",

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

print "Found ", $aℓℓuser search−>count(), " entries in VTC LDAP server.\n";

bind as admin to local server();

1080

# 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 ( $aℓℓuser search−>all entries() ) {

my ( $sn, $givenName );  1090

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

   | | "$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.  1100

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

acOwner => $e−>get value( 'acOwner' ),

acType => $acType,

instituteEmail => $instituteEmaiℓ,

department => $e−>get value( 'department' ),

site => $e−>get value( 'site' ) | | 'TY',

);

if ( ! $get staff ) {

$entry−>add(

course => $course,  1120

year => $year,

instituteEmail => $instituteEmaiℓ,

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

}  1130

# $e->dump() if $debug; # $entry->dump() if $debug; my $secondary groups;

if ( $get staff ) {

$secondary groups = [ "staff" ]; } else

{  1140

$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,  1150

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

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

}

sub fix groups() {

bind as admin to local server(); ensure all groups are groupOfUniqueNames();

}  1170

sub useradd($$$$$) {

my ( $uid, $cn, $maiℓ, $passwd, $secondary groups ) = @ ;

print "Sorry, not implemented properly yet.  ",
"Tell Nick if you need this.\n"; return;

usage() unless $uid; $cn = $uid unless $cn; $maiℓ = "(unknown)" unless $maiℓ;

bind as admin to local server();  1180

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

1190

print "Sorry, not implemented properly yet.  ",
"Tell Nick if you need this.\n"; return;

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

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

$course = $1; undef $year; next;

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

$course = $1;  1210

$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 1220

)

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

{  1230

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

#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, ",  1240

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

{ my $course; my $year;

print "Sorry, not implemented properly yet.  ",
"Tell Nick if you need this.\n"; return;

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

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

while ( <> ) {

chomp; if ( m!^(\d+)/(\d)\s! ) {

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

}  1270

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 1280

\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 $maiℓ = "(unknown)";

my $passwd = $hk id;  1290

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;

}  1300

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

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  1320

−−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  1330

USAGE

exit 0; }

sub main() {

# Getopt::Long::Configure( “bundling” ); GetOptions( "useradd!" => \$useradd,

"a!" => \$useradd,

"d:i" => \$debug, 1340

"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, "g=s" => \@other groups,

"p=s" => \$passwd, 1350

# “invent-passwords!” => \$gen new password,

"l!" => \$ℓdif output, "ldif-output!" => \$ℓdif output, "n!" => \$fix groups,

         "fix-groups!" => \$fix groups,

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

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

or $import staff from vtc ldap

or $oracℓe part time text files or $grs part time text files

or $fix groups;

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

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 )

{  1380

fix groups(); } elsif ( $useradd ) {

useradd( $uid to add, $users full name,

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

} elsif ( $oracℓe part time text files ) {

add part time students from oracle text files();  1390

} elsif ( $grs part time text files )

{

add part time students from grs text files(); } else {

usage(); }

$ℓdap ict−>unbind  1400

}

main();