genelists.in 14.5 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh Stoller's avatar
Leigh Stoller committed
2 3

#
4
# Copyright (c) 2000-2019 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Leigh Stoller's avatar
Leigh Stoller committed
24
#
25
use Fcntl ':flock';
26
use English;
27
use Getopt::Std;
28 29

sub usage() {
30 31 32
    print("Usage: genelists [-d] [-n] -a\n".
	  "Usage: genelists [-d] [-n] [-m] -u user\n".
	  "Usage: genelists [-d] [-n] -p project\n".
33
	  "Usage: genelists [-d] [-n] [-P | -t]\n".
34 35 36 37 38
	  "where:\n".
	  "  -d    - Turn on debugging\n".
	  "  -n    - Impotent mode\n".
	  "  -u    - Generate lists for a user; add -m for new email address\n".
	  "  -p    - Generate lists for a project (includes subgroups)\n".
39
	  "  -P    - Generate lists for all projects (includes subgroups)\n".
40
	  "  -t    - Generate activity lists\n".
41
	  "  -c    - Generate just the current users list\n".
42
	  "  -a    - Generate all email lists; careful ...\n");
43 44
    exit(-1);
}
45 46 47 48

sub ActiveUsers();
sub RecentUsers();
sub RecentProjects();
49
sub RecentProjectLeaders();
50 51
sub ProjectLeaders();
sub ProjectLists($$);
52
sub genelist($$$$);
53

54
my $optlist = "anu:p:tdmfcP";
55 56 57 58
my $debug   = 0;
my $all     = 0;
my $update  = 0;
my $activity= 0;
59
my $projects= 0;
60
my $current = 0;
61
my $impotent= 0;
62
my $force   = 0;
63 64
my $pid;
my $user;
65 66 67 68

# Configure variables
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
69
my $USERS       = "@USERNODE@";
70
my $OURDOMAIN   = "@OURDOMAIN@";
71 72
my $TBACTIVE    = "@TBACTIVEARCHIVE@";
my $TBALL       = "@TBUSERSARCHIVE@";
73
my $ELISTS      = "$TB/lists";
74
my $ELABINELAB  = @ELABINELAB@;
75
my $MAILMANSUPPORT= @MAILMANSUPPORT@;
76
my $PROJECTMAILLISTS = @PROJECTMAILLISTS@;
77
my $MMPROG	= "$TB/sbin/setmmlistmembers";
78
my $PGENISUPPORT= @PROTOGENI_SUPPORT@;
79 80

# Note no -n option. We redirect stdin from the new exports file below.
81
my $SSH		= "$TB/bin/sshtb -l root -host $USERS";
82
my $PROG	= "/usr/testbed/sbin/genelists.proxy";
83
my $lockfile    = "/var/tmp/testbed_genelists_lockfile";
84
my $tempfile    = "/var/tmp/testbed_genelists_tempfile";
85
my $SAVEUID	= $UID;
86

87 88 89
#
# Turn off line buffering on output
#
90
$| = 1;
91 92

# Load the Testbed support stuff.
93
use lib "@prefix@/lib";
94
use emdbi;
95 96
use libdb;
use libtestbed;
97
use libtblog;
98
use User;
99

100 101 102 103
#
# We don't want to run this script unless its the real version.
#
if ($EUID != 0) {
Leigh Stoller's avatar
Leigh Stoller committed
104 105
    die("*** $0:\n".
	"    Must be root! Maybe its a development version?\n");
106 107
}
# XXX Hacky!
108
if (0 && $TB ne "/usr/testbed") {
Leigh Stoller's avatar
Leigh Stoller committed
109 110
    die("*** $0:\n".
	"    Wrong version. Maybe its a development version?\n");
111
}
112 113 114 115 116 117 118

#
# un-taint path
#
$ENV{'PATH'} = '/bin:/usr/bin:/usr/sbin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

