spewconlog.in 3.31 KB
Newer Older
1 2 3
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2005, 2006 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14
# All rights reserved.
#
use English;
use Getopt::Std;

#
# Spew a console log from the tipserver that hosts it.
#
sub usage()
{
15
    print(STDOUT "Usage: spewconlog [-l linecount] node\n");
16 17
    exit(-1);
}
18 19 20
my $optlist   = "l:";
my $linecount = 0;
my $logdir    = "/var/log/tiplogs";
21
my $logname;
22
my $cmd;
23 24 25 26 27 28

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
29
my $ELABINELAB  = @ELABINELAB@;
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
my $SSH		= "$TB/bin/sshtb";
my $SAVEUID	= $UID;

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

#
# We don't want to run this script unless its the real version.
#
if ($EUID != 0) {
    die("*** $0:\n".
	"    Must be setuid! Maybe its a development version?\n");
}

#
# 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");
}

54 55 56 57
#
# Not yet ... need a xmlrpc hook.
#
if ($ELABINELAB) {
58 59 60
    print STDERR "*** $0:\n".
	"    Not supported in an inner Emulab, yet!\n";
    exit(0);
61 62
}

63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
#
# Turn off line buffering on output. Very important for this script!
#
$| = 1; 

# Load the Testbed support stuff.
use lib "@prefix@/lib";
use libdb;
use libtestbed;

# Be careful not to exit on transient error
$libdb::DBQUERY_MAXTRIES = 30;

#
# Locals
# 
my $logfile;

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
89 90 91 92 93 94 95 96 97 98 99 100
if (defined($options{"l"})) {
    $linecount = $options{"l"};

    # Untaint of course.
    if ($linecount =~ /^([\d]+)$/) {
	$linecount = $1;
    }
    else {
	die("*** $0:\n".
	    "    Bad data in linecount: $linecount\n");
    }
}
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
usage()
    if (@ARGV != 1);
my $node = $ARGV[0];

# Untaint
if ($node =~ /^([-\w]+)$/) {
    $node = $1;
}
else {
    die("*** Tainted node name: $node\n");
}

#
# Check permission.
#
if (!TBAdmin($UID) &&
    (! TBNodeAccessCheck($UID, TB_NODEACCESS_READINFO, ($node)))) {
    die("*** $0:\n".
	"    You not have permission to view console log for $node!\n");
}

#
# Grab DB data. 
#
my $query_result =
    DBQueryFatal("select server from tiplines where node_id='$node'");

if (!$query_result->numrows) {
    die("*** $0:\n".
	"    No console log (tipline) available for $node!\n");
}
my ($tipserver) = $query_result->fetchrow_array();

#
# Form the logfile name; admin users get the .log while users get .run.
#
if (!TBAdmin($UID)) {
    $logname = "$logdir/${node}.run"
}
else {
    $logname = "$logdir/${node}.log"
}

144 145 146 147 148 149 150
if ($linecount) {
    $cmd = "tail -". $linecount
}
else {
    $cmd = "cat";
}

151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
#
# Run an ssh command in a child process, protected by an alarm to
# ensure that the ssh is not hung up forever if the machine is in
# some funky state.
#
my $syspid = fork();

#
# Parent waits for ssh to complete.
# 
if ($syspid) {
    local $SIG{ALRM} = sub { kill("TERM", $syspid); };
    alarm 20;
    waitpid($syspid, 0);
    my $exitstatus = $?;
    alarm 0;

    if ($exitstatus) {
	exit(1);
    }
    exit(0);
}

#
# Now we want to ssh over and cat the file.
#
$UID = 0;
178
system("$SSH -host $tipserver $cmd $logname");
179 180
$UID = $SAVEUID;
exit(($? == 0 ? 0 : 1));