]>
Commit | Line | Data |
---|---|---|
09a62ac4 | 1 | #!/moira/bin/perl -Tw |
2 | # $Id$ | |
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", 0, "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"; | |
52abd78e | 158 | print MRTEST "qy alis $name 1 0 1 1 $export \"create unique GID\" 0 0 [NONE] LIST $owner NONE NONE \"$desc\"\n"; |
09a62ac4 | 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 | } |