119 120 121 122 123 124 125 126 127 128 129
#
# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV) {
    usage();
}
130
if (defined($options{"d"})) {
131
    $debug++;
132
}
133 134 135
if (defined($options{"f"})) {
    $force = 1;
}
136 137 138
if (defined($options{"c"})) {
    $current = 1;
}
139
if (defined($options{"a"})) {
140 141 142 143 144
    $all = 1;
}
if (defined($options{"m"})) {
    $update = 1;
}
145 146 147
if (defined($options{"P"})) {
    $projects = 1;
}
148 149
if (defined($options{"t"})) {
    $activity = 1;
150 151
}
if (defined($options{"n"})) {
152 153 154 155 156
    $impotent = 1;
}
if (defined($options{"u"})) {
    $user = $options{"u"};
    
157 158 159
    #
    # Untaint.
    #
160 161
    if ($user =~ /^([-\w]+)$/) {
	$user = $1;
162 163
    }
    else {
164
	die("Tainted argument $user!\n");
165 166
    }
}
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185

if (defined($options{"p"})) {
    $pid = $options{"p"};
    
    #
    # Untaint.
    #
    if ($pid =~ /^([-\w]+)$/) {
	$pid = $1;
    }
    else {
	die("Tainted argument $pid!\n");
    }
}

if (defined($user) && defined($pid)) {
    usage();
}
if ($update && !defined($user)) {
186 187 188
    usage();
}

189 190
#
# We need to serialize this script to avoid a trashed map file. Use
191
# a dummy file in /var/tmp, opened for writing and flock'ed.
192
#
193 194
open(LOCK, ">>$lockfile") || fatal("Couldn't open $lockfile\n");
$count = 0;
195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226
if (flock(LOCK, LOCK_EX|LOCK_NB) == 0) {
    #
    # If we don't get it the first time, we wait for:
    # 1) The lock to become free, in which case we do our thing
    # 2) The time on the lock to change, in which case we wait for that process
    #    to finish
    #
    my $oldlocktime = (stat(LOCK))[9];
    my $gotlock = 0;
    while (1) {
	print "Another genelists in progress, waiting for it to finish\n";
	if (flock(LOCK, LOCK_EX|LOCK_NB) != 0) {
	    # OK, got the lock, we can do what we're supposed to
	    $gotlock = 1;
	    last;
	}
	$locktime = (stat(LOCK))[9];
	if ($locktime != $oldlocktime) {
	    $oldlocktime = $locktime;
	    last;
	}
	if ($count++ > 20)  {
	    fatal("Could not get the lock after a long time!\n");
	}
	sleep(1);
    }

    $count = 0;
    #
    # If we didn't get the lock, wait for the processes that did to finish
    #
    if (!$gotlock) {
227 228 229 230 231 232 233 234
	while (1) {
	    if ((stat(LOCK))[9] != $oldlocktime) {
		exit(0);
	    }
	    if (flock(LOCK, LOCK_EX|LOCK_NB) != 0) {
		close(LOCK);
		exit(0);
	    }
235
	    if ($count++ > 30)  {
236
		fatal("Process with the lock didn't finish after a long time!\n");
237
	    }
238
	    sleep(1);
239
	}
240 241 242
    }
}

243 244 245 246 247 248
#
# Perl-style touch(1)
#
my $now = time;
utime $now, $now, $lockfile;

249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
#
# Grab the mailman admin password for TBOPS.
#
my $admin_address;

if ($MAILMANSUPPORT) {
    my $mailman_password;
    
    if (! TBGetSiteVar("general/mailman/password", \$mailman_password)) {
	fatal("Could not mailman admin password from sitevars!");
    }
    $admin_address = "$TBOPS $mailman_password 'Emulab Operations'";
}
else {
    $admin_address = $TBOPS;
}

266
ActiveUsers()
267
    if ($all || $activity || $update || $current);
268 269 270 271 272 273 274

RecentUsers()
    if ($all || $activity || $update);

RecentProjects()
    if ($all || $activity || $update);

275 276 277
RecentProjectLeaders()
    if ($all || $activity || $update);

