Perl script to capture tcpdump traces on Linux - multithreading

Hi I have written a script, which was working fine previously with 'snoop' commands. This script forks child in the script to start tcpdump. When i have to stop the dump I kill the child but when i look at the pcap generated in wireshark, it shows the error "The capture file appears to have been cut short in the middle of a packet". My commands are
my $snoopAPP = &startService("tcpdump -w /tmp/app.pcap -i bond0>/dev/null 2>&1" , '');
kill 9, -$snoopAPP;waitpid $snoopAPP, 0;
sub startService(){
#runs a program in background and returns PID which can be used later to kill the process
#arguments are 1, path , 2nd the name of the file
my $processPath = $_[0];chomp($processPath);
if ($_[1] ne ''){$processPath = $processPath . " >$path/$_[1].log";}
print "\nStarting ... \n-- $processPath\n";
my $pid = fork();
die "unable to fork $processPath: $!" unless defined($pid);
if (!$pid) { # child
setpgrp(0, 0);
exec("$processPath");
die "\nunable to exec: $!\n";
exit;
}
print " ---- PID: $pid\n";
return $pid;
}
Another post suggests to wait for tcpdump to exit, which I am doing already, but still it results in the same error message.

Try
kill 15, -$snoopAPP
Signal 9, SIGKILL, is an immediate terminate, and doesn't give the application the opportunity to finish up, so, well, the capture file stands a good chance of being cut short in the middle of a packet.
Signal 15, SIGTERM, can be caught by an application, so it can clean up before terminating. Tcpdump catches it and finishes writing out buffered output.

Related

Forking Turtle inshell command not streaming stdout

I'm using the the following function to fork commands in my Turtle script:
forkCommand shellCommand = do
pid <- inshell (shellCommand <> "& echo $!") empty
return $ PID (lineToText pid)
The reason for doing this is because I want to get the PID of the forked process that I'm running.
The issue is that the command I'm ruining isn't streaming any stdout. For example you could set shellCommand to:
"python -c \"print('Hello, World')\""
and you won't see the print occur.

Track and kill a process on timeout using Perl script

I want to write a Perl script which can monitor a running process. If the process executes for more than expected time,then it should be killed.
I am trying to do this on a Linux machine(Linux_x8664).
I cannot achieve the same using cronjob because I want to embed the same to another Perl script, which I have been using from a long time.
If you have any suggestions, Please suggest me.
I have a code to do that, But the problem is that my perl script is rinning a process using system command. And I want to track the pid of that invoked process and I want to kill it on timeout.
=========================
#!/usr/pde/bin/perl
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 "\$#=$#\n";`enter code here`
die "Timeout Exit\n" if $# and $# =~ /alarm/;
print "Exited normally.\n";
__END__
Based on your code - there is a reason why use strict and use warnings are strongly recommended.
Specifically:
Can't modify constant item in scalar assignment at line 17, near "$$;"
You aren't doing what you think you're doing there.
If you set it to
kill ( 'INT', -$$ );
Then you will send a SIGINT to the current process group - parent and child. I'm not sure why you're doing this when you don't want to kill the parent.
I'd suggest you can simplify this greatly by:
else { # child
alarm 5;
exec (q[perl -e 'while (1) {print 1}' tee test.txt]);
exit; # the child shouldn't execute code hereafter
}

Why doesn't waitpid wait for the process to exit?

