Win32 capturing output from a process that may hang

[Random_Walk]

Wise Brothers and Sisters in Perl I beg your assistance

I have a perl script that queries an Oracle database using sqlplus on Win2003. The perl script is run by a Tivoli monitor that has a hard time limit of 120 seconds. Sometimes the SQL plus fails to return, the Tivoli monitor times out and a perl process is left hanging around waiting on sqlplus.

I can not use DBI due to local managment decision

What I want is to run the sqlplus command and if it has not returned after 110 seconds kill it and return an appropriate error to Tivoli. If it does complete in 110 seconds I need to capture STDOUT and process it. I thought this should be easy.

I have tried using $SIG{ALRM} and alarms, they are not implemented in Active State on Windows.

I have tried using win32::Process and grabbing STDOUT with no luck, here is my test code

#!/usr/bin/perl 
use strict;
use warnings;
use Win32::Process;
use Win32;
$|++;

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# spawn process
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

my $process="c:\\perl\\bin\\perl.exe";
my $output="nothing";
open OUT, ">", \$output;

select OUT;
my $ProcObj;
    Win32::Process::Create ( $ProcObj,
                             $process,
                             "perl printer.pl 1 2 3",
                             0,
                             NORMAL_PRIORITY_CLASS,
                             "."
                        ) or die "Create process failed: $!";
    
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# wait 10 seconds for process to finish
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
unless ( $ProcObj->Wait(10000) ) # waits for 10,000 milliseconds
{
    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # process has not completed, so return
    # result for monitoring probe and kill
    # wntmon process
    #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    print "-1";
    $ProcObj->Kill(2001);
}
print "Ball cocks\n";
select STDOUT;
print "output was: $output\n";
__END__
# printer.pl just prints the @ARG array it gets
# output is this 
C:\PERL\bin>perl test_proc.pl
this was called with: 1, 2, 3
output was: Ball cocks

I also found others have tried to follow this via dolorosa capturing STDOUT after Win32::Process::Create()

And finally I thought open a handle to the process and use select but the results of my search were rather off-putting IO::Select on Windows, stdin-socket without fork()?? and RE: stdin-socket without fork()??

What is the normal way to do this under Windows ? Do I need to fork and set up some form of IPC to get the results back ? Would I be OK to spawn a thread and use a shared data structure to get the results from the thread ? What is considered best practice ? One last caveat, this script has to run on Unix too so the less different the behaviour can be for the two OSes the happier I shall be, though I do expect I will have to write a sub for each OS.

My Gratitude in advance,
R.

[Corion]

