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 $?; }