Browse Tag

Work

Perl sig-int and open

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

Ready Set Rant

Well are you all ready for yet another rant about people and their cars? Well I certainly am.

Last Friday I was pulling out of a car park and I noticed as I was pulling back that the person directly behind me had their reversing lights on also but as a I was already going and they were just starting I thought, “Hey I’m right here just keep going and they will wait”. Well how wrong I was! grrr.

So I got halfway out just about to put my car into 1st gear and I see this person pulling out I thought “Oh no!” so I hit the horn…. But to no avail this looser just kept coming all I could do was sit there hand on horn and wait for the inevitable… Once they realized what happened they quickly pulled back in and I get out to assess the damage.

Thankfully they didn’t cause any damage. But they didn’t even get out of their car; this stupid looking Kia Carnaval thing. I couldn’t believe it they just sat their. But as there was no damage it was Friday evening and I had my dinner in the car going cold I just couldn’t be bothered with it all. So I left….

Now I guess they couldn’t see my little Excel in their giant blind spot maybe but to not stop while there is a horn going for like 3 seconds behind you is just plain stupid… Grrr.

Enough of that now I’m getting red blooded just thinking about it. I checked broken code into source control last week, a first for me. We are in the middle of a giant refactor of our codebase so it’s only natural that I can’t do it alone but checking in code that leaves the copy under source control unable to compile just feels dirty…

Oh well until next time rant on brother/sister.

Contract

Yey for money I have signed a contract for a graduate position with VSL(Vision Systems Limited). Which makes everyone really happy :).

Back off to Uni on Monday week off to finish the final year project and all that guff and repeat that stupid subject I failed :(.

Also once again the superiority of Linux came through today because here at work you have to have all the virus protection etc if you were to place a computer on the network. Linux no worries :) long live the penguin.

Crazy Daze

Well my life is all but quiet at the moment. Last Friday I started back at Vision Systems one day a week a bit of casual work. Teaming up with the 85 hours I have already spent on the final year project. I’m a wrek :P.

Oh well just keep on going and going and going.

Tears

:cry: Tomorrow will be my last day here at work before I go back to Uni to finish my Bachelor of Software Engineering. A few tears are shed for the fact Uni doesn’t pay as well as word :P. But I sure wont miss the 2/3 the starting wage once I finish and get a real wage.