libaudit.pm.in 14.7 KB
Newer Older
1 2 3
#!/usr/bin/perl -w

#
4
# Copyright (c) 2000-2014 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/>.
# 
# }}}
24 25 26 27 28 29 30
#

package libaudit;
use Exporter;

@ISA = "Exporter";
@EXPORT =
31
    qw ( AuditStart AuditEnd AuditAbort AuditFork AuditSetARGV AuditGetARGV
Kevin Atkinson's avatar
Kevin Atkinson committed
32
	 AddAuditInfo
33
	 LogStart LogEnd LogAbort AuditDisconnect
34
	 LIBAUDIT_NODAEMON LIBAUDIT_DAEMON LIBAUDIT_LOGONLY
35
	 LIBAUDIT_NODELETE LIBAUDIT_FANCY LIBAUDIT_LOGTBOPS LIBAUDIT_LOGTBLOGS
36
       );
37 38 39

# After package decl.
use English;
40
use POSIX qw(isatty setsid dup2);
41 42
use File::Basename;
use IO::Handle;
Kevin Atkinson's avatar
Kevin Atkinson committed
43
use Carp;
44 45 46 47 48 49 50 51 52

#
# Testbed Support libraries
#
use libtestbed;

my $TBOPS	= "@TBOPSEMAIL@";
my $TBAUDIT	= "@TBAUDITEMAIL@";
my $TBLOGS	= "@TBLOGSEMAIL@";
53
my $OURDOMAIN   = "@OURDOMAIN@";
54 55
my $SCRIPTNAME	= "Unknown";
my $USERNAME    = "Unknown";
56
my $GCOS        = "Unknown";
57 58
my @SAVEARGV	= @ARGV;
my $SAVEPID	= $PID;
59 60
my $SAVE_STDOUT = 0;
my $SAVE_STDERR = 0;
61 62 63 64 65 66 67

# Indicates, this script is being audited.
my $auditing	= 0;

# Where the log is going. When not defined, do not send it in email!
my $logfile;

68 69
# Logonly, not to audit list.
my $logonly     = 0;
70 71
# Log to tbops or tblogs
my $logtblogs   = 0;
72

73 74 75
# Save log when logging only.
my $savelog     = 0;

Kevin Atkinson's avatar
Kevin Atkinson committed
76 77 78 79 80 81 82
# If set than send "fancy" email and also call tblog_find_error
# on errors
my $fancy       = 0;

# Extra info used when AUDIT_FANCY is set
my %AUDIT_INFO;

83 84 85 86 87 88 89 90 91
# Untainted scriptname for email below.
if ($PROGRAM_NAME =~ /^([-\w\.\/]+)$/) {
    $SCRIPTNAME = basename($1);
}
else {
    $SCRIPTNAME = "Tainted";
}

# The user running the script.
92
if (my ($name,undef,undef,undef,undef,undef,$gcos) = getpwuid($UID)) {
93
    $USERNAME = $name;
94
    $GCOS     = $gcos;
95 96
}

97 98 99 100 101 102 103
#
# Options to AuditStart.
#
sub LIBAUDIT_NODAEMON	{ 0; }
sub LIBAUDIT_DAEMON	{ 0x01; }
sub LIBAUDIT_LOGONLY	{ 0x02; }
sub LIBAUDIT_NODELETE	{ 0x04; }
Kevin Atkinson's avatar
Kevin Atkinson committed
104 105
sub LIBAUDIT_FANCY      { 0x08; } # Only use if libdb and libtblog are
                                  # already in use
106
sub LIBAUDIT_LOGTBOPS	{ 0x10; }
107
sub LIBAUDIT_LOGTBLOGS	{ 0x20; }
108

