Perl

1.
my $pid = fork();
die "Unable to fork: $!" unless defined($pid);
if (!$pid) { #child
exec('ls -l');
die "unable to exec: $!";
}
#parent
my $pwd = cwd();
chdir("/tmp");
waitpid($pid, 0); #block mode


2. daemon
use POSIX 'setsid';
sub daemonize {
chdir '/' or die "Can't chdir to /: $!";
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
open STDOUT, '>/dev/null'
or die "Can't write to /dev/null: $!";
defined(my $pid = fork) or die "Can't fork: $!";
exit if $pid; #parent exit
# this is child
setsid or die "Can't start a new session: $!";
open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}

3. run cmd on remote machine: ssh
my $pid = fork();
if ( (defined $pid ) and $pid == 0) {
#child
do_remote_batch_jobs();
} elsif (defined $pid ) {
#parent
do_other_stuff(); #timer: signal--> alarm;
} else {
# error
die "Unable to fork: $!\n";
}


4. system()
use POSIX;
system("./test.sh &"); # this system() fork a shell, the shell fork a child that
#rna test.sh code.
|
|---> (Parent) /bin/sh (to run test.sh and exit--> background)
| |
| |-->(P) test.sh & (still running)
|(parent)-process

# Generate an rsa key and store it in the given file
system("ssh-keygen -t rsa -N '' -f /root/.ssh/id_rsa 1>/dev/null");
# Copy the generated key to a remote system whose username
# is stored in variable $uname and IP address is stored in variable $ip
system("ssh-copy-id -i /root/.ssh/id_rsa.pub $uname\@$ip 2>&1 1>/dev/null");



5. anyevent
Personally, I prefer to let AnyEvent babysit:
my $done = AnyEvent->condvar;
my $pid = fork;
unless( $pid ) { ... }
my $w = AnyEvent->child (
pid => $pid,
cb => sub {
my ($pid, $status) = @_;
warn "pid $pid exited with status $status";
$done->send;
},
);
$done->recv; # control resumes here when child exits
Or, more generally: http://github.com/jrockway/anyevent-subprocess/tree/master

6. timer select loop
#!/usr/bin/perl
use strict;
use warnings;
use POSIX ":sys_wait_h";
die "could not fork: $!" unless defined(my $pid = fork);

#child sleeps then exits with a random exit code
unless ($pid) {
#your code replaces this code
#in this case, it should probably just be
#system();-->block mode; not daemonize()
#exec "ssh-copy-id -i /root/.ssh/id_rsa.pub $uname\@$ip 2>&1 1>/dev/null";
#as that will replace the child process with ssh-copy-id
sleep 5;
exit int rand 255;
}

#parent waits for child to finish
$| = 1;
print "waiting: ";
my @throbber = qw/ . o O o . /;
until ($pid = waitpid(-1, WNOHANG)) {
#get the next frame
my $frame = shift @throbber;
#display it
print $frame;
#put it at the end of the list of frames
push @throbber, $frame;

#wait a quarter second
select undef, undef, undef, .25;

#backspace over the frame
print "\b";
}
#exit code is in bits" 8 - 15 of $?, so shift them down to 0 - 7
my $exit_code = $? >> 8;
print "got exit code of $exit_code\n";


