#!/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 # # 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 = ) { 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; }