109 110 111 112 113 114
#
# Start an audit (or log) of a script. First arg is a flag indicating if
# the script should fork/detach. The second (optional) arg is a file name
# into which the log should be written. The return value is non-zero in the
# parent, and zero in the child (if detaching).
# 
115
sub AuditStart($;$$)
116
{
117
    my($daemon, $logname, $options) = @_;
118 119 120 121 122 123 124 125 126 127

    #
    # If we are already auditing, then do not audit a child script. This
    # would result in a blizzard of email! We wrote the scripts, so we
    # should now what they do!
    #
    if (defined($ENV{'TBAUDITON'})) {
	return;
    }

128
    # Logging instead of "auditing" ...
129
    if (defined($options)) {
130 131 132
	if ($options & LIBAUDIT_NODELETE()) {
	    $savelog = 1;
	}
133 134 135
	if ($options & LIBAUDIT_LOGONLY()) {
	    $logonly = 1;

136 137 138
	    if ($options & LIBAUDIT_LOGTBOPS()) {
		$logtbops = 1;
	    }
139 140 141
	    elsif ($options & LIBAUDIT_LOGTBLOGS()) {
		$logtblogs = 1;
	    }
142
	}
Kevin Atkinson's avatar
Kevin Atkinson committed
143 144 145 146 147 148
	if ($options & LIBAUDIT_FANCY()) {
	    if (!$INC{"libdb.pm"} || !$INC{"libtblog.pm"}) {
		croak "libdb and libtblog must be loaded when using LIBAUDIT_FANCY";
	    }
	    $fancy = 1;
	}
149 150
    }

151 152 153 154 155 156 157
    #
    # If this is an interactive session, then do not bother with a log
    # file. Just send it to the output and hope the user is smart enough to
    # save it off. We still want to audit the operation though, sending a
    # "what was done" message to the audit list, and CC it to tbops if it
    # exits with an error. But the log is the responsibility of the user.
    #
158 159 160 161 162
    if (!$daemon && isatty(STDIN)) {
	$auditing = 1;
	$ENV{'TBAUDITON'} = "$SCRIPTNAME:$USERNAME";
	return;
    }
163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181

    if (!defined($logname)) {
	$logfile = TBMakeLogname("$SCRIPTNAME");
    }
    else {
	$logfile = $logname;
    }
    $ENV{'TBAUDITLOG'} = $logfile;
    $ENV{'TBAUDITON'}  = "$SCRIPTNAME:$USERNAME";

    #
    # Okay, daemonize.
    #
    if ($daemon) {
	my $mypid = fork();
	if ($mypid) {
	    select(undef, undef, undef, 0.2);
	    return $mypid;
	}
Kevin Atkinson's avatar
Kevin Atkinson committed
182 183 184
	if (defined(&libtblog::tblog_new_child_process)) {
	    libtblog::tblog_new_child_process();
	}
185 186 187 188 189 190 191 192 193 194 195 196 197
    }
    $auditing = 1;

    #
    # If setuid, lets reset the owner/mode of the log file. Otherwise its
    # owned by root, mode 600 and a pain to deal with later, especially if
    # the script drops its privs!
    #
    if ($UID != $EUID) {
	chown($UID, $EUID, $logfile);
	chmod(0664, $logfile);
    }

198
    # Save old stderr and stdout.
199
    if (!$daemon && $PERL_VERSION >= 5.008) {
200 201 202 203 204
	eval("open(OLDOUT, \">&\", \*STDOUT); ".
	     "\$libaudit::SAVE_STDOUT = *OLDOUT; ".
	     "open(OLDERR, \">&\", \*STDERR); ".
	     "\$libaudit::SAVE_STDERR = *OLDERR;");
    }
205

206 207 208 209 210 211 212 213 214 215 216
    open(STDOUT, ">> $logfile") or
	die("opening $logfile for STDOUT: $!");
    open(STDERR, ">> $logfile") or
	die("opening $logfile for STDERR: $!");

    #
    # Turn off line buffering on output
    #
    STDOUT->autoflush(1);
    STDERR->autoflush(1);

217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232
    if ($daemon) {
	#
	# We have to disconnect from the caller by redirecting both
	# STDIN and STDOUT away from the pipe. Otherwise the caller
	# will continue to wait even though the parent has exited.
	#
	open(STDIN, "< /dev/null") or
	    die("opening /dev/null for STDIN: $!");

	#
	# Create a new session to ensure we are clear of any process group
	#
        POSIX::setsid() or
	    die("setsid failed: $!");
    }

233 234 235
    return 0;
}

236
# Logging, not auditing.
237
sub LogStart($;$$)
238
{
239 240 241
    my($daemon, $logname, $options) = @_;
    $options = 0
	if (!defined($options));
242

243
    return AuditStart($daemon, $logname, $options|LIBAUDIT_LOGONLY());
244 245
}

246
sub LogEnd(;$)
247
{
248 249 250
    my ($status) = @_;
    
    return AuditEnd($status);
251 252
}

253 254 255 256 257
sub LogAbort()
{
    return AuditAbort();
}

