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# pidexists checks if a process with a given pid exists and is alive.
52# This will return the positive pid if the process exists and is alive.
53# This will return the negative pid if the process exists differently.
54# This will return 0 if the process could not be found.
55#
56sub pidexists {
57    my $pid = $_[0];
58
59    if($pid > 0) {
60        # verify if currently existing and alive
61        if(kill(0, $pid)) {
62            return $pid;
63        }
64
65        # verify if currently existing Windows process
66        if($^O eq "msys") {
67            my $filter = "PID eq $pid";
68            my $result = `tasklist -fi \"$filter\" 2>nul`;
69            if(index($result, "$pid") != -1) {
70                return -$pid;
71            }
72        }
73    }
74
75    return 0;
76}
77
78#######################################################################
79# pidterm asks the process with a given pid to terminate gracefully.
80#
81sub pidterm {
82    my $pid = $_[0];
83
84    if($pid > 0) {
85        # signal the process to terminate
86        kill("TERM", $pid);
87
88        # request the process to quit
89        if($^O eq "msys") {
90            my $filter = "PID eq $pid";
91            my $result = `tasklist -fi \"$filter\" 2>nul`;
92            if(index($result, "$pid") != -1) {
93                system("taskkill -fi \"$filter\" >nul 2>&1");
94            }
95        }
96    }
97}
98
99#######################################################################
100# pidkill kills the process with a given pid mercilessly andforcefully.
101#
102sub pidkill {
103    my $pid = $_[0];
104
105    if($pid > 0) {
106        # signal the process to terminate
107        kill("KILL", $pid);
108
109        # request the process to quit
110        if($^O eq "msys") {
111            my $filter = "PID eq $pid";
112            my $result = `tasklist -fi \"$filter\" 2>nul`;
113            if(index($result, "$pid") != -1) {
114                system("taskkill -f -fi \"$filter\" >nul 2>&1");
115                # Windows XP Home compatibility
116                system("tskill $pid >nul 2>&1");
117            }
118        }
119    }
120}
121
122#######################################################################
123# processexists checks if a process with the pid stored in the given
124# pidfile exists and is alive. This will return 0 on any file related
125# error or if a pid can not be extracted from the given file. When a
126# process with the same pid as the one extracted from the given file
127# is currently alive this returns that positive pid. Otherwise, when
128# the process is not alive, will return the negative value of the pid.
129#
130sub processexists {
131    use POSIX ":sys_wait_h";
132    my $pidfile = $_[0];
133
134    # fetch pid from pidfile
135    my $pid = pidfromfile($pidfile);
136
137    if($pid > 0) {
138        # verify if currently alive
139        if(pidexists($pid)) {
140            return $pid;
141        }
142        else {
143            # get rid of the certainly invalid pidfile
144            unlink($pidfile) if($pid == pidfromfile($pidfile));
145            # reap its dead children, if not done yet
146            waitpid($pid, &WNOHANG);
147            # negative return value means dead process
148            return -$pid;
149        }
150    }
151    return 0;
152}
153
154#######################################################################
155# killpid attempts to gracefully stop processes in the given pid list
156# with a SIGTERM signal and SIGKILLs those which haven't died on time.
157#
158sub killpid {
159    use POSIX ":sys_wait_h";
160    my ($verbose, $pidlist) = @_;
161    my @requested;
162    my @signalled;
163    my @reapchild;
164
165    # The 'pidlist' argument is a string of whitespace separated pids.
166    return if(not defined($pidlist));
167
168    # Make 'requested' hold the non-duplicate pids from 'pidlist'.
169    @requested = split(' ', $pidlist);
170    return if(not @requested);
171    if(scalar(@requested) > 2) {
172        @requested = sort({$a <=> $b} @requested);
173    }
174    for(my $i = scalar(@requested) - 2; $i >= 0; $i--) {
175        if($requested[$i] == $requested[$i+1]) {
176            splice @requested, $i+1, 1;
177        }
178    }
179
180    # Send a SIGTERM to processes which are alive to gracefully stop them.
181    foreach my $tmp (@requested) {
182        chomp $tmp;
183        if($tmp =~ /^(\d+)$/) {
184            my $pid = $1;
185            if($pid > 0) {
186                if(pidexists($pid)) {
187                    print("RUN: Process with pid $pid signalled to die\n")
188                        if($verbose);
189                    pidterm($pid);
190                    push @signalled, $pid;
191                }
192                else {
193                    print("RUN: Process with pid $pid already dead\n")
194                        if($verbose);
195                    # if possible reap its dead children
196                    waitpid($pid, &WNOHANG);
197                    push @reapchild, $pid;
198                }
199            }
200        }
201    }
202
203    # Allow all signalled processes five seconds to gracefully die.
204    if(@signalled) {
205        my $twentieths = 5 * 20;
206        while($twentieths--) {
207            for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) {
208                my $pid = $signalled[$i];
209                if(!pidexists($pid)) {
210                    print("RUN: Process with pid $pid gracefully died\n")
211                        if($verbose);
212                    splice @signalled, $i, 1;
213                    # if possible reap its dead children
214                    waitpid($pid, &WNOHANG);
215                    push @reapchild, $pid;
216                }
217            }
218            last if(not scalar(@signalled));
219            select(undef, undef, undef, 0.05);
220        }
221    }
222
223    # Mercilessly SIGKILL processes still alive.
224    if(@signalled) {
225        foreach my $pid (@signalled) {
226            if($pid > 0) {
227                print("RUN: Process with pid $pid forced to die with SIGKILL\n")
228                    if($verbose);
229                pidkill($pid);
230                # if possible reap its dead children
231                waitpid($pid, &WNOHANG);
232                push @reapchild, $pid;
233            }
234        }
235    }
236
237    # Reap processes dead children for sure.
238    if(@reapchild) {
239        foreach my $pid (@reapchild) {
240            if($pid > 0) {
241                waitpid($pid, 0);
242            }
243        }
244    }
245}
246
247#######################################################################
248# killsockfilters kills sockfilter processes for a given server.
249#
250sub killsockfilters {
251    my ($proto, $ipvnum, $idnum, $verbose, $which) = @_;
252    my $server;
253    my $pidfile;
254    my $pid;
255
256    return if($proto !~ /^(ftp|imap|pop3|smtp)$/);
257
258    die "unsupported sockfilter: $which"
259        if($which && ($which !~ /^(main|data)$/));
260
261    $server = servername_id($proto, $ipvnum, $idnum) if($verbose);
262
263    if(!$which || ($which eq 'main')) {
264        $pidfile = mainsockf_pidfilename($proto, $ipvnum, $idnum);
265        $pid = processexists($pidfile);
266        if($pid > 0) {
267            printf("* kill pid for %s-%s => %d\n", $server,
268                ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose);
269            pidkill($pid);
270            waitpid($pid, 0);
271        }
272        unlink($pidfile) if(-f $pidfile);
273    }
274
275    return if($proto ne 'ftp');
276
277    if(!$which || ($which eq 'data')) {
278        $pidfile = datasockf_pidfilename($proto, $ipvnum, $idnum);
279        $pid = processexists($pidfile);
280        if($pid > 0) {
281            printf("* kill pid for %s-data => %d\n", $server,
282                $pid) if($verbose);
283            pidkill($pid);
284            waitpid($pid, 0);
285        }
286        unlink($pidfile) if(-f $pidfile);
287    }
288}
289
290#######################################################################
291# killallsockfilters kills sockfilter processes for all servers.
292#
293sub killallsockfilters {
294    my $verbose = $_[0];
295
296    for my $proto (('ftp', 'imap', 'pop3', 'smtp')) {
297        for my $ipvnum (('4', '6')) {
298            for my $idnum (('1', '2')) {
299                killsockfilters($proto, $ipvnum, $idnum, $verbose);
300            }
301        }
302    }
303}
304
305
306sub set_advisor_read_lock {
307    my ($filename) = @_;
308
309    if(open(FILEH, ">$filename")) {
310        close(FILEH);
311        return;
312    }
313    printf "Error creating lock file $filename error: $!";
314}
315
316
317sub clear_advisor_read_lock {
318    my ($filename) = @_;
319
320    if(-f $filename) {
321        unlink($filename);
322    }
323}
324
325
3261;
327