I would spawn a second Perl process (possibly via system(qq{start "$^X" -w execute_sybase_collector.pl}), which starts sqlplus and writes the output to a file, and writes a .ok-file if it has completed. If the .ok file doesn't exist after 110 seconds, report the failure, otherwise report the result of the SQL query.

[ZlR]

Hello,

Win32::Job available with the default 5.8 activestate distribution will allow you to redirect the STDERR, STDOUT, and STDIN of the spawned process to any arbitrary file handle.

hope this helps,
zlr

updated with working code : Re^5: Win32 capturing output from a process that may hang

[Random_Walk]

This looks really nice but I can not get it to work :(

C:\system\Perl\bin>perl print.pl one two
This is my @ARGV one, two

>perl -MWin32::Job -le"$job=Win32::Job->new;$job->spawn('perl', 'perl 
+print.pl one two', {stdout=> 'test.out'}); print "ran OK" if $job->ru
+n(5);"

>type test.out

>dir test.out
 Volume in drive C is CDRIVE
 Volume Serial Number is 144D-4181

 Directory of C:\system\Perl\bin

02/03/2005  16:13                 0 test.out
               1 File(s)              0 bytes
               0 Dir(s)   2,907,258,880 bytes free

C:\system\Perl\bin>time
The current time is: 16:13:31.15
Enter the new time:

It is also not printing "Ran OK" even though it is returning the prompt imediately so not hitting the 5 second timeout. Did I miss something obvious ? (I also tried giving it stdout => 'test.out' which the doco says should also work, same thing, zero byte file)

Cheers,
R.

[ZlR]

I will have to check later on a 5.8 install .
At first i'd say it doesn't print "ran OK" because the run method applies the timeout only if something went wrong which is not the case here . From the docs of run:

Returns a boolean indicating whether the processes exited by themselves, or whether the time expired.

later,
zlr

[BrowserUk]

Would I be OK to spawn a thread and use a shared data structure to get the results from the thread ?

Hmm. Seems select doesn't timeout on pipes! If the spawn process writes output regulalry as my test.pl did, then this works, but if it doesn't, the select never times out and it blocks forver:(

Update2: This works now even if the process produces no ouput.

That's the way I would do it. I don't see any reason this shouldn't work equally well on non-win systems (assuming a threaded perl), but I don't have the facility to test that.

#! perl -slw
use strict;
use threads;
use Thread::Queue;

sub captureWithTimeout {
    my( $cmd, $Q, $timeout ) = @_;
    my $pid = open CMD, "$cmd |" or die "$cmd : $!";
    sleep $timeout;
    my $rv;
    $rv = kill 9, $pid if kill 0, $pid;
    $Q->enqueue( $_ ) while defined( $_ = <CMD> );
    return $rv;
}

my $Q = new Thread::Queue;
my $t = threads->create( 
    \&captureWithTimeout, 
    $ARGV[ 0 ],
    $Q, $ARGV[ 1 ]
);
print "Running '$ARGV[ 0 ] for $ARGV[ 1] seconds";
print "It took too long, so I killed it" if $t->join;
print 'It produced the following output:';
printf $Q->dequeue while $Q->pending;

__END__
P:\test>435776 "perl test.pl 15" 10
Running 'perl test.pl 15 for 10 seconds
It took too long, so I killed it
It produced the following output:
Starting
1
2
3
4
5
6
7
8
9

P:\test>435776 "perl test.pl 15" 20
Running 'perl test.pl 15 for 20 seconds
It produced the following output:
Starting
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Stopping

[Random_Walk]

Thanks BrowserUK

I feared that threads under windows were flakey but I guess that is old news. If you think they are safe I am more than happy to use them. Have done quite a bit under *nix with them and for a simple job like this they work perfectly there so this does give me the one size fits all solution.

Cheers,
R.

[BrowserUk]

Thanks. A few words of caution. Unless you want to do other things in your main code during the timeout, you don;t need the thread. Something as simple as this (almost) suffices:

#! perl -slw
use strict;

my( $cmd, $timeout ) = @ARGV;

print "Running '$cmd' for $timeout seconds";

my $pid = open CMD, "$ARGV[ 0 ] |" 
    or die "'$ARGV[ 0 ] : $!";
    
print $pid;
    
sleep 1 while $timeout-- and kill 0, $pid;

my $rv = kill 9, $pid;
my @capture = <CMD>;

print "It took too long, so I killed it" if $rv;
print 'It produced the following output:';

printf $_ for @capture;

That will allow the spawned process to run for the timeout number of seconds before killing it and returning whatever output it had managed to produce--but there are problems.

1. The timeout will always run to completion, even if the process finishes early.

   The sleep 1 while $timeout-- and kill 0, $pid; is meant to allow the timeout to be shorted circuited if the process finishes, but it doesn;t work.

   Even though kill 0, $pid will return false if the process never existed, it seems to continue to return true, once it has returned true once, even after the process has gone away?

   I think this is a bug in perl's implementation of kill on win32, but I a, finding it hard to confirm that.

2. If the process produces a large volume of output, then the pipe between the processes "fills" and the spawned process will block until the spawning process reads some data from the it's end of the pipe.

   That means that the spawned process will always be killed and only partial output returned, even if it could produce all of the data within the timeout period if it didn't get blocked. Ie. If the spawning process was serviceing it's end of the pipe.

   This problem could be alleviated by reading this end of the pipe as the output is being produced, but of course, the moment we go into a read state on the pipe, we block until the spawned process produces output. Back to problem one.

   So the next thing (actually, the original thing) I tried was to use select on the pipe handle to determine if tehre was something available to read before attempting a read, but neither select, nor IO::Select->can_read() seem to work on (Win32) pipes?

   If this limitation is documented, I have been unable to find it.

The upshot. If your process only produces a small volue of output, and you can live with always waiting for the full timeout period, the above code, or the threaded version above may be usable, but otherwise, you'd best consider some of the other options.

Sorry if I gave you false hope, but I've long since given up putting to much effort into exploring things until the OP shows some interest in the possible solution I am offereing. I've spent way to many hours exploring and testing possible solutions only to have the OP pop back and say "Oh, but I don't like threads!", or "Your code doesn't work exactly the way I want it to so I'm not going to be bothered to try and correct it myself, I'm just coing to complain and do something completely different.".

If that sounds a little jaundiced--it is:(