258 259 260
#
# Finish an Audit. 
#
261
sub AuditEnd(;$)
262
{
263 264 265 266 267 268
    my ($status) = @_;

    $status = 0
	if (!defined($status));
    
    SendAuditMail($status);
269
    delete @ENV{'TBAUDITLOG', 'TBAUDITON'};
270 271
    unlink($logfile)
	if (defined($logfile) && !$savelog);
272 273 274
    return 0;
}

275 276 277 278 279 280 281 282
#
# Overwrite our saved argv. Usefull when script contains something that
# should not go into a mail log.
#
sub AuditSetARGV(@)
{
    @SAVEARGV = @_;
}
283 284 285 286
sub AuditGetARGV()
{
    return @SAVEARGV;
}
287

288 289 290 291 292 293 294 295 296 297 298 299 300 301
sub AuditDisconnect()
{
    if ($auditing) {
	if (!$daemon && $PERL_VERSION >= 5.008 && $libaudit::SAVE_STDOUT) {
	    close($libaudit::SAVE_STDOUT);
	    close($libaudit::SAVE_STDERR);

	    open(FOO, "> /dev/null");
	    $libaudit::SAVE_STDOUT = *FOO;
	    $libaudit::SAVE_STDERR = *FOO;
	}
    }
}

302 303 304 305 306 307 308 309
#
# Abort an Audit. Dump the log file and do not send email.
#
sub AuditAbort()
{
    if ($auditing) {
	$auditing = 0;

310
	if (!$daemon && $PERL_VERSION >= 5.008 && $libaudit::SAVE_STDOUT) {
311 312 313 314
	    eval("open(STDOUT, \">&\", \$libaudit::SAVE_STDOUT); ".
		 "open(STDERR, \">&\", \$libaudit::SAVE_STDERR);");
	}

315 316 317 318 319
	if (defined($logfile)) {
	    #
	    # This should be okay; the process will keep writing to it,
	    # but will be deleted once the process ends and its closed.
	    #
320 321
	    unlink($logfile)
	    	if (!$savelog);
322 323
	    undef($logfile);
	}
324
	delete @ENV{'TBAUDITLOG', 'TBAUDITON'};
325 326 327 328 329 330 331 332 333 334
    }
    return 0;
}

#
# Ug, forked children result in multiple copies. It does not happen often
# since most forks result in an exec.
#
sub AuditFork()
{
335 336 337
    return 0
	if (!$auditing || !defined($logfile));

338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355
    open(LOG, ">> $logfile") or
	die("opening $logfile for $logfile: $!");
	
    close(STDOUT);
    close(STDERR);
    POSIX::dup2(fileno(LOG), 1);
    POSIX::dup2(fileno(LOG), 2);
    STDOUT->fdopen(1, "a");
    STDERR->fdopen(2, "a");
    close(LOG);

    #
    # Turn off line buffering on output
    #
    STDOUT->autoflush(1);
    STDERR->autoflush(1);

    #
356
    # Need to close these so that this side of the fork is disconnected.
357 358 359 360
    # Do NOT close the saved STDOUT/STDERR descriptors until the new
    # ones are open and dup'ed into fileno 1 and 2, and the LOG descriptor
    # closed. This was causing SelfLoader to get confused abut something!
    #
361
    if (!$daemon && $PERL_VERSION >= 5.008) {
362 363 364 365
	close($libaudit::SAVE_STDOUT)
	    if ($libaudit::SAVE_STDOUT);
	close($libaudit::SAVE_STDERR)
	    if ($libaudit::SAVE_STDERR);
366 367
	$libaudit::SAVE_STDOUT = 0;
	$libaudit::SAVE_STDERR = 0;
368 369
    }

370 371 372 373 374 375
    #
    # We have to disconnect STDIN from the caller too.
    #
    open(STDIN, "< /dev/null") or
	die("opening /dev/null for STDIN: $!");

376 377 378 379 380
    #
    # Create a new session to ensure we are clear of any process group.
    #
    POSIX::setsid();
    
381
    return 0;
382 383 384 385 386 387 388 389 390 391
}

