1#*************************************************************************** 2# _ _ ____ _ 3# Project ___| | | | _ \| | 4# / __| | | | |_) | | 5# | (__| |_| | _ <| |___ 6# \___|\___/|_| \_\_____| 7# 8# Copyright (C) 1998 - 2010, Daniel Stenberg, <daniel@haxx.se>, et al. 9# 10# This software is licensed as described in the file COPYING, which 11# you should have received as part of this distribution. The terms 12# are also available at http://curl.haxx.se/docs/copyright.html. 13# 14# You may opt to use, copy, modify, merge, publish, distribute and/or sell 15# copies of the Software, and permit persons to whom the Software is 16# furnished to do so, under the terms of the COPYING file. 17# 18# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY 19# KIND, either express or implied. 20# 21########################################################################### 22 23use strict; 24use warnings; 25 26use serverhelp qw( 27 servername_id 28 mainsockf_pidfilename 29 datasockf_pidfilename 30 ); 31 32####################################################################### 33# pidfromfile returns the pid stored in the given pidfile. The value 34# of the returned pid will never be a negative value. It will be zero 35# on any file related error or if a pid can not be extracted from the 36# given file. 37# 38sub pidfromfile { 39 my $pidfile = $_[0]; 40 my $pid = 0; 41 42 if(-f $pidfile && -s $pidfile && open(PIDFH, "<$pidfile")) { 43 $pid = 0 + <PIDFH>; 44 close(PIDFH); 45 $pid = 0 unless($pid > 0); 46 } 47 return $pid; 48} 49 50####################################################################### 51# pidexists checks if a process with a given pid exists and is alive. 52# This will return the positive pid if the process exists and is alive. 53# This will return the negative pid if the process exists differently. 54# This will return 0 if the process could not be found. 55# 56sub pidexists { 57 my $pid = $_[0]; 58 59 if($pid > 0) { 60 # verify if currently existing and alive 61 if(kill(0, $pid)) { 62 return $pid; 63 } 64 65 # verify if currently existing Windows process 66 if($^O eq "msys") { 67 my $filter = "PID eq $pid"; 68 my $result = `tasklist -fi \"$filter\" 2>nul`; 69 if(index($result, "$pid") != -1) { 70 return -$pid; 71 } 72 } 73 } 74 75 return 0; 76} 77 78####################################################################### 79# pidterm asks the process with a given pid to terminate gracefully. 80# 81sub pidterm { 82 my $pid = $_[0]; 83 84 if($pid > 0) { 85 # signal the process to terminate 86 kill("TERM", $pid); 87 88 # request the process to quit 89 if($^O eq "msys") { 90 my $filter = "PID eq $pid"; 91 my $result = `tasklist -fi \"$filter\" 2>nul`; 92 if(index($result, "$pid") != -1) { 93 system("taskkill -fi \"$filter\" >nul 2>&1"); 94 } 95 } 96 } 97} 98 99####################################################################### 100# pidkill kills the process with a given pid mercilessly andforcefully. 101# 102sub pidkill { 103 my $pid = $_[0]; 104 105 if($pid > 0) { 106 # signal the process to terminate 107 kill("KILL", $pid); 108 109 # request the process to quit 110 if($^O eq "msys") { 111 my $filter = "PID eq $pid"; 112 my $result = `tasklist -fi \"$filter\" 2>nul`; 113 if(index($result, "$pid") != -1) { 114 system("taskkill -f -fi \"$filter\" >nul 2>&1"); 115 # Windows XP Home compatibility 116 system("tskill $pid >nul 2>&1"); 117 } 118 } 119 } 120} 121 122####################################################################### 123# processexists checks if a process with the pid stored in the given 124# pidfile exists and is alive. This will return 0 on any file related 125# error or if a pid can not be extracted from the given file. When a 126# process with the same pid as the one extracted from the given file 127# is currently alive this returns that positive pid. Otherwise, when 128# the process is not alive, will return the negative value of the pid. 129# 130sub processexists { 131 use POSIX ":sys_wait_h"; 132 my $pidfile = $_[0]; 133 134 # fetch pid from pidfile 135 my $pid = pidfromfile($pidfile); 136 137 if($pid > 0) { 138 # verify if currently alive 139 if(pidexists($pid)) { 140 return $pid; 141 } 142 else { 143 # get rid of the certainly invalid pidfile 144 unlink($pidfile) if($pid == pidfromfile($pidfile)); 145 # reap its dead children, if not done yet 146 waitpid($pid, &WNOHANG); 147 # negative return value means dead process 148 return -$pid; 149 } 150 } 151 return 0; 152} 153 154####################################################################### 155# killpid attempts to gracefully stop processes in the given pid list 156# with a SIGTERM signal and SIGKILLs those which haven't died on time. 157# 158sub killpid { 159 use POSIX ":sys_wait_h"; 160 my ($verbose, $pidlist) = @_; 161 my @requested; 162 my @signalled; 163 my @reapchild; 164 165 # The 'pidlist' argument is a string of whitespace separated pids. 166 return if(not defined($pidlist)); 167 168 # Make 'requested' hold the non-duplicate pids from 'pidlist'. 169 @requested = split(' ', $pidlist); 170 return if(not @requested); 171 if(scalar(@requested) > 2) { 172 @requested = sort({$a <=> $b} @requested); 173 } 174 for(my $i = scalar(@requested) - 2; $i >= 0; $i--) { 175 if($requested[$i] == $requested[$i+1]) { 176 splice @requested, $i+1, 1; 177 } 178 } 179 180 # Send a SIGTERM to processes which are alive to gracefully stop them. 181 foreach my $tmp (@requested) { 182 chomp $tmp; 183 if($tmp =~ /^(\d+)$/) { 184 my $pid = $1; 185 if($pid > 0) { 186 if(pidexists($pid)) { 187 print("RUN: Process with pid $pid signalled to die\n") 188 if($verbose); 189 pidterm($pid); 190 push @signalled, $pid; 191 } 192 else { 193 print("RUN: Process with pid $pid already dead\n") 194 if($verbose); 195 # if possible reap its dead children 196 waitpid($pid, &WNOHANG); 197 push @reapchild, $pid; 198 } 199 } 200 } 201 } 202 203 # Allow all signalled processes five seconds to gracefully die. 204 if(@signalled) { 205 my $twentieths = 5 * 20; 206 while($twentieths--) { 207 for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) { 208 my $pid = $signalled[$i]; 209 if(!pidexists($pid)) { 210 print("RUN: Process with pid $pid gracefully died\n") 211 if($verbose); 212 splice @signalled, $i, 1; 213 # if possible reap its dead children 214 waitpid($pid, &WNOHANG); 215 push @reapchild, $pid; 216 } 217 } 218 last if(not scalar(@signalled)); 219 select(undef, undef, undef, 0.05); 220 } 221 } 222 223 # Mercilessly SIGKILL processes still alive. 224 if(@signalled) { 225 foreach my $pid (@signalled) { 226 if($pid > 0) { 227 print("RUN: Process with pid $pid forced to die with SIGKILL\n") 228 if($verbose); 229 pidkill($pid); 230 # if possible reap its dead children 231 waitpid($pid, &WNOHANG); 232 push @reapchild, $pid; 233 } 234 } 235 } 236 237 # Reap processes dead children for sure. 238 if(@reapchild) { 239 foreach my $pid (@reapchild) { 240 if($pid > 0) { 241 waitpid($pid, 0); 242 } 243 } 244 } 245} 246 247####################################################################### 248# killsockfilters kills sockfilter processes for a given server. 249# 250sub killsockfilters { 251 my ($proto, $ipvnum, $idnum, $verbose, $which) = @_; 252 my $server; 253 my $pidfile; 254 my $pid; 255 256 return if($proto !~ /^(ftp|imap|pop3|smtp)$/); 257 258 die "unsupported sockfilter: $which" 259 if($which && ($which !~ /^(main|data)$/)); 260 261 $server = servername_id($proto, $ipvnum, $idnum) if($verbose); 262 263 if(!$which || ($which eq 'main')) { 264 $pidfile = mainsockf_pidfilename($proto, $ipvnum, $idnum); 265 $pid = processexists($pidfile); 266 if($pid > 0) { 267 printf("* kill pid for %s-%s => %d\n", $server, 268 ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose); 269 pidkill($pid); 270 waitpid($pid, 0); 271 } 272 unlink($pidfile) if(-f $pidfile); 273 } 274 275 return if($proto ne 'ftp'); 276 277 if(!$which || ($which eq 'data')) { 278 $pidfile = datasockf_pidfilename($proto, $ipvnum, $idnum); 279 $pid = processexists($pidfile); 280 if($pid > 0) { 281 printf("* kill pid for %s-data => %d\n", $server, 282 $pid) if($verbose); 283 pidkill($pid); 284 waitpid($pid, 0); 285 } 286 unlink($pidfile) if(-f $pidfile); 287 } 288} 289 290####################################################################### 291# killallsockfilters kills sockfilter processes for all servers. 292# 293sub killallsockfilters { 294 my $verbose = $_[0]; 295 296 for my $proto (('ftp', 'imap', 'pop3', 'smtp')) { 297 for my $ipvnum (('4', '6')) { 298 for my $idnum (('1', '2')) { 299 killsockfilters($proto, $ipvnum, $idnum, $verbose); 300 } 301 } 302 } 303} 304 305 306sub set_advisor_read_lock { 307 my ($filename) = @_; 308 309 if(open(FILEH, ">$filename")) { 310 close(FILEH); 311 return; 312 } 313 printf "Error creating lock file $filename error: $!"; 314} 315 316 317sub clear_advisor_read_lock { 318 my ($filename) = @_; 319 320 if(-f $filename) { 321 unlink($filename); 322 } 323} 324 325 3261; 327