7. signal
system("kill -9 $pid");
system(kill -s STOP or CONT $pid");
waitpid($pid, 0);

switch (my $ret = fork())
case -1:
die "$!\n";
case 0:
exec ( "");
case default:
#parent:
#waitpid($pid, 0); use select() or use signal--alarm
kill 9, $pid;
warn "kill -s STOP $pid";
kill 'STOP', $pid;
kill 'CONT, $pid;
kill 9, $pid;


8.
There are many ways to execute external commands from Perl. The most commons are:

* system function
* exec function
* backticks (``) operator
* open function
All of these methods have different behaviour, so you should choose which one to use depending of your particular need. In brief, these are the recommendations:
method use if ...
system() you want to execute a command and don't want to capture its output
exec you don't want to return to the calling perl script
backticks you want to capture the output of the command
open you want to pipe the command (as input or output) to your script



9. check if a process is running or die or idle
my #exists kil 0, $pid;
print "Process is running\n" if ( $exists );



10.

#!C:/ActivePerl/bin/perl.exe
use strict;
use warnings;
use Win32::OLE qw/in/;
use Getopt::Long;
#
#How to run a process on a remote workstation (NT/2K)
#
my ($remote_computer, $command_path, $help);
GetOptions ('r:s'=>\$remote_computer,
'c:s'=>\$command_path,
'h' =>\$help )
or warn("Couldn't read arguments.\n");

help_and_exit() if ($help);
help_and_exit() if (!defined($remote_computer) || !defined($command_pa
+th) );

my $wmihandle = Win32::OLE->GetObject( "winmgmts:{impersonationLeve
+l=impersonate,(security)}//$remote_computer\\root\\cimv2");
my $wmiprocesses = Win32::OLE->GetObject( "winmgmts:{impersonationLeve
+l=impersonate,(security)}//$remote_computer\\root\\cimv2:Win32_Proces
+s");

#Is the process running already?
unless ( cmd_is_running($wmihandle,$command_path) ) {
print "$command_path is not already running.\n";
}
....



sub cmd_is_running {
my ($wmi,$cmd) = @_;
return undef if not defined($wmi);
return undef if not defined($cmd);
my $cmdname;
if ( $cmd=~ /(?:\\|\/)*([^\\\/]+)$/ ) {
$cmdname=uc($1);
}else{
print "Failed to get command name from $cmd\n";
return 0;
}

my $message = '';
#Ask the WMI Class for a list of Processes
foreach my $process (in($wmihandle->InstancesOf("Win32_Process")))
+{
if (uc($process->{'Name'}) eq $cmdname ) {
$message .= "$cmdname is running with PID = " . $process->{'P
+rocessID'} . "\n";
}
}
if ($message) {
print $message
return 1;
}
return 0;

}

sub help_and_exit {
print <$0

Syntax:
-r
-c [Remember to use quotes if there are spaces!]
-h print this and exit.
EOF

exit(1);
}



11.
#!/usr/bin/perl
#
# ssh parallelism through Perl
#
# 27 March 2000 - v.1.0
#
# John B. Pormann
# Duke University
# Department of Electrical & Computer Engineering
# jpormann@ee.duke.edu
#

# we'll use the Getopt package to load in a host list, other args
use Getopt::Std;
getopts('xh:c:');

if( defined($opt_x) ) {
print "usage: sshtst [-h host1,host2,...] [-c commands]\n";
print " -h comma separated host list\n";
print " -c comma separated list of commands\n";
print " -x this help info\n";
exit( -1 );
}

if( not defined($opt_h) ) {
@hostlist = ( "cow1", "cow2", "cow3", "cow4", "cow5", "cow6" );
} else {
@hostlist = split( ",", $opt_h );
}
print "hostlist = @hostlist\n";

@joblist = split( ",", $opt_c );
$num_jobs = scalar(@joblist);
print "$num_jobs total jobs to process\n";

# keep track of jobs
$jobs_finished = 0;
$next_job = 0;
%jobloc = ();

# now start things off - 1 on each host
foreach $h ( @hostlist ) {
&startjob( $next_job, $h );
$next_job++;
}

# wait for all jobs to be started
while( $jobs_finished < $num_jobs ) {
# wait for any job to finish
wait;

# the job# will be returned in the status byte
# : note that since this status is returned by the child process
# (a Perl process), we should not have problems with erroneous values
$job = $?;
$job >>= 8;
# : figure out which host just finished (so we can start a new job there)
$h = $jobloc{$job};

print "job $job finished on host $h\n";
$jobs_finished++;

if( $next_job < $num_jobs ) {
startjob( $next_job, $h );
$next_job++;
}
}

# ######################################################################

sub startjob {
my $job = $_[0];
my $host = $_[1];
my $cmd = $joblist[$job];
my $pid;

$pid = fork;
if( $pid == 0 ) {
# this is the child process
# : modify this to run your program!!!
# : the '-n' means no stdin will be pushed to the remote machine
# : the '> /dev/null' means stdout is thrown away
print "$job: /usr/bin/ssh -n $host $cmd > /dev/null \n";
system( "/usr/bin/ssh -n $host $cmd > /dev/null" );
exit( $job );
} else {
$jobloc{$job} = $host;
}
}



my $retval = system("ulimit -t ; prog> /tmp/$$_temp_file 2>/dev/null");



12. alarm

$SIG{ALRM} = sub { die "timeout" };
eval {
alarm (3600);
#long job here;
# not exec()
system("ls -lt");

#alarm(0); #cancel it
}

if ($@) {
if ($@ =~ /timeout/) {
print "timeout\n";
kill -9 , $pid;
} else {
alarm (0);
die;
}
}

alarm (0); # clear



13 timeout

> > I replaced the system call with fork and exec and it works just the
> > way I want it to:
> >
> > use warnings;
> > use strict;
> >
> > my $pid;
> >
> > eval {
> > local $SIG{ALRM} = sub {
> > print "Timed out\n";
> > kill 'INT', $pid;
> > die 'alarm';
> > };
> > alarm 5;
> > if ($pid = fork)
> > {
> > waitpid ($pid, 0);
> > }
> > else
> > {
> > exec ('sleep 45');
> > }
> > alarm 0;
> > };
> > die if $@ && $@ !~ /alarm/;
> > print "Exited normally.\n";



--working version---
==========

#!/usr/bin/perl

use strict;
use warnings;

my $pid;
my $finish=0;

# actions after timeout to keep SIGHANDLER short
#
sub timeout {
print "Timed out pid $pid\n";

# kill the process group, but not the parent process
local $SIG{INT}='IGNORE';
local $SIG{TERM}='IGNORE';
kill 'INT' => -$$;

# eventually try also with TERM and KILL if necessary
die 'alarm';
}

eval {
local $SIG{ALRM} = sub { $finish=1 };

alarm 5;

die "Can't fork!" unless defined ($pid=fork); # check also this!

if ($pid) { # parent
warn "child pid: $pid\n";

# Here's the code that checks for the timeout and do the work:
while (1) {
$finish and timeout() and last;
sleep 1;
}

waitpid ($pid, 0);
}
else { # child
exec (q[perl -e 'while (1) {print 1}' > tee test.txt]);
exit; # the child shouldn't execute code hereafter
}

alarm 0;

};

warn "[EMAIL PROTECTED]@\n";
die "Timeout Exit\n" if $@ and $@ =~ /alarm/;
print "Exited normally.\n";

__END__

Yes! Thank you so much!! That works so nicely. I learned a lot too
from fiddling with your script -- I didn't know, for example, that
killing a negative process ID kills the children of that pid. This is
so helpful! Thanks!! - Jen





Hi waavman,

Try this instead:
Code

#!/usr/bin/perl

# ipc2.pl
#
# Test of perl pipe communication between parent and child processes.
#
# File ipc2.txt should be any text file with a lot of lines.
#
#
use strict;
use warnings;

use POSIX ":sys_wait_h";

# Kill a child process by pid.
sub killchild {
my $pid = shift;
my $ret = waitpid($pid, &WNOHANG);
if ( $ret == 0 ) {
print "Child is still running. Attempting to kill with SIGINT.\n";
kill('INT', $pid);
sleep 1;
if ( waitpid($pid, &WNOHANG) == 0 ) {
print "Child is still running. Attempting to kill with SIGKILL.\n";
kill('KILL', $pid);
sleep 1;
if ( waitpid($pid, &WNOHANG) == 0 ) {
die "Child is still running. Giving up.";
} else {
print "SIGKILL worked. Child is dead.\n";
}
} else {
print "SIGINT worked. Child is dead.\n";
}
} elsif ( $ret == $pid ) {
print "Reaped the child.\n";
} else {
print "No child running.\n";
}
}

# fork a process
my $pid=open(PARENT_READ_HANDLE, "-|");

if ($pid==0) {
# child process

open (CHILDREADHANDLE, "<", "./ipc2.txt");
my $nlines = 0;
while (my $line = ) {
chomp($line);
$nlines += 1;
my ($sec,$min,$hour) = (localtime) [0,1,2];
print "$hour:$min:$sec - $line\n";
if ( ($nlines % 100) == 0 ) {
# Uncomment the sleep if you want to see the parent timeout.
# sleep 6;
}
}
close(CHILDREADHANDLE);
exit(0);
} else {
#parent process

# Check to make sure the child started.
if ( waitpid($pid, &WNOHANG) != 0 ) {
print "Child process didn't start or exited immediately";
exit -1;
}

# Read the data printed by child
eval {
# Set a timeout on the read.
local $SIG{ALRM} = sub { die "alarm clock restart" };
alarm 5;
eval {
# This loop won't exit until the filehandle is closed by the child.
while (my $line = ) {
# We don't want to time out on a long-running but properly working
# child, so reset the timer after each read.
alarm 5;
chomp($line);
print ("Parent received from the child : $line\n");
}
};
alarm 0;
die "The pipe to the child timed out." if $@;
};
alarm 0;
if ($@) {
print "$@";
killchild($pid);
exit(-1);
} else {
# Wait forever until the child exits.
print "Waiting for the child to exit.\n";
waitpid($pid, 0);
print "The child exited normally.\n";
exit(0);
}
}




#!/usr/bin/perl -w

use WWW::Mechanize;
use POSIX;

[..... all the html analysis, getting the mms-links]

# programm alarm for main so we wake up and
# can terminate in main as well

alarm($duration*60+10);

die "can't fork: $!" unless defined($kidpid = fork());

if ($kidpid){

print "forked: started recorder pid $kidpid\n";

# this is parent thread
# first send off the record-killer

die "can't fork: $!" unless defined($killerpid = fork());

if ($killerpid){

print "forked again: killer is $killerpid\n";

# again parent -- to protect the recording pid from keyboard interactive we just exit.
print "************ parent setting watch\n";
$SIG{CHLD} = \&REAPER;
while(true){
my $timeleft=alarm(0);
print "alarm clock say $timeleft time is still left!\n";
alarm($timeleft);
sleep($timeleft);
}
# finished -- full recording time has gone buy
exit 0;
}else{
# so this is the killer
sleep($duration*60+10);
print "killer woke up -- killing recording process pid $kidpid\n";
kill("TERM" => $kidpid);
exit 0;
}
}else{

# child process
# here we run mplayer to record the stuff to a wav file

$date=`date +"%Y%m%d-%R"`;
$date=~s/:/_/g;
chomp($date);
if ( -f $sender."-".$date.".wav" ){
print "looks like the outputfile exists already....\n";
$date=$date."-a";
}
exec ('mplayer',$link1, "-vc", "dummy", "-vo", "null", "-ao", "pcm:waveheader:file=$sender-".$date.".wav");


}


print "program reached code after all the forking code....shouldn't happen.\nkilling myself and all my children.\n";
kill("TERM" => -$$);


sub REAPER {
my $stiff;
while (($stiff = waitpid(-1, &WNOHANG)) > 0) {
# do something with $stiff if you want
print "\nThis is the reaper.... $stiff came back\n\n";
if ($stiff == $killerpid){
print "killer $killerpid has exited... so recording is finished\n";
exit 0;
}
if ($stiff == $kidpid){
print "Recording pid exited, checking killer\n";
$killerstat=waitpid($killerpid,&WNOHANG);
print "Killerstauts is: $killerstat\n";
if ($killerstat == 0){
print "Killer still running, restarting recording process\n";
die "can't fork: $!" unless defined($kidpid = fork());
if ($kidpid){
print "start a new killer...(just forget about the old one for now, would trigger another SIGCHILD)\n";

### here the killer should be restarted with the new child pid
### this has to be after recording child is restarted or we use the wrong PID

print "parent going to sleep again\n";
$SIG{CHLD} = \&REAPER;
return;
}else{
$date=`date +"%Y%m%d-%R-%S"`;
$date=~s/:/_/g;
chomp($date);
exec ('mplayer',$link1, "-vc", "dummy", "-vo", "null", "-ao", "pcm:waveheader:file=$sender-".$date.".wav");
}
}
}

}

$SIG{CHLD} = \&REAPER; # install after calling waitpid
}




3 vote down check


It is important to give context to your question. You already have two processes: a parent and a child. The child is replacing itself with the exec, so you can't use the child to do any form of monitoring, but the parent is available. We just need to make the waitpid call non-blocking (i.e. it won't wait to be successful, it will fail right away). This also gets rid of the need for the eval and alarm functions:

#!/usr/bin/perl

use strict;
use warnings;
use POSIX ":sys_wait_h";

my $timeout = 180;
my $program = "simulator --shell";

die "could not fork: $!" unless defined (my $pid = fork);

#this is the child process
unless ($pid) {
exec $program;
#if we reach this code the exec failed
die "exec of simulator failed: $!";
}

#this is the parent process
my $tries = 0;
#check to see if $pid is done, but don't block if it isn't
until (waitpid(-1, WNOHANG) == $pid) {
#put what you want to print while waiting here:
print scalar localtime, "\n";

if ($tries++ > $timeout) {
warn "timed out, sending SIGKILL to simulator\n";
kill 9, $pid;
waitpid($pid, 0);
last;
}
} continue {
sleep 1;
}