#
# Internal function to send the email. First argument is exit status.
#
# Two messages are sent. A topical message is sent to the audit list. This
# is a short message that says what was done and by who. The actual log of
# what happened is sent to the logs list so that we can go back and see the
# details if needed.
# 
Kevin Atkinson's avatar
Kevin Atkinson committed
392
sub SendFancyMail($);
393 394 395 396 397 398 399 400
sub SendAuditMail($)
{
    my($exitstatus) = @_;
    
    if ($auditing) {
	# Avoid duplicate messages.
	$auditing = 0;

Kevin Atkinson's avatar
Kevin Atkinson committed
401 402 403 404 405 406
	# Needs to called here before STDOUT and STDERR is
	# redirectected below
	if ($exitstatus && $fancy) {
	    &libtblog::tblog_find_error(); 
	}

407
	if (!$daemon && $PERL_VERSION >= 5.008 && $libaudit::SAVE_STDOUT) {
408 409 410 411
	    eval("open(STDOUT, \">&\", \$libaudit::SAVE_STDOUT); ".
		 "open(STDERR, \">&\", \$libaudit::SAVE_STDERR);");
	}

412
	my $subject  = "$SCRIPTNAME @SAVEARGV";
413
	if ($exitstatus) {
414 415 416
	    $subject = "Failed: $subject";
	}

417 418
	my $body     = "$SCRIPTNAME @SAVEARGV\n" .
	               "Invoked by $USERNAME ($GCOS)";
419 420
	if ($exitstatus) {
	    $body   .= "\nExited with status: $exitstatus";
421
	}
422 423 424
	if (defined($AUDIT_INFO{'message'})) {
	    $body   .= "\n" . $AUDIT_INFO{'message'};
	}
425
	my $FROM     = "$GCOS <${USERNAME}\@${OURDOMAIN}>";
426

427 428 429
	if (! $logonly) {
	    SENDMAIL($TBAUDIT, $subject, $body, $FROM, undef, ());
	}
430 431

	# Success and no log ...
432
	if ($exitstatus == 0 && !(defined($logfile) && -s $logfile)) {
433 434 435
	    # Do not save empty logfile. 
	    unlink($logfile)
		if (defined($logfile));
436 437 438
	    return;
	}

Kevin Atkinson's avatar
Kevin Atkinson committed
439 440 441 442 443
	if ($fancy) {
	    SendFancyMail($exitstatus);
	    return;
	}

444 445 446 447 448 449 450 451
	#
	# Send logfile to tblogs. Carbon to tbops if it failed. If no logfile
	# then no point in sending to tblogs, obviously.
	#
	my $TO;
	my $HDRS  = "Reply-To: $TBOPS";
	my @FILES = ();
	
452
	if (defined($logfile) && -s $logfile) {
453
	    @FILES = ($logfile);
454 455

	    if ($logonly) {
456 457 458 459
		if (defined($AUDIT_INFO{'to'})) {
		    $TO    = join(', ', @{ $AUDIT_INFO{'to'} });
		}
		elsif ($logtbops) {
460 461
		    $TO    = $TBOPS;
		}
462 463 464 465
		elsif ($logtblogs) {
		    $TO    = $TBLOGS;
		    $HDRS .= "\nCC: $TBOPS" if ($exitstatus);
		}
466 467 468 469
		else {
		    $TO    = $FROM;
		    $HDRS .= "\nCC: ". ($exitstatus ? $TBOPS : $TBLOGS);
		}
470 471 472 473 474
	    }
	    else {
		$TO    = $TBLOGS;
		$HDRS .= "\nCC: $TBOPS" if ($exitstatus);
	    }
475
	}
476 477 478 479
	elsif ($logtblogs) {
	    $TO    = $TBLOGS;
	    $HDRS .= "\nCC: $TBOPS" if ($exitstatus);
	}
480 481 482
	else {
	    $TO    = $TBOPS;
	}
483 484 485 486
	if (defined($AUDIT_INFO{'cc'})) {
	    $HDRS .= "\n";
	    $HDRS .= "CC: " . join(', ', @{ $AUDIT_INFO{'cc'} });
	}
487

488 489 490
	# Leave logfile if sendmail fails. 
	if (SENDMAIL($TO, $subject, $body, $FROM, $HDRS, @FILES)) {
	    unlink($logfile)
491
		if (defined($logfile) && !$savelog);
492 493 494 495
	}
    }
}

