Archive the MySQL -> LDAP migration procedure.

1 files changed, 0 insertions, 180 deletions

diff --git a/ldap-migrate.pl b/ldap-migrate.pl
deleted file mode 100755
index d8af8ca..0000000
--- a/ldap-migrate.pl
+++ /dev/null
@@ -1,180 +0,0 @@
-#!/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';
-}