#! /usr/bin/perl

# setup-ldap1.pl
# Create a playground for students to create their own directories.

# My plan to allow the students access to their own directory:

# o Create a top level ldap object o=ICT on ldapl
# o Below this, create ldap objects ou=student_number,o=ICT for each
#   student (create this using a shell script or perl program)
# o Create second level object ou=sys,o=ICT
# o Create third level objects ou=People,ou=sys,o=ICT and
#   ou=Group,ou=sys,o=ICT
# o Replicate the account information for the students under
#   ou=People,ou=sys,o=ICT and ou=Group,ou=sys,o=ICT,
#   adjusting the DNs appropriately, and only replicating the
#   posixAccount, shadowAccount, person and posixGroup information

# All the above will be done by this one Perl program.

# Another simple script will do the following:

# o Edit /etc/openldap/slapd.conf granting access to the user
#   uid=student_number,ou=People,ou=sys,o=ICT to have write access
#   to the subtree ou=student_number,o=ICT

# Finally:

# o Write a simple perl program that will search for the userPassword
#   attributes of the students on ldap.tyict.vtc.edu.hk, using start_tls
#   to encrypt the network communication, and copy these attributes to
#   the appropriate account on ldap1.
# o Run this every night on ldap1 to synchronise passwords every night.

# Copyright (C) 2004  Nick Urbanik <nicku(at)vtc.edu.hk>
 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use warnings;
use strict;

use Carp qw( croak confess verbose );
use Net::LDAP qw/ LDAP_NO_SUCH_OBJECT /;

# We die if we dont get at least this number of users from our directory
# ldap.tyict.vtc.edu.hk:
use constant MIN_NUM_USERS => 60;
use constant ICT_SUFFIX => 'dc=tyict,dc=vtc,dc=edu,dc=hk';
use constant ICT_USER_BASE => 'ou=People,dc=tyict,dc=vtc,dc=edu,dc=hk';
use constant ICT_GROUP_BASE => 'ou=Group,dc=tyict,dc=vtc,dc=edu,dc=hk';
use constant ICT_USER_FILTER => '(|(uid=nicku)(uid=albertho)(&(year=3)(course=41300)))';
use constant NEW_TOP_LEVEL_O_NAME => 'ICT';
use constant NEW_SUFFIX => 'o=ICT';
use constant NEW_SYS_SUFFIX => 'ou=sys,o=ICT';
use constant SKEL_DIR => '/etc/skel';
use constant DEBUG => 1;

# Error reporting.
# Could use confess instead of croak
sub die_on_error {
    my ( $mesg, $extra_info ) = @_;
    if ( $extra_info ) {
        $extra_info .= ': ' unless index( $extra_info, ':' ) > -1;
    } else {
        $extra_info = "";
    }
    confess $extra_info, '[', $mesg->code, ']', $mesg->error if $mesg->code;
}

# Given an LDAP object and a DN or Entry object ,
# returns true if entry exists, false otherwise.
# Assumes have bound with permission to search for the entry.
sub does_entry_exist($$) {
    my ( $ldap, $dn ) = @_;
    my $mesg = $ldap->search(
                             base => $dn,
                             scope => 'base',
                             filter => '(objectClass=*)',
                             attr => [ 'dn' ],
                            );
    return if $mesg->code == LDAP_NO_SUCH_OBJECT;
    die_on_error $mesg;
    return $mesg->count;
}

# Blindly create an entry in the directory:
# Assumes have bound with permission to create an entry.
sub create_entry($$) {
    my ( $ldap, $entry ) = @_;
    croak "not an entry" unless $entry->isa( 'Net::LDAP::Entry' );
    my $mesg = $entry->update( $ldap );
    die_on_error $mesg, "create_entry";
}

# Check if entry exists in directory before trying to create it:
# Assumes have bound with permission to create an entry.
sub create_entry_if_not_exist($$) {
    my ( $ldap, $entry ) = @_;
    croak "not an entry" unless $entry->isa( 'Net::LDAP::Entry' );
    create_entry $ldap, $entry unless does_entry_exist $ldap, $entry;
}


# Create an organisation entry with o=$orgname as the RDN.
# $parent_dn is the DN of the parent entry.
sub make_organisation_entry($$) {
    my ( $orgname, $parent_dn ) = @_;
    my $entry = Net::LDAP::Entry->new;
    my $dn = "o=$orgname";
    $dn .= ",$parent_dn" if $parent_dn;
    $entry->dn( $dn );
    $entry->add(
                objectClass => 'organization',
                o => $orgname,
               );
    croak "not an entry" unless $entry->isa( 'Net::LDAP::Entry' );
    return $entry;
}

# Create an organisationalUnit entry with ou=$ou_name as the RDN.
# $parent_dn is the DN of the parent entry.
sub make_organisational_unit_entry($$) {
    my ( $ou_name, $parent_dn ) = @_;
    my $entry = Net::LDAP::Entry->new;
    my $dn = "ou=$ou_name";
    $dn .= ",$parent_dn" if $parent_dn;
    $entry->dn( $dn );
    $entry->add(
                objectClass => 'organizationalUnit',
                ou => $ou_name,
               );
    croak "not an entry" unless $entry->isa( 'Net::LDAP::Entry' );
    return $entry;
}

