The mailing list for listmasters using Sympa

[Dan Pritts <address@concealed>]

Hi,

as i've mentioned before on the list i wrote some scripts
to move lists from our old sympa 3.4 server to our new 
sympa 6.1 server.

several people have asked, so i cleaned them up a bit and here
they are.

createlist creates a single list on the new server.  it needs access to
the original config file, archives, and db as well as the new db.

fixuserprefs runs after all lists have been created on the new server.
it updates the user prefs of included users.  I had to do this on a second
pass, as some lists depended on other lists that were created later.

i suppose i could have figured out which lists to create first, but this
was simple, it is just a stripped dowwn version of the first script.

danno
--
Dan Pritts, Sr. Systems Engineer
Internet2
office: +1-734-352-4953 | mobile: +1-734-834-7224

ESCC/Internet2 Joint Techs
July 11-15, 2010 - Columbus, Ohio
http://events.internet2.edu/2010/jt-oarnet/
#!/usr/bin/perl -w


#my $listname=This Is The List;
my $listname=$ARGV[0];

my $config="/sympa/oldserver/expl/$listname/config";

# your new sympa instance's database
my $newsympadbDBI;
my $newsympadbuser;
my $newsympadbpass;

$newsympadbDBI="DBI:mysql:database=sympa;host=blah.bard";
$newsympadbuser="sympa";
$newsympadbpass="passwordhere";

# your old sympa instance's database, or perhaps a local copy
my $oldsympadbDBI="DBI:mysql:database=sympa;host=oldserver";
my $oldsympadbuser="sympa";
my $oldsympadbpass="passwordhere";

# old archive directory
my $oldsympaarc="/sympa/oldserver/arc";
my $newsympaarc="/sympa/arc";

my $sympaspool="/sympa/spool";

my $symparoot="/usr/local/pkg/sympa";
my $xmlfyle="/tmp/newlist.sympa.$$.xml";
my $configtt2="$symparoot/default/create_list_templates/addlist/config.tt2";

# host specific directory, used to locate scenario files
my $sympaetc="/etc/sympa";


my $robotname="example.com";

use DBI();


$DEBUG=1;


sub dprint {
        return 1 unless ($DEBUG);
        my $neednewline=1;
        foreach $boof (@_) {
                if (defined $boof) {
                        print STDERR $boof; 
                        $neednewline=0 if ($boof =~ m{\n});
                }
        }
        if ($neednewline) { print STDERR "\n" };
        return 1;
}


# Verify that the send. scenario is one that is supported on the
# new server, change if necessary.

open (CONFIG,"$config") || die "cannot open config file $config for list 
$listname";

my $sendscenario=0;
my @includes;


# this code was written to parse a bunch of list config files
# at once so we have this hash which will have only one top value, 
$lists{$listname}
# %lists{listname}{owneremail}=ownergecos
my %lists;
        
