JBlog

skip to solution

While recently re-writing our build script into a simple perl script I came across a problem.

I wanted to have the script put output from the commands that it was executing onto both the screen and into a file at the same time.

No problem, in perl you can open commands like you can files, by simply putting a pipe ‘|’ as the first character.

open(OUT, ">log.txt")
    || die "can't open log: $!";
open(STATUS, "netstat -an 2>&1 |")
    || die "can't fork: $!";
while () {
    next if /^(tcp|udp)/;
    print;
    print OUT;
}
close STATUS || die "bad netstat: $! $?";

This code will output the lines to both stdout and to a log file.

Great nice simple code that works using standard perl operations. However one thing that this does not provide is that the forked processes do not receive ‘Ctrl-C’ or ‘Sig-Int’ if you are more of a Unix head.

Which is really quite bad when you are creating a build script you want all processes to die if you need to pull the plug on a build.

So next I turned to calling a direct windows api call GenerateConsoleCtrlEvent calling this function on all child processes in a perl sig-int handler to send CTRL_C_EVENT (0) to each of these processes.

use Win32::Process::Info;
use Win32::API;

$SIG{INT} = 'killChildren';

sub killChildren
{
    print "Killing process\n";
    my $pi = Win32::Process::Info->new ();

    Win32::API->Import('Kernel32.dll',
'BOOL GenerateConsoleCtrlEvent(DWORD dwCtrlEvent,  DWORD dwProcessGroupId)');

    my %children = $pi->Subprocesses($$);
    foreach my $child (@{$children{$$}})
    {
        GenerateConsoleCtrlEvent(0, $child);
    }
    exit(1);
}

However if you read the documentation of GenerateConsoleCtrlEvent closely:

Sends a specified signal to a console process group

So then you realize that the process must be created in a process group by calling CreateProcess and passing a CREATE_NEW_PROCESS_GROUP flag. Which is getting to be way too much work there must be a simpler way surely.

The solution I eventually came up with was perl calling via the system command and running an inline script.

open(CMD, "$^X -e \"system(q{$cmd});\" |") || die "Failed to run \"$cmd\": $!\n";

However since the commands I were executing had ” in them as well there were too many variants that were requiring regex replacement to get the commands working correctly.

So like any good web monkey I ended up Base64 encoding the command I wish to execute and then un-encoding it in the sub perl process.

Final Solution

sub RunCommand
{
    my ($cmd, $dontStop) = @_;
	print "$cmd\n";
	print BUILDLOG "$cmd\n";
	# Run the command through another instance of perl so that it can all be
	# killed when Sig-C is sent to this build file.
	# However command contain characters such as \ and " which are hard
	# to pas through 2 interpreters so base64 endcode and decode the command
	# $^X is a special variable that is the path to perl
	my $encoded = encode_base64($cmd);
    open(CMD,
  "$^X -e \"use MIME::Base64;system(decode_base64(q{$encoded}));\" |")
  || die "Failed to run \"$cmd\": $!\n";

    while()
    {
        print "$_";
        print BUILDLOG "$_";
    }
    close(CMD);

    if(!$dontStop and $? != 0)
    {
        die "Command: $cmd\nFailed with code: $?\n";
    }

    return $?;
}