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 25package processhelp; 26 27use strict; 28use warnings; 29 30BEGIN { 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 Win32 52 eval { 53 no warnings "all"; 54 require Win32; 55 } 56} 57 58use serverhelp qw( 59 servername_id 60 mainsockf_pidfilename 61 datasockf_pidfilename 62 ); 63 64use 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# 75sub 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# 95sub pidfromfile { 96 my $pidfile = $_[0]; 97 my $pid = 0; 98 99 if(-f $pidfile && -s $pidfile && open(my $pidfh, "<", "$pidfile")) { 100 $pid = 0 + <$pidfh>; 101 close($pidfh); 102 $pid = 0 if($pid < 0); 103 } 104 return $pid; 105} 106 107####################################################################### 108# pidexists checks if a process with a given pid exists and is alive. 109# This will return the positive pid if the process exists and is alive. 110# This will return the negative pid if the process exists differently. 111# This will return 0 if the process could not be found. 112# 113sub pidexists { 114 my $pid = $_[0]; 115 116 if($pid > 0) { 117 # verify if currently existing Windows process 118 if ($pid > 65536 && os_is_win()) { 119 $pid -= 65536; 120 if($^O ne 'MSWin32') { 121 my $filter = "PID eq $pid"; 122 my $result = `tasklist -fi \"$filter\" 2>nul`; 123 if(index($result, "$pid") != -1) { 124 return -$pid; 125 } 126 return 0; 127 } 128 } 129 130 # verify if currently existing and alive 131 if(kill(0, $pid)) { 132 return $pid; 133 } 134 } 135 136 return 0; 137} 138 139####################################################################### 140# pidterm asks the process with a given pid to terminate gracefully. 141# 142sub pidterm { 143 my $pid = $_[0]; 144 145 if($pid > 0) { 146 # request the process to quit 147 if ($pid > 65536 && os_is_win()) { 148 $pid -= 65536; 149 if($^O ne 'MSWin32') { 150 my $filter = "PID eq $pid"; 151 my $result = `tasklist -fi \"$filter\" 2>nul`; 152 if(index($result, "$pid") != -1) { 153 system("taskkill -fi \"$filter\" >nul 2>&1"); 154 } 155 return; 156 } 157 } 158 159 # signal the process to terminate 160 kill("TERM", $pid); 161 } 162} 163 164####################################################################### 165# pidkill kills the process with a given pid mercilessly and forcefully. 166# 167sub pidkill { 168 my $pid = $_[0]; 169 170 if($pid > 0) { 171 # request the process to quit 172 if ($pid > 65536 && os_is_win()) { 173 $pid -= 65536; 174 if($^O ne 'MSWin32') { 175 my $filter = "PID eq $pid"; 176 my $result = `tasklist -fi \"$filter\" 2>nul`; 177 if(index($result, "$pid") != -1) { 178 system("taskkill -f -fi \"$filter\" >nul 2>&1"); 179 # Windows XP Home compatibility 180 system("tskill $pid >nul 2>&1"); 181 } 182 return; 183 } 184 } 185 186 # signal the process to terminate 187 kill("KILL", $pid); 188 } 189} 190 191####################################################################### 192# pidwait waits for the process with a given pid to be terminated. 193# 194sub pidwait { 195 my $pid = $_[0]; 196 my $flags = $_[1]; 197 198 # check if the process exists 199 if ($pid > 65536 && os_is_win()) { 200 if($flags == &WNOHANG) { 201 return pidexists($pid)?0:$pid; 202 } 203 while(pidexists($pid)) { 204 portable_sleep(0.01); 205 } 206 return $pid; 207 } 208 209 # wait on the process to terminate 210 return waitpid($pid, $flags); 211} 212 213####################################################################### 214# processexists checks if a process with the pid stored in the given 215# pidfile exists and is alive. This will return 0 on any file related 216# error or if a pid can not be extracted from the given file. When a 217# process with the same pid as the one extracted from the given file 218# is currently alive this returns that positive pid. Otherwise, when 219# the process is not alive, will return the negative value of the pid. 220# 221sub processexists { 222 use POSIX ":sys_wait_h"; 223 my $pidfile = $_[0]; 224 225 # fetch pid from pidfile 226 my $pid = pidfromfile($pidfile); 227 228 if($pid > 0) { 229 # verify if currently alive 230 if(pidexists($pid)) { 231 return $pid; 232 } 233 else { 234 # get rid of the certainly invalid pidfile 235 unlink($pidfile) if($pid == pidfromfile($pidfile)); 236 # reap its dead children, if not done yet 237 pidwait($pid, &WNOHANG); 238 # negative return value means dead process 239 return -$pid; 240 } 241 } 242 return 0; 243} 244 245####################################################################### 246# killpid attempts to gracefully stop processes in the given pid list 247# with a SIGTERM signal and SIGKILLs those which haven't died on time. 248# 249sub killpid { 250 my ($verbose, $pidlist) = @_; 251 use POSIX ":sys_wait_h"; 252 my @requested; 253 my @signalled; 254 my @reapchild; 255 256 # The 'pidlist' argument is a string of whitespace separated pids. 257 return if(not defined($pidlist)); 258 259 # Make 'requested' hold the non-duplicate pids from 'pidlist'. 260 @requested = split(' ', $pidlist); 261 return if(not @requested); 262 if(scalar(@requested) > 2) { 263 @requested = sort({$a <=> $b} @requested); 264 } 265 for(my $i = scalar(@requested) - 2; $i >= 0; $i--) { 266 if($requested[$i] == $requested[$i+1]) { 267 splice @requested, $i+1, 1; 268 } 269 } 270 271 # Send a SIGTERM to processes which are alive to gracefully stop them. 272 foreach my $tmp (@requested) { 273 chomp $tmp; 274 if($tmp =~ /^(\d+)$/) { 275 my $pid = $1; 276 if($pid > 0) { 277 if(pidexists($pid)) { 278 print("RUN: Process with pid $pid signalled to die\n") 279 if($verbose); 280 pidterm($pid); 281 push @signalled, $pid; 282 } 283 else { 284 print("RUN: Process with pid $pid already dead\n") 285 if($verbose); 286 # if possible reap its dead children 287 pidwait($pid, &WNOHANG); 288 push @reapchild, $pid; 289 } 290 } 291 } 292 } 293 294 # Allow all signalled processes five seconds to gracefully die. 295 if(@signalled) { 296 my $twentieths = 5 * 20; 297 while($twentieths--) { 298 for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) { 299 my $pid = $signalled[$i]; 300 if(!pidexists($pid)) { 301 print("RUN: Process with pid $pid gracefully died\n") 302 if($verbose); 303 splice @signalled, $i, 1; 304 # if possible reap its dead children 305 pidwait($pid, &WNOHANG); 306 push @reapchild, $pid; 307 } 308 } 309 last if(not scalar(@signalled)); 310 portable_sleep(0.05); 311 } 312 } 313 314 # Mercilessly SIGKILL processes still alive. 315 if(@signalled) { 316 foreach my $pid (@signalled) { 317 if($pid > 0) { 318 print("RUN: Process with pid $pid forced to die with SIGKILL\n") 319 if($verbose); 320 pidkill($pid); 321 # if possible reap its dead children 322 pidwait($pid, &WNOHANG); 323 push @reapchild, $pid; 324 } 325 } 326 } 327 328 # Reap processes dead children for sure. 329 if(@reapchild) { 330 foreach my $pid (@reapchild) { 331 if($pid > 0) { 332 pidwait($pid, 0); 333 } 334 } 335 } 336} 337 338####################################################################### 339# killsockfilters kills sockfilter processes for a given server. 340# 341sub killsockfilters { 342 my ($piddir, $proto, $ipvnum, $idnum, $verbose, $which) = @_; 343 my $server; 344 my $pidfile; 345 my $pid; 346 347 return if($proto !~ /^(ftp|imap|pop3|smtp)$/); 348 349 die "unsupported sockfilter: $which" 350 if($which && ($which !~ /^(main|data)$/)); 351 352 $server = servername_id($proto, $ipvnum, $idnum) if($verbose); 353 354 if(!$which || ($which eq 'main')) { 355 $pidfile = mainsockf_pidfilename($piddir, $proto, $ipvnum, $idnum); 356 $pid = processexists($pidfile); 357 if($pid > 0) { 358 printf("* kill pid for %s-%s => %d\n", $server, 359 ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose); 360 pidkill($pid); 361 pidwait($pid, 0); 362 } 363 unlink($pidfile) if(-f $pidfile); 364 } 365 366 return if($proto ne 'ftp'); 367 368 if(!$which || ($which eq 'data')) { 369 $pidfile = datasockf_pidfilename($piddir, $proto, $ipvnum, $idnum); 370 $pid = processexists($pidfile); 371 if($pid > 0) { 372 printf("* kill pid for %s-data => %d\n", $server, 373 $pid) if($verbose); 374 pidkill($pid); 375 pidwait($pid, 0); 376 } 377 unlink($pidfile) if(-f $pidfile); 378 } 379} 380 381####################################################################### 382# killallsockfilters kills sockfilter processes for all servers. 383# 384sub killallsockfilters { 385 my ($piddir, $verbose) = @_; 386 387 for my $proto (('ftp', 'imap', 'pop3', 'smtp')) { 388 for my $ipvnum (('4', '6')) { 389 for my $idnum (('1', '2')) { 390 killsockfilters($piddir, $proto, $ipvnum, $idnum, $verbose); 391 } 392 } 393 } 394} 395 396 397sub set_advisor_read_lock { 398 my ($filename) = @_; 399 400 my $fileh; 401 if(open($fileh, ">", "$filename") && close($fileh)) { 402 return; 403 } 404 printf "Error creating lock file $filename error: $!\n"; 405} 406 407 408sub clear_advisor_read_lock { 409 my ($filename) = @_; 410 411 if(-f $filename) { 412 unlink($filename); 413 } 414} 415 416 4171; 418
