smtp: use the upload buffer size for scratch buffer malloc
[platform/upstream/curl.git] / tests / ftp.pm
index b3cc14a..f4a4ace 100644 (file)
@@ -5,11 +5,11 @@
 #                            | (__| |_| |  _ <| |___
 #                             \___|\___/|_| \_\_____|
 #
-# Copyright (C) 1998 - 2006, Daniel Stenberg, <daniel@haxx.se>, et al.
+# Copyright (C) 1998 - 2010, Daniel Stenberg, <daniel@haxx.se>, et al.
 #
 # This software is licensed as described in the file COPYING, which
 # you should have received as part of this distribution. The terms
-# are also available at http://curl.haxx.se/docs/copyright.html.
+# are also available at https://curl.haxx.se/docs/copyright.html.
 #
 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
 # copies of the Software, and permit persons to whom the Software is
 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
 # KIND, either express or implied.
 #
-# $Id$
 ###########################################################################
 
+use strict;
+use warnings;
+
+use serverhelp qw(
+    servername_id
+    mainsockf_pidfilename
+    datasockf_pidfilename
+    );
+
+#######################################################################
+# pidfromfile returns the pid stored in the given pidfile.  The value
+# of the returned pid will never be a negative value. It will be zero
+# on any file related error or if a pid can not be extracted from the
+# given file.
+#
+sub pidfromfile {
+    my $pidfile = $_[0];
+    my $pid = 0;
+
+    if(-f $pidfile && -s $pidfile && open(PIDFH, "<$pidfile")) {
+        $pid = 0 + <PIDFH>;
+        close(PIDFH);
+        $pid = 0 unless($pid > 0);
+    }
+    return $pid;
+}
+
+#######################################################################
+# pidexists checks if a process with a given pid exists and is alive.
+# This will return the positive pid if the process exists and is alive.
+# This will return the negative pid if the process exists differently.
+# This will return 0 if the process could not be found.
+#
+sub pidexists {
+    my $pid = $_[0];
+
+    if($pid > 0) {
+        # verify if currently existing and alive
+        if(kill(0, $pid)) {
+            return $pid;
+        }
+
+        # verify if currently existing Windows process
+        if($^O eq "msys") {
+            my $filter = "PID eq $pid";
+            my $result = `tasklist -fi \"$filter\" 2>nul`;
+            if(index($result, "$pid") != -1) {
+                return -$pid;
+            }
+        }
+    }
+
+    return 0;
+}
+
 #######################################################################
-# Return the pid of the server as found in the given pid file
+# pidterm asks the process with a given pid to terminate gracefully.
 #
