1#*************************************************************************** 2# _ _ ____ _ 3# Project ___| | | | _ \| | 4# / __| | | | |_) | | 5# | (__| |_| | _ <| |___ 6# \___|\___/|_| \_\_____| 7# 8# Copyright (C) 1998 - 2010, 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 http://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 23use strict; 24use warnings; 25 26use serverhelp qw( 27 servername_id 28 mainsockf_pidfilename 29 datasockf_pidfilename 30 ); 31 32####################################################################### 33# pidfromfile returns the pid stored in the given pidfile. The value 34# of the returned pid will never be a negative value. It will be zero 35# on any file related error or if a pid can not be extracted from the 36# given file. 37# 38sub pidfromfile { 39 my $pidfile = $_[0]; 40 my $pid = 0; 41 42 if(-f $pidfile && -s $pidfile && open(PIDFH, "<$pidfile")) { 43 $pid = 0 + <PIDFH>; 44 close(PIDFH); 45 $pid = 0 unless($pid > 0); 46 } 47 return $pid; 48} 49 50####################################################################### 51# processexists checks if a process with the pid stored in the given 52# pidfile exists and is alive. This will return 0 on any file related 53# error or if a pid can not be extracted from the given file. When a 54# process with the same pid as the one extracted from the given file 55# is currently alive this returns that positive pid. Otherwise, when 56# the process is not alive, will return the negative value of the pid. 57# 58sub processexists { 59 use POSIX ":sys_wait_h"; 60 my $pidfile = $_[0]; 61 62 # fetch pid from pidfile 63 my $pid = pidfromfile($pidfile); 64 65 if($pid > 0) { 66 # verify if currently alive 67 if(kill(0, $pid)) { 68 return $pid; 69 } 70 else { 71 # get rid of the certainly invalid pidfile 72 unlink($pidfile) if($pid == pidfromfile($pidfile)); 73 # reap its dead children, if not done yet 74 waitpid($pid, &WNOHANG); 75 # negative return value means dead process 76 return -$pid; 77 } 78 } 79 return 0; 80} 81 82####################################################################### 83# killpid attempts to gracefully stop processes in the given pid list 84# with a SIGTERM signal and SIGKILLs those which haven't died on time. 85# 86sub killpid { 87 use POSIX ":sys_wait_h"; 88 my ($verbose, $pidlist) = @_; 89 my @requested; 90 my @signalled; 91 my @reapchild; 92 93 # The 'pidlist' argument is a string of whitespace separated pids. 94 return if(not defined($pidlist)); 95 96 # Make 'requested' hold the non-duplicate pids from 'pidlist'. 97 @requested = split(' ', $pidlist); 98 return if(not @requested); 99 if(scalar(@requested) > 2) { 100 @requested = sort({$a <=> $b} @requested); 101 } 102 for(my $i = scalar(@requested) - 2; $i >= 0; $i--) { 103 if($requested[$i] == $requested[$i+1]) { 104 splice @requested, $i+1, 1; 105 } 106 } 107 108 # Send a SIGTERM to processes which are alive to gracefully stop them. 109 foreach my $tmp (@requested) { 110 chomp $tmp; 111 if($tmp =~ /^(\d+)$/) { 112 my $pid = $1; 113 if($pid > 0) { 114 if(kill(0, $pid)) { 115 print("RUN: Process with pid $pid signalled to die\n") 116 if($verbose); 117 kill("TERM", $pid); 118 push @signalled, $pid; 119 } 120 else { 121 print("RUN: Process with pid $pid already dead\n") 122 if($verbose); 123 # if possible reap its dead children 124 waitpid($pid, &WNOHANG); 125 push @reapchild, $pid; 126 } 127 } 128 } 129 } 130 131 # Allow all signalled processes five seconds to gracefully die. 132 if(@signalled) { 133 my $twentieths = 5 * 20; 134 while($twentieths--) { 135 for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) { 136 my $pid = $signalled[$i]; 137 if(!kill(0, $pid)) { 138 print("RUN: Process with pid $pid gracefully died\n") 139 if($verbose); 140 splice @signalled, $i, 1; 141 # if possible reap its dead children 142 waitpid($pid, &WNOHANG); 143 push @reapchild, $pid; 144 } 145 } 146 last if(not scalar(@signalled)); 147 select(undef, undef, undef, 0.05); 148 } 149 } 150 151 # Mercilessly SIGKILL processes still alive. 152 if(@signalled) { 153 foreach my $pid (@signalled) { 154 if($pid > 0) { 155 print("RUN: Process with pid $pid forced to die with SIGKILL\n") 156 if($verbose); 157 kill("KILL", $pid); 158 # if possible reap its dead children 159 waitpid($pid, &WNOHANG); 160 push @reapchild, $pid; 161 } 162 } 163 } 164 165 # Reap processes dead children for sure. 166 if(@reapchild) { 167 foreach my $pid (@reapchild) { 168 if($pid > 0) { 169 waitpid($pid, 0); 170 } 171 } 172 } 173} 174 175####################################################################### 176# killsockfilters kills sockfilter processes for a given server. 177# 178sub killsockfilters { 179 my ($proto, $ipvnum, $idnum, $verbose, $which) = @_; 180 my $server; 181 my $pidfile; 182 my $pid; 183 184 return if($proto !~ /^(ftp|imap|pop3|smtp)$/); 185 186 die "unsupported sockfilter: $which" 187 if($which && ($which !~ /^(main|data)$/)); 188 189 $server = servername_id($proto, $ipvnum, $idnum) if($verbose); 190 191 if(!$which || ($which eq 'main')) { 192 $pidfile = mainsockf_pidfilename($proto, $ipvnum, $idnum); 193 $pid = processexists($pidfile); 194 if($pid > 0) { 195 printf("* kill pid for %s-%s => %d\n", $server, 196 ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose); 197 kill("KILL", $pid); 198 waitpid($pid, 0); 199 } 200 unlink($pidfile) if(-f $pidfile); 201 } 202 203 return if($proto ne 'ftp'); 204 205 if(!$which || ($which eq 'data')) { 206 $pidfile = datasockf_pidfilename($proto, $ipvnum, $idnum); 207 $pid = processexists($pidfile); 208 if($pid > 0) { 209 printf("* kill pid for %s-data => %d\n", $server, 210 $pid) if($verbose); 211 kill("KILL", $pid); 212 waitpid($pid, 0); 213 } 214 unlink($pidfile) if(-f $pidfile); 215 } 216} 217 218####################################################################### 219# killallsockfilters kills sockfilter processes for all servers. 220# 221sub killallsockfilters { 222 my $verbose = $_[0]; 223 224 for my $proto (('ftp', 'imap', 'pop3', 'smtp')) { 225 for my $ipvnum (('4', '6')) { 226 for my $idnum (('1', '2')) { 227 killsockfilters($proto, $ipvnum, $idnum, $verbose); 228 } 229 } 230 } 231} 232 233 234sub set_advisor_read_lock { 235 my ($filename) = @_; 236 237 if(open(FILEH, ">$filename")) { 238 close(FILEH); 239 return; 240 } 241 printf "Error creating lock file $filename error: $!"; 242} 243 244 245sub clear_advisor_read_lock { 246 my ($filename) = @_; 247 248 if(-f $filename) { 249 unlink($filename); 250 } 251} 252 253 2541; 255