# This does not attempt to be general.
# IT IS HARDCODED to use o=ICT.
sub gen_top_level_entry() {
    return make_organisation_entry NEW_TOP_LEVEL_O_NAME, '';
}

# Assumes have bound with permission to create an entry.
sub create_top_level_entry($) {
    my ( $ldap ) = @_;
    create_entry_if_not_exist $ldap, gen_top_level_entry;
}

# Assumes have bound to ldap.tyict.vtc.edu.hk with permission
# to read all attributes of each user entry.
# ASSUME have bound to ldap.tyict.vtc.edu.hk, NOT the local machine.
# This can NOT be done anonymously.
# Returns a Net::LDAP::Search object.
# Aim to limit the attributes (not create the zillions on ictlab)
sub get_user_accounts_from_ictlab($$$) {
    my ( $ict_ldap, $ict_user_search_filter, $ict_people_base ) = @_;
    my $search = $ict_ldap->search(
                                   base => $ict_people_base,
                                   scope => 'one',
                                   filter => $ict_user_search_filter,
                                   attrs => [
                                             qw(
                           uid userPassword cn sn homeDirectory
                           gidNumber uidNumber gecos loginShell objectClass
                                               ),
                                            ],
                                  );
    die_on_error $search;
    die "only found ", $search->count, " users"
        if $search->count < MIN_NUM_USERS;
    return $search;
}

# return a reference to a list of OU names.
# Purpose: to generate about 80 ou=student_id,o=ICT OU entries,
# below which students will create their own directories.
sub get_list_of_ous($) {
    my $search = shift;
    my @list_of_ous;
    foreach my $entry ( $search->all_entries ) {
        croak "not an entry" unless $entry->isa( 'Net::LDAP::Entry' );
        push @list_of_ous, $entry->get_value( 'uid' );
    }
    return [ @list_of_ous ];
}

# Assumes have bound to ldap.tyict.vtc.edu.hk with permission
# to read all attributes of each user entry.
# ASSUME have bound to ldap.tyict.vtc.edu.hk, NOT the local machine.
# This can NOT be done anonymously.
# Returns a reference to an array of entries, NOT a search object.
sub get_group_entries_from_ictlab($\@$) {
    my ( $ict_ldap, $list_of_group_names, $ict_group_base ) = @_;
    my @group_entries;
    foreach my $cn ( @$list_of_group_names ) {
        my $search = $ict_ldap->search(
                                       base => "cn=$cn,$ict_group_base",
                                       scope => 'base',
                                       filter => '(objectClass=*)',
				       attrs => [
						qw( cn gidNumber objectClass )
					       ],
                                      );
        die_on_error $search;
        croak "did not find 1 entry, found ", $search->count
            if $search->count != 1;
        push @group_entries, $search->pop_entry;
    }
    print "found ", scalar @group_entries, " groups\n" if DEBUG;
    return [ @group_entries ];
}

# Assumes have bound with permission to create an entry.
# Assumes the top level entry has already been created.
# The second parameter is a reference to an array of strings which are
# the names of OUs to be created.
sub create_all_ou_entries($\@) {
    my ( $ldap, $list_of_ous ) = @_;
    create_entry_if_not_exist $ldap,
        make_organisational_unit_entry 'sys', NEW_SUFFIX;
    foreach my $ou ( 'People', 'Group' ) {
        create_entry_if_not_exist $ldap,
            make_organisational_unit_entry $ou, NEW_SYS_SUFFIX;
    }
    foreach my $ou ( @$list_of_ous ) {
	print "looped: ou=$ou\n" if DEBUG > 1;
        create_entry_if_not_exist $ldap,
            make_organisational_unit_entry $ou, NEW_SUFFIX;
    }
}

# If $sourcefile is /etc/skel/.kde/Autostart/Autorun.desktop,
# and $sourcedir is /etc/skel,
# and $destdir is /home/user,
# then this function returns /home/user/.kde/Autostart/Autorun.desktop
# Does no fancy removal of excess slashes or removing unecessy '..'
# Does not handle relative filenames.
# It's pretty stupid, and just designed for coping skel files
# to home directories, where source and destdir are well defined and regular.

sub calc_destname($$$) {
    my ( $sourcefile, $sourcedir, $destdir ) = @_;
    my $destfile = $sourcefile;
    $destfile =~ s/^$sourcedir/$destdir/;
    return $destfile;
}

use File::Find ();
use File::Copy;

# Note: $owner and $group are numeric IDs.
# Not tested with symbolic links.
sub copyfile_no_overwrite($$$$$) {
    my ( $source_file, $source_dir, $dest_dir, $owner, $group ) = @_;
    # die "$dest_dir does not exist\n" unless -d $dest_dir;
    my $destination_file = calc_destname $source_file, $source_dir, $dest_dir;
    if ( -e $destination_file ) {
        print "$destination_file exists\n" if DEBUG;
    } elsif ( -d $source_file and not -e $destination_file ) {
        # See perldoc -f stat:
        my $mode = ( stat( $source_file ) )[ 2 ] & 07777;
        mkdir $destination_file, $mode
            or die "unable to mkdir $destination_file: $!";
        print "Made directory $destination_file with mode $mode\n" if DEBUG;
    } else {
        copy $source_file, $destination_file
            or die "Unable to copy $source_file, $destination_file: ";
        print "Copied $source_file, $destination_file\n" if DEBUG;
    }
    chown $owner, $group, $destination_file
        or warn "unable to change ownership of $destination_file to ",
            "$owner, $group\n";
    print "Changed ownership of $destination_file to $owner, $group\n"
        if DEBUG;
}

