3 # Create the mailing-lists from the database
4 # Copyright 2001-2003, 2009 Roland Mas <lolando@debian.org>
5 # Copyright 2003, 2004, Christian Bayle <bayle@debian.org>
6 # Copyright 2005, INRIA (David Margery and Soraya Arias)
7 # Copyright 2012, Franck Villaume - TrivialDev
12 use File::Temp qw/ :mktemp /;
14 use vars qw/ $dbh $sys_lists_host $sys_users_host / ;
20 require ("/usr/share/gforge/lib/include.pl") ; # Include all the predefined functions
24 $dbh->{AutoCommit} = 0;
25 $dbh->{RaiseError} = 1;
27 my ($query, $sth, @array, @lines, $line) ;
29 $query = "SELECT mail_group_list.group_list_id,
30 mail_group_list.list_name,
32 mail_group_list.password,
33 mail_group_list.description,
34 mail_group_list.is_public
35 FROM mail_group_list, users
36 WHERE mail_group_list.status = 1
37 AND mail_group_list.list_admin = users.user_id" ; # Status = 1: list just created on the website
38 $sth = $dbh->prepare ($query) ;
40 while (my @myarray = $sth->fetchrow_array ()) {
41 push @lines, \@myarray ;
45 foreach $line (@lines) {
47 my ($group_list_id, $listname, $user_name, $password, $description, $is_public) ;
50 ($group_list_id, $listname, $user_name, $password, $description, $is_public)= @array ;
51 next if $listname eq '' ;
52 next if $listname eq '.' ;
53 next if $listname eq '..' ;
54 next if $listname !~ /^[a-z0-9\-_\.]*$/ ;
56 my $cmd = "/usr/sbin/newlist -q $listname $user_name\@$sys_users_host $password >/dev/null 2>&1" ;
57 #print "cmd = <$cmd>\n" ;
60 $query = "UPDATE mail_group_list SET status = 2 where group_list_id = group_list_id" ; # Status = 2: list created on Mailman
61 $sth = $dbh->prepare ($query) ;
65 $tmp = mktemp ("/tmp/XXXXXX") ;
66 $cmd = "/usr/lib/mailman/bin/config_list -o $tmp $listname" ;
67 #print "cmd = <$cmd>\n" ;
68 # Commented out on Matt Hope <dopey@debian.org> advice
69 # To be revised by Roland Mas
71 open CONFIG, ">>$tmp" ;
72 print CONFIG "# -*- coding: utf-8 -*-\n";
73 print CONFIG "description = \"$description\"\n" ;
74 print CONFIG "host_name = '$sys_lists_host'\n" ;
76 print CONFIG "archive_private = True\n" ;
77 print CONFIG "advertised = False\n" ;
78 print CONFIG "subscribe_policy = 3\n" ;
79 ## Reject mails sent by non-members
80 print CONFIG "generic_nonmember_action = 2\n";
81 ## Do not forward auto discard message
82 print CONFIG "forward_auto_discards = 0\n";
84 print CONFIG "archive_private = False\n" ;
85 print CONFIG "advertised = True\n" ;
86 print CONFIG "subscribe_policy = 1\n" ;
89 $cmd = "/usr/lib/mailman/bin/config_list -i $tmp $listname" ;
90 #print "cmd = <$cmd>\n" ;
94 $cmd= "/usr/lib/mailman/bin/withlist -l -r fix_url $listname -u $sys_lists_host" ;
95 #print "cmd = <$cmd>\n" ;
98 $query = "UPDATE mail_group_list SET status = 3 where group_list_id = group_list_id" ; # Status = 3: list configured on Mailman
99 $sth = $dbh->prepare ($query) ;
103 #debug "Committing." ;
107 $query = "SELECT mail_group_list.group_list_id,
108 mail_group_list.list_name,
110 mail_group_list.password,
111 mail_group_list.description,
112 mail_group_list.is_public
113 FROM mail_group_list, users
114 WHERE mail_group_list.status = 4
115 AND mail_group_list.list_admin = users.user_id" ; # Status = 4: password reset requested
116 $sth = $dbh->prepare ($query) ;
119 while (my @myarray = $sth->fetchrow_array ()) {
120 push @lines, \@myarray ;
124 foreach $line (@lines) {
126 my ($group_list_id, $listname, $user_name, $password, $description, $is_public) ;
129 ($group_list_id, $listname, $user_name, $password, $description, $is_public)= @array ;
130 next if $listname eq '' ;
131 next if $listname eq '.' ;
132 next if $listname eq '..' ;
133 next if $listname !~ /^[a-z0-9\-_\.]*$/ ;
135 my $cmd = "/usr/lib/mailman/bin/change_pw -l $listname >/dev/null 2>&1" ;
138 $query = "UPDATE mail_group_list SET status = 3 where group_list_id = group_list_id" ; # Status = 3: list configured on Mailman
139 $sth = $dbh->prepare ($query) ;
143 #debug "Committing." ;
147 $query = "SELECT mail_group_list.group_list_id,
148 mail_group_list.list_name,
150 mail_group_list.password,
151 mail_group_list.description,
152 mail_group_list.is_public
153 FROM mail_group_list, users
154 WHERE mail_group_list.status = 5
155 AND mail_group_list.list_admin = users.user_id" ; # Status = 5: configuration change requested
156 $sth = $dbh->prepare ($query) ;
159 while (my @myarray = $sth->fetchrow_array ()) {
160 push @lines, \@myarray ;
163 foreach $line (@lines) {
165 my ($group_list_id, $listname, $user_name, $password, $description, $is_public) = @array ;
167 $tmp = mktemp ("/tmp/XXXXXX") ;
168 my $cmd = "/usr/lib/mailman/bin/config_list -o $tmp $listname" ;
169 #print "cmd = <$cmd>\n" ;
170 # Commented out on Matt Hope <dopey@debian.org> advice
171 # To be revised by Roland Mas
173 open CONFIG, ">>$tmp" ;
174 print CONFIG "# -*- coding: utf-8 -*-\n";
175 print CONFIG "description = \"$description\"\n" ;
176 print CONFIG "host_name = '$sys_lists_host'\n" ;
178 print CONFIG "archive_private = True\n" ;
179 print CONFIG "advertised = False\n" ;
180 print CONFIG "subscribe_policy = 3\n" ;
181 ## Reject mails sent by non-members
182 print CONFIG "generic_nonmember_action = 2\n";
183 ## Do not forward auto discard message
184 print CONFIG "forward_auto_discards = 0\n";
186 print CONFIG "archive_private = False\n" ;
187 print CONFIG "advertised = True\n" ;
188 print CONFIG "subscribe_policy = 1\n" ;
191 $cmd = "/usr/lib/mailman/bin/config_list -i $tmp $listname" ;
192 #print "cmd = <$cmd>\n" ;
196 $query = "UPDATE mail_group_list SET status = 3 where group_list_id = group_list_id" ; # Status = 3: list configured on Mailman
197 $sth = $dbh->prepare ($query) ;
201 #debug "Committing." ;
205 # There should be a commit at the end of every block above.
206 # If there is not, then it might be symptomatic of a problem.
207 # For safety, we roll back.
212 warn "Transaction aborted because $@" ;
213 debug "Transaction aborted because $@" ;
215 debug "Please report this bug on the Debian bug-tracking system." ;
216 debug "Please include the previous messages as well to help debugging." ;
226 print STDERR "$v\n" ;