[23932] | 1 | #!/moira/bin/perl -Tw |
---|
| 2 | # $Id: stellar.pl,v 1.2 2009-07-07 03:09:30 zacheiss Exp $ |
---|
| 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"; |
---|
| 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 | } |
---|