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 "description = \"$description\"\n" ;
73 print CONFIG "host_name = '$sys_lists_host'\n" ;
75 print CONFIG "archive_private = True\n" ;
76 print CONFIG "advertised = False\n" ;
77 print CONFIG "subscribe_policy = 3\n" ;
78 ## Reject mails sent by non-members
79 print CONFIG "generic_nonmember_action = 2\n";
80 ## Do not forward auto discard message
81 print CONFIG "forward_auto_discards = 0\n";
83 print CONFIG "archive_private = False\n" ;
84 print CONFIG "advertised = True\n" ;
85 print CONFIG "subscribe_policy = 1\n" ;
88 $cmd = "/usr/lib/mailman/bin/config_list -i $tmp $listname" ;
89 #print "cmd = <$cmd>\n" ;
93 $cmd= "/usr/lib/mailman/bin/withlist -l -r fix_url $listname -u $sys_lists_host" ;
94 #print "cmd = <$cmd>\n" ;
97 $query = "UPDATE mail_group_list SET status = 3 where group_list_id = group_list_id" ; # Status = 3: list configured on Mailman
98 $sth = $dbh->prepare ($query) ;
102 #debug "Committing." ;
106 $query = "SELECT mail_group_list.group_list_id,
107 mail_group_list.list_name,
109 mail_group_list.password,
110 mail_group_list.description,
111 mail_group_list.is_public
112 FROM mail_group_list, users
113 WHERE mail_group_list.status = 4
114 AND mail_group_list.list_admin = users.user_id" ; # Status = 4: password reset requested
115 $sth = $dbh->prepare ($query) ;
118 while (my @myarray = $sth->fetchrow_array ()) {
119 push @lines, \@myarray ;
123 foreach $line (@lines) {
125 my ($group_list_id, $listname, $user_name, $password, $description, $is_public) ;
128 ($group_list_id, $listname, $user_name, $password, $description, $is_public)= @array ;
129 next if $listname eq '' ;
130 next if $listname eq '.' ;
131 next if $listname eq '..' ;
132 next if $listname !~ /^[a-z0-9\-_\.]*$/ ;
134 my $cmd = "/usr/lib/mailman/bin/change_pw -l $listname >/dev/null 2>&1" ;
137 $query = "UPDATE mail_group_list SET status = 3 where group_list_id = group_list_id" ; # Status = 3: list configured on Mailman
138 $sth = $dbh->prepare ($query) ;
142 #debug "Committing." ;
146 $query = "SELECT mail_group_list.group_list_id,
147 mail_group_list.list_name,
149 mail_group_list.password,
150 mail_group_list.description,
151 mail_group_list.is_public
152 FROM mail_group_list, users
153 WHERE mail_group_list.status = 5
154 AND mail_group_list.list_admin = users.user_id" ; # Status = 5: configuration change requested
155 $sth = $dbh->prepare ($query) ;
158 while (my @myarray = $sth->fetchrow_array ()) {
159 push @lines, \@myarray ;
162 foreach $line (@lines) {
164 my ($group_list_id, $listname, $user_name, $password, $description, $is_public) ;
166 $tmp = mktemp ("/tmp/XXXXXX") ;
167 $cmd = "/usr/lib/mailman/bin/config_list -o $tmp $listname" ;
168 #print "cmd = <$cmd>\n" ;
169 # Commented out on Matt Hope <dopey@debian.org> advice
170 # To be revised by Roland Mas
172 open CONFIG, ">>$tmp" ;
173 print CONFIG "description = \"$description\"\n" ;
174 print CONFIG "host_name = '$sys_lists_host'\n" ;
176 print CONFIG "archive_private = True\n" ;
177 print CONFIG "advertised = False\n" ;
178 print CONFIG "subscribe_policy = 3\n" ;
179 ## Reject mails sent by non-members
180 print CONFIG "generic_nonmember_action = 2\n";
181 ## Do not forward auto discard message
182 print CONFIG "forward_auto_discards = 0\n";
184 print CONFIG "archive_private = False\n" ;
185 print CONFIG "advertised = True\n" ;
186 print CONFIG "subscribe_policy = 1\n" ;
189 $cmd = "/usr/lib/mailman/bin/config_list -i $tmp $listname" ;
190 #print "cmd = <$cmd>\n" ;
194 $query = "UPDATE mail_group_list SET status = 3 where group_list_id = group_list_id" ; # Status = 3: list configured on Mailman
195 $sth = $dbh->prepare ($query) ;
199 #debug "Committing." ;
203 # There should be a commit at the end of every block above.
204 # If there is not, then it might be symptomatic of a problem.
205 # For safety, we roll back.
210 warn "Transaction aborted because $@" ;
211 debug "Transaction aborted because $@" ;
213 debug "Please report this bug on the Debian bug-tracking system." ;
214 debug "Please include the previous messages as well to help debugging." ;
224 print STDERR "$v\n" ;