#!/usr/bin/perl

#######################################################################
# Migration from MySQL to LDAP.                                       #
#######################################################################

# This file depends on the LDAP version of Fripost::Schema.
# (git checkout ldap)
#
# It reads LDAP's configuration from `./ldap.yml', and the MySQL
# configuration from `./dbh.yml'. (The MySQL configuration is the old
# configuration (default.yml) that was read by the vanilla fripost-tools
# (from the master branch).
#
# Set the flag `--pretend' to only simulate the migration.
# REMARK: The migration has not been tested yet!
#
# The changes and warnings are dumped both into the standard error, and
# into a log file "fripost-migration-$$.log", where "$$" is the current
# PID.
#
# REMARK: the columns `create_date' and `change_date' are ignored
# (reseted, actually), since the corresponding LDAP attributes are set
# by the server and there is no way for the client to force their value.
# 
# Some other columns may be ignored during the migration (e.g.,
# `domain.description' if it does not have the right form), but the
# program is supposed to say so.
#
# REMARK: The columns `alias.domain', and `mailbox.domain' are not in
# the LDAP schema.

use 5.010_000;
use strict;
use warnings;
use utf8;

use FindBin qw($Bin);
use lib "$Bin/lib";

use Fripost::Schema;
use DBI;
use Getopt::Long;
use YAML::Syck;

my $pretend = 0;
GetOptions( 'pretend' => \$pretend );


# Connect to the LDAP server
my $ldapconf = LoadFile ( 'ldap.yml' );
my $ldap = Fripost::Schema->new( $ldapconf );


# Connection to the MySQL sever
my $dbhconf = LoadFile ( 'dbh.yml' );
my $dbh = DBI->connect( $dbhconf->{dbi_dsn}, $dbhconf->{admuser}, $dbhconf->{admpass} );
$dbh->do( "SET NAMES UTF8" ) or die "Error: Can't set names to UTF-8.\n";

# Log the inserts and errors.
open LOG, '>', "fripost-migration-$$.log" or die $!;


# Migrate domains
{
    my $rs = $dbh->selectall_hashref( "SELECT * FROM domain", 'domain' )
        or die "Can't select: $!\n";
    foreach my $domainname (keys %$rs) {
        my $domain = $rs->{$domainname};
        if ($ldap->domain->search({ domain => $domainname })->count) {
            &mesg ("WARN: Skipping domain `$domainname': Already exists.\n");
            next;
        }
        my $mesg = "Inserting domain `$domainname'";
        if (defined $domain->{description} and $domain->{description} ne '') {
            my $owner = $domain->{description};
            if ($ldap->user->search({ domain => (split/\@/, $owner, 2)[1] })->count
                && $ldap->user->search({ username => $owner })->count) {
                $mesg .= " (for owner `$owner')"
            }
            else {
                &mesg ("WARN: Skipping ownership of `$domainname': Unknown owner `$owner'.\n");
                delete $domain->{description};
            }
        }
        else {
            delete $domain->{description} if exists $domain->{description};
        }
        &mesg ($mesg ."... ");
        $ldap->domain->add({ domain   => $domainname
                           , owner    => $domain->{description}
                           , isActive => &isActive($domain)
                          })
            unless $pretend;
        &mesg ("Done.\n");
    }
}
&mesg ("\n================================\n\n");


# Migrate mailboxes
{
    my $rs = $dbh->selectall_hashref( "SELECT * FROM mailbox", 'username' )
        or die "Can't select: $!\n";
    foreach my $username (keys %$rs) {
        my $user = $rs->{$username};
        unless ($ldap->domain->search({ domain => (split/\@/, $username, 2)[1] })->count) {
            &mesg ("WARN: Skipping user `$username': Unknown domain.\n");
            next;
        }
        if ($ldap->user->search({ username => $username })->count) {
            &mesg ("WARN: Skipping user `$username': Already exists.\n");
            next;
        }
        &mesg ("WARN: Ignoring user name `$user->{name}'")
            if defined $user->{name} and $user->{name} ne '';
        &mesg ("Inserting user `$username'... ");
        $ldap->user->add({ username     => $username
                         , userPassword => $user->{password}
                         , maildir      => $user->{maildir}
                         , isActive     => &isActive($user)
                        })
            unless $pretend;
        &mesg ("Done.\n");
    }
}
&mesg ("\n================================\n\n");


# Migrate aliases
{
    my $rs = $dbh->selectall_hashref( "SELECT * FROM alias", 'address' )
        or die "Can't select: $!\n";
    foreach my $address (keys %$rs) {
        unless ($ldap->domain->search({ domain => (split/\@/, $address, 2)[1] })->count) {
            &mesg ("WARN: Skipping alias `$address': Unknown domain.\n");
            next;
        }

        my $alias = $rs->{$address};
        if ($ldap->alias->search({ address => $address })->count) {
            &mesg ("WARN: Skipping alias `$address': Already exists.\n");
            next;
        }
        my @goto = split /, */, $alias->{goto};  
        unless ($#goto >= 0) {
            &mesg ("WARN: Skipping alias `$address': Empty goto.\n");
            next;
        }

        foreach my $goto (@goto) {
            &mesg ("Inserting alias `$address' -> `$goto'... ");
            $ldap->alias->add({ address  => $address
                              , goto     => $goto
                              , isActive => &isActive($alias)
                             })
            unless $pretend;
            &mesg ("Done.\n");
        }
    }
}
&mesg ("\n================================\n\n");


# Disconnect
$dbh->disconnect();
$ldap->unbind();
close LOG;

sub mesg {
    print STDERR @_;
    print LOG    @_;
}

sub isActive {
    if ($_[0]->{active}) {
        return 'TRUE';
    }
    return 'FALSE';
}