aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xldap-migrate.pl103
1 files changed, 57 insertions, 46 deletions
diff --git a/ldap-migrate.pl b/ldap-migrate.pl
index 014f868..7494005 100755
--- a/ldap-migrate.pl
+++ b/ldap-migrate.pl
@@ -7,7 +7,7 @@
# This file depends on the LDAP version of Fripost::Schema.
# (git checkout ldap)
#
-# It reads LDAP's configuration from `~/.fripost.yml', and the MySQL
+# 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).
@@ -38,9 +38,6 @@ use utf8;
use FindBin qw($Bin);
use lib "$Bin/lib";
-use Env qw /HOME/;
-use File::Spec::Functions;
-
use Fripost::Schema;
use DBI;
use Getopt::Long;
@@ -50,11 +47,8 @@ my $pretend = 0;
GetOptions( 'pretend' => \$pretend );
-# Log the inserts and errors.
-open LOG, '>', "fripost-migration-$$.log" or die $!;
-
# Connect to the LDAP server
-my $ldapconf = LoadFile ( catfile ($HOME, '.fripost.yml') );
+my $ldapconf = LoadFile ( 'ldap.yml' );
my $ldap = Fripost::Schema->new( $ldapconf );
@@ -63,37 +57,15 @@ 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";
-
-# 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};
- 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");
+# Log the inserts and errors.
+open LOG, '>', "fripost-migration-$$.log" or die $!;
# Migrate domains
{
- my $rs = $dbh->selectall_hashref( "SELECT * FROM domains", 'domain' )
+ my $rs = $dbh->selectall_hashref( "SELECT * FROM domain", 'domain' )
or die "Can't select: $!\n";
- foreach my $domainname (keys $rs) {
+ foreach my $domainname (keys %$rs) {
my $domain = $rs->{$domainname};
if ($ldap->domain->search({ domain => $domainname })->count) {
&mesg ("WARN: Skipping domain `$domainname': Already exists.\n");
@@ -101,11 +73,13 @@ $dbh->do( "SET NAMES UTF8" ) or die "Error: Can't set names to UTF-8.\n";
}
my $mesg = "Inserting domain `$domainname'";
if (defined $domain->{description} and $domain->{description} ne '') {
- if ($ldap->user->search({ username => $domain->{description} })->count) {
- $mesg .= " (for owner `$domain->{description}')"
+ 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 `$domain->{description}'.\n");
+ &mesg ("WARN: Skipping ownership of `$domainname': Unknown owner `$owner'.\n");
delete $domain->{description};
}
}
@@ -124,28 +98,65 @@ $dbh->do( "SET NAMES UTF8" ) or die "Error: Can't set names to UTF-8.\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 aliases", 'address' )
+ my $rs = $dbh->selectall_hashref( "SELECT * FROM alias", 'address' )
or die "Can't select: $!\n";
- foreach my $address (keys $rs) {
+ 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;
}
- unless (defined $alias->{goto} and $alias->{goto} ne '') {
+ my @goto = split /, */, $alias->{goto};
+ unless ($#goto >= 0) {
&mesg ("WARN: Skipping alias `$address': Empty goto.\n");
next;
}
- &mesg ("Inserting alias `$address' -> `$alias->{goto}'... ");
- $ldap->alias->add({ address => $address
- , goto => $alias->{goto}
- , isActive => &isActive($alias)
- })
+ 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 ("Done.\n");
+ }
}
}
&mesg ("\n================================\n\n");