1 | #!/moira/bin/perl -Tw |
---|
2 | |
---|
3 | # $Id: mailman.gen 3956 2010-01-05 20:56:56Z zacheiss $ |
---|
4 | |
---|
5 | # The following exit codes are defined and MUST BE CONSISTENT with the |
---|
6 | # error codes the library uses: |
---|
7 | $MR_DBMS_ERR = 47836421; |
---|
8 | |
---|
9 | $outdir = '/moira/dcm/mailman'; |
---|
10 | umask 022; |
---|
11 | |
---|
12 | use DBI; |
---|
13 | |
---|
14 | $dbh = DBI->connect("dbi:Oracle:moira", "moira", "moira") || exit $MR_DBMS_ERR; |
---|
15 | |
---|
16 | $sth0 = $dbh->prepare("SELECT m.name FROM machine m, serverhosts sh " . |
---|
17 | "WHERE m.mach_id = sh.mach_id AND " . |
---|
18 | "sh.service = 'MAILMAN' AND sh.enable = 1"); |
---|
19 | $sth0->execute; |
---|
20 | |
---|
21 | while (($hostname) = $sth0->fetchrow_array) { |
---|
22 | open(OUT, ">$outdir/$hostname"); |
---|
23 | |
---|
24 | $sth1 = $dbh->prepare("SELECT l.name, l.memacl_type, l.memacl_id " . |
---|
25 | "FROM list l, machine m WHERE ". |
---|
26 | "l.mailman = 1 AND " . |
---|
27 | "m.name = " . $dbh->quote($hostname) . |
---|
28 | "AND m.mach_id = l.mailman_id AND l.active = 1" . |
---|
29 | "AND l.memacl_type != 'KERBEROS'") |
---|
30 | || exit $MR_DBMS_ERR; |
---|
31 | $sth1->execute; |
---|
32 | |
---|
33 | while (($listname, $memacl_type, $memacl_id) = $sth1->fetchrow_array) { |
---|
34 | $row = "$listname:"; |
---|
35 | $row =~ s/\0//g; |
---|
36 | print OUT $row; |
---|
37 | |
---|
38 | if ($memacl_type eq "USER") { |
---|
39 | ($member) = $dbh->selectrow_array("SELECT login FROM users " . |
---|
40 | "WHERE users_id = " . |
---|
41 | $dbh->quote($memacl_id)) || |
---|
42 | exit $MR_DBMS_ERR; |
---|
43 | $member = $member . "\@mit.edu"; |
---|
44 | $row = "$member"; |
---|
45 | print OUT $row; |
---|
46 | } else { |
---|
47 | $sth2 = $dbh->prepare("SELECT UNIQUE i.member_type, i.member_id " . |
---|
48 | "FROM imembers i, list l " . |
---|
49 | "WHERE l.list_id = " . |
---|
50 | $dbh->quote($memacl_id) . |
---|
51 | "AND i.list_id = l.list_id " . |
---|
52 | "AND (i.member_type = 'USER' " . |
---|
53 | "OR i.member_type = 'STRING')") || |
---|
54 | exit $MR_DBMS_ERR; |
---|
55 | $sth2->execute; |
---|
56 | $maybecomma = ""; |
---|
57 | |
---|
58 | while (($type, $id) = $sth2->fetchrow_array) { |
---|
59 | if ($type eq "USER") { |
---|
60 | ($member) = $dbh->selectrow_array("SELECT login " . |
---|
61 | "FROM users " . |
---|
62 | "WHERE users_id = " . |
---|
63 | $dbh->quote($id)) || |
---|
64 | exit $MR_DBMS_ERR; |
---|
65 | $member = $member . "\@mit.edu"; |
---|
66 | } |
---|
67 | elsif ($type eq "STRING") { |
---|
68 | ($member) = $dbh->selectrow_array("SELECT string " . |
---|
69 | "FROM strings " . |
---|
70 | "WHERE string_id = " . |
---|
71 | $dbh->quote($id)) || |
---|
72 | exit $MR_DBMS_ERR; |
---|
73 | } |
---|
74 | $row = "$maybecomma$member"; |
---|
75 | $row =~ s/\0//g; |
---|
76 | print OUT $row; |
---|
77 | $maybecomma = ","; |
---|
78 | } |
---|
79 | } |
---|
80 | $row = "\n"; |
---|
81 | $row =~ s/\0//g; |
---|
82 | print OUT $row; |
---|
83 | } |
---|
84 | close(OUT); |
---|
85 | } |
---|
86 | |
---|
87 | $dbh->disconnect; |
---|
88 | |
---|
89 | exit 0; |
---|