libtestbed.pm.in 4.53 KB
Newer Older
1 2
#!/usr/bin/perl -w
use English;
3
use POSIX qw(strftime);
4

5 6 7 8 9
package libtestbed;
use Exporter;

@ISA = "Exporter";
@EXPORT =
10
    qw ( SENDMAIL OPENMAIL TBTimeStamp TBBackGround TBDateTimeFSSafe
11
	 TBMakeLogname TB_BOSSNODE TBGenSecretKey TBDebugTimeStamp );
12

13 14
my $MAILTAG  = "@OURDOMAIN@";
my $BOSSNODE = "@BOSSNODE@";
15
my $TIMESTAMPS = "@TIMESTAMPS@";
16 17 18

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

20 21 22 23 24 25 26 27
# 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 B. Stoller's avatar
Leigh B. Stoller committed
28
# SENDMAIL(To, Subject, Message, [From], [More Headers], [files to append])
29
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30
sub SENDMAIL($$$;$$@)
31
{
32
    my($To, $Subject, $Message, $From, $Headers, @Files) = @_;
33
    my $tag = uc($MAILTAG);
34 35 36 37 38 39 40 41 42 43 44 45 46

    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";
    }
    print MAIL "To: $To\n";
47
    print MAIL "Subject: $tag: $Subject\n";
48 49 50 51 52
    if (defined($Headers)) {
	print MAIL "$Headers\n";
    }
    print MAIL "\n";
    print MAIL "$Message\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
53 54 55 56 57
    print MAIL "\n";

    if (defined(@Files)) {
	foreach my $file ( @Files ) {
	    if (open(IN, "$file")) {
58
		print MAIL "\n--------- $file --------\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
59 60 61 62 63 64 65 66 67

		while (<IN>) {
		    print MAIL "$_";
		}
		close(IN);
	    }
	}
    }
    
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
    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";
99
    print MAIL "Subject: $tag: $Subject\n";
100 101 102 103 104 105 106 107
    if (defined($Headers)) {
	print MAIL "$Headers\n";
    }
    print MAIL "\n";

    return(*MAIL);
}

108 109 110 111 112 113 114 115
#
# 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());
116 117 118 119 120 121 122 123 124 125 126
}

#
# 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());
127 128
}

129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
#
# 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";
    }
}



144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
#
# 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 B. Stoller's avatar
Leigh B. Stoller committed
159 160
    select(undef, undef, undef, 0.2);
    
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181
    #
    # 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: $!");

    return 0;
}

182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201
#
# 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;
}

202 203 204 205 206 207 208 209 210
#
# Get me a secret key!
#
sub TBGenSecretKey()
{
    my $key = `/bin/dd if=/dev/urandom count=128 bs=1 2> /dev/null | /sbin/md5`;
    return $key;
}

211
1;