processhelp.pm (13356B)
1 #*************************************************************************** 2 # _ _ ____ _ 3 # Project ___| | | | _ \| | 4 # / __| | | | |_) | | 5 # | (__| |_| | _ <| |___ 6 # \___|\___/|_| \_\_____| 7 # 8 # Copyright (C) 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 https://curl.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 # SPDX-License-Identifier: curl 22 # 23 ########################################################################### 24 25 package processhelp; 26 27 use strict; 28 use warnings; 29 30 BEGIN { 31 use base qw(Exporter); 32 33 our @EXPORT = qw( 34 portable_sleep 35 pidfromfile 36 pidexists 37 pidwait 38 processexists 39 killpid 40 killsockfilters 41 killallsockfilters 42 set_advisor_read_lock 43 clear_advisor_read_lock 44 ); 45 46 # portable sleeping needs Time::HiRes 47 eval { 48 no warnings "all"; 49 require Time::HiRes; 50 }; 51 # portable sleeping falls back to native Sleep on Windows 52 eval { 53 no warnings "all"; 54 require Win32; 55 } 56 } 57 58 use serverhelp qw( 59 servername_id 60 mainsockf_pidfilename 61 datasockf_pidfilename 62 ); 63 64 use pathhelp qw( 65 os_is_win 66 ); 67 68 ####################################################################### 69 # portable_sleep uses Time::HiRes::sleep if available and falls back 70 # to the classic approach of using select(undef, undef, undef, ...). 71 # even though that one is not portable due to being implemented using 72 # select on Windows: https://perldoc.perl.org/perlport.html#select 73 # Therefore it uses Win32::Sleep on Windows systems instead. 74 # 75 sub portable_sleep { 76 my ($seconds) = @_; 77 78 if($Time::HiRes::VERSION) { 79 Time::HiRes::sleep($seconds); 80 } 81 elsif(os_is_win()) { 82 Win32::Sleep($seconds*1000); 83 } 84 else { 85 select(undef, undef, undef, $seconds); 86 } 87 } 88 89 ####################################################################### 90 # pidfromfile returns the pid stored in the given pidfile. The value 91 # of the returned pid will never be a negative value. It will be zero 92 # on any file related error or if a pid can not be extracted from the 93 # given file. 94 # 95 sub pidfromfile { 96 my $pidfile = $_[0]; 97 my $timeout_sec = $_[1]; 98 my $pid = 0; 99 my $waits = 0; 100 # wait at max 15 seconds for the file to exist and have valid content 101 while(!$pid && ($waits <= ($timeout_sec * 10))) { 102 if(-f $pidfile && -s $pidfile && open(my $pidfh, "<", "$pidfile")) { 103 $pid = 0 + <$pidfh>; 104 close($pidfh); 105 $pid = 0 if($pid < 0); 106 } 107 Time::HiRes::sleep(0.1) unless $pid || !$timeout_sec; 108 ++$waits; 109 } 110 return $pid; 111 } 112 113 ####################################################################### 114 # return Cygwin pid from virtual pid 115 # 116 sub winpid_to_pid { 117 my $vpid = $_[0]; 118 if(($^O eq 'cygwin' || $^O eq 'msys') && $vpid > 4194304) { 119 my $pid = Cygwin::winpid_to_pid($vpid - 4194304); 120 if($pid) { 121 return $pid; 122 } else { 123 return $vpid 124 } 125 } 126 return $vpid; 127 } 128 129 ####################################################################### 130 # pidexists checks if a process with a given pid exists and is alive. 131 # This will return the positive pid if the process exists and is alive. 132 # This will return the negative pid if the process exists differently. 133 # This will return 0 if the process could not be found. 134 # 135 sub pidexists { 136 my $pid = $_[0]; 137 138 if($pid > 0) { 139 # verify if currently existing Windows process 140 $pid = winpid_to_pid($pid); 141 if($pid > 4194304 && os_is_win()) { 142 $pid -= 4194304; 143 if($^O ne 'MSWin32') { 144 my $filter = "PID eq $pid"; 145 # https://ss64.com/nt/tasklist.html 146 my $result = `tasklist -fi \"$filter\" 2>nul`; 147 if(index($result, "$pid") != -1) { 148 return -$pid; 149 } 150 return 0; 151 } 152 } 153 154 # verify if currently existing and alive 155 if(kill(0, $pid)) { 156 return $pid; 157 } 158 } 159 160 return 0; 161 } 162 163 ####################################################################### 164 # pidterm asks the process with a given pid to terminate gracefully. 165 # 166 sub pidterm { 167 my $pid = $_[0]; 168 169 if($pid > 0) { 170 # request the process to quit 171 $pid = winpid_to_pid($pid); 172 if($pid > 4194304 && os_is_win()) { 173 $pid -= 4194304; 174 if($^O ne 'MSWin32') { 175 # https://ss64.com/nt/taskkill.html 176 my $cmd = "taskkill -f -t -pid $pid >nul 2>&1"; 177 print "Executing: '$cmd'\n"; 178 system($cmd); 179 return; 180 } 181 } 182 183 # signal the process to terminate 184 kill("TERM", $pid); 185 } 186 } 187 188 ####################################################################### 189 # pidkill kills the process with a given pid mercilessly and forcefully. 190 # 191 sub pidkill { 192 my $pid = $_[0]; 193 194 if($pid > 0) { 195 # request the process to quit 196 $pid = winpid_to_pid($pid); 197 if($pid > 4194304 && os_is_win()) { 198 $pid -= 4194304; 199 if($^O ne 'MSWin32') { 200 # https://ss64.com/nt/taskkill.html 201 my $cmd = "taskkill -f -t -pid $pid >nul 2>&1"; 202 print "Executing: '$cmd'\n"; 203 system($cmd); 204 return; 205 } 206 } 207 208 # signal the process to terminate 209 kill("KILL", $pid); 210 } 211 } 212 213 ####################################################################### 214 # pidwait waits for the process with a given pid to be terminated. 215 # 216 sub pidwait { 217 my $pid = $_[0]; 218 my $flags = $_[1]; 219 220 $pid = winpid_to_pid($pid); 221 # check if the process exists 222 if($pid > 4194304 && os_is_win()) { 223 if($flags == &WNOHANG) { 224 return pidexists($pid)?0:$pid; 225 } 226 my $start = time; 227 my $warn_at = 5; 228 while(pidexists($pid)) { 229 if(time - $start > $warn_at) { 230 print "pidwait: still waiting for PID ", $pid, "\n"; 231 $warn_at += 5; 232 if($warn_at > 20) { 233 print "pidwait: giving up waiting for PID ", $pid, "\n"; 234 last; 235 } 236 } 237 portable_sleep(0.2); 238 } 239 return $pid; 240 } 241 242 # wait on the process to terminate 243 return waitpid($pid, $flags); 244 } 245 246 ####################################################################### 247 # processexists checks if a process with the pid stored in the given 248 # pidfile exists and is alive. This will return 0 on any file related 249 # error or if a pid can not be extracted from the given file. When a 250 # process with the same pid as the one extracted from the given file 251 # is currently alive this returns that positive pid. Otherwise, when 252 # the process is not alive, will return the negative value of the pid. 253 # 254 sub processexists { 255 use POSIX ":sys_wait_h"; 256 my $pidfile = $_[0]; 257 258 # fetch pid from pidfile 259 my $pid = pidfromfile($pidfile, 0); 260 261 if($pid > 0) { 262 # verify if currently alive 263 if(pidexists($pid)) { 264 return $pid; 265 } 266 else { 267 # get rid of the certainly invalid pidfile 268 unlink($pidfile) if($pid == pidfromfile($pidfile, 0)); 269 # reap its dead children, if not done yet 270 pidwait($pid, &WNOHANG); 271 # negative return value means dead process 272 return -$pid; 273 } 274 } 275 return 0; 276 } 277 278 ####################################################################### 279 # killpid attempts to gracefully stop processes in the given pid list 280 # with a SIGTERM signal and SIGKILLs those which haven't died on time. 281 # 282 sub killpid { 283 my ($verbose, $pidlist) = @_; 284 use POSIX ":sys_wait_h"; 285 my @requested; 286 my @signalled; 287 my @reapchild; 288 289 # The 'pidlist' argument is a string of whitespace separated pids. 290 return if(not defined($pidlist)); 291 292 # Make 'requested' hold the non-duplicate pids from 'pidlist'. 293 @requested = split(' ', $pidlist); 294 return if(not @requested); 295 if(scalar(@requested) > 2) { 296 @requested = sort({$a <=> $b} @requested); 297 } 298 for(my $i = scalar(@requested) - 2; $i >= 0; $i--) { 299 if($requested[$i] == $requested[$i+1]) { 300 splice @requested, $i+1, 1; 301 } 302 } 303 304 # Send a SIGTERM to processes which are alive to gracefully stop them. 305 foreach my $tmp (@requested) { 306 chomp $tmp; 307 if($tmp =~ /^(\d+)$/) { 308 my $pid = $1; 309 if($pid > 0) { 310 if(pidexists($pid)) { 311 print("RUN: Process with pid $pid signalled to die\n") 312 if($verbose); 313 pidterm($pid); 314 push @signalled, $pid; 315 } 316 else { 317 print("RUN: Process with pid $pid already dead\n") 318 if($verbose); 319 # if possible reap its dead children 320 pidwait($pid, &WNOHANG); 321 push @reapchild, $pid; 322 } 323 } 324 } 325 } 326 327 # Allow all signalled processes five seconds to gracefully die. 328 if(@signalled) { 329 my $twentieths = 5 * 20; 330 while($twentieths--) { 331 for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) { 332 my $pid = $signalled[$i]; 333 if(!pidexists($pid)) { 334 print("RUN: Process with pid $pid gracefully died\n") 335 if($verbose); 336 splice @signalled, $i, 1; 337 # if possible reap its dead children 338 pidwait($pid, &WNOHANG); 339 push @reapchild, $pid; 340 } 341 } 342 last if(not scalar(@signalled)); 343 # give any zombies of us a chance to move on to the afterlife 344 pidwait(0, &WNOHANG); 345 portable_sleep(0.05); 346 } 347 } 348 349 # Mercilessly SIGKILL processes still alive. 350 if(@signalled) { 351 foreach my $pid (@signalled) { 352 if($pid > 0) { 353 print("RUN: Process with pid $pid forced to die with SIGKILL\n") 354 if($verbose); 355 pidkill($pid); 356 # if possible reap its dead children 357 pidwait($pid, &WNOHANG); 358 push @reapchild, $pid; 359 } 360 } 361 } 362 363 # Reap processes dead children for sure. 364 if(@reapchild) { 365 foreach my $pid (@reapchild) { 366 if($pid > 0) { 367 pidwait($pid, 0); 368 } 369 } 370 } 371 } 372 373 ####################################################################### 374 # killsockfilters kills sockfilter processes for a given server. 375 # 376 sub killsockfilters { 377 my ($piddir, $proto, $ipvnum, $idnum, $verbose, $which) = @_; 378 my $server; 379 my $pidfile; 380 my $pid; 381 382 return if($proto !~ /^(ftp|imap|pop3|smtp)$/); 383 384 die "unsupported sockfilter: $which" 385 if($which && ($which !~ /^(main|data)$/)); 386 387 $server = servername_id($proto, $ipvnum, $idnum) if($verbose); 388 389 if(!$which || ($which eq 'main')) { 390 $pidfile = mainsockf_pidfilename($piddir, $proto, $ipvnum, $idnum); 391 $pid = processexists($pidfile); 392 if($pid > 0) { 393 printf("* kill pid for %s-%s => %d\n", $server, 394 ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose); 395 pidkill($pid); 396 pidwait($pid, 0); 397 } 398 unlink($pidfile) if(-f $pidfile); 399 } 400 401 return if($proto ne 'ftp'); 402 403 if(!$which || ($which eq 'data')) { 404 $pidfile = datasockf_pidfilename($piddir, $proto, $ipvnum, $idnum); 405 $pid = processexists($pidfile); 406 if($pid > 0) { 407 printf("* kill pid for %s-data => %d\n", $server, 408 $pid) if($verbose); 409 pidkill($pid); 410 pidwait($pid, 0); 411 } 412 unlink($pidfile) if(-f $pidfile); 413 } 414 } 415 416 ####################################################################### 417 # killallsockfilters kills sockfilter processes for all servers. 418 # 419 sub killallsockfilters { 420 my ($piddir, $verbose) = @_; 421 422 for my $proto (('ftp', 'imap', 'pop3', 'smtp')) { 423 for my $ipvnum (('4', '6')) { 424 for my $idnum (('1', '2')) { 425 killsockfilters($piddir, $proto, $ipvnum, $idnum, $verbose); 426 } 427 } 428 } 429 } 430 431 432 sub set_advisor_read_lock { 433 my ($filename) = @_; 434 435 my $fileh; 436 if(open($fileh, ">", "$filename") && close($fileh)) { 437 return; 438 } 439 printf "Error creating lock file $filename error: $!\n"; 440 } 441 442 443 sub clear_advisor_read_lock { 444 my ($filename) = @_; 445 446 if(-f $filename) { 447 unlink($filename); 448 } 449 } 450 451 452 1;