mariadb/Build-tools/Do-compile

712 lines
18 KiB
Text
Raw Normal View History

#!/usr/bin/perl -w
2000-07-31 21:29:14 +02:00
use Getopt::Long;
@config_options= ();
@make_options= ();
$opt_distribution=$opt_user=$opt_config_env="";
$opt_dbd_options=$opt_perl_options=$opt_config_options=$opt_make_options=$opt_suffix="";
$opt_tmp=$opt_version_suffix="";
$opt_help=$opt_delete=$opt_debug=$opt_stage=$opt_no_test=$opt_no_perl=$opt_with_low_memory=$opt_fast_benchmark=$opt_static_client=$opt_static_server=$opt_static_perl=$opt_sur=$opt_with_small_disk=$opt_local_perl=$opt_tcpip=$opt_build_thread=$opt_use_old_distribution=$opt_enable_shared=$opt_no_crash_me=$opt_no_strip=0;
$opt_innodb=$opt_bdb=$opt_raid=$opt_libwrap=0;
2001-05-11 22:51:24 +02:00
GetOptions(
"bdb",
"build-thread=i",
"config-env=s",
"config-options=s" => \@config_options,
"dbd-options=s",
"debug",
"delete",
"distribution=s",
"enable-shared",
"fast-benchmark",
"help|Information",
"innodb",
"libwrap",
"local-perl",
"make-options=s" => \@make_options,
"no-crash-me",
"no-perl",
"no-strip",
"no-test|no-mysqltest",
"perl-files=s",
"perl-options=s",
"raid",
"stage=i",
"static-client",
"static-perl",
"static-server",
"suffix=s",
"sur",
"tcpip",
"tmp=s",
"use-old-distribution",
"user=s",
"version-suffix=s",
"with-low-memory",
"with-other-libc=s",
"with-small-disk",
) || usage();
usage() if ($opt_help);
2000-07-31 21:29:14 +02:00
usage() if (!$opt_distribution);
if ($opt_bdb && $opt_version_suffix eq "")
2001-05-11 22:51:24 +02:00
{
$opt_version_suffix="-max";
2001-05-11 22:51:24 +02:00
}
if (@make_options > 0)
{
chomp(@make_options);
$opt_make_options= join(" ", @make_options);
}
if (@config_options > 0)
{
chomp(@config_options);
$opt_config_options= join(" ", @config_options);
}
2000-07-31 21:29:14 +02:00
chomp($host=`hostname`);
2001-01-21 16:38:36 +01:00
$full_host_name=$host;
$connect_option= ($opt_tcpip ? "--host=$host" : "");
2000-07-31 21:29:14 +02:00
$host =~ /^([^.-]*)/;
2001-01-21 16:38:36 +01:00
$host=$1 . $opt_suffix;
2000-07-31 21:29:14 +02:00
$email="$opt_user\@mysql.com";
$pwd = `pwd`; chomp($pwd);
$log="$pwd/Logs/$host$opt_version_suffix.log";
2002-02-10 01:28:24 +01:00
$opt_distribution =~ /(mysql[^\/]*)\.tar/;
2000-07-31 21:29:14 +02:00
$ver=$1;
$gcc_version=which("gcc");
if (defined($gcc_version) && ! $opt_config_env)
{
$tmp=`$gcc_version -v 2>&1`;
if ($tmp =~ /version 2\.7\./)
{
2001-02-14 23:09:38 +01:00
$opt_config_env= 'CC=gcc CFLAGS="-O2 -fno-omit-frame-pointer" CXX=gcc CXXFLAGS="-O2 -fno-omit-frame-pointer"';
2000-07-31 21:29:14 +02:00
}
elsif ($tmp =~ /version 3\.0\./)
{
$opt_config_env= 'CC=gcc CFLAGS="-O3 -fno-omit-frame-pointer" CXXFLAGS="-O3 -fno-omit-frame-pointer -felide-constructors -fno-exceptions -fno-rtti"';
}
2000-07-31 21:29:14 +02:00
else
{
2001-02-14 23:09:38 +01:00
$opt_config_env= 'CC=gcc CFLAGS="-O3 -fno-omit-frame-pointer" CXX=gcc CXXFLAGS="-O3 -fno-omit-frame-pointer -felide-constructors -fno-exceptions -fno-rtti"';
2000-07-31 21:29:14 +02:00
}
}
2001-01-21 16:38:36 +01:00
$new_opt_tmp=0;
2000-07-31 21:29:14 +02:00
if ($opt_tmp)
{
2001-01-21 16:38:36 +01:00
if (! -d $opt_tmp)
{
safe_system("mkdir $opt_tmp");
$new_opt_tmp=1;
}
2000-07-31 21:29:14 +02:00
$ENV{'TMPDIR'}=$opt_tmp;
}
else
{
$opt_tmp="/tmp";
}
2001-01-21 16:38:36 +01:00
$bench_tmpdir="$opt_tmp/my_build-$host";
2000-07-31 21:29:14 +02:00
$ENV{'PATH'}= "$pwd/$host/bin:" . $ENV{'PATH'};
2001-01-02 14:24:18 +01:00
$make=which("gmake","make"); # Can't use -j here!
2000-07-31 21:29:14 +02:00
$tar=which("gtar","tar");
$sendmail=find("/usr/lib/sendmail","/usr/sbin/sendmail");
$sur= $opt_sur ? "/my/local/bin/sur" : "";
delete $ENV{'MYSQL_PWD'}; # Reset possibly password
delete $ENV{'MY_BASEDIR_VERSION'};
$ENV{'MYSQL_TCP_PORT'}= $mysql_tcp_port= 3334 + $opt_build_thread*2;
2001-01-21 16:38:36 +01:00
$ENV{'MYSQL_UNIX_PORT'}=$mysql_unix_port="$opt_tmp/mysql$opt_suffix.build";
2000-07-31 21:29:14 +02:00
$ENV{"PERL5LIB"}="$pwd/$host/perl5:$pwd/$host/perl5/site_perl";
$slave_port=$mysql_tcp_port+16;
$manager_port=$mysql_tcp_port+1;
if ($opt_stage == 0)
{
system("mkdir Logs") if (! -d "Logs");
system("mv $log ${log}-old") if (-f $log);
unlink($log);
}
open(LOG,">>$log") || abort("Can't open log file, error $?");
select LOG;
$|=1;
select STDOUT;
$|=1;
info("Compiling MySQL$opt_version_suffix at $host$opt_suffix, stage: $opt_stage\n");
if (-x "$host/bin/mysqladmin")
{
log_system("$host/bin/mysqladmin --no-defaults -u root -S $mysql_unix_port -s shutdown");
log_system("$host/bin/mysqladmin --no-defaults -u root -P $mysql_tcp_port -h $host -s shutdown");
log_system("$host/bin/mysqladmin --no-defaults -u root -P $slave_port -h $host -s shutdown");
log_system("$host/bin/mysqladmin --no-defaults -u root -P 9306 -h $host -s shutdown");
log_system("$host/bin/mysqladmin --no-defaults -u root -P 9307 -h $host -s shutdown");
}
kill_all("mysqlmanager");
2000-07-31 21:29:14 +02:00
if ($opt_stage == 0)
{
print "$host: Removing old distribution\n" if ($opt_debug);
2001-05-11 22:51:24 +02:00
if (!$opt_use_old_distribution)
{
system("mkdir $host") if (! -d $host);
system("touch $host/mysql-fix-for-glob");
rm_all(<$host/mysql*>);
2001-05-11 22:51:24 +02:00
system("mkdir $host/bin") if (! -d "$host/bin");
}
2000-07-31 21:29:14 +02:00
rm_all("$host/test");
system("mkdir $host/test") if (! -d "$host/test");
}
safe_cd($host);
2001-05-11 22:51:24 +02:00
if ($opt_stage == 0 && ! $opt_use_old_distribution)
2000-07-31 21:29:14 +02:00
{
safe_system("gunzip < $opt_distribution | $tar xf -");
# Fix file times; This is needed because the time for files may be
# in the future. The following is done this way to ensure that
# we don't get any errors from xargs touch
system("touch timestamp");
sleep(2);
system("touch timestamp2");
system("find . -newer timestamp -print | xargs touch");
unlink("timestamp");
unlink("timestamp2");
sleep(2);
# Ensure that files we don't want to rebuild are newer than other files
safe_cd($ver);
foreach $name ("configure",
"Docs/include.texi",
"Docs/*.html", "Docs/manual.txt", "Docs/mysql.info",
"sql/sql_yacc.h", "sql/sql_yacc.cc")
{
system("touch $name");
}
# Fix some file modes in BDB tables that makes life harder.
system("chmod -R u+rw .");
2000-07-31 21:29:14 +02:00
}
safe_cd("$pwd/$host/$ver");
#
# Configure the sources
#
2000-07-31 21:29:14 +02:00
if ($opt_stage <= 1)
2001-05-11 22:51:24 +02:00
{
# Fix files if this is in another timezone than the build host
2000-07-31 21:29:14 +02:00
unlink("config.cache");
2001-10-03 17:38:30 +02:00
unlink("bdb/build_unix/config.cache");
unlink("innobase/config.cache");
2001-05-11 22:51:24 +02:00
log_system("$make clean") if ($opt_use_old_distribution);
$opt_config_options.= " --disable-shared" if (!$opt_enable_shared); # Default for binary versions
$opt_config_options.= " --with-berkeley-db" if ($opt_bdb);
$opt_config_options.= " --with-client-ldflags=-all-static" if ($opt_static_client);
$opt_config_options.= " --with-libwrap" if ($opt_libwrap);
$opt_config_options.= " --with-low-memory" if ($opt_with_low_memory);
$opt_config_options.= " --with-mysqld-ldflags=-all-static" if ($opt_static_server);
$opt_config_options.= " --with-raid" if ($opt_raid);
# Only enable InnoDB when requested (required to be able to
# build the "Classic" packages that do not include InnoDB)
$opt_config_options.= " --without-innodb" if (!$opt_innodb);
if ($opt_with_other_libc)
{
$opt_with_other_libc= " --with-other-libc=$opt_with_other_libc";
$opt_config_options.= $opt_with_other_libc;
}
check_system("$opt_config_env ./configure --prefix=/usr/local/mysql --with-comment=\"Official MySQL$opt_version_suffix binary\" --with-extra-charsets=complex --with-server-suffix=\"$opt_version_suffix\" --enable-thread-safe-client --enable-local-infile $opt_config_options","Thank you for choosing MySQL");
2000-07-31 21:29:14 +02:00
if (-d "$pwd/$host/include-mysql")
{
safe_system("cp -r $pwd/$host/include-mysql/* $pwd/$host/$ver/include");
}
}
#
# Compile the binaries
#
2000-07-31 21:29:14 +02:00
if ($opt_stage <= 2)
{
my ($command);
unlink($opt_distribution) if ($opt_delete && !$opt_use_old_distribution);
$command=$make;
$command.= " $opt_make_options" if (defined($opt_make_options) && $opt_make_options ne "");
safe_system($command);
2000-07-31 21:29:14 +02:00
}
#
# Create the binary distribution
2000-07-31 21:29:14 +02:00
#
if ($opt_stage <= 3)
{
my $flags= "";
2001-01-21 16:38:36 +01:00
log_system("rm -fr mysql-3* mysql-4* $pwd/$host/*.tar.gz");
log_system("nm -n sql/mysqld | gzip -9 -v 2>&1 > sql/mysqld.sym.gz | cat");
$flags.= "--no-strip" if ($opt_no_strip);
check_system("scripts/make_binary_distribution --tmp=$opt_tmp --suffix=$opt_suffix $flags",".tar.gz created");
2000-07-31 21:29:14 +02:00
safe_system("mv mysql*.tar.gz $pwd/$host");
if (-f "client/.libs/mysqladmin")
{
safe_system("cp client/.libs/mysqladmin $pwd/$host/bin");
}
else
{
safe_system("cp client/mysqladmin $pwd/$host/bin");
}
2001-01-02 14:24:18 +01:00
safe_system("$make clean") if ($opt_with_small_disk);
2000-07-31 21:29:14 +02:00
}
2001-05-11 22:51:24 +02:00
$tar_file=<$pwd/$host/*.tar.gz>;
if (!defined($tar_file))
{
$tar_file=<$pwd/$host/*.tgz>;
}
#
# Unpack the binary distribution
#
2000-07-31 21:29:14 +02:00
if ($opt_stage <= 4 && !$opt_no_test)
{
rm_all(<$pwd/$host/test/*>);
safe_cd("$pwd/$host/test");
safe_system("gunzip < $tar_file | $tar xf -");
}
2002-02-10 01:28:24 +01:00
$tar_file =~ /(mysql[^\/]*)\.tar/;
2001-05-11 22:51:24 +02:00
$ver=$1;
$test_dir="$pwd/$host/test/$ver";
$ENV{"LD_LIBRARY_PATH"}= "$test_dir/lib:" . $ENV{"LD_LIBRARY_PATH"};
2001-01-02 14:24:18 +01:00
#
# Run the test suite
#
if ($opt_stage <= 5 && !$opt_no_test)
2001-01-02 14:24:18 +01:00
{
system("mkdir $bench_tmpdir") if (! -d $bench_tmpdir);
2001-01-21 16:38:36 +01:00
safe_cd("${test_dir}/mysql-test");
check_system("./mysql-test-run --tmpdir=$bench_tmpdir --master_port=$mysql_tcp_port --slave_port=$slave_port --sleep=10", "tests were successful");
2001-01-02 14:24:18 +01:00
}
#
# Start the server if we are going to run any of the benchmarks
#
if (!$opt_no_test)
2000-07-31 21:29:14 +02:00
{
2001-05-11 22:51:24 +02:00
my $extra;
2000-07-31 21:29:14 +02:00
safe_cd($test_dir);
log_system("./bin/mysqladmin --no-defaults -u root -S $mysql_unix_port -s shutdown") || info("There was no mysqld running\n");
sleep(2);
log_system("rm -f ./data/mysql/*");
2000-09-08 08:45:56 +02:00
check_system("scripts/mysql_install_db --no-defaults --skip-locking","https://order");
2001-05-11 22:51:24 +02:00
$extra="";
if ($opt_bdb)
{
$extra.=" -O bdb_cache_size=16M";
}
if ($opt_innodb)
{
$extra.=" --innodb_data_file_path=ibdata1:100M";
}
safe_system("./bin/mysqld --no-defaults --basedir . --datadir ./data --skip-locking $extra >> $log 2>&1 &");
2000-07-31 21:29:14 +02:00
sleep(2);
}
#
# Compile and install the required Perl modules
#
2001-01-02 14:24:18 +01:00
if ($opt_stage <= 7 && $opt_perl_files && !$opt_no_perl && !$opt_no_test)
2000-07-31 21:29:14 +02:00
{
safe_cd($test_dir);
rm_all("perl");
safe_system("mkdir perl");
$ENV{'IN_MYSQL_DISTRIBUTION'}=1;
$ENV{'MYSQL_BUILD'}=$test_dir;
foreach $module (split(/,/,$opt_perl_files))
{
my $options;
safe_cd("$test_dir/perl");
if ($opt_debug)
{
safe_system("gunzip < $pwd/$module | tar xvf -");
}
else
{
safe_system("gunzip < $pwd/$module | tar xf -");
}
$module =~ m|([^/]+)\.tar\.gz|;
$module = $1;
safe_cd($module);
$options="";
$options= "--mysql-install --noprompt --mysql-incdir=$test_dir/include --mysql-libdir=$test_dir/lib -nomsql-install -nomsql1-install --mysql-test-db=test $opt_dbd_options" if ($module =~ /Msql-Mysql/);
$options.= " PREFIX=$pwd/$host INSTALLPRIVLIB=$pwd/$host/perl5 INSTALLSCRIPT=$pwd/$host/bin INSTALLSITELIB=$pwd/$host/perl5/site_perl INSTALLBIN=$pwd/$host/bin INSTALLMAN1DIR=$pwd/$host/man INSTALLMAN3DIR=$pwd/$host/man/man3" if ($opt_local_perl);
$options.= " $opt_perl_options" if (defined($opt_perl_options));
safe_system($opt_static_perl ? "perl Makefile.PL -static $options" : "perl Makefile.PL $options");
safe_system("$make ; $sur $make install");
}
}
#
# Run crash-me test
#
2001-06-12 11:04:31 +02:00
if ($opt_stage <= 8 && !$opt_no_test && !$opt_no_crash_me)
2000-07-31 21:29:14 +02:00
{
safe_cd("$test_dir/sql-bench");
log_system("rm -f limits/mysql.cfg");
safe_system("perl ./crash-me --force --batch-mode $connect_option");
2000-07-31 21:29:14 +02:00
}
#
# Run sql-bench Benchmarks
#
2001-01-02 14:24:18 +01:00
if ($opt_stage <= 9 && !$opt_no_test)
2000-07-31 21:29:14 +02:00
{
safe_cd("$test_dir/sql-bench");
log_system("rm -f output/*");
$tmp= $opt_fast_benchmark ? "--fast --user root --small-test" : "";
check_system("perl ./run-all-tests --log --die-on-errors $connect_option $tmp","RUN-mysql");
2001-05-11 22:51:24 +02:00
if ($opt_bdb)
{
check_system("perl ./run-all-tests --log --suffix=\"_bdb\" --die-on-errors $connect_option $tmp --create-option=\"type=bdb\"","RUN-mysql");
}
if ($opt_innodb)
{
check_system("perl ./run-all-tests --log --suffix=\"_innodb\" --die-on-errors $connect_option $tmp --create-option=\"type=innodb\"","RUN-mysql");
}
2000-07-31 21:29:14 +02:00
}
2001-01-21 16:38:36 +01:00
rm_all($bench_tmpdir);
rm_all("$opt_tmp") if ($new_opt_tmp);
log_system("$pwd/$host/bin/mysqladmin --no-defaults -S $mysql_unix_port -u root shutdown");
2000-07-31 21:29:14 +02:00
print LOG "ok\n";
close LOG;
print "$host: ok\n";
exit 0;
sub usage
{
print <<EOF;
$0 version 1.4
2000-07-31 21:29:14 +02:00
$0 takes the following options:
--bdb
Compile with support for Berkeley DB tables
--config-env <environment for configure>
To set up the environment, like 'CC=cc CXX=gcc CXXFLAGS=-O3'
--config-options <options>
To add some extra options to configure (e.g. '--with-perl=yes')
--dbd-options <options>
Options for Makefile.PL when configuring msql-mysql-modules.
--debug
Print all shell commands on stdout.
--delete
Delete the distribution file.
--distribution <distribution_file>
Name of the MySQL source distribution file.
--enable-shared
Compile with shared libraries
--fast-benchmark
Run fast benchmark only to speed up testing
2000-07-31 21:29:14 +02:00
--help or --Information
Show this help
2001-05-11 22:51:24 +02:00
--innodb
Compile with support for Innodb tables
--libwrap
Compile with TCP wrapper support
2001-05-11 22:51:24 +02:00
--local-perl
Install Perl modules locally
2000-07-31 21:29:14 +02:00
--make-options <options>
Options to make after configure. (Like 'CXXLD=gcc')
2000-07-31 21:29:14 +02:00
--no-crash-me
Do not run the "crash-me" test
2000-07-31 21:29:14 +02:00
--no-strip
Do not strip the binaries included in the binary distribution
--no-test
Do not run any tests
2000-07-31 21:29:14 +02:00
--perl-files=list of files
Compile and install the given perl modules.
--perl-options <options>
Build Perl modules with the additional options
2000-07-31 21:29:14 +02:00
--raid
Compile with RAID support
2000-07-31 21:29:14 +02:00
--stage (1-6)
Start script from some specific point.
2000-07-31 21:29:14 +02:00
--static-client
Build statically linked client binaries
2000-07-31 21:29:14 +02:00
--static-perl
Build statically linked Perl modules
--static-server
Build statically linked server binary
--tcpip
Connect to the server to be tested via TCP/IP instead of socket
--tmp <directory>
Use a different temporary directory than /tmp
--use-old-distribution
Do not clean up the build environment and extract a fresh source
distribution, use an existing one instead.
--user <user_name>
Mail 'user_name'\@mysql.com if something went wrong.
If user is empty then no mail is sent.
--version-suffix suffix
Set name suffix (e.g. 'com' or '-max') for a distribution
2000-07-31 21:29:14 +02:00
--with-low-memory
Use less memory when compiling.
--with-other-libc <path to libc>
Link against libc and other standard libraries installed in the specified
non-standard location overriding default.
2000-07-31 21:29:14 +02:00
--with-small-disk
Clean up the build environment before testing the binary distribution
(to save disk space)
2000-07-31 21:29:14 +02:00
EOF
exit 1;
}
sub abort
{
my($message)=@_;
my($mail_header_file);
2000-07-31 21:29:14 +02:00
print LOG "\n$message\n";
print "$host: $message\n" if ($opt_debug);
close LOG;
if ($opt_user)
{
$mail_header_file="$opt_tmp/do-command.$$";
open(TMP,">$mail_header_file");
2001-01-21 16:38:36 +01:00
print TMP "From: mysql\@$full_host_name\n";
2000-07-31 21:29:14 +02:00
print TMP "To: $email\n";
print TMP "Subject: $ver$opt_version_suffix compilation failed\n\n";
2000-07-31 21:29:14 +02:00
close TMP;
system("tail -40 $log > $log.mail");
system("cat $mail_header_file $log.mail | $sendmail -t -f $email");
2000-07-31 21:29:14 +02:00
unlink($mail_header_file);
unlink("$log.mail");
}
print LOG "Aborting\n";
exit 1;
}
sub info
{
my($message)=@_;
print LOG "$message\n";
print "$host: $message\n";
}
sub log_system
{
my($com)=@_;
print "$host: $com\n" if ($opt_debug);
if (defined($log))
{
print LOG "$com\n";
system("$com >> $log 2>&1") &&
print LOG ("Info: couldn't execute command, error: " . ($? / 256) ."\n");
}
else
{
system($com) && print "$host: Couldn't execute command, error: " . ($? / 256) ."\n";
}
}
sub safe_system
{
my($com,$res)=@_;
print LOG "$com\n";
print "$host: $com\n" if ($opt_debug);
system("$com >> $log 2>&1") && abort("error: Couldn't execute command, error: " . ($? / 256));
}
sub check_system
{
my($com,$res)=@_;
my ($error,$found);
print LOG "$com\n";
print "$host: $com\n" if ($opt_debug);
open (COM, "$com 2>&1 < /dev/null|") || abort("Got error " . ($?/256) ." opening pipe");
$found=0;
while (<COM>)
{
print LOG $_;
if (index($_,$res) >= 0)
{
$found=1;
last;
}
}
close COM;
abort("Couldn't find '$res' in the command result") if (!$found);
print "$host: Command ok\n" if ($opt_debug);
}
sub safe_cd
{
my($dir)=@_;
print LOG "cd $dir\n";
print "$host: cd $dir\n" if ($opt_debug);
chdir($dir) || abort("Can't cd to $dir");
}
sub which
{
my(@progs)=@_;
foreach $prog (@progs)
{
chomp($found=`which $prog | head -1`);
if ($? == 0 && $found ne "" && index($found," ") == -1)
{
$found =~ s|/+|/|g; # Make nicer output
return $found;
}
}
return undef();
}
sub find
{
my (@progs)=@_;
foreach $prog (@progs)
{
return $prog if (-x $prog);
}
return undef();
}
#
# Remove recursively all from a directory
# This is needed because problems with NFS and open files
#
sub rm_all
{
my(@rm_files)=@_;
my($dir,$current_dir,@files,@dirs);
$current_dir = `pwd`; chomp($current_dir);
foreach $dir (@rm_files)
{
if (-d $dir)
{
chdir($dir) || abort("Can't cd to $dir");
print "$host: Removing from $dir\n" if ($opt_debug);
while (<* .*>)
{
next if ($_ eq "." x (length($_)));
if (-d $_)
{
# die "Can't remove directory that starts with ." if ($_ =~ /^\./ && $_ ne ".libs"); # Safety
push (@dirs,$_);
}
else
{
push (@files,$_);
}
}
if ($#files >= 0)
{
system("rm -f " . join(" ",@files)) && abort("Can't remove files from $dir");
}
foreach $dir (@dirs)
{
rm_all($dir);
}
chdir($current_dir) || abort("Can't cd to $current_dir");
log_system("rmdir $dir");
}
else
{
system("rm -f $dir") && abort("Can't remove file $dir");
}
}
}
sub kill_all
{
my ($pattern) = @_;
my ($USER,$BSD,$LINUX, $pscmd, $user, $pid);
$user=$ENV{'USER'};
$BSD = -f '/vmunix' || $ENV{"OS"} eq "SunOS4" || $^O eq 'darwin';
$LINUX = $^O eq 'linux';
$pscmd = $BSD ? "/bin/ps -auxww" : $LINUX ? "/bin/ps axuw" : "/bin/ps -ef";
if (!open(PS, "$pscmd|"))
{
print "Warning: Can't run $pscmd: $!\n";
exit;
}
# Catch any errors with eval. A bad pattern, for instance.
process:
while ($cand = <PS>)
{
chop($cand);
($pid_user, $pid) = split(' ', $cand);
next if $pid == $$;
next process if (! ($cand =~ $pattern) || $pid_user ne $user);
print LOG "Killing $_\n";
&killpid($pid);
}
}
sub killpid
{
local($pid) = @_;
kill 15, $pid;
for (1..5)
{
sleep 2;
return if kill(0, $pid) == 0;
}
kill 9, $pid;
for (1..5) {
sleep 2;
return if kill(0, $pid) == 0;
}
print LOG "$pid will not die!\n";
}