libtestbed.pm.in 7.07 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh Stoller's avatar
Leigh Stoller committed
2 3 4

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
Leigh Stoller's avatar
Leigh Stoller committed
6 7 8
# All rights reserved.
#

9 10 11 12 13
package libtestbed;
use Exporter;

@ISA = "Exporter";
@EXPORT =
14
    qw ( SENDMAIL OPENMAIL TBTimeStamp TBBackGround TBDateTimeFSSafe
15
	 TBMakeLogname TB_BOSSNODE TB_OPSEMAIL TBGenSecretKey TBDebugTimeStamp
16
	 TBDebugTimeStampsOn TBForkCmd);
17

18 19 20 21 22 23 24 25
# After package decl.
use English;
use POSIX qw(strftime);
use POSIX qw(setsid);
use Fcntl;
use IO::Handle;
use File::Basename;

26 27
#my $MAILTAG  = "@OURDOMAIN@";
my $MAILTAG  = "@THISHOMEBASE@";
28
my $BOSSNODE = "@BOSSNODE@";
29
my $TIMESTAMPS = "@TIMESTAMPS@";
30
my $TBOPSEMAIL = "@TBOPSEMAIL@";
31
my $SCRIPTNAME = "Unknown";
32 33 34

# Hostname of our boss node
sub TB_BOSSNODE()	{ $BOSSNODE; }
35

36 37 38
# Testbed ops email address
sub TB_OPSEMAIL()	{ $TBOPSEMAIL; }

39 40 41 42 43 44 45 46
# Untainted scriptname for email below.
if ($PROGRAM_NAME =~ /^([-\w\.\/]+)$/) {
    $SCRIPTNAME = basename($1);
}
else {
    $SCRIPTNAME = "Tainted";
}

47 48 49 50 51 52
#
# Turn off line buffering on output
#
STDOUT->autoflush(1);
STDERR->autoflush(1);

53 54 55 56 57 58 59 60
# A library of useful stuff.

# Send an email message via sendmail -t.
#
# I am mimicking the PHP mail interface, only because I'm old and its
# hard to remember new things. I did add a From arg since thats basically
# required to make the mail look nice (not generated by root or daemon!).
#
Leigh Stoller's avatar
Leigh Stoller committed
61
# SENDMAIL(To, Subject, Message, [From], [More Headers], [files to append])
62
#
Leigh Stoller's avatar
Leigh Stoller committed
63
sub SENDMAIL($$$;$$@)
64
{
65
    my($To, $Subject, $Message, $From, $Headers, @Files) = @_;
66
    my $tag = uc($MAILTAG);
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81

    if (! open(MAIL, "|/usr/sbin/sendmail -t")) {
	print STDERR "SENDMAIL: Could not start sendmail: $!\n";
	return 0;
    }

    #
    # Sendmail will figure this out if not given.
    # 
    if (defined($From) && $From) {
	print MAIL "From: $From\n";
    }
    if (defined($Headers)) {
	print MAIL "$Headers\n";
    }
82
    print MAIL "X-NetBed: $SCRIPTNAME\n";
83 84
    print MAIL "To: $To\n";
    print MAIL "Subject: $tag: $Subject\n";
85 86
    print MAIL "\n";
    print MAIL "$Message\n";
Leigh Stoller's avatar
Leigh Stoller committed
87 88 89 90 91
    print MAIL "\n";

    if (defined(@Files)) {
	foreach my $file ( @Files ) {
	    if (open(IN, "$file")) {
92
		print MAIL "\n--------- $file --------\n";
Leigh Stoller's avatar
Leigh Stoller committed
93 94 95 96 97 98 99 100 101

		while (<IN>) {
		    print MAIL "$_";
		}
		close(IN);
	    }
	}
    }
    
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
    print MAIL "\n";
    if (! close(MAIL)) {
	print STDERR "SENDMAIL: Could not finish sendmail: $!\n";
	return 0;
    }
    return 1;
}

#
# Fire up a sendmail process, and return the handle for the caller
# to print the body of the message into. This is easer in many places.
#
# OPENMAIL(To, Subject, [From], [More Headers])
#
sub OPENMAIL($$;$$)
{
    my($To, $Subject, $From, $Headers) = @_;
    local *MAIL;

    if (! open(MAIL, "|/usr/sbin/sendmail -t")) {
	print STDERR "OPENMAIL: Could not start sendmail: $!\n";
	return 0;
    }

    #
    # Sendmail will figure this out if not given.
    # 
    if (defined($From) && $From) {
	print MAIL "From: $From\n";
    }
    print MAIL "To: $To\n";
133
    print MAIL "Subject: $tag: $Subject\n";
134 135 136
    if (defined($Headers)) {
	print MAIL "$Headers\n";
    }
137
    print MAIL "X-NetBed: $SCRIPTNAME\n";
138 139 140 141 142
    print MAIL "\n";

    return(*MAIL);
}

