All im trying to do here is:
Create a pipe
Fork a sub-process
Parent gets a message from the user, sends it to the child
Child gets the message, prints it to the screen
Repeat until user doesn't enter a message
This is what I got now so far: I still need to implement a loop to repeat until user doesn't enter a message.
#!perl -w
use strict
pipe(PIPE_READ, PIPE_WRITE);
autoflush PIPE_WRITE 1;
my $pid = fork();
if ($pid) {
&write_pipe ($pid);
waitpid($pid,0);
}
elsif (defined $pid) {
&read_pipe;
}
else {
die "cannot fork: $!";
}
sub write_pipe {
print "pid $$ \n";
print "Enter message: ";
sleep 1;
my $usr_msg = <>;
print "Parent pid = $$ message = $usr_msg";
print PIPE_WRITE "$usr_msg\n";
close(PIPE_WRITE)
close(PIPE_READ);
}
sub read_pipe {
print "child pid = $pid";
my $msg_read = <PIPE_READ>;
close(PIPE_WRITE);
print "received from pipe $msg_read";
}
First of all, you are unintentionally creating two children. Replace
if ($pid = fork)
with
if ($pid)
In the child, call
close(PIPE_WRITE);
In the parent, call
close(PIPE_READ);
In the parent (when done writing), call
close(PIPE_WRITE);
As for reading from a file handle until EOF or a specific command is entered,
while (my $line = <>) {
last if $line =~ /^(?:quit|exit)$/;
...
}
Related
is it possible in perl to establish a pipe in such a way that the parent has only one READER pipe and many children write to it as they come to life/exit?
The typical cookbook code is:
#!/usr/bin/perl -w
# pipe2 - use pipe and fork so child can send to parent
use IO::Handle;
pipe(READER, WRITER);
WRITER->autoflush(1);
if ($pid = fork) {
close WRITER;
chomp($line = <READER>);
print "Parent Pid $$ just read this: `$line'\n";
// do what you need
} else {
die "cannot fork: $!" unless defined $pid;
close READER;
print WRITER "Child Pid $$ is sending this\n";
close WRITER; # this will happen anyway
exit;
}
Let's instead assume a case where I need my parent "READER" to get messages from multiple children, is it possible to do this without keeping a list of pipes, one per child? I can't close WRITER in the parent because the next child won't get a valid handle to write to. I also need the parent to continue its regular operation and not block on any client data from the pipe.
Pseudocode of what I need:
# parent code
pipe (READER, WRITER)
fork_random_number_of_children(READER,WRITER)
on_some_tick => {
my $data = read_from(READER, non_blocking)
if (data) print "Hey some child sent me: $data"
else print "No data, going back life"
do_other_things_before_next_tick()
}
child_job(R,W) { # lets assume this is called for each child fork
close (R); # no problem, its a copy
sleep (random duration)
print W, "Message from child with pid $$"
exit 0
}
I don't think it's necessary to close WRITER in the parent. It may be a good practice, but since you can't reuse the same pipe for new child processes after you close it, that's a good excuse not to do it. If you keep WRITER open until you are done launching all your child processes, you can reuse the pipe with multiple child processes. Here's a proof of concept:
use IO::Handle;
use POSIX ':sys_wait_h';
pipe(READER,WRITER);
WRITER->autoflush(1);
sub child_process {
my $stage = shift;
close READER; # also a best but optional practice
srand($$);
do {
sleep 1 + 5*rand();
print WRITER "Child Pid $$ ($stage) is sending this\n";
} while (rand > 0.5);
exit;
}
# initial set of children
for (my $i=0; $i<5; $i++) {
if (fork() == 0) {
child_process("LAUNCH");
}
}
# parent
my ($rin,$rout) = ('');
vec($rin,fileno(READER),1) = 1;
while (1) {
# non-blocking read on pipe
my $read_avail = select($rout=$rin, undef, undef, 0.0);
if ($read_avail < 0) {
if (!$!{EINTR}) {
warn "READ ERROR: $read_avail $!\n";
last;
}
} elsif ($read_avail > 0) {
chomp(my $line = <READER>);
print "Read in Parent $$: '$line'\n";
} else {
print STDERR "No input ... do other stuff\n";
# start some run-time child processes
if (time-$^T > 5 && time-$^T < 10) {
# launch a few more children in the middle of the program
if (fork() == 0) {
child_process("RUN");
}
}
sleep 1;
}
last if waitpid(-1,&WNOHANG) < 0; # no more children are alive
}
close WRITER; # now it is safe to do this ...
I'm trying to write a helper function that runs a perl function in another process and returns a closure that produces a line of output at a time when called.
I figured out a way of doing this using pipe that mixes old and new-style filehandles. I used an old-style one for the sink in order to use the open(STDOUT, ">&thing") syntax and a new-style one for the source since it needs to be captured by a closure and I didn't want to burden the caller with providing a filehandle.
Is there a way of using a new-style filehandle in a construction with the same meaning as open(STDOUT, ">&thing")?
#!/usr/bin/env perl
# pipe.pl
# use pipe() to create a pair of fd's.
# write to one and read from the other.
#
# The source needs to be captured by the closure and can't be
# destructed at the end of get_reader(), so it has to be lexical.
#
# We need to be able to redirect stdout to sink in such a way that
# we actually dup the file descriptor (so shelling out works as intended).
# open(STDOUT, ">&FILEHANDLE") achieves this but appears to require an
# old-style filehandle.
use strict;
use warnings;
sub get_reader {
local *SINK;
my $source;
pipe($source, SINK) or die "can't open pipe!";
my $cpid = fork();
if ($cpid == -1) {
die 'failed to fork';
}
elsif ($cpid == 0) {
open STDOUT, ">&SINK" or die "can't open sink";
system("echo -n hi");
exit;
}
else {
return sub {
my $line = readline($source);
printf "from child (%s)\n", $line;
exit;
}
}
}
sub main {
my $reader = get_reader();
$reader->();
}
main();
When run, this produces
from child (hi)
as expected.
sub get_reader {
my ($cmd) = #_;
open(my $pipe, '-|', #$cmd);
return sub {
return undef if !$pipe;
my $line = <$pipe>;
if (!defined($line)) {
close($pipe);
$pipe = undef;
return undef;
}
chomp($line);
return $line;
};
}
If that's not good enough (e.g. because you also need to redirect the child's STDIN or STDERR), you can use IPC::Run instead.
use IPC::Run qw( start );
sub get_reader {
my ($cmd) = #_;
my $buf = '';
my $h = start($cmd, '>', \$buf);
return sub {
return undef if !$h;
while (1) {
if ($buf =~ s/^([^\n]*)\n//) {
return $1;
}
if (!$h->pump())) {
$h->finish();
$h = undef;
return substr($buf, 0, length($buf), '') if length($buf);
return undef;
}
}
};
}
Either way, you can now do
my $i = get_reader(['prog', 'arg', 'arg']);
while (defined( my $line = $i->() )) {
print "$line\n";
}
Either way, error handling left to you.
I almost have no idea of forking. I tried to research, but I couldn't find a simple example of how to do these things. For windows I found a good module and wrote this piece of code, which is doing what I want.
Win32::Process::Create( my $ProcessObj,
"$jobs{$id}->{path}", "execute job", 0, NORMAL_PRIORITY_CLASS, "." )
|| die ErrorReport();
print "Available commands:\n1.Suspend\n2.Resume\n3.Kill\n";
while (1) {
chomp( my $input = <STDIN> );
if ( $input eq "1" ) {
$ProcessObj->Suspend();
}
if ( $input eq "2" ) {
$ProcessObj->Resume();
}
if ( $input eq "3" ) {
print "Returned to main menu.\n";
$ProcessObj->Kill(0);
return;
}
}
So my question is if there is a way to do this with forking?
And here is my try for forking:
unless ( $pid = fork) {
unless (fork) {
exec "$jobs{$id}->{path}";
die "exec failed!";
}
exit 0;
}
waitpid($pid, 0);
I have a program which is printing Hello world every 3 seconds and I want to pause it, resume it and kill it, if this example will help.
Forks::Super makes this simple and platform-independent.
use Forks::Super;
...
my $pid = fork { exec => $jobs{$id}->{path} };
...
$pid->suspend;
...
$pid->resume;
...
$pid->kill; # or $pid->kill('TERM'), $pid->kill('QUIT'), etc.
If you must go by hand, the signals to use are 'SIGSTOP' and 'SIGCONT'.
A command-line demo
perl -wE'
$pid = fork // die "Cant fork: $!";
if ($pid == 0) {
for (1..6) { say "\tkid ..."; sleep 1; };
say "\tKID DONE"; exit;
};
sleep 3;
kill "STOP", $pid;
for (1..2) { say "Parent here!"; sleep 1};
kill "CONT", $pid;
wait;
'
prints
kid ...
kid ...
kid ...
Parent here!
Parent here!
kid ...
kid ...
kid ...
KID DONE
Then you'd need to implement this in your STDIN-driven management.
But I suggest to try to resolve the installation of Forks::Super, from mob's answer.
A STDIN controlled example. The forked process and the parent write to a file for a test.
use warnings;
use strict;
use feature 'say';
#use IO::Handle; # needed pre v5.16 (for autoflush)
my $fh_kid;
$SIG{INT} = sub { close $fh_kid; exit 1 };
my $file = 'kidfile.out';
open $fh_kid, '>', $file or die "Can't open $file: $!";
$fh_kid->autoflush;
my $pid = fork // die "Can't fork: $!";
if ($pid == 0) {
$SIG{TERM} = sub { close $fh_kid; exit 1 };
for (1..20) {
say $fh_kid "\tkid, $_";
sleep 1;
}
exit;
}
say "Parent: started $pid";
while (1) {
chomp (my $input = <STDIN>);
if (not $input) {
close $fh_kid;
last;
}
if ($input == 1) {
kill 'STOP', $pid;
say "Parent: STOP-ed $pid";
say $fh_kid "Parent STOP-ed $pid";
}
elsif ($input == 2) {
say "Parent: CONT the $pid";
kill 'CONT', $pid;
}
elsif ($input == 3) {
close $fh_kid;
kill 'TERM', $pid;
say "Parent: TERM-ed the $pid";
}
}
my $gone = waitpid $pid, 0;
if ($gone > 0) { say "Child $gone exited with: $?" }
elsif ($gone < 0) { say "No such process ($gone), reaped already?" }
else { say "Still out there?" }
This needs more detail but it does show what kinds of things get involved.
Output (with comments)
Parent: started 19628
1 # entered a few seconds after starting
Parent: STOP-ed 19628
2 # after waiting for a minute
Parent: CONT the 19628
3 # after waiting for a few more seconds
Parent: TERM-ed the 19628
^C # quit STDIN
We allow the kid to print to a file for a few seconds (so a few times) and then STOP it (1), then wait for a bit and then CONTinue the child (2) and let it print a few more times before killing it (3).
The output kidfile.out has a few lines from the child, then a line from the parent, and then a few more lines from the child, confirming that the child was paused, resumed, and stopped.
I'm trying to fork a separate process/thread in perl and get the input back to the parent via a pipe. For instance:
my($RD, $WR);
pipe($RD, $WR);
if(fork())
{
#parent
while(!eof $RD) { print "From Child: " . readline($RD); }
print "Parent reached EOF\n";
} else {
#child
for(my $i = 0; $i < 25; $i++) { print $WR "$i\n"; }
close $WR;
}
All of the lines from the child are recieved and printed out by the parent. But the parent never detects EOF and is stuck in that while loop, waiting. What is the proper way to detect EOF here?
A file handle is only closed when all file descriptors referring to that handle are closed. Have the parent close its copy.
pipe(my ($RD, $WR))
or die("pipe: $!\n");
defined( my $pid = fork() )
or die("fork: $!\n");
if ($pid) {
# parent
close($WR);
print "From Child: $_" while <$RD>;
print "Parent reached EOF\n";
} else {
# child
close($RD);
print $WR "$_\n" for 0..25;
}
I am writing a Perl script that will write some inputs and send those inputs to an external program. There is a small but non-zero chance that this program will hang, and I want to time it out:
my $pid = fork;
if ($pid > 0){
eval{
local $SIG{ALRM} = sub { die "TIMEOUT!"};
alarm $num_secs_to_timeout;
waitpid($pid, 0);
alarm 0;
};
}
elsif ($pid == 0){
exec('echo blahblah | program_of_interest');
exit(0);
}
As it stands now, after $num_secs_to_timeout, program_of_interest still persists. I tried to kill it in the anonymous subroutine for $SIG{ALRM} as follows:
local $SIG{ALRM} = sub{kill 9, $pid; die "TIMEOUT!"}
but this doesn't do anything. program_of_interest is still persisting. How do I go about killing this process?
I was able to successfully kill my exec()ed process by killing the process group, as shown as the answer to question In perl, killing child and its children when child was created using open. I modified my code as follows:
my $pid = fork;
if ($pid > 0){
eval{
local $SIG{ALRM} = sub {kill 9, -$PID; die "TIMEOUT!"};
alarm $num_secs_to_timeout;
waitpid($pid, 0);
alarm 0;
};
}
elsif ($pid == 0){
setpgrp(0,0);
exec('echo blahblah | program_of_interest');
exit(0);
}
After timeout, program_of_interest is successfully killed.
The above code (by strictlyrude27) didn't work out of the box, because -$PID is spelt in capitals.
(BTW: there's also: http://www.gnu.org/software/coreutils/manual/html_node/timeout-invocation.html)
Here's an example with test:
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
my $prg = basename $0;
my $num_secs_sleep = 2;
my $num_secs_to_timeout = 1;
my $orig_program = "sleep $num_secs_sleep; echo \"Look ma, survived!\"";
my $program = $orig_program;
my $expect = "";
if (#ARGV){
if($ARGV[0] eq "test"){
test();
exit 0;
} elsif (#ARGV == 1) {
$num_secs_to_timeout = $ARGV[0];
} elsif (#ARGV == 2) {
$program = $ARGV[0];
$num_secs_to_timeout = $ARGV[1];
} else {
die "Usage: $prg [ \"test\" | [program] seconds ] "
}
}
if($orig_program eq $program) {
if(#ARGV < 2) {
$expect = $num_secs_to_timeout > $num_secs_sleep ?
"(we expected to survive.)" : "(we expected to TIME OUT!)";
}
print STDERR "sleeping: $num_secs_sleep seconds$/";
}
print STDERR <<END;
timeout after: $num_secs_to_timeout seconds,
running program: '$program'
END
if($orig_program eq $program) {
print STDERR "$expect$/";
}
exit Timed::timed($program, $num_secs_to_timeout);
sub test {
eval "use Test::More qw(no_plan);";
my $stdout;
close STDOUT;
open STDOUT, '>', \$stdout or die "Can't open STDOUT: $!";
Timed::timed("sleep 1", 3);
is($stdout, undef);
Timed::timed("sleep 2", 1);
is($stdout, "TIME OUT!$/");
}
################################################################################
package Timed;
use strict;
use warnings;
sub timed {
my $retval;
my ($program, $num_secs_to_timeout) = #_;
my $pid = fork;
if ($pid > 0){ # parent process
eval{
local $SIG{ALRM} =
sub {kill 9, -$pid; print STDOUT "TIME OUT!$/"; $retval = 124;};
alarm $num_secs_to_timeout;
waitpid($pid, 0);
alarm 0;
};
return defined($retval) ? $retval : $?>>8;
}
elsif ($pid == 0){ # child process
setpgrp(0,0);
exec($program);
} else { # forking not successful
}
}
Hmmm your code works for me, after some minor modifications - which I assume are changes made by yourself to make the code into a generic example.
So that leaves me with two ideas:
You removed the problem when you created the sample code - try creating a small sample that actually runs (I had to change 'program_of_interest' and $num_secs_to_timeout to real values to test it). Make sure the sample has the same problem.
It's something to do with the program_of_interest you're running - as far as I know, you can't mask a kill 9, but maybe there's something going on. Have you tried testing your code with a really simple script. I created one for my testing that goes while (1) { print "hi\n"; sleep 1; }
Something else.
Good luck...
The only way SIGKILL can be ignored is if the process is stuck in a system call which is uninterruptible. Check the state of the hung process (with ps aux) if the state is D, then the process can't be killed.
You might also want to check that the function is being called by outputting something from it.