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