-sub serverpid {
-    my $PIDFILE = $_[0];
-    open(PFILE, "<$PIDFILE");
-    my $PID=0+<PFILE>;
-    close(PFILE);
-    return $PID;
+sub pidterm {
+    my $pid = $_[0];
+
+    if($pid > 0) {
+        # signal the process to terminate
+        kill("TERM", $pid);
+
+        # request the process to quit
+        if($^O eq "msys") {
+            my $filter = "PID eq $pid";
+            my $result = `tasklist -fi \"$filter\" 2>nul`;
+            if(index($result, "$pid") != -1) {
+                system("taskkill -fi \"$filter\" >nul 2>&1");
+            }
+        }
+    }
+}
+
+#######################################################################
+# pidkill kills the process with a given pid mercilessly andforcefully.
+#
+sub pidkill {
+    my $pid = $_[0];
+
+    if($pid > 0) {
+        # signal the process to terminate
+        kill("KILL", $pid);
+
+        # request the process to quit
+        if($^O eq "msys") {
+            my $filter = "PID eq $pid";
+            my $result = `tasklist -fi \"$filter\" 2>nul`;
+            if(index($result, "$pid") != -1) {
+                system("taskkill -f -fi \"$filter\" >nul 2>&1");
+                # Windows XP Home compatibility
+                system("tskill $pid >nul 2>&1");
+            }
+        }
+    }
 }
 
 #######################################################################
-# Check the given test server if it is still alive.
+# processexists checks if a process with the pid stored in the given
+# pidfile exists and is alive. This will return 0 on any file related
+# error or if a pid can not be extracted from the given file. When a
+# process with the same pid as the one extracted from the given file
+# is currently alive this returns that positive pid. Otherwise, when
+# the process is not alive, will return the negative value of the pid.
 #
-sub checkserver {
-    my ($pidfile)=@_;
-    my $pid=0;
-
-    # check for pidfile
-    if ( -f $pidfile ) {
-        $pid=serverpid($pidfile);
-        if ($pid ne "" && kill(0, $pid)) {
+sub processexists {
+    use POSIX ":sys_wait_h";
+    my $pidfile = $_[0];
+
+    # fetch pid from pidfile
+    my $pid = pidfromfile($pidfile);
+
+    if($pid > 0) {
+        # verify if currently alive
+        if(pidexists($pid)) {
             return $pid;
         }
         else {
-            return -$pid; # negative means dead process
+            # get rid of the certainly invalid pidfile
+            unlink($pidfile) if($pid == pidfromfile($pidfile));
+            # reap its dead children, if not done yet
+            waitpid($pid, &WNOHANG);
+            # negative return value means dead process
+            return -$pid;
         }
     }
     return 0;
 }
 
-#############################################################################
-# Kill a specific slave
+#######################################################################
+# killpid attempts to gracefully stop processes in the given pid list
+# with a SIGTERM signal and SIGKILLs those which haven't died on time.
+#
+sub killpid {
+    use POSIX ":sys_wait_h";
+    my ($verbose, $pidlist) = @_;
+    my @requested;
+    my @signalled;
+    my @reapchild;
+
+    # The 'pidlist' argument is a string of whitespace separated pids.
+    return if(not defined($pidlist));
+
+    # Make 'requested' hold the non-duplicate pids from 'pidlist'.
+    @requested = split(' ', $pidlist);
+    return if(not @requested);
+    if(scalar(@requested) > 2) {
+        @requested = sort({$a <=> $b} @requested);
+    }
+    for(my $i = scalar(@requested) - 2; $i >= 0; $i--) {
+        if($requested[$i] == $requested[$i+1]) {
+            splice @requested, $i+1, 1;
+        }
+    }
+
+    # Send a SIGTERM to processes which are alive to gracefully stop them.
+    foreach my $tmp (@requested) {
+        chomp $tmp;
+        if($tmp =~ /^(\d+)$/) {
+            my $pid = $1;
+            if($pid > 0) {
+                if(pidexists($pid)) {
+                    print("RUN: Process with pid $pid signalled to die\n")
+                        if($verbose);
+                    pidterm($pid);
+                    push @signalled, $pid;
+                }
+                else {
+                    print("RUN: Process with pid $pid already dead\n")
+                        if($verbose);
+                    # if possible reap its dead children
+                    waitpid($pid, &WNOHANG);
+                    push @reapchild, $pid;
+                }
+            }
+        }
+    }
+
+    # Allow all signalled processes five seconds to gracefully die.
+    if(@signalled) {
+        my $twentieths = 5 * 20;
+        while($twentieths--) {
+            for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) {
+                my $pid = $signalled[$i];
+                if(!pidexists($pid)) {
+                    print("RUN: Process with pid $pid gracefully died\n")
+                        if($verbose);
+                    splice @signalled, $i, 1;
+                    # if possible reap its dead children
+                    waitpid($pid, &WNOHANG);
+                    push @reapchild, $pid;
+                }
+            }
+            last if(not scalar(@signalled));
+            select(undef, undef, undef, 0.05);
+        }
+    }
+
+    # Mercilessly SIGKILL processes still alive.
+    if(@signalled) {
+        foreach my $pid (@signalled) {
+            if($pid > 0) {
+                print("RUN: Process with pid $pid forced to die with SIGKILL\n")
+                    if($verbose);
+                pidkill($pid);
+                # if possible reap its dead children
+                waitpid($pid, &WNOHANG);
+                push @reapchild, $pid;
+            }
+        }
+    }
+
+    # Reap processes dead children for sure.
+    if(@reapchild) {
+        foreach my $pid (@reapchild) {
+            if($pid > 0) {
+                waitpid($pid, 0);
+            }
+        }
+    }
+}
+
+#######################################################################
+# killsockfilters kills sockfilter processes for a given server.
 #
-sub ftpkillslave {
-    my ($id, $ext, $verbose)=@_;
-    my $base;
-    for $base (('filt', 'data')) {
-        my $f = ".sock$base$id$ext.pid";
-        my $pid = checkserver($f);
+sub killsockfilters {
+    my ($proto, $ipvnum, $idnum, $verbose, $which) = @_;
+    my $server;
+    my $pidfile;
+    my $pid;
+
+    return if($proto !~ /^(ftp|imap|pop3|smtp)$/);
+
+    die "unsupported sockfilter: $which"
+        if($which && ($which !~ /^(main|data)$/));
+
+    $server = servername_id($proto, $ipvnum, $idnum) if($verbose);
+
+    if(!$which || ($which eq 'main')) {
+        $pidfile = mainsockf_pidfilename($proto, $ipvnum, $idnum);
+        $pid = processexists($pidfile);
         if($pid > 0) {
-            printf ("* kill pid for %s => %d\n", "ftp-$base$id$ext", $pid) if($verbose);
-            kill (9, $pid); # die!
+            printf("* kill pid for %s-%s => %d\n", $server,
+                ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose);
+            pidkill($pid);
             waitpid($pid, 0);
         }
-        unlink($f);
+        unlink($pidfile) if(-f $pidfile);
     }
-}
 
+    return if($proto ne 'ftp');
+
+    if(!$which || ($which eq 'data')) {
+        $pidfile = datasockf_pidfilename($proto, $ipvnum, $idnum);
+        $pid = processexists($pidfile);
+        if($pid > 0) {
+            printf("* kill pid for %s-data => %d\n", $server,
+                $pid) if($verbose);
+            pidkill($pid);
+            waitpid($pid, 0);
+        }
+        unlink($pidfile) if(-f $pidfile);
+    }
+}
 
-#############################################################################
-# Make sure no FTP leftovers are still running. Kill all slave processes.
-# This uses pidfiles since it might be used by other processes.
+#######################################################################
+# killallsockfilters kills sockfilter processes for all servers.
 #
-sub ftpkillslaves {
-    my ($versbose) = @_;
-    for $ext (("", "ipv6")) {
-        for $id (("", "2")) {
-            ftpkillslave ($id, $ext, $verbose);
+sub killallsockfilters {
+    my $verbose = $_[0];
+
+    for my $proto (('ftp', 'imap', 'pop3', 'smtp')) {
+        for my $ipvnum (('4', '6')) {
+            for my $idnum (('1', '2')) {
+                killsockfilters($proto, $ipvnum, $idnum, $verbose);
+            }
         }
     }
 }
 
+
+sub set_advisor_read_lock {
+    my ($filename) = @_;
+
+    if(open(FILEH, ">$filename")) {
+        close(FILEH);
+        return;
+    }
+    printf "Error creating lock file $filename error: $!";
+}
+
+
+sub clear_advisor_read_lock {
+    my ($filename) = @_;
+
+    if(-f $filename) {
+        unlink($filename);
+    }
+}
+
+
 1;