143 144 145 146 147 148 149 150
#
# Return a timestamp. We don't care about day/date/year. Just the time mam.
# 
# TBTimeStamp()
#
sub TBTimeStamp()
{
    return POSIX::strftime("%H:%M:%S", localtime());
151 152 153 154 155 156 157 158 159 160 161
}

#
# Another routine for creating a file name based on the current date and
# time. The format is slightly different so that it can be a proper filename.
#
# usage: char *TBDateTimeFSSafe()
#
sub TBDateTimeFSSafe()
{
    return POSIX::strftime("20%y%m%d-%H.%M.%S", localtime());
162 163
}

164 165 166 167 168 169 170 171 172 173 174 175 176
#
# Print out a timestamp if the TIMESTAMPS configure variable was set.
# 
# usage: void TBDebugTimeStamp(@)
#
sub TBDebugTimeStamp(@)
{
    my @strings = @_;
    if ($TIMESTAMPS) {
	print "TIMESTAMP: ", TBTimeStamp(), " ", join("",@strings), "\n";
    }
}

177 178 179 180 181 182 183 184
#
# Turn on timestamps locally. We could do this globally by using an
# env variable to pass it along, but lets see if we need that.
# 
sub TBDebugTimeStampsOn()
{
    $TIMESTAMPS = 1;
}
185

186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
#
# Put ourselves into the background, directing output to the log file.
# The caller provides the logfile name, which should have been created
# with mktemp, just to be safe. Returns the usual return of fork. 
#
# usage int TBBackGround(char *filename).
# 
sub TBBackGround($)
{
    my($logname) = @_;
    
    my $mypid = fork();
    if ($mypid) {
	return $mypid;
    }
Leigh Stoller's avatar
Leigh Stoller committed
201 202
    select(undef, undef, undef, 0.2);
    
203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
    #
    # We have to disconnect from the caller by redirecting both STDIN and
    # STDOUT away from the pipe. Otherwise the caller (the web server) will
    # continue to wait even though the parent has exited. 
    #
    open(STDIN, "< /dev/null") or
	die("opening /dev/null for STDIN: $!");

    # Note different taint check (allow /).
    if ($logname =~ /^([-\@\w.\/]+)$/) {
	$logname = $1;
    } else {
	die "Bad data in logfile name: $logname";
    }

    open(STDERR, ">> $logname") or die("opening $logname for STDERR: $!");
    open(STDOUT, ">> $logname") or die("opening $logname for STDOUT: $!");

221 222 223 224 225 226
    #
    # Turn off line buffering on output
    #
    STDOUT->autoflush(1);
    STDERR->autoflush(1);

227 228 229 230 231 232
    #
    # 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 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
#
# Create a logname and untaint it!
#
sub TBMakeLogname($)
{
    my($prefix) = @_;
    my $logname;
    
    $logname = `mktemp /tmp/${prefix}.XXXXXX`;

    if ($logname =~ /^([-\@\w\.\/]+)$/) {
	$logname = $1;
    }
    else {
	die("Bad data in logfile name: $logname");
    }

    return $logname;
}

256 257 258 259 260
#
# Get me a secret key!
#
sub TBGenSecretKey()
{
261 262
    my $key=`/bin/dd if=/dev/urandom count=128 bs=1 2> /dev/null | /sbin/md5`;
    chomp($key);
263 264 265
    return $key;
}

266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
#
# Fork+exec a command and return its exit value.  This is similar to
# system(), but does not use a shell to invoke the command.  The function
# exits with the return value from wait().
#
# If the second optional param is passed and true, then
# a signal handler for TERM will be installed, and the
# child process will be sent a SIGTERM if this (the calling)
# process gets one. The handler exits with the exit status returned by 
# wait() after sending the signal.
#
sub TBForkCmd($;$) {
    my ($cmd, $dokill) = @_;

    my $childpid = fork();
        
    if ($childpid) {
        my $handler = sub {
            kill("TERM", $childpid);
            my $exstat = wait();
            print STDERR "*** $0:\n".
                "    Command terminated: $cmd.\n"; 
            exit($exstat);
        };
        local $SIG{TERM} = \&$handler if (defined($dokill) && $dokill);

        my $waitpid = wait();
        my $exitstatus = $?;
        if ($waitpid < 0) {
            die("*** $0:\n".
                "    Uh oh, wait() returned a negative number");
        }
        elsif ($waitpid != $childpid) {
            warn("*** $0:\n".
                "    pid returned by wait() != pid ".
                "from fork(): $waitpid $childpid");
        }
        return $exitstatus;
    }
    else {
        exec($cmd);
        die("*** $0:\n".
            "    exec of $cmd failed!\n");
    }

    # NOTREACHED
    return(0);
}

315
1;