Annotation of embedaddon/curl/tests/ftp.pm, revision 1.1.1.1
1.1 misho 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:
23: BEGIN {
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:
36: use strict;
37: use warnings;
38:
39: use serverhelp qw(
40: servername_id
41: mainsockf_pidfilename
42: datasockf_pidfilename
43: );
44:
45: use 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: #
56: sub 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: #
76: sub 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: #
94: sub 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: #
123: sub 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: #
148: sub 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: #
175: sub 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: #
202: sub 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: #
230: sub 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: #
322: sub 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: #
365: sub 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:
378: sub 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:
389: sub clear_advisor_read_lock {
390: my ($filename) = @_;
391:
392: if(-f $filename) {
393: unlink($filename);
394: }
395: }
396:
397:
398: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ftp.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / tests