#! /usr/bin/perl # Copyright (C) 2004 Nick Urbanik # 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 <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