--- Cmd.pm.orig	2010-04-29 23:47:00.000000000 +0400
+++ Cmd.pm	2010-06-22 17:36:21.000000000 +0400
@@ -340,29 +340,89 @@
     return $CAN_USE_RUN_FORKED eq "1";
 }
 
+# incompatible with POSIX::SigAction
+#
+sub install_layered_signal {
+  my ($s, $handler_code) = @_;
+
+  my %available_signals = map {$_ => 1} keys %SIG;
+
+  die("install_layered_signal got nonexistent signal name [$s]")
+    unless defined($available_signals{$s});
+  die("install_layered_signal expects coderef")
+    if !ref($handler_code) || ref($handler_code) ne 'CODE';
+
+  my $previous_handler = $SIG{$s};
+
+  my $sig_handler = sub {
+    my ($called_sig_name, @sig_param) = @_;
+    
+    # $s is a closure refering to real signal name
+    # for which this handler is being installed.
+    # it is used to distinguish between
+    # real signal handlers and aliased signal handlers
+    my $signal_name = $s;
+
+    # $called_sig_name is a signal name which
+    # was passed to this signal handler;
+    # it doesn't equal $signal_name in case
+    # some signal handlers in %SIG point
+    # to other signal handler (CHLD and CLD,
+    # ABRT and IOT)
+    #
+    # initial signal handler for aliased signal
+    # calles some other signal handler which
+    # should not execute the same handler_code again
+    if ($called_sig_name eq $signal_name) {
+      $handler_code->($signal_name);
+    }
+
+    # run original signal handler if any (including aliased)
+    #
+    if (ref($previous_handler)) {
+      $previous_handler->($called_sig_name, @sig_param);
+    }
+  };
+
+  $SIG{$s} = $sig_handler;
+}
+
 # give process a chance sending TERM,
 # waiting for a while (2 seconds)
 # and killing it with KILL
 sub kill_gently {
-  my ($pid) = @_;
+  my ($pid, $opts) = @_;
+  
+  $opts = {} unless $opts;
+  $opts->{'wait_time'} = 2 unless defined($opts->{'wait_time'});
+  $opts->{'first_kill_type'} = 'just_process' unless $opts->{'first_kill_type'};
+  $opts->{'final_kill_type'} = 'just_process' unless $opts->{'final_kill_type'};
   
-  kill(15, $pid);
+  if ($opts->{'first_kill_type'} eq 'just_process') {
+    kill(15, $pid);
+  }
+  elsif ($opts->{'first_kill_type'} eq 'process_group') {
+    kill(-15, $pid);
+  }
   
-  my $wait_cycles = 0;
   my $child_finished = 0;
+  my $wait_start_time = time();
 
-  while (!$child_finished && $wait_cycles < 8) {
+  while (!$child_finished && $wait_start_time + $opts->{'wait_time'} > time()) {
     my $waitpid = waitpid($pid, WNOHANG);
     if ($waitpid eq -1) {
       $child_finished = 1;
     }
-
-    $wait_cycles = $wait_cycles + 1;
-    Time::HiRes::usleep(250000); # half a second
+    Time::HiRes::usleep(250000); # quarter of a second
   }
 
   if (!$child_finished) {
-    kill(9, $pid);
+    if ($opts->{'final_kill_type'} eq 'just_process') {
+      kill(9, $pid);
+    }
+    elsif ($opts->{'final_kill_type'} eq 'process_group') {
+      kill(-9, $pid);
+    }
   }
 }
 
@@ -454,9 +514,16 @@
     }
 
     if ($got_sig_child) {
-      if (time() - $got_sig_child > 10) {
-        print STDERR "select->can_read did not return 0 for 10 seconds after SIG_CHLD, killing [$pid]\n";
-        kill (-9, $pid);
+      if (time() - $got_sig_child > 1) {
+        # select->can_read doesn't return 0 after SIG_CHLD
+        #
+        # "On POSIX-compliant platforms, SIGCHLD is the signal
+        # sent to a process when a child process terminates."
+        # http://en.wikipedia.org/wiki/SIGCHLD
+        #
+        # nevertheless kill KILL wouldn't break anything here
+        #
+        kill (9, $pid);
         $child_finished = 1;
       }
     }
@@ -491,8 +558,9 @@
 
   waitpid($pid, 0);
 
-  # i've successfully reaped my child,
-  # let my parent know this
+  # since we've successfully reaped the child,
+  # let our parent know about this.
+  #
   if ($opts->{'parent_info'}) {
     my $ps = $opts->{'parent_info'};
     print $ps "reaped $pid\n";
@@ -629,6 +697,7 @@
 
     $opts = {} unless $opts;
     $opts->{'timeout'} = 0 unless $opts->{'timeout'};
+    $opts->{'terminate_wait_time'} = 2 unless defined($opts->{'terminate_wait_time'});
 
     # sockets to pass child stdout to parent
     my $child_stdout_socket;
@@ -696,8 +765,13 @@
       my $parent_died = 0;
 
       my $got_sig_child = 0;
+      my $got_sig_quit = 0;
       $SIG{'CHLD'} = sub { $got_sig_child = time(); };
 
+      if ($opts->{'terminate_on_signal'}) {
+        install_layered_signal($opts->{'terminate_on_signal'}, sub { $got_sig_quit = time(); });
+      }
+
       my $child_child_pid;
 
       while (!$child_finished) {
@@ -737,6 +811,15 @@
           }
         }
 
+        if ($got_sig_quit) {
+          kill_gently ($pid, {
+            'first_kill_type' => 'process_group',
+            'final_kill_type' => 'process_group',
+            'wait_time' => $opts->{'terminate_wait_time'}
+            });
+          $child_finished = 1;
+        }
+
         my $waitpid = waitpid($pid, WNOHANG);
 
         # child finished, catch it's exit status
@@ -762,7 +845,7 @@
         }
 
         while (my $l = <$child_stdout_socket>) {
-          if (!$opts->{discard_output}) {
+          if (!$opts->{'discard_output'}) {
             $child_stdout .= $l;
             $child_merged .= $l;
           }
@@ -772,7 +855,7 @@
           }
         }
         while (my $l = <$child_stderr_socket>) {
-          if (!$opts->{discard_output}) {
+          if (!$opts->{'discard_output'}) {
             $child_stderr .= $l;
             $child_merged .= $l;
           }
@@ -800,6 +883,23 @@
         kill_gently($child_child_pid);
       }
 
+      # in case there are forks in child which
+      # do not forward or process signals (TERM) correctly
+      # kill whole child process group, effectively trying
+      # not to return with some children or their parts still running
+      #
+      # to be more accurate -- we need to be sure
+      # that this is process group created by our child
+      # (and not some other process group with the same pgid,
+      # created just after death of our child) -- fortunately
+      # this might happen only when process group ids
+      # are reused quickly (there are lots of processes
+      # spawning new process groups for example)
+      #
+      if ($opts->{'clean_up_children'}) {
+        kill(-9, $pid);
+      }
+
   #    print "child $pid finished\n";
 
       close($child_stdout_socket);
@@ -812,7 +912,8 @@
         'merged' => $child_merged,
         'timeout' => $child_timedout ? $opts->{'timeout'} : 0,
         'exit_code' => $child_exit_code,
-       'parent_died' => $parent_died,
+        'parent_died' => $parent_died,
+        'child_pgid' => $pid,
         };
 
       my $err_msg = '';