278 279 280
ProjectLeaders()
    if ($all || defined($user) || defined($pid));

281
if ($all || $projects || defined($user) || defined($pid)) {
282 283 284 285
    my $query;
    my $phash = {};
    my $query_result;
    
286
    if ($all || $projects) {
287 288
	$query = "select g.pid,g.gid from groups as g ".
		 "left join projects as p on p.pid=g.pid ".
289 290
		 "where p.approved=1 and p.nonlocal_id is null ".
		 "order by g.pid,g.gid";
291 292
    }
    elsif ($user) {
293 294 295 296 297
	$query  = "select g.pid,g.gid from group_membership as g ".
	          "left join projects as p on p.pid=g.pid ".
		  "where g.uid='$user' and p.approved=1 and ".
		  "    p.nonlocal_id is null " .
		  "order by g.pid,g.gid";
298 299
    }
    else {
300 301
	$query  = "select g.pid,g.gid from groups as g ".
	          "left join projects as p on p.pid=g.pid ".
302
		  "where g.pid='$pid' and p.nonlocal_id is null " .
303
		  "order by g.pid,g.gid";
304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324
    }

    if (! ($query_result = DBQuery($query))) {
	DBFatal("Getting Project List!");
    }
    while (my ($pid,$gid) = $query_result->fetchrow_array()) {
	ProjectLists($pid, $gid);
    }
}

#
# Close the lock file. Exiting releases it, but might as well.
#
close(LOCK);
exit 0;

#
# All active users on the testbed
#
sub ActiveUsers()
{
325
    my $userlist;
326 327 328 329 330 331 332
    my $query_result;

    print "Getting Active Users\n" if $debug;
    
    if (! ($query_result =
	   DBQuery("SELECT DISTINCT u.usr_email from experiments as e ".
		   "left join group_membership as p ".
333
		   "     on e.pid_idx=p.pid_idx and p.pid_idx=p.gid_idx ".
334
		   "left join users as u on u.uid_idx=p.uid_idx ".
335 336 337 338 339 340 341
		   "where u.status='active' and ".
		   "      e.state='active' ".
		   "order by u.usr_email"))) {
	DBFatal("Getting Active Users!");
    }
    $userlist = "$TBOPS\n".
	        "$TBACTIVE";
342

343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363
    if ($PGENISUPPORT) {
	require GeniDB;
	require GeniUser;
	require GeniHRN;

	if (emdbi::DBExists(GeniDB::GENICM_DBNAME())) {
	    # Connect to the proper DB.
	    GeniDB::DBConnect(GeniDB::GENICM_DBNAME());

	    my $geni_users =
		GeniDB::DBQueryFatal("select distinct u.email ".
				     "  from geni_aggregates as a ".
				     "left join geni_users as u on ".
				     "     a.creator_uuid=u.uuid ".
				     "where u.email is not null");
	    
	    while (my ($email) = $geni_users->fetchrow_array()) {
		$userlist = "$email\n" . $userlist;
	    }
	}
    }
364
    genelist($query_result, $userlist, "emulab-active-users", 0);
365 366 367 368 369 370 371 372 373 374 375 376 377 378
}

#
# Recently active users.
# 
sub RecentUsers()
{
    my $userlist;
    my $query_result;

    my $limit = (60 * 60 * 24) * TBGetSiteVar("general/recently_active");
    print "Getting Recently Active Users\n" if $debug;

    if (! ($query_result =
379
	   DBQuery("select distinct u.usr_email from user_stats as s ".
380
		   "left join users as u on u.uid_idx=s.uid_idx ".
381 382
		   "where ((UNIX_TIMESTAMP(now()) - ".
		   "       UNIX_TIMESTAMP(s.last_activity)) <= $limit) ".
383 384
		   "order by u.usr_email"))) {
	DBFatal("Getting Recently Active Users!");
385
    }
386 387
    $userlist  = "$TBOPS\n";
    $userlist .= "$TBACTIVE";
388

389
    genelist($query_result, $userlist, "emulab-recently-active-users", 0);
390 391 392 393 394 395 396 397 398 399 400 401 402 403
}

