#! /usr/bin/perl

# 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 Net::LDAP qw( LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT );
use Net::LDAP::LDIF;

use constant LDAP_SERVER  => 'ldap1.tyict.vtc.edu.hk';
use constant ADMIN_DN     => 'uid=nicku,ou=People,ou=sys,o=ICT';
use constant USER_SUFFIX  => 'ou=People,ou=nicku,o=ICT';
use constant GROUP_SUFFIX => 'ou=Group,ou=nicku,o=ICT';

sub show(\%) {
    my ( $d ) = @_;
    foreach my $id ( sort keys %$d ) {
        printf "%-10s %-8s %-10s %s\n", $id, $d->{$id}{PASSWD},
            $d->{$id}{SN}, $d->{$id}{CN};
    }
}

sub make_record($$$) {
    my ( $hkid, $family, $given ) = @_;
    warn "Bad record HKID: '$hkid', family: '$family', given: '$given'\n"
        unless $hkid and $family and $given;
    return {
            HKID => $hkid,
            SN => $family,
            GIVEN => $given,
            PASSWD => lc( substr( $hkid, 0, 7 ) ),
            CN => "$family $given",
           };
}

sub read_srs_data() {
    my %data;
    while ( <> ) {
        if ( m/
                  \s+             # must be space before
                  (\d{9})         # Student ID, captured as $1
                  \s+             # must be space after
                  (               # start capturing HKID in $2
                      [A-Z]\d{6}  # letter, 6 digits
                      \(          # literal opening parenthesis
                      [0-9A]      # check digit
                      \)          # literal closing parenthesis
                  )
                  \s+
                  [MF]            # gender
                  \s+
                  (               # Capture family name in $3
                      [A-Za-z]+
                  )
                  [\s,]{1,2}      # I messed up data: only , separates names
                  (               # capture remaining names in $4
                      [\S]+,?     # some names have parentheses and...
                      (?:\s[\S]+)*
                  )
                  \s\s            # Names end in at least two spaces
              /x
           ) {
            my ( $user_id, $hkid, $family, $given ) = ( $1, $2, $3, $4 );
            $data{$user_id} = make_record $hkid, $family, $given;
        } elsif ( /\s[A-Za-z]\d{6}\([0-9Aa]\)\s/ ) {
            warn "Unprocessed student: $_"
        }
    }
    return \%data;
}

use Crypt::PasswdMD5;
sub ldap_password_hash($) {
    my $plain_text = shift;
    my $hashed_password = unix_md5_crypt $plain_text;
    return '{crypt}' . $hashed_password;
}

use Term::ReadKey;
# See Recipe 15.10 in Perl Cookbook, 1st edition, page 529
sub read_password() {
    print STDERR "Password: ";
    ReadMode 'noecho';
    my $passwd = ReadLine 0;
    ReadMode 'restore';
    print STDERR "\n";
    chomp $passwd;
    return $passwd;
}

sub bind_as_admin($$) {
    my ( $ldap, $binddn ) = @_;
    my $pw = read_password;
    my $mesg = $ldap->bind( $binddn, 'password' => $pw );
    die "Bad Password\n" if $mesg->code;
}

sub make_posix_entry($\%$) {
    my ( $id, $hash, $idNumber ) = @_;
    my $entry = Net::LDAP::Entry->new;
    $entry->dn( "uid=$id," . USER_SUFFIX );
    $entry->add(
                cn          => $hash->{CN},
                sn          => $hash->{SN},
                givenName   => $hash->{GIVEN},
                uid         => $id,
                uidNumber   => $idNumber,
                gidNumber   => $idNumber,
                homeDirectory => "/home/$id",
                loginShell  => '/bin/bash',
                userPassword  => ldap_password_hash( $hash->{PASSWD} ),
                objectClass => [ qw{posixAccount shadowAccount inetOrgPerson} ],
               );
    return $entry;
}

sub make_posix_group($$) {
    my ( $id, $idNumber ) = @_;
    my $entry = Net::LDAP::Entry->new;
    $entry->dn( "cn=$id," . GROUP_SUFFIX );
    $entry->add(
                cn          => $id,
                gidNumber   => $idNumber,
                objectClass => 'posixGroup',
               );
    return $entry;
}

# assume have bound beforehand unless $ldif is defined.
sub add_entry($$$) {
    my ( $ldap, $ldif, $entry ) = @_;
    if ( $ldif ) {
        $ldif->write_entry( $entry );
        die $ldif->error if $ldif->error;
    } else {
        my $mesg = $entry->update( $ldap );
        warn $entry->dn, " exists\n" and return
            if $mesg->code == LDAP_ALREADY_EXISTS;
        die "Failed to add ", $entry->dn, ": ",
            $mesg->error if $mesg->code;
    }
    return 1;
}

# assume have bound beforehand unless $ldif is defined.
sub delete_entry($$$) {
    my ( $ldap, $ldif, $entry ) = @_;
    if ( $ldif ) {
        $entry->changetype( 'delete' );
        $ldif->write_entry( $entry );
        die $ldif->error if $ldif->error;
    } else {
        my $mesg = $ldap->delete( $entry );
        warn $entry->dn, " does not exist\n" and return
            if $mesg->code == LDAP_NO_SUCH_OBJECT;
        die_on_error $mesg;
    }
    return 1;
}

use Getopt::Long;
sub main() {
    my ( $ldap, $ldif, $del );
    my $host = LDAP_SERVER;
    GetOptions( ldif => \$ldif, del => \$del, 'server=s' => \$host )
        or die <<USAGE;
Usage: $0 [OPTIONS]
OPTIONS:
--ldif\tWrite LDIF to standard output instead of to directory
--del\tDelete accounts instead of creating them.
USAGE
    my $students = read_srs_data;
    unless ( $ldif ) {
        $ldap = Net::LDAP->new( $host );
        my $mesg = $ldap->start_tls;
        die $mesg->error if $mesg->code;
        bind_as_admin $ldap, ADMIN_DN;
    }
    my $idNumber = 2000;
    $ldif = Net::LDAP::LDIF->new( \*STDOUT, 'w', change => $del )
        or die $! if $ldif;

    while ( my ( $id, $hash ) = each %$students ) {
        my $entry  = make_posix_entry $id, %$hash, $idNumber;
        my $gentry = make_posix_group $id,         $idNumber;
        if ( $del ) {
            delete_entry $ldap, $ldif, $entry;
            delete_entry $ldap, $ldif, $gentry;
        } else {
            my $ok = add_entry $ldap, $ldif, $entry;
            ++$idNumber if add_entry $ldap, $ldif, $gentry or $ok;
        }
    }

    unless ( $ldif ) {
        my $mesg = $ldap->unbind;
        die $mesg->error if $mesg->code;
    }
}

main