source: trunk/third/moira/regtape/stellar.pl @ 23932

Revision 23932, 5.4 KB checked in by broder, 15 years ago (diff)
In moira: * New CVS snapshot.
  • Property svn:executable set to *
RevLine 
[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';
11if ( ! -x $sendmail) { $sendmail = '/usr/sbin/sendmail'; }
12
13use 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;
27while (($name) = $sth->fetchrow_array) {
28    $lists{$name} = $name;
29}
30
31open(MRTEST, "|$mrtest >/dev/null 2>&1");
32print MRTEST "connect $db\n";
33print MRTEST "auth\n";
34open(LOG, ">>$logfile");
35
36open(DATA, "$datafile") or die "Unable to open $datafile: $!\n";
37while (<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
135close(DATA);
136$moira->disconnect;
137
138if (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
152exit 0;
153
154sub 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
162sub add_member {
163    my ( $user, $type, $list ) = @_;
164    print MRTEST "qy amtl $list $type $user\n";
165}
166
167sub del_member {
168    my ( $user, $type, $list ) = @_;
169    print MRTEST "qy dmfl $list $type $user\n";
170}
Note: See TracBrowser for help on using the repository browser.