#!/usr/bin/perl # Hassle-free list migration from Majordomo 1.94.5 to Sympa 6.0 # 2009 by Matthias Warkus # Applications Department, Computing Centre, Marburg University use strict; use File::Temp qw/ tempfile /; use File::Path; use Mail::Address; ###################################################################### # Source side: Majordomo-related constants and stuff ##################################################################### require "config_parse.pl"; # two-digit years less or equal to this are considered to be in the # 21st century, others in the 20th my $Y2KLINE = 95; my $MJPREFIX = "/majordomo-import"; my $ALIASESFILENAME = "/majordomo-import/aliases"; my $LISTDIR = $MJPREFIX . "/lists"; my $ARCHIVEDIR = $MJPREFIX . "/archive"; #my $DOCDIR = $MJPREFIX . "/doc"; # not needed at present ###################################################################### # Target side: Sympa-related constants ###################################################################### my $LANGUAGE = "de"; my $initial_status = "pending"; # TODO command line switch? my $topics = "service"; # TODO fetch from command line? my $web_archive_access = "private"; #TODO enable choice? my $SYMPAPREFIX = "/home/sympa"; my $SYMPA = $SYMPAPREFIX . "/sbin/sympa.pl"; my $ROBOT = "lists.uni-marburg.de"; my $DATATARGETDIR = "/var/spool/sympa/list_data"; my $ARCHIVETARGETDIR = "/archive"; # set to 1 to actually make Sympa calls my $thisisnotadrill = 1; ####################################################################### # Get started ####################################################################### my $argc = @ARGV; $argc == 1 or die "$0 needs exactly one argument, the list name.\n"; my $listname = $ARGV[0]; # TODO fetch from command line or determine heuristically my $listtype = "newsletter"; get_config($LISTDIR, $listname); # Ignore errors! We know what we are doing, or, at least, so we pretend #&& die "Could not get configuration for $listname from $LISTDIR: $!"; #my $key; #foreach $key (keys %main::config_opts) # { # print $key . " = " . $main::config_opts{$key} . "\n"; # } #die; ######################################################################### # create XML template for list creation, call sympa --create_list with it ######################################################################### (my $xmlfile, my $xmlfilename) = tempfile(UNLINK => 1, SUFFIX => ".xml"); print $xmlfile "\n"; print $xmlfile "\n"; print $xmlfile "" . $listname . "\n"; print $xmlfile "" . $listtype . "\n"; print $xmlfile "" . $main::config_opts{$listname, "description"} . "\n"; my $infofilename = $LISTDIR . "/" . $listname . ".info"; if (-e $infofilename) { print $xmlfile ""; open INFOFILE, "<", $infofilename or die "$infofilename exists, yet can't be opened: $!"; while (my $line = ) { print $xmlfile $line; } close INFOFILE; print $xmlfile "\n"; }; # reduce subscribe policies to two cases my $policyin = $main::config_opts{$listname, "subscribe_policy"}; my $policy; if (($policyin =~ /auto/) || ($policyin =~ /open/)) { $policy = "auth_notify"; } else { $policy = "auth_owner"; } print $xmlfile "" . $policy . "\n"; # default to listmaster ownership my $owner = 'listmaster@lists.uni-marburg.de'; open ALIASESFILE, "<", $ALIASESFILENAME or die "Can't open $ALIASESFILENAME: $!"; while (my $line = ) { my $pattern = $listname . "-owner:"; if ($line =~ /$pattern/) { my @fields = split(/: /, $line); $owner = @fields[1]; } } close ALIASESFILE; print $xmlfile "\n"; print $xmlfile " " . $owner . "\n"; print $xmlfile "\n"; if ("" ne main::cf_ck_bool($listname, "moderator")) { my @moderators = split(/,/, $main::config_opts{$listname, "moderator"}); my $moderator; foreach $moderator (@moderators) { print $xmlfile "\n"; print $xmlfile " " . $moderator . "\n"; print $xmlfile "\n"; } } print $xmlfile "" . $initial_status . "\n"; print $xmlfile "" . $LANGUAGE . "\n"; print $xmlfile "" . $topics . "\n"; print $xmlfile "\n"; print $xmlfile " " . $web_archive_access . "\n"; print $xmlfile "\n"; print $xmlfile "\n"; print "Created XML list template file " . $xmlfilename . "\n"; #system("cat $xmlfilename"); die; my $cmdline = $SYMPA . " --create_list --robot " . $ROBOT . " --input_file ". $xmlfilename; if ($thisisnotadrill) { system("$cmdline"); # Ignore errors! -- here we just pretend # or die "Could not call Sympa to create list: $!"; } else { print "Would normally now call $cmdline\n"; } ############################################################################# # Grab headers and footers, put them into appropriate template files ############################################################################# if ($main::config_opts{$listname, "message_header"} ne '') { my $header = $main::config_opts{$listname, "message_header"}; $header =~ s/\001|$/\n/g; my $headerfilename = $DATATARGETDIR . "/" . $ROBOT . "/" . $listname . "/message.header"; open headerfile, ">", $headerfilename or die "Could not open header file $headerfilename: $!"; print headerfile $header; close headerfile; print "Wrote header file\n"; } else { print "No message header\n"; } if ($main::config_opts{$listname, "message_footer"} ne '') { my $footer = $main::config_opts{$listname, "message_footer"}; $footer =~ s/\001|$/\n/g; my $footerfilename = $DATATARGETDIR . "/" . $ROBOT . "/" . $listname . "/message.footer"; open footerfile, ">", $footerfilename or die "Could not open footer file $footerfilename: $!"; print footerfile $footer; close footerfile; print "Wrote footer file\n"; } else { print "No message footer\n"; } ############################################################################ # Grab subscribers and pipe them to sympa.pl --import ############################################################################ my $subscribersfilename = $LISTDIR . "/" . $listname; open subscribersfile, "<", $subscribersfilename or die "couldn't open subscribers file: $!"; my $pipecmd = "|" . $SYMPA. " --import " . $listname . "\\@" . $ROBOT; if ($thisisnotadrill) { open sympapipe, $pipecmd or die "Couldn't run $pipecmd: $!"; } else { print "Would normally now call $pipecmd"; } while (my $line = ) { my @addrs = Mail::Address->parse($line); my $addr; foreach $addr (@addrs) { my $addline = $addr->address . " " . $addr->name . "\n"; if ($thisisnotadrill) { print sympapipe $addline; } else { print "."; } } } close subscribersfile; if (!$thisisnotadrill) { print "\n"; } ############################################################################# # Migrate archives ############################################################################# my $listarchivedir = $ARCHIVEDIR . "/" . $listname; if ((-e $listarchivedir) && (-d $listarchivedir)) { print "Migrating archives... "; my @sourcefiles = glob($listarchivedir . "/" . $listname . ".[0-9][0-9][0-9][0-9]*"); my $filename; my $lastmonth = 0; my $lastyear = 0; my $index = 0; my $dir; foreach $filename (@sourcefiles) { open infile, "<", $filename or die "Couldn't open $filename: $!"; my @fields = split(/\./, $filename); my $suffix = $fields[1]; my $year = substr($suffix, 0, 2); if ($year > $Y2KLINE) { $year = "19" . $year; } else { $year = "20" . $year; }; my $month = substr($suffix, 2, 2); print "[$month/$year]"; if (($lastmonth != $month) || ($lastyear != $year)) { $dir = $ARCHIVETARGETDIR . "/" . $listname . "@" . $ROBOT . "/" . $year . "-" . $month . "/arctxt"; mkpath ($dir) or die "Could not create directory $dir: $!"; $lastmonth = $month; $lastyear = $year; $index = 0; } while (my $line = ) { if ($line =~ /^From /) { if (tell(outfile) != -1) { close outfile; } $index++; my $outfilename = $dir . "/" . $index; open outfile, ">", $outfilename or die "Could not create $outfilename: $!"; } print outfile $line; } close outfile; close infile; } if (0 == $lastmonth) { print "Archives empty\n"; } print "\nNow regenerate your archives!\n"; } else { print "No archive directory to migrate\n"; }