# | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____|
#
-# Copyright (C) 1998 - 2006, Daniel Stenberg, <daniel@haxx.se>, et al.
+# Copyright (C) 1998 - 2010, Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
-# are also available at http://curl.haxx.se/docs/copyright.html.
+# are also available at https://curl.haxx.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
-# $Id$
###########################################################################
use strict;
-#use warnings; # requires perl 5.006 or later
+use warnings;
+use serverhelp qw(
+ servername_id
+ mainsockf_pidfilename
+ datasockf_pidfilename
+ );
-my $DEFAULT_TIMEOUT_START = 90; # default allowed time for a process to startup
-my $DEFAULT_TIMEOUT_STOP = 90; # default allowed time for a process to stop
-
-my $ONE_HALF_STOP_TIMEOUT = int($DEFAULT_TIMEOUT_STOP / 2);
-my $ONE_THIRD_STOP_TIMEOUT = int($DEFAULT_TIMEOUT_STOP / 3);
-my $ONE_SIXTH_STOP_TIMEOUT = int($DEFAULT_TIMEOUT_STOP / 6);
-
-my $pidpattern = qr/^\-?(\d+)$/; # pre-compiled pid pattern regexp
-
-
-######################################################################
+#######################################################################
# pidfromfile returns the pid stored in the given pidfile. The value
# of the returned pid will never be a negative value. It will be zero
# on any file related error or if a pid can not be extracted from the
-# file. Otherwise it will be a positive value, even If the pid number
-# stored in the file is a negative one.
+# given file.
#
sub pidfromfile {
- my ($pidfile)=@_;
-
- my $pid = 0; # on failure or empty file return 0
- my $pidline;
+ my $pidfile = $_[0];
+ my $pid = 0;
- if(not defined $pidfile) {
- return 0;
- }
- if(-f $pidfile) {
- if(open(PIDF, "<$pidfile")) {
- my $pidline = <PIDF>;
- close(PIDF);
- if($pidline) {
- chomp $pidline;
- $pidline =~ s/^\s+//;
- $pidline =~ s/\s+$//;
- $pidline =~ s/^[+-]?0+//;
- if($pidline =~ $pidpattern) {
- $pid = $1;
- }
- }
- }
+ if(-f $pidfile && -s $pidfile && open(PIDFH, "<$pidfile")) {
+ $pid = 0 + <PIDFH>;
+ close(PIDFH);
+ $pid = 0 unless($pid > 0);
}
return $pid;
}
-
-######################################################################
-# unlinkpidfiles unlinks/deletes the given pidfiles. The first argument
-# 'pidfiles' is a string of whitespace separated pidfiles. If successful
-# returns 0, on error it returns the number of files not deleted.
+#######################################################################
+# pidexists checks if a process with a given pid exists and is alive.
+# This will return the positive pid if the process exists and is alive.
+# This will return the negative pid if the process exists differently.
+# This will return 0 if the process could not be found.
#
-sub unlinkpidfiles {
- my ($pidfiles)=@_;
+sub pidexists {
+ my $pid = $_[0];
- if(not defined $pidfiles) {
- return 0;
- }
- my $pidfile;
- my $errcount = 0;
- for $pidfile (split(" ", $pidfiles)) {
- if($pidfile) {
- if(unlink($pidfile) == 0) {
- $errcount++;
+ if($pid > 0) {
+ # verify if currently existing and alive
+ if(kill(0, $pid)) {
+ return $pid;
+ }
+
+ # verify if currently existing Windows process
+ if($^O eq "msys") {
+ my $filter = "PID eq $pid";
+ my $result = `tasklist -fi \"$filter\" 2>nul`;
+ if(index($result, "$pid") != -1) {
+ return -$pid;
}
}
}
- return $errcount;
-}
+ return 0;
+}
-######################################################################
-# checkalivepid checks if the process of the given pid is alive. The
-# argument must represent a single pid and be a valid number, if not
-# it will return 0. It will also return 0 if the pid argument is zero
-# or negative. If the pid argument is positive and it is alive returns
-# the same positive pid, otherwise, if it is not alive it will return
-# the negative value of the pid argument.
+#######################################################################
+# pidterm asks the process with a given pid to terminate gracefully.
#
-sub checkalivepid {
- my ($pid)=@_;
+sub pidterm {
+ my $pid = $_[0];
- if(not defined $pid) {
- return 0;
- }
- if ($pid !~ $pidpattern) {
- return 0; # invalid argument
- }
if($pid > 0) {
- if(kill(0, $pid)) {
- return $pid; # positive means it is alive
- }
- else {
- return -$pid; # negative means dead process
+ # signal the process to terminate
+ kill("TERM", $pid);
+
+ # request the process to quit
+ if($^O eq "msys") {
+ my $filter = "PID eq $pid";
+ my $result = `tasklist -fi \"$filter\" 2>nul`;
+ if(index($result, "$pid") != -1) {
+ system("taskkill -fi \"$filter\" >nul 2>&1");
+ }
}
}
- return 0; # not a positive pid argument
}
-
-######################################################################
-# checkalivepidfile checks if the process of the pid stored in the
-# given pidfile is alive. It will return 0 on any file related error
-# or if a pid can not be extracted from the file. If the process of
-# the pid present in the file is alive it returns that positive pid,
-# if it is not alive it will return the negative value of the pid.
-#
-sub checkalivepidfile {
- my ($pidfile)=@_;
-
- my $pid = pidfromfile($pidfile);
- my $ret = checkalivepid($pid);
- return $ret;
-}
-
-
-######################################################################
-# signalpids signals processes in the second argument with the signal
-# given in the first argument. The second argument 'pids' is a string
-# of whitespace separated pids. Of the given pids only those that are
-# positive and are actually alive will be signalled, and no matter
-# how many times a pid is repeated it will only be signalled once.
+#######################################################################
+# pidkill kills the process with a given pid mercilessly andforcefully.
#
-sub signalpids {
- my ($signal, $pids)=@_;
+sub pidkill {
+ my $pid = $_[0];
- if((not defined $signal) || (not defined $pids)) {
- return;
- }
- if($pids !~ /\s+/) {
- # avoid sorting if only one pid
- if(checkalivepid($pids) > 0) {
- kill($signal, $pids);
- }
- return;
- }
- my $prev = 0;
- for(sort({$a <=> $b} split(" ", $pids))) {
- if($_ =~ $pidpattern) {
- my $pid = $1;
- if($prev != $pid) {
- $prev = $pid;
- if(checkalivepid($pid) > 0) {
- kill($signal, $pid);
- }
+ if($pid > 0) {
+ # signal the process to terminate
+ kill("KILL", $pid);
+
+ # request the process to quit
+ if($^O eq "msys") {
+ my $filter = "PID eq $pid";
+ my $result = `tasklist -fi \"$filter\" 2>nul`;
+ if(index($result, "$pid") != -1) {
+ system("taskkill -f -fi \"$filter\" >nul 2>&1");
+ # Windows XP Home compatibility
+ system("tskill $pid >nul 2>&1");
}
}
}
}
-
-######################################################################
-# signalpidfile signals the process of the pid stored in the given
-# pidfile with the signal given in the first argument if the process
-# with that pid is actually alive.
+#######################################################################
+# processexists checks if a process with the pid stored in the given
+# pidfile exists and is alive. This will return 0 on any file related
+# error or if a pid can not be extracted from the given file. When a
+# process with the same pid as the one extracted from the given file
+# is currently alive this returns that positive pid. Otherwise, when
+# the process is not alive, will return the negative value of the pid.
#
-sub signalpidfile {
- my ($signal, $pidfile)=@_;
+sub processexists {
+ use POSIX ":sys_wait_h";
+ my $pidfile = $_[0];
+ # fetch pid from pidfile
my $pid = pidfromfile($pidfile);
+
if($pid > 0) {
- signalpids($signal, $pid);
+ # verify if currently alive
+ if(pidexists($pid)) {
+ return $pid;
+ }
+ else {
+ # get rid of the certainly invalid pidfile
+ unlink($pidfile) if($pid == pidfromfile($pidfile));
+ # reap its dead children, if not done yet
+ waitpid($pid, &WNOHANG);
+ # negative return value means dead process
+ return -$pid;
+ }
}
+ return 0;
}
-
-######################################################################
-# waitdeadpid waits until all processes given in the first argument
-# are not alive, waiting at most timeout seconds. The first argument
-# 'pids' is a string of whitespace separated pids. Returns 1 when all
-# pids are not alive. Returns 0 when the specified timeout has expired
-# and at least one of the specified pids is still alive.
+#######################################################################
+# killpid attempts to gracefully stop processes in the given pid list
+# with a SIGTERM signal and SIGKILLs those which haven't died on time.
#
-sub waitdeadpid {
- my ($pids, $timeout)=@_;
-
- if(not defined $pids) {
- return 1;
+sub killpid {
+ use POSIX ":sys_wait_h";
+ my ($verbose, $pidlist) = @_;
+ my @requested;
+ my @signalled;
+ my @reapchild;
+
+ # The 'pidlist' argument is a string of whitespace separated pids.
+ return if(not defined($pidlist));
+
+ # Make 'requested' hold the non-duplicate pids from 'pidlist'.
+ @requested = split(' ', $pidlist);
+ return if(not @requested);
+ if(scalar(@requested) > 2) {
+ @requested = sort({$a <=> $b} @requested);
}
- if((not defined $timeout) || ($timeout < 1)) {
- $timeout = $DEFAULT_TIMEOUT_STOP;
+ for(my $i = scalar(@requested) - 2; $i >= 0; $i--) {
+ if($requested[$i] == $requested[$i+1]) {
+ splice @requested, $i+1, 1;
+ }
}
- while($timeout--) {
- my $alive = 0;
- for(split(" ", $pids)) {
- if($_ =~ $pidpattern) {
- my $pid = $1;
- if(checkalivepid($pid) > 0) {
- $alive++;
+
+ # Send a SIGTERM to processes which are alive to gracefully stop them.
+ foreach my $tmp (@requested) {
+ chomp $tmp;
+ if($tmp =~ /^(\d+)$/) {
+ my $pid = $1;
+ if($pid > 0) {
+ if(pidexists($pid)) {
+ print("RUN: Process with pid $pid signalled to die\n")
+ if($verbose);
+ pidterm($pid);
+ push @signalled, $pid;
+ }
+ else {
+ print("RUN: Process with pid $pid already dead\n")
+ if($verbose);
+ # if possible reap its dead children
+ waitpid($pid, &WNOHANG);
+ push @reapchild, $pid;
}
}
}
- if($alive == 0) {
- return 1; # not a single pid is alive
- }
- sleep(1);
}
- return 0; # at least one pid is still alive after timeout seconds
-}
-
-
-######################################################################
-# waitalivepidfile waits until the given pidfile has a pid that is
-# alive, waiting at most timeout seconds. It returns the positive pid
-# When it is alive, otherwise it returns 0 when timeout seconds have
-# elapsed and the pidfile does not have a pid that is alive.
-#
-sub waitalivepidfile {
- my ($pidfile, $timeout)=@_;
- if(not defined $pidfile) {
- return 0;
- }
- if((not defined $timeout) || ($timeout < 1)) {
- $timeout = $DEFAULT_TIMEOUT_START;
- }
- while($timeout--) {
- my $pid = checkalivepidfile($pidfile);
- if($pid > 0) {
- return $pid; # positive means it is alive
+ # Allow all signalled processes five seconds to gracefully die.
+ if(@signalled) {
+ my $twentieths = 5 * 20;
+ while($twentieths--) {
+ for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) {
+ my $pid = $signalled[$i];
+ if(!pidexists($pid)) {
+ print("RUN: Process with pid $pid gracefully died\n")
+ if($verbose);
+ splice @signalled, $i, 1;
+ # if possible reap its dead children
+ waitpid($pid, &WNOHANG);
+ push @reapchild, $pid;
+ }
+ }
+ last if(not scalar(@signalled));
+ select(undef, undef, undef, 0.05);
}
- sleep(1);
}
- return 0; # no pid in pidfile or not alive
-}
-
-
-######################################################################
-# stopprocess ends the given pid(s), waiting for them to die. The 'pids'
-# argument is a string of whitespace separated pids. Returns 1 if all
-# of the processes have been successfully stopped. If unable to stop
-# any of them in DEFAULT_TIMEOUT_STOP seconds then it returns 0.
-#
-sub stopprocess {
- my ($pids)=@_;
- if(not defined $pids) {
- return 1;
+ # Mercilessly SIGKILL processes still alive.
+ if(@signalled) {
+ foreach my $pid (@signalled) {
+ if($pid > 0) {
+ print("RUN: Process with pid $pid forced to die with SIGKILL\n")
+ if($verbose);
+ pidkill($pid);
+ # if possible reap its dead children
+ waitpid($pid, &WNOHANG);
+ push @reapchild, $pid;
+ }
+ }
}
- signalpids("KILL", $pids);
- if(waitdeadpid($pids, $ONE_HALF_STOP_TIMEOUT) == 0) {
- signalpids("KILL", $pids);
- if(waitdeadpid($pids, $ONE_THIRD_STOP_TIMEOUT) == 0) {
- signalpids("KILL", $pids);
- if(waitdeadpid($pids, $ONE_SIXTH_STOP_TIMEOUT) == 0) {
- return 0; # at least one pid is still alive !!!
+
+ # Reap processes dead children for sure.
+ if(@reapchild) {
+ foreach my $pid (@reapchild) {
+ if($pid > 0) {
+ waitpid($pid, 0);
}
}
}
- return 1; # not a single pid is alive
}
-
-######################################################################
-# stopprocesspidfile ends the test server process of the given pidfile,
-# waiting for it to die, and unlinking/deleting the given pidfile. If
-# the given process was not running or has been successfully stopped it
-# returns 1. If unable to stop it in DEFAULT_TIMEOUT_STOP seconds then
-# returns 0.
+#######################################################################
+# killsockfilters kills sockfilter processes for a given server.
#
-sub stopprocesspidfile {
- my ($pidfile)=@_;
+sub killsockfilters {
+ my ($proto, $ipvnum, $idnum, $verbose, $which) = @_;
+ my $server;
+ my $pidfile;
+ my $pid;
- if(not defined $pidfile) {
- return 1;
- }
- my $ret = 1; # assume success stopping it
- my $pid = checkalivepidfile($pidfile);
- if($pid > 0) {
- $ret = stopprocess($pid);
- }
- unlinkpidfiles($pidfile);
- return $ret;
-}
+ return if($proto !~ /^(ftp|imap|pop3|smtp)$/);
+ die "unsupported sockfilter: $which"
+ if($which && ($which !~ /^(main|data)$/));
-######################################################################
-# ftpkillslave ends a specific slave, waiting for it to die, and
-# unlinking/deleting its pidfiles. If the given ftpslave was not
-# running or has been successfully stopped it returns 1. If unable
-# to stop it in DEFAULT_TIMEOUT_STOP seconds then it returns 0.
-#
-sub ftpkillslave {
- my ($id, $ext)=@_;
+ $server = servername_id($proto, $ipvnum, $idnum) if($verbose);
- if(not defined $id) {
- $id = "";
- }
- if(not defined $ext) {
- $ext = "";
- }
- my $ret = 1; # assume success stopping them
- my $pids = "";
- my $pidfiles = "";
- for my $base (('filt', 'data')) {
- my $pidfile = ".sock$base$id$ext.pid";
- my $pid = checkalivepidfile($pidfile);
- $pidfiles .= " $pidfile";
+ if(!$which || ($which eq 'main')) {
+ $pidfile = mainsockf_pidfilename($proto, $ipvnum, $idnum);
+ $pid = processexists($pidfile);
if($pid > 0) {
- $pids .= " $pid";
+ printf("* kill pid for %s-%s => %d\n", $server,
+ ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose);
+ pidkill($pid);
+ waitpid($pid, 0);
}
+ unlink($pidfile) if(-f $pidfile);
}
- if($pids) {
- $ret = stopprocess($pids);
- }
- if($pidfiles) {
- unlinkpidfiles($pidfiles);
+
+ return if($proto ne 'ftp');
+
+ if(!$which || ($which eq 'data')) {
+ $pidfile = datasockf_pidfilename($proto, $ipvnum, $idnum);
+ $pid = processexists($pidfile);
+ if($pid > 0) {
+ printf("* kill pid for %s-data => %d\n", $server,
+ $pid) if($verbose);
+ pidkill($pid);
+ waitpid($pid, 0);
+ }
+ unlink($pidfile) if(-f $pidfile);
}
- return $ret;
}
-
-######################################################################
-# ftpkillslaves ends all the ftpslave processes, waiting for them to
-# die, unlinking/deleting its pidfiles. If they were not running or
-# have been successfully stopped it returns 1. If unable to stop any
-# of them in DEFAULT_TIMEOUT_STOP seconds then returns 0.
+#######################################################################
+# killallsockfilters kills sockfilter processes for all servers.
#
-sub ftpkillslaves {
-
- my $ret = 1; # assume success stopping them
- my $pids = "";
- my $pidfiles = "";
- for my $ext (("", "ipv6")) {
- for my $id (("", "2")) {
- for my $base (('filt', 'data')) {
- my $pidfile = ".sock$base$id$ext.pid";
- my $pid = checkalivepidfile($pidfile);
- $pidfiles .= " $pidfile";
- if($pid > 0) {
- $pids .= " $pid";
- }
+sub killallsockfilters {
+ my $verbose = $_[0];
+
+ for my $proto (('ftp', 'imap', 'pop3', 'smtp')) {
+ for my $ipvnum (('4', '6')) {
+ for my $idnum (('1', '2')) {
+ killsockfilters($proto, $ipvnum, $idnum, $verbose);
}
}
}
- if($pids) {
- $ret = stopprocess($pids);
+}
+
+
+sub set_advisor_read_lock {
+ my ($filename) = @_;
+
+ if(open(FILEH, ">$filename")) {
+ close(FILEH);
+ return;
}
- if($pidfiles) {
- unlinkpidfiles($pidfiles);
+ printf "Error creating lock file $filename error: $!";
+}
+
+
+sub clear_advisor_read_lock {
+ my ($filename) = @_;
+
+ if(-f $filename) {
+ unlink($filename);
}
- return $ret;
}
-######################################################################
-# library files end with 1; to make 'require' and 'use' succeed.
1;
-
projects / platform / upstream / curl.git / blobdiff