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

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 add_posix_account($$\%$) {
    my ( $ldap, $id, $hash, $idNumber ) = @_;
    my $result = $ldap->add( "uid=$id," . USER_SUFFIX,
            attr => [
                     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{
                                          inetOrgPerson
                                          posixAccount
                                          shadowAccount
                                       }
                                    ],
                    ],
                           );
    warn "Entry for $id exists\n" and return
        if $result->code == LDAP_ALREADY_EXISTS;
    warn "Failed to add entry for $id: ", $result->error if $result->code;
}

sub add_posix_group($$$) {
    my ( $ldap, $id, $idNumber ) = @_;
    my $result = $ldap->add( "cn=$id," . GROUP_SUFFIX,
            attr => [
                     cn          => $id,
                     gidNumber   => $idNumber,
                     objectClass => 'posixGroup',
                    ],
                           );
    warn "Group for $id exists\n" and return
        if $result->code == LDAP_ALREADY_EXISTS;
    warn "Failed to add group for $id: ", $result->error if $result->code;
}

sub main() {
    my $students = read_srs_data;
    # show %$d;
    my $ldap = Net::LDAP->new( LDAP_SERVER );
    my $mesg = $ldap->start_tls;
    die $mesg->error if $mesg->code;
    bind_as_admin $ldap, ADMIN_DN;
    my $idNumber = 1999;
    while ( my ( $id, $hash ) = each %$students ) {
        add_posix_account $ldap, $id, %$hash, ++$idNumber;
        add_posix_group   $ldap, $id,           $idNumber;
    }
    $mesg = $ldap->unbind;
    die $mesg->error if $mesg->code;
}

main