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