aboutsummaryrefslogtreecommitdiffstats
path: root/ldap/obsolete/ldap-migrate.pl
diff options
context:
space:
mode:
Diffstat (limited to 'ldap/obsolete/ldap-migrate.pl')
-rwxr-xr-xldap/obsolete/ldap-migrate.pl180
1 files changed, 180 insertions, 0 deletions
diff --git a/ldap/obsolete/ldap-migrate.pl b/ldap/obsolete/ldap-migrate.pl
new file mode 100755
index 0000000..d8af8ca
--- /dev/null
+++ b/ldap/obsolete/ldap-migrate.pl
@@ -0,0 +1,180 @@
+#!/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';
+}