Annotation of embedaddon/curl/tests/ftp.pm, revision 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