#!/usr/bin/perl -w use File::Basename; use Getopt::Long; use Sys::Hostname; @config_options= (); @make_options= (); $opt_distribution=$opt_user=$opt_config_env=$opt_config_extra_env=""; $opt_dbd_options=$opt_perl_options=$opt_config_options=$opt_make_options=$opt_suffix=""; $opt_tmp=$opt_version_suffix=""; $opt_bundled_zlib=$opt_help=$opt_delete=$opt_debug=$opt_stage=$opt_no_test=$opt_no_perl=$opt_one_error=$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=$opt_with_archive=$opt_with_cluster=$opt_with_csv=$opt_with_example=$opt_with_debug=$opt_no_benchmark=$opt_no_mysqltest=$opt_without_embedded=$opt_readline=0; $opt_skip_embedded_test=$opt_skip_ps_test=$opt_innodb=$opt_bdb=$opt_raid=$opt_libwrap=$opt_clearlogs=$opt_with_federated=0; GetOptions( "bdb", "build-thread=i", "bundled-zlib", "config-env=s" => \@config_env, "config-extra-env=s" => \@config_extra_env, "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", "no-benchmark", "one-error", "perl-files=s", "perl-options=s", "raid", "readline", "skip-embedded-test", "skip-ps-test", "stage=i", "static-client", "static-perl", "static-server", "suffix=s", "sur", "tcpip", "tmp=s", "use-old-distribution", "user=s", "version-suffix=s", "with-archive", "with-cluster", "with-csv", "with-debug", "with-example", "with-federated", "with-low-memory", "with-other-libc=s", "with-small-disk", "without-embedded", "clearlogs", ) || usage(); usage() if ($opt_help); usage() if (!$opt_distribution); 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); } if (@config_env > 0) { chomp(@config_env); $opt_config_env= join(" ", @config_env); } if (@config_extra_env > 0) { chomp(@config_extra_env); $opt_config_extra_env= join(" ", @config_extra_env); } $host= hostname(); chomp($uname=`uname`); $full_host_name=$host; $connect_option= ($opt_tcpip ? "--host=$host" : ""); $host =~ /^([^.-]*)/; $host=$1 . $opt_suffix; $email="$opt_user\@mysql.com"; chomp($pwd = `pwd`); $VER= basename($opt_distribution); $VER=~ /mysql.*-([1-9]\.[0-9]{1,2}\.[0-9]{1,2}.*)\.tar*/; $version=$1; $release=""; # Shut up perl ($major, $minor, $release) = split(/\./,$version); $log="$pwd/Logs/$host-$major.$minor$opt_version_suffix.log"; $opt_distribution =~ /(mysql[^\/]*)\.tar/; $ver=$1; $gcc_version=which("gcc"); if (defined($gcc_version) && ! $opt_config_env) { $tmp=`$gcc_version -v 2>&1`; if ($tmp =~ /version 2\.7\./) { $opt_config_env= 'CC=gcc CFLAGS="-O2 -fno-omit-frame-pointer" CXX=gcc CXXFLAGS="-O2 -fno-omit-frame-pointer"'; } 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"'; } else { $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"'; } } $opt_config_env.=" $opt_config_extra_env"; $new_opt_tmp=0; if ($opt_tmp) { unless (-d $opt_tmp) { safe_system("mkdir $opt_tmp"); $new_opt_tmp=1; } $ENV{'TMPDIR'}=$opt_tmp; } else { $opt_tmp="/tmp"; } $bench_tmpdir="$opt_tmp/my_build-$host"; $ENV{'PATH'}= "$pwd/$host/bin:" . $ENV{'PATH'}; $make=which("gmake","make"); # Can't use -j here! $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; $ENV{'MYSQL_UNIX_PORT'}=$mysql_unix_port="$opt_tmp/mysql$opt_suffix.build"; $ENV{"PERL5LIB"}="$pwd/$host/perl5:$pwd/$host/perl5/site_perl"; $slave_port=$mysql_tcp_port+16; $ndbcluster_port= 9350 + $opt_build_thread*2; $manager_port=$mysql_tcp_port+1; $mysqladmin_args="--no-defaults -u root --connect_timeout=5 --shutdown_timeout=20"; if ($opt_stage == 0 || $opt_clearlogs) { 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"); info("LD_LIBRARY_PATH is $ENV{LD_LIBRARY_PATH}"); info("PATH is $ENV{PATH}"); log_timestamp(); $md5_result= safe_system("perl $ENV{HOME}/my_md5sum -c ${opt_distribution}.md5"); if ($md5_result != 0) { abort("MD5 check failed for $opt_distribution!"); } else { info("SUCCESS: MD5 checks for $opt_distribution"); } if (-x "$host/bin/mysqladmin") { log_system("$host/bin/mysqladmin $mysqladmin_args -S $mysql_unix_port -s shutdown"); log_system("$host/bin/mysqladmin $mysqladmin_args -P $mysql_tcp_port -h $host -s shutdown"); log_system("$host/bin/mysqladmin $mysqladmin_args -P $slave_port -h $host -s shutdown"); log_system("$host/bin/mysqladmin $mysqladmin_args -P 9306 -h $host -s shutdown"); log_system("$host/bin/mysqladmin $mysqladmin_args -P 9307 -h $host -s shutdown"); } kill_all("mysqlmanager"); # # Kill all old processes that are in the build directories # This is to find any old mysqld servers left from previous builds kill_all("$pwd/host/mysql"); kill_all("$pwd/host/test"); if ($opt_stage == 0) { log_timestamp(); print "$host: Removing old distribution\n" if ($opt_debug); if (!$opt_use_old_distribution) { system("mkdir $host") if (! -d $host); system("touch $host/mysql-fix-for-glob"); rm_all(<$host/mysql*>); system("mkdir $host/bin") if (! -d "$host/bin"); } rm_all("$host/test"); system("mkdir $host/test") if (! -d "$host/test"); } safe_cd($host); if ($opt_stage == 0 && ! $opt_use_old_distribution) { 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 ."); } safe_cd("$pwd/$host/$ver"); # # Configure the sources # if ($opt_stage <= 1) { # Fix files if this is in another timezone than the build host log_timestamp(); unlink("config.cache"); unlink("bdb/build_unix/config.cache"); unlink("innobase/config.cache"); 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-zlib-dir=bundled" if ($opt_bundled_zlib); $opt_config_options.= " --with-client-ldflags=-all-static" if ($opt_static_client); $opt_config_options.= " --with-debug" if ($opt_with_debug); $opt_config_options.= " --without-ndb-debug" if ($opt_with_debug && $opt_with_cluster); $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); if ($opt_readline) { $opt_config_options.= " --with-readline"; } else { $opt_config_options.= " --with-libedit"; } $opt_config_options.= " --with-embedded-server" unless ($opt_without_embedded); $opt_skip_embedded_test= 1 if ($opt_without_embedded); $opt_config_options.= " --with-archive-storage-engine" if ($opt_with_archive); $opt_config_options.= " --with-ndbcluster" if ($opt_with_cluster); $opt_config_options.= " --with-csv-storage-engine" if ($opt_with_csv); $opt_config_options.= " --with-example-storage-engine" if ($opt_with_example); $opt_config_options.= " --with-federated-storage-engine" if ($opt_with_federated); # Only enable InnoDB when requested (required to be able to # build the "Classic" packages that do not include InnoDB) if ($opt_innodb) { $opt_config_options.= " --with-innodb"; } else { $opt_config_options.= " --without-innodb"; } if ($opt_with_other_libc) { $opt_with_other_libc= " --with-other-libc=$opt_with_other_libc"; $opt_config_options.= $opt_with_other_libc; } $prefix="/usr/local/mysql"; check_system("$opt_config_env ./configure --prefix=$prefix --localstatedir=$prefix/data --libexecdir=$prefix/bin --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"); if (-d "$pwd/$host/include-mysql") { safe_system("cp -r $pwd/$host/include-mysql/* $pwd/$host/$ver/include"); } } # # Compile the binaries # if ($opt_stage <= 2) { my ($command); log_timestamp(); 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); print LOG "Do-compile: Build successful\n"; } # # Create the binary distribution # if ($opt_stage <= 3) { my $flags= ""; log_timestamp(); log_system("rm -fr mysql-{3,4,5}* $pwd/$host/mysql*.t*gz"); # No need to add the debug symbols, if the binaries are not stripped (saves space) unless ($opt_with_debug || $opt_no_strip) { log_system("nm -n sql/mysqld | gzip -9 -v 2>&1 > sql/mysqld.sym.gz | cat"); } $flags.= " --no-strip" if ($opt_no_strip || $opt_with_debug); $flags.= " --with-ndbcluster" if ($opt_with_cluster); check_system("scripts/make_binary_distribution --tmp=$opt_tmp --suffix=$opt_suffix $flags",".tar.gz created"); safe_system("mv mysql*.t*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"); } safe_system("$make clean") if ($opt_with_small_disk); } $tar_file=<$pwd/$host/mysql*.t*gz>; abort ("Could not find tarball!") unless ($tar_file); # Generate the MD5 for the binary distribution $tar_file=~ /(mysql[^\/]*)\.(tar\.gz|tgz)/; $tar_file_lite= "$1.$2"; system("cd $pwd/$host; perl $ENV{HOME}/my_md5sum $tar_file_lite > ${tar_file_lite}.md5"); # # Unpack the binary distribution # if ($opt_stage <= 4 && !$opt_no_test) { log_timestamp(); rm_all(<$pwd/$host/test/*>); safe_cd("$pwd/$host/test"); safe_system("gunzip < $tar_file | $tar xf -"); } $tar_file =~ /(mysql[^\/]*)\.(tar\.gz|tgz)/; $ver=$1; $test_dir="$pwd/$host/test/$ver"; $ENV{"LD_LIBRARY_PATH"}= ("$test_dir/lib" . (defined($ENV{"LD_LIBRARY_PATH"}) ? ":" . $ENV{"LD_LIBRARY_PATH"} : "")); # # Run the test suite # if ($opt_stage <= 5 && !$opt_no_test && !$opt_no_mysqltest) { my $flags= ""; $flags.= " --with-ndbcluster" if ($opt_with_cluster); $flags.= " --force" if (!$opt_one_error); log_timestamp(); info("Running test suite"); system("mkdir $bench_tmpdir") if (! -d $bench_tmpdir); safe_cd("${test_dir}/mysql-test"); check_system("./mysql-test-run $flags --tmpdir=$bench_tmpdir --master_port=$mysql_tcp_port --slave_port=$slave_port --ndbcluster_port=$ndbcluster_port --manager-port=$manager_port --no-manager --sleep=10", "tests were successful"); unless ($opt_skip_ps_test) { log_timestamp(); info("Running test suite using prepared statements"); check_system("./mysql-test-run $flags --ps-protocol --tmpdir=$bench_tmpdir --master_port=$mysql_tcp_port --slave_port=$slave_port --ndbcluster_port=$ndbcluster_port --manager-port=$manager_port --no-manager --sleep=10", "tests were successful"); } unless ($opt_skip_embedded_test) { log_timestamp(); info("Running embedded server test suite"); # Embedded server and NDB don't jive $flags=~ s/ --with-ndbcluster//; check_system("./mysql-test-run $flags --embedded-server --tmpdir=$bench_tmpdir --master_port=$mysql_tcp_port --slave_port=$slave_port --manager-port=$manager_port --no-manager --sleep=10", "tests were successful"); } # 'mysql-test-run' writes its own final message for log evaluation. } # # Start the server if we are going to run any of the benchmarks # if (!$opt_no_test && !$opt_no_benchmark) { my $extra; safe_cd($test_dir); log_system("./bin/mysqladmin $mysqladmin_args -S $mysql_unix_port -s shutdown") || info("There was no mysqld running\n"); sleep(2); log_system("rm -f ./data/mysql/*"); check_system("scripts/mysql_install_db --no-defaults --skip-locking","https://order"); $extra=""; if ($opt_bdb) { $extra.=" --bdb_cache_size=16M --bdb_max_lock=240000" } if ($opt_innodb) { $extra.=" --innodb_data_file_path=ibdata1:100M:autoextend"; } safe_system("./bin/mysqld --no-defaults --basedir . --datadir ./data --skip-locking $extra >> $log 2>&1 &"); sleep(2); } # # Compile and install the required Perl modules # if ($opt_stage <= 7 && $opt_perl_files && !$opt_no_perl && !$opt_no_test && !$opt_no_benchmark) { log_timestamp(); 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 # if ($opt_stage <= 8 && !$opt_no_test && !$opt_no_crash_me) { log_timestamp(); safe_cd("$test_dir/sql-bench"); log_system("rm -f limits/mysql.cfg"); safe_system("perl ./crash-me --force --batch-mode $connect_option"); } # # Run sql-bench Benchmarks # if ($opt_stage <= 9 && !$opt_no_test && !$opt_no_benchmark) { log_timestamp(); 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"); # Run additional fast test with dynamic-row tables check_system("perl ./run-all-tests --log --suffix=\"_dynamic_rows\" --die-on-errors $connect_option --fast --user=root --small-test --create-options=\"row_format=dynamic\"","RUN-mysql"); if ($opt_innodb) { check_system("perl ./run-all-tests --log --suffix=\"_innodb\" --die-on-errors $connect_option $tmp --create-options=\"type=innodb\"","RUN-mysql"); } if ($opt_bdb) { check_system("perl ./run-all-tests --log --suffix=\"_bdb\" --die-on-errors $connect_option $tmp --create-options=\"type=bdb\"","RUN-mysql"); } } rm_all($bench_tmpdir); rm_all("$opt_tmp") if ($new_opt_tmp); log_system("$pwd/$host/bin/mysqladmin $mysqladmin_args -S $mysql_unix_port shutdown"); print LOG "ok\n"; close LOG; print "$host: ok\n"; exit 0; sub usage { print < When running several Do-compile runs in parallel, each build should have its own thread ID, so running the test suites does not cause conflicts with duplicate TCP port numbers. --config-env= To set up the environment, like 'CC=cc CXX=gcc CXXFLAGS=-O3' --config-extra-env Additional flags for environment (not CC or CXX). Should be used when one wants Do-compile to propose proper CC and CXX flags. --config-options= To add some extra options to configure (e.g. '--with-perl=yes') --dbd-options Options for Makefile.PL when configuring msql-mysql-modules. --debug Print all shell commands on stdout. --delete Delete the distribution file. --distribution= Name of the MySQL source distribution file. --enable-shared Compile with shared libraries --fast-benchmark Run fast benchmark only to speed up testing --help or --Information Show this help --innodb Compile with support for Innodb tables --libwrap Compile with TCP wrapper support --local-perl Install Perl modules locally --make-options= Options to make after configure. (Like 'CXXLD=gcc') --no-crash-me Do not run the "crash-me" test --no-strip Do not strip the binaries included in the binary distribution --no-test Do not run any tests. --no-benchmark Do not run the benchmark test (written in perl) --no-mysqltest Do not run the mysql-test-run test (Same as 'make test') --one-error Terminate the mysql-test-run test after the first difference (default: use '--force') --no-perl Do not compile or install Perl modules, use the system installed ones --perl-files= Compile and install the given perl modules. --perl-options= Build Perl modules with the additional options --raid Compile with RAID support --readline Compile against readline library instead of libedit --skip-embedded-test Skip running the test suite against the embedded server --skip-ps-test Skip running the additional test run that uses the prepared statement protocol --stage=[1-6] Start script from some specific point. --static-client Build statically linked client binaries --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= 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= 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 --with-archive Enable the Archive storage engine --with-cluster Compile and test with NDB Cluster enabled --with-csv Enable the CSV storage engine --with-example Enable the Example storage engine --with-federated Enable the Federated storage engine --with-debug Build binaries with debug information (implies "--no-strip") --with-low-memory Use less memory when compiling. --with-other-libc= Link against libc and other standard libraries installed in the specified non-standard location overriding default. --with-small-disk Clean up the build environment before testing the binary distribution (to save disk space) --without-embedded Don't compile the embedded server. EOF exit 1; } sub abort { my($message)=@_; my($mail_header_file); print LOG "\n$message\n"; print "$host: $message\n" if ($opt_debug); print LOG "Aborting\n"; close LOG; if ($opt_user) { $mail_header_file="$opt_tmp/do-command.$$"; open(TMP,">$mail_header_file"); print TMP "From: mysqldev\@$full_host_name\n"; print TMP "To: $email\n"; print TMP "Subject: $host($uname): $ver$opt_version_suffix compilation failed\n\n"; close TMP; system("tail -n 40 $log > $log.mail"); system("cat $mail_header_file $log.mail | $sendmail -t -f $email"); unlink($mail_header_file); unlink("$log.mail"); } 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); my $result= system("$com >> $log 2>&1"); abort("error: Couldn't execute command, error: " . ($? / 256)) unless $result == 0; return $result; } 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 () { 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 -n 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, $os, $pid); $user=$ENV{'USER'}; $os=defined($ENV{'OS'}) ? $ENV{'OS'} : "unknown"; $BSD = -f '/vmunix' || $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 = ) { chop($cand); ($pid_user, $pid) = split(' ', $cand); next if $pid eq $$; 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"; } # # return the current date as a string (YYYY-MM-DD HH:MM:SS) # sub log_timestamp { my @ta=localtime(time()); print LOG sprintf("%4d-%02d-%02d %02d:%02d:%02d\n", $ta[5]+1900, $ta[4]+1, $ta[3], $ta[2], $ta[1], $ta[0]); }