#
# Recently active projects (members).
#
sub RecentProjects()
{
    my $userlist;
    my $query_result;

    my $limit = (60 * 60 * 24) * TBGetSiteVar("general/recently_active");
    print "Getting Recently Active Projects (members)\n" if $debug;

    if (! ($query_result =
404 405
	   DBQuery("select distinct u.usr_email from project_stats as s ".
		   "left join group_membership as g on ".
406
		   "  g.pid_idx=s.pid_idx and g.gid_idx=g.pid_idx ".
407
		   "left join users as u on u.uid_idx=g.uid_idx ".
408 409 410
		   "where u.status='active' and ".
		   "      ((UNIX_TIMESTAMP(now()) - ".
		   "       UNIX_TIMESTAMP(s.last_activity)) <= $limit) ".
411 412
		   "order by u.usr_email"))) {
	DBFatal("Getting Recently Active Projects!");
413
    }
414 415
    $userlist  = "$TBOPS\n";
    $userlist .= "$TBACTIVE";
416

417
    genelist($query_result, $userlist, "emulab-recently-active-projects", 0);
418 419
}

420 421 422 423 424 425 426 427 428 429 430 431 432
#
# Recently active projects (leaders).
#
sub RecentProjectLeaders()
{
    my $userlist;
    my $query_result;

    my $limit = (60 * 60 * 24) * TBGetSiteVar("general/recently_active");

    if (! ($query_result =
	   DBQuery("select distinct u.usr_email from project_stats as s ".
		   "left join group_membership as g on ".
433
		   "  g.pid_idx=s.pid_idx and g.gid_idx=g.pid_idx ".
434
		   "left join users as u on u.uid_idx=g.uid_idx ".
435
                   "left join projects as p on u.uid_idx=p.head_idx ".
436 437 438 439 440 441 442 443 444 445 446 447 448 449
		   "where u.status='active' and ".
		   "      ((UNIX_TIMESTAMP(now()) - ".
		   "       UNIX_TIMESTAMP(s.last_activity)) <= $limit) ".
                   " and p.pid is not null " .
		   "order by u.usr_email"))) {
	DBFatal("Getting Recently Active Project Leaders!");
    }
    $userlist  = "$TBOPS\n";
    $userlist .= "$TBACTIVE";

    genelist($query_result, $userlist,
             "emulab-recently-active-project-leaders", 0);
}

450
#
451
# Another list of project leaders.
452
#
453 454 455
sub ProjectLeaders()
{
    my $query_result =
456 457 458 459
	DBQueryFatal("SELECT DISTINCT u.usr_email ".
		     ($MAILMANSUPPORT ?
		      ", u.uid ,u.usr_name, u.mailman_password " : "") .
		     "  from projects as p ".
460
		     "left join users as u on u.uid_idx=p.head_idx ".
461 462
		     "where p.approved!=0 ".
		     "order by usr_email");
463

464
    genelist($query_result, "$TBOPS", "emulab-project-leaders", 0);
465
}
466

467
#
468
# Regen project lists. 
469
#
470 471 472
sub ProjectLists($$)
{
    my ($pid, $gid) = @_;
473 474
    my $proj_result;

475 476 477
    return
	if (!$PROJECTMAILLISTS);

478
    print "Getting project members for $pid/$gid\n" if $debug;
479

480
    my $query_result =
481 482 483 484
	DBQueryFatal("SELECT distinct u.usr_email ".
		     ($MAILMANSUPPORT ?
		      ", u.uid ,u.usr_name, u.mailman_password " : "") .
		     " from group_membership as p ".
485
		     "left join users as u on u.uid_idx=p.uid_idx ".
486
		     "where p.pid='$pid' and p.gid='$gid' and ".
487
		     " p.trust!='none' and u.status='active' ".
488
		     "order by u.usr_email");
489

490 491
    if ($query_result->numrows) {
	if ($pid eq $gid) {
492 493
	    genelist($query_result, undef, "$pid-users",
		     ($pid eq "CloudLab" ? 0 : 1));
494 495
	}
	else {
496 497
	    genelist($query_result, undef, "$pid-$gid-users",
		     ($ELABINELAB ? 0 : 1));
498 499 500 501 502 503 504
	}
    }
}