our ( $source_dir, $dest_dir, $owner, $group );
sub wanted {
    #doexec(0, 'cp','-a','{}','destdir');
    copyfile_no_overwrite $File::Find::name, $source_dir, $dest_dir,
        $owner, $group;
}

# Note: the parameters initialise the global variables above!
sub copy_directory_no_overwrite($$$$) {
    ( $source_dir, $dest_dir, $owner, $group ) = @_;
    File::Find::find( \&wanted, $source_dir );
}

sub update_home_dir($$$) {
    my ( $home_dir, $uid_num, $gid_num ) = @_;
    mkdir $home_dir, 0700 unless -d $home_dir;
    copy_directory_no_overwrite SKEL_DIR, $home_dir, $uid_num, $gid_num;
}

# Assumes have bound with permission to create entries.
# Does not need to be bound to ictlab.
# $search_for_users is the Net::LDAP::Search object returned from a search
# for users on ictlab.
# $groups is a reference to an array of Group entry objects
# $ictlab_suffix is the old suffix of ictlab entries:
#                         dc=tyict,dc=vtc,dc=edu,dc=hk
# $new_suffix is what should be its replacement on this server: ou=sys,o=ICT
# This is the parent of the ou=People and the ou=Group entries
# below which all user accounts for authenticating to this system are placed.
# Oh, feature creep: we also make the home directories if they don't exist.
sub copy_user_and_group_entries_from_ictlab($$\@$$) {
    my ( $ldap, $search_for_users, $groups, $ictlab_suffix, $new_suffix ) = @_;
    foreach my $entry ( $search_for_users->all_entries, @$groups ) {
        croak "not an entry" unless $entry->isa( 'Net::LDAP::Entry' );
        my $dn = $entry->dn;
        $dn =~ s/$ictlab_suffix$/$new_suffix/io;
        $entry->dn( $dn );
        if ( $dn =~ /ou=People/ ) {
            $entry->replace(
             objectClass => [ qw( posixAccount shadowAccount inetOrgPerson ) ]
                           );
            # A special case for Albert, since his home on ictlab is in /home2:
            $entry->replace(
                            homeDirectory => [ qw( /home/albertho ) ]
                           ) if $dn =~ /uid=albertho/;
            my $home_dir = $entry->get_value( 'homeDirectory' );
            my $uid_num  = $entry->get_value( 'uidNumber' );
            my $gid_num  = $entry->get_value( 'gidNumber' );
            update_home_dir $home_dir, $uid_num, $gid_num;
        }
	$entry->replace(
			objectClass => [ qw( posixGroup ) ]
		       ) if $dn =~ /ou=Group/;
	$entry->dump if DEBUG;
	$entry->changetype( 'add' );
	unless ( does_entry_exist $ldap, $dn ) {
	    print "Adding entry $dn:\n" if DEBUG;
	    my $mesg = $entry->update( $ldap );
	    die_on_error $mesg;
	}
    }
}

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

# parameter is the $ldap object
sub bind_as_admin_to_local_server($) {
    bind_not_anonymous
        "/root/ldapaccounts/ldap-admin-password",
            "cn=admin," . NEW_SUFFIX,
                shift;
}

# parameter is the $ldap object
sub bind_as_admin_to_ict_server($) {
    bind_not_anonymous
        "/root/ldapaccounts/ldap-ict-admin-password",
            "cn=admin," . ICT_SUFFIX,
                shift;
}

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

sub main() {
    my $ldap = new Net::LDAP( 'ldap.tyict.vtc.edu.hk', onerror => 'die' )
	or die "$@";
    my $mesg = $ldap->start_tls;
    die_on_error $mesg;
    bind_as_admin_to_ict_server $ldap;
    my $search = get_user_accounts_from_ictlab $ldap,
        ICT_USER_FILTER, ICT_USER_BASE;
    my $list_of_uids = get_list_of_ous $search;
    my $group_list = get_group_entries_from_ictlab $ldap,
        @$list_of_uids, ICT_GROUP_BASE;
    $ldap->unbind;

    $ldap = new Net::LDAP( 'ldap1.tyict.vtc.edu.hk' ) or die "$@";
    $mesg = $ldap->start_tls;
    die_on_error $mesg;
    bind_as_admin_to_local_server $ldap;
    create_top_level_entry $ldap;
    create_all_ou_entries $ldap, @$list_of_uids;
    copy_user_and_group_entries_from_ictlab $ldap, $search,
        @$group_list, ICT_SUFFIX, NEW_SYS_SUFFIX;
    return 1;
}

main;