Kevin Atkinson's avatar
Kevin Atkinson committed
496 497 498 499
sub SendFancyMail($)
{
    import libdb;
    import libtblog;
500
    import User;
Kevin Atkinson's avatar
Kevin Atkinson committed
501 502 503 504 505

    my ($exitstatus) = @_;
    
    my ($TO, $FROM);
    my ($name, $email);
506 507 508 509 510
    my $this_user = User->ThisUser();
    if (defined($this_user)) {
	$name  = $this_user->name();
	$email = $this_user->email();
	$TO    = "$name <$email>";
Kevin Atkinson's avatar
Kevin Atkinson committed
511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572
    } else {
	$TO = "$GCOS <${USERNAME}\@${OURDOMAIN}>";
    }
    $FROM = $TO;

    my @FILES;
    
    if (defined($logfile) && -s $logfile) {
	@FILES = ($logfile);
    }

    # Avoid sending a person the same email twice
    my $extra_cc;
    if (defined ($AUDIT_INFO{cc})) {
	my @cc;
	my @prev_emails = ($email);
	OUTER: foreach (@{$AUDIT_INFO{cc}}) {
	    ($email) = /([^<> \t@]+@[^<> \t@]+)/;
	    foreach my $e (@prev_emails) {
		next OUTER if $email eq $e;
		push @prev_email, $e;
	    }
	    push @cc, $_;
	}
	if (@cc) {
	    $extra_cc = "Cc: ";
	    $extra_cc .= join(', ', @cc);
	}
    }

    my $sendmail_res;
    if ($exitstatus) {
	my $d = tblog_lookup_error();
	my $prefix;
	$prefix .= "$SCRIPTNAME @SAVEARGV\n";
	$prefix .= "Exited with status: $exitstatus";
	my $what = "Failed: $SCRIPTNAME";
	$what = $AUDIT_INFO{failure_frag} if defined $AUDIT_INFO{failure_frag};
	$which = $AUDIT_INFO{which};
	$sendmail_res 
	    = tblog_email_error($d, $TO, $what,	$which, 
				$FROM, $extra_cc, "Cc: $TBOPS",
				$prefix, @FILES); 

    } else {

	my $subject  = "$SCRIPTNAME succeeded";
	$subject = $AUDIT_INFO{success_frag} if defined $AUDIT_INFO{success_frag};
	$subject .= ": $AUDIT_INFO{which}" if defined $AUDIT_INFO{which};
	my $body     = "$SCRIPTNAME @SAVEARGV\n";

	my $HDRS;
	$HDRS .= "$extra_cc\n" if defined $extra_cc;
	$HDRS .= "Reply-To: $TBOPS\n";
	$HDRS .= "Bcc: $TBLOGS";
	
	$sendmail_res 
	    = SENDMAIL($TO, $subject, $body, $FROM, $HDRS, @FILES);
    }
    
    if ($sendmail_res) {
	unlink($logfile)
573
	    if (defined($logfile) && !$savelog);
Kevin Atkinson's avatar
Kevin Atkinson committed
574 575 576 577 578 579 580 581 582 583
    }
}


# Info on possibe values for AUDIT_INFO
# [KEY => string|list]
my %AUDIT_METAINFO = 
    ( which => 'string',        # ex "PROJ/EXP"
      success_frag => 'string', # ex "T. Swapped In"
      failure_frag => 'string', # ie "Bla Failure"
584
      message      => 'string',
585 586
      to           => 'list',   # Send audit mail to these people
      cc           => 'list');  # Cc audit mail to these people
Kevin Atkinson's avatar
Kevin Atkinson committed
587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624

#
# AddAuditInfo($key, $value)
#   add additional information for libaudit to use in SendAuditMail
#   when AUDIT_FANCY is set
#
# TODO: Eventually child scripts should be able to use AddAuditInfo, not 
#   just the script in which AuditStart(...) was called.  This will probably
#   involve storing the values in the database somehow.
#
sub AddAuditInfo ($$) {
    my ($key, $value) = @_;

    if (!$auditing) {

	carp "AddAuditInfo($key, ...) ignored since the script isn't being audited.";
	return 0;

    }

    if ($AUDIT_METAINFO{$key} eq 'string') {
	
	$AUDIT_INFO{$key} = $value;
	return 1;

    } elsif ($AUDIT_METAINFO{$key} eq 'list') {

	push @{$AUDIT_INFO{$key}}, $value;
	return 1;

    } else {

	carp "Unknown key, \"$key\" in AddAuditInfo";
	return 0;

    }
}

625 626 627 628 629 630 631 632 633 634 635 636 637
#
# When the script ends, if the audit has not been sent, send it. 
# 
END {
    # Save, since shell commands will alter it.
    my $exitstatus = $?;
    
    SendAuditMail($exitstatus);

    $? = $exitstatus;
}

1;