#
# Generate and fire over a list.
#
505
sub genelist($$$$)
506
{
507
    my($query_result, $inituserlist, $listname, $usemailman) = @_;
508 509

    print "Processing $listname at: \t".time()." \t(".
510
      $query_result->numrows()." entries)\n" if $debug>1;
511

512 513
    open(LIST,"> $tempfile") ||
	fatal("Couldn't open $tempfile: $!\n");
514

515 516 517
    print LIST "#\n";
    print LIST "# WARNING! THIS FILE IS AUTOGENERATED. DO NOT EDIT!\n";
    print LIST "#\n";
518 519 520
    if (defined($inituserlist)) {
	print LIST "$inituserlist\n";
    }
521 522

    for ($i = 0; $i < $query_result->numrows; $i++) {
523 524 525
	my ($user_email, $uid, $user_name, $mailman_password) =
	    $query_result->fetchrow_array();
	
526 527 528
	if (! defined($user_email)) {
	    next;
	}
529 530
	# HACK! These special accounts should be flagged in the DB
	next 
531 532 533
	    if ($usemailman && $MAILMANSUPPORT &&
		($uid eq "elabman" || $uid eq "elabckup" ||
		 $uid eq "operator"));
534
	
535
	if ($usemailman && $MAILMANSUPPORT) {
536
	    print LIST "$uid $user_email $mailman_password '$user_name'\n";
537 538 539 540 541
	}
	else {
	    print LIST "$user_email\n";
	    print "$user_email\n" if $debug>1;
	}
542 543
    }
    close(LIST);
544 545 546 547 548 549
    chmod(0664, $tempfile);

    if (! -d $ELISTS) {
	if (! mkdir($ELISTS, 0770)) {
	    fatal("Could not make directory $ELISTS: $!");
	}
550

551 552 553 554 555 556 557
	if (! chmod(0775, $ELISTS)) {
	    fatal("Could not chmod directory $ELISTS: $!");
	}
    }

    if (-e "$ELISTS/$listname" &&
	system("cmp -s $tempfile $ELISTS/$listname") == 0) {
558
	print "$listname has not changed. Skipping.\n"
559
	    if ($debug && !$force);
560 561 562 563
	if (!$force) {
	    unlink("$tempfile");
	    return;
	}
564 565
    }

Leigh Stoller's avatar
Leigh Stoller committed
566
    system("/bin/cp -pf $tempfile $ELISTS/$listname") == 0 ||
567 568
	fatal("Could not move $tempfile to $ELISTS/$listname: $!");
    
569 570 571
    #
    # Fire the new file over to the fileserver to finish up.
    #
572
    if (!$impotent) {
573 574 575 576 577 578 579 580 581 582 583 584 585 586
	if ($usemailman && $MAILMANSUPPORT) {
	    my $optarg = ($debug ? "-d" : "");

	    $EUID = $UID;
	    system("$MMPROG $optarg $listname $tempfile") == 0 or
		fatal("Failed: $MMPROG $listname $tempfile: $?");
	    $EUID = 0;
	}
	else {
	    $UID = 0;
	    system("$SSH $PROG $listname < $tempfile") == 0 or
		fatal("Failed: $SSH $PROG $listname < $tempfile: $?");
	    $UID = $SAVEUID;
	}
587
    }
588
    unlink("$tempfile");
589 590
}

591 592
sub fatal {
  local($msg) = $_[0];
593
  SENDMAIL($TBOPS, "Failure Generating Email Lists", $msg);
594 595
  die($msg);
}