diff options
-rwxr-xr-x | ldap-migrate.pl | 103 |
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"); |