spewlogfile.in 3.33 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh Stoller's avatar
Leigh Stoller committed
2 3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2010 University of Utah and the Flux Group.
Leigh Stoller's avatar
Leigh Stoller committed
5 6
# All rights reserved.
#
7
use strict;
8 9 10 11
use English;
use Getopt::Std;

#
12 13 14
# Spew the current log file for an experiment or template to stdout.
# This is for use by the web interface, so it can send the logfile to
# the user in a web page.
15 16 17 18 19 20 21
#
# The wrinkle is that the logfile only exists while the experiment is
# in transition, and we have to quit when the experiment is no longer in
# transition so that the web page can finish.
#
sub usage()
{
22 23
    print("Usage: spewlogfile -i logid\n".
	  "Spew a logfile to stdout, as for the web interface\n");
24 25
    exit(-1);
}
26
my $optlist = "we:t:i:";
27
my $fromweb = 0;
28 29 30 31 32 33 34 35 36
  
#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $TBLOGS      = "@TBLOGSEMAIL@";

my $logname;
37
my $isopen;
38
my $logfile;
39 40 41 42 43

#
# Load the Testbed support stuff. 
#
use lib "@prefix@/lib";
44
use emdb;
45
use libtestbed;
46
use User;
47
use Logfile;
48 49 50 51 52 53 54 55 56 57 58 59

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

# Turn off line buffering on output
$| = 1; 

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
60
my %options = ();
61 62 63
if (! getopts($optlist, \%options)) {
    usage();
}
64 65 66
if (defined($options{"w"})) {
    $fromweb = 1;
}
67
if (defined($options{"i"})) {
68 69 70 71 72 73
    $logfile = Logfile->Lookup($options{"i"});
    if (! $logfile) {
	die("*** $0:\n".
	    "    No such logfile in the Emulab Database.\n");
    }
}
74
usage()
75
    if (@ARGV || !$logfile);
76 77 78 79 80 81 82 83 84

#
# This script is setuid, so please do not run it as root. Hard to track
# what has happened.
# 
if ($UID == 0) {
    die("*** $0:\n".
	"    Please do not run this as root! Its already setuid!\n");
}
85 86

#
87
# Verify user and get his DB uid and other info for later.
88
#
89 90
my $this_user = User->ThisUser();
if (! defined($this_user)) {
91
    die("*** $0:\n".
92
	"    You ($UID) do not exist!");
93 94 95
}

#
96
# Verify that this person is allowed to do this. 
97
#
98 99 100
if (!$logfile->AccessCheck($this_user)) {
    die("*** $0:\n".
	"    You do not have permission to view logfile!\n");
101
}
102 103
$logname = $logfile->filename();
$isopen  = $logfile->isopen();
104 105 106 107 108

use Fcntl;
use IO::Handle;
STDOUT->autoflush(1);

109
#
110 111 112
# Open the file up while still root. We verified permission above, and the
# added check using the filesystems permissions if more of a pain then it
# buys us. Well, might revisit this.
113
#
114 115
sysopen(LOG, $logname, O_RDONLY | O_NONBLOCK) or
    die("*** $0:\n".
116 117
	"    Could not open $logname: $!\n");

118 119
# Now flip back to user.
$EUID = $UID;
120

121 122 123 124 125
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    $atime,$mtime,$ctime,$blksize,$blocks) = stat(LOG);

#
# Icky. If the file is open and less then 1024 bytes, send out some
126
# stuff at the beginning to make the browser do something. This is terrible,
127 128 129
# but not sure what else to do.
#
if ($fromweb && $isopen && $size < 1024) {
130
    for (my $i = $size; $i <= 1024; $i++) {
131 132 133 134 135
	print " ";
    }
    print "\n";
}

136 137
#
# Loop reading the file in nonblocking mode. Sleep between loops, and
138
# check for a change in status.
139 140 141
#
while (1) {
    my $tmp;
142
    my $buf;
143 144 145 146
    
    while (sysread(LOG, $buf, 2048)) {
	print STDOUT "$buf";
    }
147 148 149 150
    # Stop if the logfile object becomes invalid (deleted by someone).
    last
	if ($logfile->Refresh() != 0 || !$logfile->isopen());

151
    sleep(2);
152 153 154 155
}
close(LOG);
exit(0);