init
This commit is contained in:
162
wcmtools/spud/bin/wrapper
Executable file
162
wcmtools/spud/bin/wrapper
Executable file
@@ -0,0 +1,162 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Danga's Statistics Wrapper
|
||||
# This little program simply runs a command and pipes the output to a
|
||||
# statistics server so that you can see the output of the command. Data
|
||||
# will be stored in $KEY.output and $KEY.status, so you can determine
|
||||
# exactly how long a run took.
|
||||
#
|
||||
# Command line options:
|
||||
#
|
||||
# -s STRING server to connect to
|
||||
# -p INT port statistics server is running on
|
||||
# -k STRING key to put data in ($KEY.status, $KEY.output)
|
||||
# -e STRING command to execute
|
||||
# -c STRING file to load config data from
|
||||
#
|
||||
# Configuration file format:
|
||||
#
|
||||
# server = STRING location of server
|
||||
# port = INT port of server
|
||||
#
|
||||
# Copyright 2004, Danga Interactive
|
||||
#
|
||||
# Authors:
|
||||
# Mark Smith <marksmith@danga.com>
|
||||
#
|
||||
# License:
|
||||
# undecided.
|
||||
#
|
||||
|
||||
# uses
|
||||
use strict;
|
||||
use IO::Socket;
|
||||
use IPC::Open3;
|
||||
use Getopt::Long;
|
||||
use Carp;
|
||||
use POSIX;
|
||||
|
||||
# Command-line options will override
|
||||
my ($daemonize, $conf_file, $key, $host, $port, $cmd);
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
Getopt::Long::GetOptions(
|
||||
'D|daemon' => \$daemonize,
|
||||
'c|config=s' => \$conf_file,
|
||||
'k|key=s' => \$key,
|
||||
'p|port=i' => \$port,
|
||||
's|server=s' => \$host,
|
||||
'e|exec=s' => \$cmd,
|
||||
);
|
||||
|
||||
# if we don't have all the data we need, parse a config file
|
||||
die "No key (-k KEY) specified.\n" unless $key;
|
||||
unless ($port && $host) {
|
||||
die "You must at least specify --config=FILENAME for me to work.\n" unless $conf_file;
|
||||
die "File '$conf_file' doesn't exist for configuration.\n" unless -e $conf_file;
|
||||
|
||||
# parse the config file
|
||||
open FILE, "<$conf_file"
|
||||
or die "Unable to open config file: $!\n";
|
||||
while (my $line = <FILE>) {
|
||||
if ($line =~ /^\s*([^#].*)\s*=\s*(.*)\s*/) {
|
||||
my ($l, $r) = (trim($1), trim($2));
|
||||
if ($l eq 'server') { $host = $r; }
|
||||
elsif ($l eq 'port') { $port = $r+0; }
|
||||
}
|
||||
}
|
||||
close FILE;
|
||||
}
|
||||
|
||||
# if cmd was specified, use that
|
||||
@ARGV = split /\s+/, $cmd if $cmd;
|
||||
|
||||
# error checking
|
||||
die "No server to connect to.\n" unless $port && $host;
|
||||
die "No arguments to run.\n" unless @ARGV;
|
||||
die "File to run ($ARGV[0]) doesn't seem to exist.\n" unless -e $ARGV[0];
|
||||
|
||||
# daemonize?
|
||||
daemonize() if $daemonize;
|
||||
|
||||
# connect to stats server we're replicating TO
|
||||
my $socket = IO::Socket::INET->new(Proto => 'tcp',
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,)
|
||||
or die "Unable to connect to local stats server ($host:$port): $!\n";
|
||||
$socket->autoflush(1);
|
||||
|
||||
# now setup our open3 socket
|
||||
my ($reader, $writer);
|
||||
my $procpid = open3($writer, $reader, $reader, @ARGV);
|
||||
|
||||
# parent pid
|
||||
my $ppid = $$;
|
||||
|
||||
# now fork
|
||||
my $kidpid;
|
||||
die "Unable to fork: $!\n" unless defined($kidpid = fork());
|
||||
|
||||
# basic parts that handle reading/writing from the two sides
|
||||
if ($kidpid) {
|
||||
# parent
|
||||
while (defined (my $line = <$socket>)) {
|
||||
# we do this to flush the read buffer, but we don't need to
|
||||
# echo this information to anybody, as all of this is going
|
||||
# to be in the form of "OK" and such saying that data got set
|
||||
}
|
||||
kill("TERM" => $kidpid); # death to the children
|
||||
waitpid $kidpid, 0;
|
||||
} else {
|
||||
# child
|
||||
print $socket "QSET $key.status started\n";
|
||||
while (defined (my $line = <$reader>)) {
|
||||
# take the output and set it
|
||||
$line = trim($line);
|
||||
print $socket "QSET $key.output $line\n";
|
||||
}
|
||||
print $socket "QSET $key.status finished\n";
|
||||
$socket->close;
|
||||
|
||||
# now kill off our parent
|
||||
kill("TERM" => $ppid);
|
||||
}
|
||||
|
||||
# daemonizer routine
|
||||
sub daemonize {
|
||||
my($pid, $sess_id, $i);
|
||||
|
||||
## Fork and exit parent
|
||||
if ($pid = fork) { exit 0; }
|
||||
|
||||
## Detach ourselves from the terminal
|
||||
croak "Cannot detach from controlling terminal"
|
||||
unless $sess_id = POSIX::setsid();
|
||||
|
||||
## Prevent possibility of acquiring a controling terminal
|
||||
$SIG{'HUP'} = 'IGNORE';
|
||||
if ($pid = fork) { exit 0; }
|
||||
|
||||
## Change working directory
|
||||
chdir "/";
|
||||
|
||||
## Clear file creation mask
|
||||
umask 0;
|
||||
|
||||
## Close open file descriptors
|
||||
close(STDIN);
|
||||
close(STDOUT);
|
||||
close(STDERR);
|
||||
|
||||
## Reopen stderr, stdout, stdin to /dev/null
|
||||
open(STDIN, "+>/dev/null");
|
||||
open(STDOUT, "+>&STDIN");
|
||||
open(STDERR, "+>&STDIN");
|
||||
}
|
||||
|
||||
# little trimming sub
|
||||
sub trim {
|
||||
my $res = shift;
|
||||
$res =~ s/^\s+//;
|
||||
$res =~ s/[\r\n\s]+$//;
|
||||
return $res;
|
||||
}
|
||||
Reference in New Issue
Block a user