run_linktest.pl.in 4.77 KB
Newer Older
1
2
3
4
5
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2004 University of Utah and the Flux Group.
# All rights reserved.
6
7
8
#
use strict;
use Getopt::Std;
9
use English;
10

11
12
13
14
15
16
17
18
19
20
21
22
#
# Wrapper for running the linktest daemon. This script is currently
# setup so it can run on either boss (or ops via plasticwrap), or from
# an experimental node. Hence the odd paths and ltevent aux program,
# which is not really on boss. Also not use of tmcc to find the server. 
#
sub usage()
{
    print "Usage: run_linktest.pl ".
	  "[-q] [-d] [-s server] [-p port] [-k keyfile] -e pid/eid\n".
	  "Use -q for quick termination mode\n";
    exit(1);
23
}
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
my $optlist = "qd:s:p:k:e:";
my $debug   = 0;
my $quick   = 0;
my $server;
my $keyfile;
my $port;
my $pid;
my $eid;

# Local goo
my $TB          = "@prefix@";
my $TMCC	= "@CLIENT_BINDIR@/tmcc";
my $LTEVENT     = "@CLIENT_BINDIR@/ltevent";
my $LTEVENTBOSS = "$TB/libexec/ltevent";
my $BOSSNODE    = "@BOSSNODE@";
39

40
41
42
43
44
45
46
47
#
# This script should be run as a real person!
#
if (! $EUID) {
    die("*** $0:\n".
	"    This script should not be run as root!\n");
}

48
49
50
51
52
53
54
55
56
57
58
59
60
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
89
90
91
92
93
94
95
96
97
98
99
100
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
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

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

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV) {
    usage();
}
if (defined($options{"d"})) {
    $debug = $options{"d"};
    if ($debug =~ /^([\w]+)$/) {
	$debug = $1;
    }
    else {
	die("*** $0:\n".
	    "    Bad data in debug: $debug\n");
    }
}
if (defined($options{"q"})) {
    $quick = 1;
}
if (defined($options{"s"})) {
    $server = $options{"s"};
    if ($server =~ /^([-\w\.]+)$/) {
	$server = $1;
    }
    else {
	die("*** $0:\n".
	    "    Bad data in server: $server\n");
    }
}
if (defined($options{"k"})) {
    $keyfile = $options{"k"};
    if ($keyfile =~ /^([-\w\.\/]+)$/) {
	$keyfile = $1;
    }
    else {
	die("*** $0:\n".
	    "    Bad data in keyfile: $keyfile\n");
    }
}
if (defined($options{"p"})) {
    $port = $options{"p"};
    if ($port =~ /^(\d+)$/) {
	$port = $1;
    }
    else {
	die("*** $0:\n".
	    "    Bad data in port: $port\n");
    }
}
if (defined($options{"e"})) {
    ($pid,$eid) = split(/\//, $options{"e"});
}
else {
    usage();
}

#
# Untaint args.
#
if ($pid =~ /^([-\w]+)$/) {
    $pid = $1;
}
else {
    die("*** $0:\n".
	"    Bad data in pid: $pid\n");
}
if ($eid =~ /^([-\@\w]+)$/) {
    $eid = $1;
}
else {
    die("*** $0:\n".
	"    Bad data in eid: $eid\n");
}

133
134
# signal handler in case the process is killed.
$SIG{INT} = sub {
135
136
    print "Aborted. Linktest continues on nodes.\nErrors so far:\n";
    exit &analyze;
137
138
};

139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
#
# Need to figure out the elvind server. Since this script runs on boss
# and on experimental nodes, do something gross!
#
if (!defined($server)) {
    if (-x $TMCC) {
	my $results = `$TMCC bossinfo`;
	if ($results =~ /^([\w\.]*)\s/) {
	    $server = $1; 
	}
	else {
	    die("*** $0:\n".
		"    Bad data in server: $results\n");
	}
    }
    else {
	# We can do this on boss/ops, but not on experimental node.
	$server = $BOSSNODE;
157
158
    }
}
159
160
161
162

#
# These days, must use a keyfile! Hmm, linktest.c is not using a keyfile.
#
163
164
165
if (!defined($keyfile)) {
    $keyfile = "/proj/$pid/exp/$eid/tbdata/eventkey";
}
166
167
168
169
170

my $linktest_path; # path to linktest data.
$linktest_path = "/proj/" . $pid . "/exp/" . $eid . "/tbdata/linktest";

# send the startup event.
171
my $args = starter();
172
173
# event arguments
$args .=  " -x START";
174
175
176
$args .= " STARTAT=1 STOPAT=3"
    if ($quick);
$args .= " DEBUG=$debug"
177
    if ($debug);
178
179
180
181
182

system($args);
if ($?) {
    die("*** $0:\n".
	"    Error running '$args'\n");
183
184
185
}

print "Linktest in progress...\n";
186
187
188
print "Quick termination requested.\n"
    if ($quick);
print "Debug mode requested.\n"
189
    if ($debug);
190
191

# wait for the shutdown event.
192
$args = starter();
193
194
$args .= " -w STOP";

195
196
197
198
system($args);
if ($?) {
    die("*** $0:\n".
	"    Error running '$args'\n");
199
200
}

201
202
203
204
205
206
207
208
209
210
211
212
213
214
#
# Spit out the results?
# 
my @dir_contents;
opendir(DIR, $linktest_path) ||
    die("*** $0:\n".
	"    Cannot open $linktest_path\n");
@dir_contents = grep(/\.fatal$|\.error$/, readdir(DIR));
closedir(DIR);

foreach my $file (@dir_contents) {
    # Hmm, need to taint check the filenames. Ick.
    if ($file =~ /^([-\w\.\/]+)$/) {
	$file = $1;
215
    }
216
217
218
219
220
    else {
	die("*** $0:\n".
	    "    Bad data in filename: $file\n");
    }
    system("/bin/cat $linktest_path/$file");
221
}
222
exit(scalar(@dir_contents));
223

224
# Initial part of command string to ltevent.
225
sub starter {
226
227
228
229
    my $cmd;

    if (-x $LTEVENTBOSS) {
	$cmd = $LTEVENTBOSS;
230
    }
231
232
    else {
	$cmd = $LTEVENT;
233
    }
234
235
236
237
238
239
    $cmd .= " -s $server -e $pid/$eid";
    $cmd .= " -p $port"
	if (defined($port));
    $cmd .= " -k $keyfile"
	if (defined($keyfile));
    
240
241
    return $cmd
}