sieve-migrate.pl
changeset 6 9d3800a5e930
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/sieve-migrate.pl	Mon Aug 03 17:06:17 2009 +0200
@@ -0,0 +1,112 @@
+#! /usr/bin/perl
+
+my $usage = << '#';
+Usage: $ME [options]
+    --dry	    dry run ($opt_dry)
+    --listscripts   listscripts on source server ($opt_list)
+#
+
+use strict;
+use warnings;
+use feature ':5.10';
+use File::Basename;
+use Net::Sieve;
+use Smart::Comments;
+use Getopt::Long;
+
+my $ME = basename $0;
+
+my $user = 'root';
+my $password = 'x';
+
+my $opt_dry = 1;
+my $opt_listscripts = 0;
+
+GetOptions(
+    'dry'	    =>	\$opt_dry,
+    'listscripts'   =>	\$opt_listscripts,
+) or die eval "\"$usage\"";
+    
+
+my @users = <>;
+foreach my $auser (@users) {
+    chomp($auser);
+
+    ### migrating sieve rules for user: $auser
+    my $pop = connect_as($auser, 'localhost');
+    my $pu =  connect_as($auser, 'localhost:2001'); # forwarded port via ssh
+
+    copy_scripts( $pu, $pop );
+    
+    # TODO: do not seem to work properly
+    #$pop->sfinish();
+    #$pu->sfinish();
+
+}
+
+
+## --------------------------------------------------------------------- 
+
+sub clean_scripts {
+    my $sieve = shift;
+    
+    foreach my $script ($sieve->list()) {
+	### deleting script: $script->{name}
+	$sieve->delete( $script->{name} ) if not $opt_dry;
+    }
+}
+
+
+sub copy_scripts {
+    my $src = shift;
+    my $dst = shift;
+
+    my $copied = 0;
+
+    foreach my $script ($src->list()) {
+	my $content = $src->get( $script->{name} );
+	my $is_active = $script->{status};
+
+	next if length($content) == 0;
+
+	$dst->put( $script->{name}, $content) or
+	    die "$ME: error on migrating script...\n";
+
+	if ($is_active) {
+	    $dst->activate( $script->{name} ) or
+		die "$ME: error on activating script...\n";
+	}
+
+	$copied++;
+    }
+
+    say "migrated $copied scriptes";
+}
+
+
+sub connect_as {
+    my ($authuser, $server) = @_;
+
+    my $sieve = Net::Sieve->new(    server => (split(':', $server))[0],
+				    user => $user,
+				    port => (split(':', $server))[1] || 2000,
+				    authzid => $authuser,
+				    password => $password,
+    ) or die "$ME: cannot connect to server $server\n";
+    return $sieve;
+}
+
+
+sub has_scripts {
+    my $sieve = shift;
+
+    if ($sieve->list()) {
+	return 1;
+    }
+    else {
+	return 0;
+    }
+}
+
+
+# vim: sw=4 sts=4 aw