1 | #!/moira/bin/perl -Tw |
---|
2 | # $Id: stellar.pl 4037 2011-04-21 16:18:33Z zacheiss $ |
---|
3 | |
---|
4 | $db = ""; |
---|
5 | $mrtest = "mrtest"; |
---|
6 | $logfile = "/moira/stellar.log"; |
---|
7 | $datafile = "/moira/stellar/stellar-groups"; |
---|
8 | $ENV{'PATH'} = "/moira/bin"; |
---|
9 | |
---|
10 | $sendmail = '/usr/lib/sendmail'; |
---|
11 | if ( ! -x $sendmail) { $sendmail = '/usr/sbin/sendmail'; } |
---|
12 | |
---|
13 | use DBI; |
---|
14 | |
---|
15 | $moira = DBI->connect("dbi:Oracle:moira", "moira", "moira", |
---|
16 | { RaiseError => 1}); |
---|
17 | |
---|
18 | ($root_id) = $moira->selectrow_array("SELECT users_id FROM users ". |
---|
19 | "WHERE login = 'root'"); |
---|
20 | |
---|
21 | # Get names of current Stellar lists |
---|
22 | ($admin_id) = $moira->selectrow_array("SELECT list_id FROM list ". |
---|
23 | "WHERE name = 'stellar-group-admin'"); |
---|
24 | $sth = $moira->prepare("SELECT name FROM list WHERE acl_type = 'LIST' ". |
---|
25 | "AND acl_id = $admin_id"); |
---|
26 | $sth->execute; |
---|
27 | while (($name) = $sth->fetchrow_array) { |
---|
28 | $lists{$name} = $name; |
---|
29 | } |
---|
30 | |
---|
31 | open(MRTEST, "|$mrtest >/dev/null 2>&1"); |
---|
32 | print MRTEST "connect $db\n"; |
---|
33 | print MRTEST "auth\n"; |
---|
34 | open(LOG, ">>$logfile"); |
---|
35 | |
---|
36 | open(DATA, "$datafile") or die "Unable to open $datafile: $!\n"; |
---|
37 | while (<DATA>) { |
---|
38 | $changed = 0; |
---|
39 | ($stellargroup, $junk, $membership) = split(/:/); |
---|
40 | chomp($stellargroup); |
---|
41 | chomp($junk); |
---|
42 | chomp($membership); |
---|
43 | $stellargroup = lc($stellargroup); |
---|
44 | @membership = split(/[,]+/, $membership); |
---|
45 | |
---|
46 | # Skip lists with leading dashes. They scare us. |
---|
47 | if ($stellargroup =~ /^-/) { |
---|
48 | print LOG "Skipping $stellargroup due to leading dash.\n"; |
---|
49 | push(@mailout, "Skipping $stellargroup due to leading dash.\n"); |
---|
50 | next; |
---|
51 | } |
---|
52 | |
---|
53 | # Skip lists with names that are too long. |
---|
54 | if (length($stellargroup) > 56) { |
---|
55 | print LOG "Skipping $stellargroup due to name longer than 56 characters.\n"; |
---|
56 | push(@mailout, "Skipping $stellargroup due to name longer than 56 characters.\n"); |
---|
57 | next; |
---|
58 | } |
---|
59 | |
---|
60 | ($conflict_exists) = $moira->selectrow_array("SELECT count(*) FROM list ". |
---|
61 | "WHERE name = " . $moira->quote($stellargroup) . |
---|
62 | "AND ((acl_type != 'LIST') OR " . |
---|
63 | "(acl_type = 'LIST' AND acl_id != $admin_id))"); |
---|
64 | if ($conflict_exists > 0) { |
---|
65 | print LOG "$stellargroup already exists with an owner other than stellar-group-admin.\n"; |
---|
66 | push(@mailout, "$stellargroup already exists with an owner other than stellar-group-admin.\n"); |
---|
67 | next; |
---|
68 | } |
---|
69 | |
---|
70 | # Create list if it doesn't exist. |
---|
71 | &check_list($stellargroup, "stellar-group-admin", 1, "Automatically imported from Stellar"); |
---|
72 | |
---|
73 | # Now fill in lists. |
---|
74 | %mrmembers = (); |
---|
75 | $sth = $moira->prepare("SELECT u.login FROM users u, imembers i, list l ". |
---|
76 | "WHERE l.list_id = i.list_id AND i.member_id = ". |
---|
77 | "u.users_id AND i.direct = 1 AND i.member_type = ". |
---|
78 | "'USER' AND l.name = " . $moira->quote($stellargroup)); |
---|
79 | $sth->execute; |
---|
80 | while (($login) = $sth->fetchrow_array) { |
---|
81 | $mrmembers{$login} = $login; |
---|
82 | } |
---|
83 | |
---|
84 | $sth = $moira->prepare("SELECT s.string FROM strings s, imembers i, list l ". |
---|
85 | "WHERE l.list_id = i.list_id AND i.member_id = ". |
---|
86 | "s.string_id AND i.direct = 1 AND i.member_type = ". |
---|
87 | "'STRING' AND l.name = " . $moira->quote($stellargroup)); |
---|
88 | $sth->execute; |
---|
89 | while (($string) = $sth->fetchrow_array) { |
---|
90 | $mrmembers{$string} = $string; |
---|
91 | } |
---|
92 | |
---|
93 | foreach $member (@membership) { |
---|
94 | if ($member =~ /\@mit.edu/) { |
---|
95 | $member =~ s/\@mit.edu//; |
---|
96 | if (!$mrmembers{$member}) { |
---|
97 | print LOG "Adding USER $member to $stellargroup\n"; |
---|
98 | &add_member($member, USER, $stellargroup); |
---|
99 | $changed = 1; |
---|
100 | } else { |
---|
101 | delete $mrmembers{$member}; |
---|
102 | } |
---|
103 | } else { |
---|
104 | if (!$mrmembers{$member}) { |
---|
105 | print LOG "Adding STRING $member to $stellargroup\n"; |
---|
106 | &add_member($member, STRING, $stellargroup); |
---|
107 | $changed = 1; |
---|
108 | } else { |
---|
109 | delete $mrmembers{$member}; |
---|
110 | } |
---|
111 | } |
---|
112 | } |
---|
113 | |
---|
114 | # Everyone in membership will have been removed from mrmembers |
---|
115 | # now, so delete the remaining users since they don't belong. |
---|
116 | foreach $member (keys(%mrmembers)) { |
---|
117 | if ($member =~ /\@/) { |
---|
118 | print LOG "Deleting STRING $member from $stellargroup\n"; |
---|
119 | &del_member($member, STRING, $stellargroup); |
---|
120 | $changed = 1; |
---|
121 | } else { |
---|
122 | print LOG "Deleting USER $member from $stellargroup\n"; |
---|
123 | &del_member($member, USER, $stellargroup); |
---|
124 | $changed = 1; |
---|
125 | } |
---|
126 | } |
---|
127 | |
---|
128 | if ($changed) { |
---|
129 | $moira->do("UPDATE list SET modtime = SYSDATE, modby = $root_id, ". |
---|
130 | "modwith = 'stellar' WHERE name = " . |
---|
131 | $moira->quote($stellargroup)); |
---|
132 | } |
---|
133 | } |
---|
134 | |
---|
135 | close(DATA); |
---|
136 | $moira->disconnect; |
---|
137 | |
---|
138 | if (scalar(@mailout) > 0) { |
---|
139 | print LOG "Found problems. Sending mail.\n"; |
---|
140 | open(MAIL, "|$sendmail -t -f errors\@mit.edu" ) || die "Failed to run $sendmail"; |
---|
141 | print MAIL "From: errors\@mit.edu\nTo: class-wiki-request\@mit.edu\nCc: zacheiss\@mit.edu\n"; |
---|
142 | print MAIL "Subject: Moira Stellar group data load problems\n"; |
---|
143 | print MAIL "The following problems were found during the Moira import of Stellar group data:\n\n"; |
---|
144 | foreach $line (@mailout) { |
---|
145 | print MAIL $line; |
---|
146 | } |
---|
147 | close(MAIL); |
---|
148 | } else { |
---|
149 | print LOG "No problems found.\n"; |
---|
150 | } |
---|
151 | |
---|
152 | exit 0; |
---|
153 | |
---|
154 | sub check_list { |
---|
155 | my ( $name, $owner, $export, $desc ) = @_; |
---|
156 | if (!$lists{$name}) { |
---|
157 | print LOG "Creating $name\n"; |
---|
158 | print MRTEST "qy alis $name 1 0 1 1 $export \"create unique GID\" 0 0 [NONE] LIST $owner NONE NONE \"$desc\"\n"; |
---|
159 | } |
---|
160 | } |
---|
161 | |
---|
162 | sub add_member { |
---|
163 | my ( $user, $type, $list ) = @_; |
---|
164 | print MRTEST "qy amtl $list $type $user\n"; |
---|
165 | } |
---|
166 | |
---|
167 | sub del_member { |
---|
168 | my ( $user, $type, $list ) = @_; |
---|
169 | print MRTEST "qy dmfl $list $type $user\n"; |
---|
170 | } |
---|