In the below script I am trying to figure out how waitpid works, but it doesn't wait for ssh process to exit. done is printed right away and not after the ssh process exists.
Question
How to I make waitpid only continue when the pid I give it have exited?
#!/usr/bin/perl
use strict;
use warnings;
use Parallel::ForkManager;
use POSIX ":sys_wait_h";
my $pm = Parallel::ForkManager->new(5);
my $pid = $pm->start;
my $p = $pid;
if (!$pid) {
system("ssh 10.10.47.47 sleep 10");
$pm->finish;
}
$p = qx(/usr/bin/pgrep -P $p);
print "ssh pid is $p\n";
my $kid;
do {
$kid = waitpid($p, 0);
} while $kid > 0;
print "done\n";
I have also tried
while (1) {
$p = kill 0, $p;
print "x";
sleep 1 if $p;
print "*";
last unless $p;
}
but it doesn't even reach the first print for some reason and never exits.
The wait family of functions only work on child processes, even waitpid. The sleep process is not your child, it's your child's child. This is because system is essentially fork + exec. By using Parallel::ForkManager + system you're forking, then forking again, then executing sleep.
Since you've already forked, you should use exec. This has the extra advantage of not needing the call to pgrep and it's timing problem (ie. it's possible the parent will call pgrep before the child has executed system).
my $pm = Parallel::ForkManager->new(5);
my $pid = $pm->start;
my $p = $pid;
if (!$pid) {
no warnings; # no warnings "exec" is not working
exec("sleep 10");
$pm->finish;
}
print "sleep pid is $p\n";
waitpid($p, 0);
For simplicity it's now using sleep. A warning from Perl that "Statement unlikely to be reached" must be suppressed because Perl doesn't realize $pm->start has forked. This should be no warnings "exec" but that's not working so I had to suppress them all.

Perl 5.8: possible to get any return code from backticks when SIGCHLD in use

When a CHLD signal handler is used in Perl, even uses of system and backticks will send the CHLD signal. But for the system and backticks sub-processes, neither wait nor waitpid seem to set $? within the signal handler on SuSE 11 linux. Is there any way to determine the return code of a backtick command when a CHLD signal handler is active?
Why do I want this? Because I want to fork(?) and start a medium length command and then call a perl package that takes a long time to produce an answer (and which executes external commands with backticks and checks their return code in $?), and know when my command is finished so I can take action, such as starting a second command. (Suggestions for how to accomplish this without using SIGCHLD are also welcome.) But since the signal handler destroys the backtick $? value, that package fails.
Example:
use warnings;
use strict;
use POSIX ":sys_wait_h";
sub reaper {
my $signame = shift #_;
while (1) {
my $pid = waitpid(-1, WNOHANG);
last if $pid <= 0;
my $rc = $?;
print "wait()=$pid, rc=$rc\n";
}
}
$SIG{CHLD} = \&reaper;
# system can be made to work by not using $?, instead using system return value
my $rc = system("echo hello 1");
print "hello \$?=$?\n";
print "hello rc=$rc\n";
# But backticks, for when you need the output, cannot be made to work??
my #IO = `echo hello 2`;
print "hello \$?=$?\n";
exit 0;
Yields a -1 return code in all places I might try to access it:
hello 1
wait()=-1, rc=-1
hello $?=-1
hello rc=0
wait()=-1, rc=-1
hello $?=-1
So I cannot find anywhere to access the backticks return value.
This same issue has been bugging me for a few days now. I believe there are 2 solutions required depending on where you have your backticks.
If you have your backticks inside the child code:
The solution was to put the line below inside the child fork. I think your statement above "if I completely turn off the CHLD handler around the backticks then I might not get the signal if the child ends" is incorrect. You will still get a callback in the parent when the child exits because the signal is only disabled inside the child. So the parent still gets a signal when the child exits. It's just the child doesn't get a signal when the child's child (the part in backticks) exits.
local $SIG{'CHLD'} = 'DEFAULT'
I'm no Perl expert, I have read that you should set the CHLD signal to the string 'IGNORE' but this did not work in my case. In face I believe it may have been causing the problem. Leaving that out completely appears to also solve the problem which I guess is the same as setting it to DEFAULT.
If you have backticks inside the parent code:
Add this line to your reaper function:
local ($!, $?);
What is happening is the reaper is being called when your code inside the backticks completes and the reaper is setting $?. By making $? local it does not set the global $?.
So, building on MikeKull's answer, here is a working example where the fork'd child uses backticks and still gets the proper return code. This example is a better representation of what I was doing, while the original example did not use forks and could not convey the entire issue.
use warnings;
use strict;
use POSIX ":sys_wait_h";
# simple child which returns code 5
open F, ">", "exit5.sh" or die "$!";
print F<<EOF;
#!/bin/bash
echo exit5 pid=\$\$
exit 5
EOF
close F;
sub reaper
{
my $signame = shift #_;
while (1)
{
my $pid = waitpid(-1, WNOHANG);
print "no child waiting\n" if $pid < 0;
last if $pid <= 0;
my $rc = $? >> 8;
print "wait()=$pid, rc=$rc\n";
}
}
$SIG{CHLD} = \&reaper;
if (!fork)
{
print "child pid=$$\n";
{ local $SIG{CHLD} = 'DEFAULT'; print `./exit5.sh`; }
print "\$?=" . ($? >> 8) . "\n";
exit 3;
}
# sig CHLD will interrupt sleep, so do multiple
sleep 2;sleep 2;sleep 2;
exit 0;
The output is:
child pid=32307
exit5 pid=32308
$?=5
wait()=32307, rc=3
no child waiting
So the expected return code 5 was received in the child when the parent's reaper was disabled before calling the child, but as indicated by ikegami the parent still gets the CHLD signal and a proper return code when the child exits.

perl fork() exec() , child process gone wild

I am using Linux and .sh is in tcsh.
I have made a very basic fork and exec, but I need help in implementing safeties to it.
Basically my perl script calls a .sh script in a child process. But when I do Ctrl+c to kill the parent, the signal gets ignored by the child.
1) How do I capture the SIGINT for the child process as well?
2) The child process that runs the .sh script still STDOUT to the screen of the xterm. How can I remove this? I was thinking of doing running the script in the background
exec("shell.sh args &");
But haven't tested as I need to figure out how to keep the child from going wild first.
3) The parent process(perl script) doesn't wait on the child(.sh script). So I've read a lot about the child becoming a zombie??? Will it happen after the script is done? And how would I stop it?
$pid = fork();
if($pid < 0){
print "Failed to fork process... Exiting";
exit(-1);
}
elsif ($pid ==0) {
#child process
exec("shell.sh args");
exit(1);
}
else { #execute rest of parent}
But when I do ctrl+c to kill the parent, the signal gets ignored by the child.
The signal is sent to two both the parent and the child.
$ perl -E'
if (my $pid = fork()) {
local $SIG{INT} = sub { say "Parent got SIGINT" };
sleep;
waitpid($pid, 0);
} else {
local $SIG{INT} = sub { say "Child got SIGINT" };
sleep;
}
'
^CParent got SIGINT
Child got SIGINT
If that child ignores it, it's because it started a new session or because it explicitly ignores it.
The child procces that runs the .sh script still STDOUT to the screen of the xterm. How can I remove this?
Do the following in the child before calling exec:
open(STDOUT, '>', '/dev/null');
open(STDERR, '>', '/dev/null');
Actually, I would use open3 to get some error checking.
open(local *CHILD_STDIN, '<', '/dev/null') or die $!;
open(local *CHILD_STDOUT, '>', '/dev/null') or die $!;
my $pid = open3(
'<&CHILD_STDIN',
'>&CHILD_STDOUT',
'>&CHILD_STDOUT',
'shell.sh', 'args',
);
The parent process(perl script) doesn't wait on the child(.sh script). So I've read alot about the child becoming a zombie???
Children are automatically reaped when the parent exits, or if they exit after the parent exits.
$ perl -e'
for (1..3) {
exec(perl => (-e => 1)) if !fork;
}
sleep 1;
system("ps");
' ; ps
PID TTY TIME CMD
26683 pts/13 00:00:00 bash
26775 pts/13 00:00:00 perl
26776 pts/13 00:00:00 perl <defunct> <-- zombie
26777 pts/13 00:00:00 perl <defunct> <-- zombie
26778 pts/13 00:00:00 perl <defunct> <-- zombie
26779 pts/13 00:00:00 ps
PID TTY TIME CMD
26683 pts/13 00:00:00 bash
26780 pts/13 00:00:00 ps
<-- all gone
If the parent exits before the children do, there's no problem.
If the parent exits shortly after the children do, there's no problem.
If the parent exits a long time after the children do, you'll want to reap them. You could do that using wait or waitpid (possibly from a SIGCHLD handler), or you could cause them to be automatically reaped using $SIG{CHLD} = 'IGNORE';. See perlipc.
Use waitpid in the parent thread: http://perldoc.perl.org/functions/waitpid.html
waitpid($pid, 0);
You can also redirect stdout of your exec to /dev/null:
exec("shell.sh args > /dev/null");

Resources