$DEBUG=0;
foreach my $list ($listname) {
        my $string;
        {
                # slurp the whole file as one big string
                local $/=undef;
                $string = <CONFIG>;
        }

        # remove comment lines
        # "m" on substitution lets ^ and $ work as \n-delimited
        $string =~ s{^#.*?$}{\n}mg;

        # remove excessive blank lines
        $string =~ s{\n\n+}{\n\n}sg;

        # remove empty stanza at beginning and end
        $string =~ s{^\n\n}{};
        $string =~ s{\n\n$}{};

        my @config=split (/\n\n/,$string);
        &dprint("config size is $#config");
        foreach $stanza (@config) {
                &dprint("processing $stanza");
                my @stanza=split(/\n/,$stanza);
                if ( $#stanza == 0 ) {
                        ($arg,$value)=split(/\s+/,$stanza[0]);
                        $arg=lc($arg);
                        $lists{$listname}{$arg}=$value;
                        &dprint("arg is $arg, value is $value\n\n");
                } else {
                        # maybe should be case insensitive match?  This WFM
                        if ( $stanza[0] eq "owner" ) {
                                ($email,$gecos)=&parseowner(@stanza);
                                &dprint("owner stanza, $email, $gecos\n\n");
                                
$lists{$listname}{'owneremail'}{$email}=$gecos;
                        } else {
                                foreach $stanzaline (@stanza) { 
&dprint("line: $stanzaline") }
                                &dprint("\n");
                        }
                }
        }
}


close CONFIG;

$DEBUG=1;


sub parseowner {
        my $list=shift(@_);
        my $email=$gecos="";
        FOREACH: foreach my $line (@_) {
                if ($line =~ /(reception|profile)/) {
                        &dprint("skipping $line");
                        next FOREACH;
                }
                &dprint(">parsing $line");
                chomp $line;
                if ( $line =~ /^\W*email/ ) {
                        $email=$line;
                        $email =~ s{^\W*\w+ }{};
                        &dprint(">>found email: $email");
                }
                if ( $line =~ /^\W*gecos/ ) {
                        $gecos=$line;
                        $gecos =~ s{^\W*\w+ }{};
                        &dprint(">>found gecos: $gecos");
                }
        }
        return($email,$gecos);
}

$sendscenario=$lists{$listname}{'send'};


open (CONFIG,"$config") || die "cannot open config file $config for list 
$listname";
open (CONFIGTT2, ">$configtt2") || die "cannot open $configtt2 for write";


# internet2 specific hackery
if ( $sendscenario eq 'staff' )  { $sendscenario = 'anylist' };
if ( $sendscenario eq 'closedbounce' )  { $sendscenario = 'closed' };
if ( $sendscenario eq 'private_nobcc' )  { $sendscenario = 'private' };
if ( $sendscenario eq 'public-nospamcheck' )  { $sendscenario = 'public' };
while (my $line=<CONFIG>) {
        $line =~ s/^send staff/send anylist/;
        $line =~ s/^send closedbounce/send closed/;
        $line =~ s/^send private_nobcc/send private/;
        $line =~ s/^send public-nospamcheck/send public/;
        print CONFIGTT2 $line;
}

close CONFIG;
close CONFIGTT2;


#&dprint("checking send scenario");
if ( ( ! -f "$sympaetc/scenari/send.$sendscenario" ) &&
     ( ! -f "$symparoot/default/scenari/send.$sendscenario" ) 
   )
{
        die "must adjust config to use supported send scenario";
}

# sympa requires a subject be set; that does not mean we
# absolutely have to set it to anything useful
my $listsubject;
if (defined $lists{$listname}{'subject'}) {
        $listsubject=$lists{$listname}{'subject'};
} else {
        $listsubject=$listname;
}


# owner email must be specified in the XML file, but it is not used for 
anything
# except by processing the tt2 file; our fake "tt2" file (really the old list
# config file) does not use it.
my $listowneremail="AFAKEMAILADDR\@SYMPA.ORG";

my $XML=qq{<?xml version="1.0" ?><list><listname>} . 
        $listname .
        qq{</listname><type>addlist</type><subject>} .
        $listsubject .
        qq{</subject><owner><email>} .
        $listowneremail .
        qq{</email></owner></list>\n};


#&dprint("xml is $XML");

open (XMLFYLE,">$xmlfyle") || die "cannot open $xmlfyle for write";
print XMLFYLE $XML;
close (XMLFYLE); 

&dprint("creating list");
# && not ||, checking return from system
system ("$symparoot/bin/sympa.pl --create_list --input_file $xmlfyle") 
        && die "error in create_list";

unlink ($xmlfyle) || warn "couldn\'t delete $xmlfyle, continuing";



# there are included subscribers
if ($#includes > -1) {
        warn "there are included subscribers in $listname, check this list 
out further";
}




#&dprint("reading old db");
######################################################################
#### get old subscriber table data , but not inclusions
my $oldsympadb = DBI->connect($oldsympadbDBI, $oldsympadbuser, 
        $oldsympadbpass, {'RaiseError' => 1});

my $selectcmd=  qq{select * from subscriber_table where list_subscriber = '} .
                $listname .
                qq{' and ( included_subscriber is null or included_subscriber 
<> 1 );};

# stblhsh = subscriber table hash
# RTFM on DBI if you don't get this
my $stblhsh = $oldsympadb->selectall_hashref($selectcmd,"user_subscriber");
$oldsympadb->disconnect;
#### end old subscriber table data
######################################################################

#&dprint("\n>-done reading old db\n\n");





# insert subscribers using normal method from command line
# look at db results and fix up anything abnormal

# sympa 3.4 schema
# | Field                      | Type          | Null | Key | Default         
    | Extra |
# 
+----------------------------+---------------+------+-----+---------------------+-------+
# | list_subscriber            | varchar(50)   | NO   | PRI |                 
    |       | 
# | user_subscriber            | varchar(100)  | NO   | PRI |                 
    |       | 
# | date_subscriber            | datetime      | NO   |     | 0000-00-00 
00:00:00 |       | 
# | update_subscriber          | datetime      | YES  |     | NULL            
    |       | 
# | visibility_subscriber      | varchar(20)   | YES  |     | NULL            
    |       | 
# | reception_subscriber       | varchar(20)   | YES  |     | NULL            
    |       | 
# | bounce_subscriber          | varchar(35)   | YES  |     | NULL            
    |       | 
# | comment_subscriber         | varchar(150)  | YES  |     | NULL            
    |       | 
# | subscribed_subscriber      | enum('0','1') | YES  |     | NULL            
    |       | 
# | included_subscriber        | enum('0','1') | YES  |     | NULL            
    |       | 
# | include_sources_subscriber | varchar(50)   | YES  |     | NULL            
    |       | 


#&dprint("adding subscribers");
open (IMPORT,"| $symparoot/bin/sympa.pl --import $listname\@$robotname");


foreach my $luser (keys %{$stblhsh}) {
        #&dprint("> 
$luser\t$stblhsh->{$luser}->{'reception_subscriber'}\t$stblhsh->{$luser}->{'comment_subscriber'}");
        my $comment = $stblhsh->{$luser}->{'comment_subscriber'};
        if (! defined $comment) { $comment = ""; } ;
        chomp $comment;
        # our data has a bunch of cr's in it that chomp does not catch
        $comment =~ s{
$}{};
        # occasional null bytes in data which postgres does not like ?
        $comment =~ s{}{}g;
        #&dprint("> adding ", $luser, "\t", $comment, "\n");
        print IMPORT ($luser, "\t", $comment, "\n");
}

close (IMPORT);

#&dprint("\n>-done adding subscribers\n\n");

#&dprint("connecting to new db");
my $newsympadb = DBI->connect($newsympadbDBI, $newsympadbuser, 
        $newsympadbpass, {'RaiseError' => 1} );


$updatenewsubreception = $newsympadb->prepare("UPDATE subscriber_table set 
reception_subscriber = ? where user_subscriber = ? and list_subscriber = 
\'$listname\'");

$updatenewsubvisibility = $newsympadb->prepare("UPDATE subscriber_table set 
visibility_subscriber = ? where user_subscriber = ? and list_subscriber = 
\'$listname\'");


# fix up user options/parameters based on old data.
# defaults are:  
#     reception: mail
#     visibility: noconceal
# change if a different, legal value in the old db
# possible values of reception: 
['mail','notice','digest','digestplain','summary','nomail','txt','html','urlize','not_me']
foreach my $luser (keys %{$stblhsh}) {
        #&dprint("> 
",$luser,"\t",$stblhsh->{$luser}->{'reception_subscriber'},"\t",$stblhsh->{$luser}->{'visibility_subscriber'});

        if (    ( defined ($stblhsh->{$luser}->{'reception_subscriber'}) ) &&
                ( $stblhsh->{$luser}->{'reception_subscriber'} ne 'mail' ) &&
                ( $stblhsh->{$luser}->{'reception_subscriber'} =~ 
m{^(notice|digest|digestplain|summary|nomail|txt|html|urlize|not_me)$} )
        ) {
                my $reception = $stblhsh->{$luser}->{'reception_subscriber'} ;
                chomp $reception;
                # data has a bunch of cr's in it that chomp does not catch
                $reception =~ s/
$//;
                &dprint("> modifying reception: $reception for $luser");
                $updatenewsubreception->execute( $reception, $luser );
        }


        if (    ( defined ($stblhsh->{$luser}->{'visibility_subscriber'}) ) &&
                ( $stblhsh->{$luser}->{'visibility_subscriber'} eq 'conceal' 
)  
        ) {
                my $visibility = 
$stblhsh->{$luser}->{'visibility_subscriber'} ;
                chomp $visibility;
                # data has a bunch of cr's in it that chomp does not catch
                $visibility =~ s/
$//;
                &dprint("> modifying visibility: $visibility for $luser");
                $updatenewsubvisibility->execute( $visibility, $luser );
        }
}


# autocommit is the default
#&dprint("> committing");
#$newsympadb->commit;
#&dprint(">-closing down database");
$newsympadb->disconnect;




#Now, copy the list archives.


if ( -d "$oldsympaarc/$listname\@$robotname" ) {
        # you could do a "mv" instead, (but not with your only copy!)
        #&dprint("rsyncing archives, may take a while");
        #$cmd="rsync -a $oldsympaarc/$listname\@$robotname $newsympaarc" ;
        #&dprint("mv'ing archives");
        $cmd="mv $oldsympaarc/$listname\@$robotname $newsympaarc" ;
        #&dprint("running: $cmd");  
        system ($cmd) && warn("error running $cmd");

        $cmd="chown -R sympa:sympa $newsympaarc/$listname\@$robotname";
        #&dprint("running: $cmd");  
        system ($cmd) && warn("error running $cmd");

        # this signals archived.pl to rebuild the web archive
        $cmd="touch $sympaspool/outgoing/.rebuild.$listname\@$robotname";
        #&dprint("running: $cmd");  
        system ($cmd) && warn("error running $cmd");
}

print "\ndone with list $listname\n\n";
#!/usr/bin/perl -w


# similar to addlist script, but runs after all lists are added and 
# all data includes have been processed; fixes user prefs for included users


$newsympadbDBI=
$newsympadbuser=
$newsympadbpass=

#### get old subscriber table data 
$oldsympadbDBI=
$oldsympadbuser=
$oldsympadbpass=

use DBI();


$DEBUG=1;


sub dprint {
        return 1 unless ($DEBUG);
        my $neednewline=1;
        foreach $boof (@_) {
                if (defined $boof) {
                        print STDERR $boof; 
                        $neednewline=0 if ($boof =~ m{\n});
                }
        }
        if ($neednewline) { print STDERR "\n" };
        return 1;
}



&dprint("reading old db");
######################################################################
#### get old subscriber table data from local copy of old server's mysql
my $oldsympadb = DBI->connect($oldsympadbDBI, $oldsympadbuser, 
        $oldsympadbpass, {'RaiseError' => 1});

my $selectcmd=  qq{select * from subscriber_table where included_subscriber = 
'1' ;};

# stblhsh = subscriber table hash
my $stblhsh = $oldsympadb->selectall_hashref($selectcmd,"user_subscriber");
$oldsympadb->disconnect;
#### end old subscriber table data
######################################################################

&dprint("\n>-done reading old db\n\n");





# insert subscribers using normal method from command line
# look at db results and fix up anything abnormal

# | Field                      | Type          | Null | Key | Default         
    | Extra |
# 
+----------------------------+---------------+------+-----+---------------------+-------+
# | list_subscriber            | varchar(50)   | NO   | PRI |                 
    |       | 
# | user_subscriber            | varchar(100)  | NO   | PRI |                 
    |       | 
# | date_subscriber            | datetime      | NO   |     | 0000-00-00 
00:00:00 |       | 
# | update_subscriber          | datetime      | YES  |     | NULL            
    |       | 
# | visibility_subscriber      | varchar(20)   | YES  |     | NULL            
    |       | 
# | reception_subscriber       | varchar(20)   | YES  |     | NULL            
    |       | 
# | bounce_subscriber          | varchar(35)   | YES  |     | NULL            
    |       | 
# | comment_subscriber         | varchar(150)  | YES  |     | NULL            
    |       | 
# | subscribed_subscriber      | enum('0','1') | YES  |     | NULL            
    |       | 
# | included_subscriber        | enum('0','1') | YES  |     | NULL            
    |       | 
# | include_sources_subscriber | varchar(50)   | YES  |     | NULL            
    |       | 


#select user_subscriber,comment_subscriber from subscriber_table where 
list_subscriber = 'tsg-secure' into outfile '/tmp/tsg-secure';


&dprint("connecting to new db");
my $newsympadb = DBI->connect($newsympadbDBI, $newsympadbuser, 
        $newsympadbpass, {'RaiseError' => 1} );

$updatenewsubreception = $newsympadb->prepare("UPDATE subscriber_table set 
reception_subscriber = ? where user_subscriber = ? and list_subscriber = ?");

$updatenewsubvisibility = $newsympadb->prepare("UPDATE subscriber_table set 
visibility_subscriber = ? where user_subscriber = ? and list_subscriber = ? 
");




# fix up user options/parameters based on old data.
# defaults are:  
#     reception: mail
#     visibility: noconceal
# only change if different
foreach my $luser (keys %{$stblhsh}) {

        if (    ( defined ($stblhsh->{$luser}->{'reception_subscriber'}) ) &&
                ( $stblhsh->{$luser}->{'reception_subscriber'} ne 'mail' )  
        ) {
                my $reception = $stblhsh->{$luser}->{'reception_subscriber'} ;
                my $list = $stblhsh->{$luser}->{'list_subscriber'} ;
                chomp $reception;
                # data has a bunch of cr's in it that chomp does not catch
                $reception =~ s/
$//;
                &dprint("> modifying reception: $reception for $luser");
                $updatenewsubreception->execute( $reception, $luser, $list );
        }


        if (    ( defined ($stblhsh->{$luser}->{'visibility_subscriber'}) ) &&
                ( $stblhsh->{$luser}->{'visibility_subscriber'} ne 
'noconceal' )  
        ) {
                my $visibility = 
$stblhsh->{$luser}->{'visibility_subscriber'} ;
                my $list = $stblhsh->{$luser}->{'list_subscriber'} ;
                chomp $visibility;
                # data has a bunch of cr's in it that chomp does not catch
                $visibility =~ s/
$//;
                &dprint("> modifying visibility: $visibility for $luser");
                $updatenewsubvisibility->execute( $visibility, $luser, $list 
);
        }
}


# autocommit is the default
#&dprint("> committing");
#$newsympadb->commit;
&dprint(">-closing down database");
$newsympadb->disconnect;