File: fix-mailing-lists.pl

package info (click to toggle)
gforge 4.5.14-22etch13
  • links: PTS
  • area: main
  • in suites: etch
  • size: 13,004 kB
  • ctags: 11,918
  • sloc: php: 36,047; sql: 29,050; sh: 10,538; perl: 6,496; xml: 3,810; makefile: 341; python: 263; ansic: 256
file content (97 lines) | stat: -rwxr-xr-x 2,687 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
#!/usr/bin/perl -w
#
# $Id: fix-mailing-lists.pl 5857 2006-11-09 20:29:51Z lo-lan-do $
#
# Fix the mailing-lists if they have been broken in previous versions
# Roland Mas <lolando@debian.org>

use DBI ;
use strict ;
use diagnostics ;
use File::Temp qw/ :mktemp  /;

use vars qw/ $dbh $sys_lists_host $sys_dbname $sys_dbuser $sys_dbpasswd $domain_name / ;

use vars qw// ;

sub debug ( $ ) ;

require ("/usr/lib/gforge/lib/include.pl") ;
require ("/etc/gforge/local.pl") ;

&db_connect ;

die "Cannot connect to database: $!" if ( ! $dbh );

$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;
eval {
    my ($query, $sth, @array, @lines, $line) ;

    $query = "SELECT mail_group_list.group_list_id,
                     mail_group_list.list_name,
                     users.user_name,
                     mail_group_list.password,
                     mail_group_list.description
              FROM mail_group_list, users
              WHERE mail_group_list.status = 3
                    AND mail_group_list.list_admin = users.user_id" ; # Status = 3: list already created
    $sth = $dbh->prepare ($query) ;
    $sth->execute () ;
    while (my @myarray = $sth->fetchrow_array ()) {
	push @lines, \@myarray ;
    }
    $sth->finish () ;

    foreach $line (@lines) {
	@array = @{$line} ;
	my ($group_list_id, $listname, $user_name, $password, $description) ;
	my ($tmp) ;
	my ($cmd) ;

	($group_list_id, $listname, $user_name, $password, $description)= @array ;

	$tmp = mktemp ("/tmp/XXXXXX") ;
	$cmd = "/usr/lib/mailman/bin/config_list -o $tmp $listname" ;
	#print "cmd = <$cmd>\n" ;
	system ($cmd) ;
	open CONFIG, ">>$tmp" ;
	print CONFIG "description = \"$description\"\n" ;
	print CONFIG "host_name = '$sys_lists_host'\n" ;
	close CONFIG ;
	$cmd = "/usr/lib/mailman/bin/config_list -i $tmp $listname" ;
	#print "cmd = <$cmd>\n" ;
	system ($cmd) ;
	unlink $tmp ;

	$cmd= "/usr/lib/mailman/bin/withlist -l -r fix_url $listname -u $sys_lists_host" ;
	#print "cmd = <$cmd>\n" ;
	system ($cmd) ;

	#debug "Rolling back -- nothing should have changed anyway." ;
	$dbh->rollback () ;
    }
    
    # There should be a commit at the end of every block above.
    # If there is not, then it might be symptomatic of a problem.
    # For safety, we roll back.
    $dbh->rollback ();
};

if ($@) {
    warn "Transaction aborted because $@" ;
    debug "Transaction aborted because $@" ;
    $dbh->rollback ;
    debug "Please report this bug on the Debian bug-tracking system." ;
    debug "Please include the previous messages as well to help debugging." ;
    exit 1 ;
}

$dbh->rollback ;
$dbh->disconnect ;

sub debug ( $ ) {
    my $v = shift ;
    chomp $v ;
    print STDERR "$v\n" ;
}