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