diff options
Diffstat (limited to 'ldap/obsolete/ldap-migrate.pl')
| -rwxr-xr-x | ldap/obsolete/ldap-migrate.pl | 180 |
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'; +} |