#! /usr/bin/perl

# gen-acls.pl
# Write to standard output a list of ACLs (access control lists) for the
# students to manage their own accounts.

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

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 FILTER => '(uid=*)';
use constant WRITEATTR => 'loginShell,description,telephoneNumber,seeAlso,l,photo,jpegPhoto,preferredLanguage,displayName,mail';
use constant DEBUG => 1;
use constant NON_ROOT_DN => 'cn=admin,ou=sys,o=ICT';

# 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;
}
sub get_list_of_admins($$) {
    my ( $ldap, $filter ) = @_;
    my $mesg = $ldap->search( 
                             base => "ou=People," . NEW_SYS_SUFFIX,
                             scope => 'one',
                             filter => $filter,
                             attrs  => [ 'uid' ],
                            );
    die_on_error $mesg;
    return $mesg;
}

sub print_acls($$$) {
    my ( $search, $admindn, $writeattrs ) = @_;
    print <<FIRST;
access to dn.children="ou=sys,o=ICT" attr=userPassword
        by self write
        by dn="$admindn" write
        by * auth
access to dn.children="ou=People,ou=sys,o=ICT" attrs=$writeattrs
        by self write
        by dn="$admindn" write
        by * read
access to dn.subtree="ou=sys,o=ICT"
        by dn="$admindn" write
        by * read

FIRST
    foreach my $e ( $search->all_entries ) {
        my $dn = $e->dn;
        my $uid = $e->get_value( 'uid' );
        die "Bad $dn and or $uid" unless $dn and $uid;
        print <<END;
access to dn.children="ou=$uid,o=ICT" attr=userPassword
\tby self write
\tby dn="$admindn" write
\tby dn="$dn" write
\tby * auth
access to dn.subtree="ou=$uid,o=ICT"
\tby dn="$admindn" write
\tby dn="$dn" write
\tby * read

END
    }
    print <<LAST;
access to *
\tby dn="$admindn" write
\tby * read
LAST
}

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

my $ldap = new Net::LDAP( 'ldap1.tyict.vtc.edu.hk' ) or die "$@";
my $mesg = $ldap->start_tls;
die_on_error $mesg;
bind_as_admin_to_local_server $ldap;
my $search = get_list_of_admins $ldap, FILTER;
print_acls $search, NON_ROOT_DN, WRITEATTR;
die_on_error $mesg;
$ldap->unbind;