#!/usr/bin/perl my $sig = 15; my $verbose = 0; my $msg = ''; my $doit = 1; while (@ARGV) { if ($ARGV[0] eq '-s' || $ARGV[0] eq '--signal') { die("$ARGV[0]: argument required") unless @ARGV > 1; $sig = $ARGV[1]; shift @ARGV; shift @ARGV; next; } if ($ARGV[0] eq '-v' || $ARGV[0] eq '--verbose') { $verbose = 1; shift @ARGV; next; } if ($ARGV[0] eq '-n') { $doit = 0; $verbose = 1; shift @ARGV; next; } if ($ARGV[0] eq '-m' || $ARGV[0] eq '--message') { die("$ARGV[0]: argument required") unless @ARGV > 1; $msg = $ARGV[1]; shift @ARGV; shift @ARGV; next; } last; } die("usage: killchroot [-s sig] ") unless @ARGV == 1 && $ARGV[0] ne ''; my $dir = $ARGV[0]; chdir($dir) || die("$dir: $!\n"); $dir = readlink('/proc/self/cwd'); die("readlink /proc/self/cwd: $!\n") unless defined $dir; my %pids; my $pid; my $path; opendir(D, "/proc") || die("/proc: $!\n"); for $pid (readdir(D)) { next unless $pid =~ /^\d+$/; $path = readlink("/proc/$pid/root"); next unless defined $path; if ($path =~ /^\Q$dir\E(\/.*)?$/) { $pids{$pid} = 1; } $path = readlink("/proc/$pid/exe"); if ($path =~ /^\Q$dir\E(\/.*)?$/) { $pids{$pid} = 1; } } closedir(D); my @pids = sort keys %pids; exit 0 unless @pids; print "$msg\n" if $msg ne ''; if ($verbose) { my @pidsv = (); for $pid (@pids) { open(F, " 1) { print "sending signal $sig to processes @pidsv\n"; } else { print "sending signal $sig to process @pidsv\n"; } } exit 0 unless $doit; kill $sig => @pids; kill CONT => @pids if $sig eq 9; exit 0;