tests/ftp.pm

   1 #***************************************************************************
   2 #                                  _   _ ____  _
   3 #  Project                     ___| | | |  _ \| |
   4 #                             / __| | | | |_) | |
   5 #                            | (__| |_| |  _ <| |___
   6 #                             \___|\___/|_| \_\_____|
   7 #
   8 # Copyright (C) 1998 - 2006, 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 # $Id$
  22 ###########################################################################
  23
  24 use strict;
  25 #use warnings; # requires perl 5.006 or later
  26
  27
  28 my $DEFAULT_TIMEOUT_START = 90; # default allowed time for a process to startup
  29 my $DEFAULT_TIMEOUT_STOP  = 90; # default allowed time for a process to stop
  30
  31 my $ONE_HALF_STOP_TIMEOUT  = int($DEFAULT_TIMEOUT_STOP / 2);
  32 my $ONE_THIRD_STOP_TIMEOUT = int($DEFAULT_TIMEOUT_STOP / 3);
  33 my $ONE_SIXTH_STOP_TIMEOUT = int($DEFAULT_TIMEOUT_STOP / 6);
  34
  35 my $pidpattern = qr/^\-?(\d+)$/; # pre-compiled pid pattern regexp
  36
  37
  38 ######################################################################
  39 # pidfromfile returns the pid stored in the given pidfile.  The value
  40 # of the returned pid will never be a negative value. It will be zero
  41 # on any file related error or if a pid can not be extracted from the
  42 # file. Otherwise it will be a positive value, even If the pid number
  43 # stored in the file is a negative one.
  44 #
  45 sub pidfromfile {
  46     my ($pidfile)=@_;
  47
  48     my $pid = 0; # on failure or empty file return 0
  49     my $pidline;
  50
  51     if(not defined $pidfile) {
  52         return 0;
  53     }
  54     if(-f $pidfile) {
  55         if(open(PIDF, "<$pidfile")) {
  56             my $pidline = <PIDF>;
  57             close(PIDF);
  58             if($pidline) {
  59                 chomp $pidline;
  60                 $pidline =~ s/^\s+//;
  61                 $pidline =~ s/\s+$//;
  62                 $pidline =~ s/^[+-]?0+//;
  63                 if($pidline =~ $pidpattern) {
  64                     $pid = $1;
  65                 }
  66             }
  67         }
  68     }
  69     return $pid;
  70 }
  71
  72
  73 ######################################################################
  74 # unlinkpidfiles unlinks/deletes the given pidfiles. The first argument
  75 # 'pidfiles' is a string of whitespace separated pidfiles. If successful
  76 # returns 0, on error it returns the number of files not deleted.
  77 #
  78 sub unlinkpidfiles {
  79     my ($pidfiles)=@_;
  80
  81     if(not defined $pidfiles) {
  82         return 0;
  83     }
  84     my $pidfile;
  85     my $errcount = 0;
  86     for $pidfile (split(" ", $pidfiles)) {
  87         if($pidfile) {
  88             if(unlink($pidfile) == 0) {
  89                 $errcount++;
  90             }
  91         }
  92     }
  93     return $errcount;
  94 }
  95
  96
  97 ######################################################################
  98 # checkalivepid checks if the process of the given pid is alive. The
  99 # argument must represent a single pid and be a valid number, if not
 100 # it will return 0. It will also return 0 if the pid argument is zero
 101 # or negative. If the pid argument is positive and it is alive returns
 102 # the same positive pid, otherwise, if it is not alive it will return
 103 # the negative value of the pid argument.
 104 #
 105 sub checkalivepid {
 106     my ($pid)=@_;
 107
 108     if(not defined $pid) {
 109         return 0;
 110     }
 111     if ($pid !~ $pidpattern) {
 112         return 0; # invalid argument
 113     }
 114     if($pid > 0) {
 115         if(kill(0, $pid)) {
 116             return $pid; # positive means it is alive
 117         }
 118         else {
 119             return -$pid; # negative means dead process
 120         }
 121     }
 122     return 0; # not a positive pid argument
 123 }
 124
 125
 126 ######################################################################
 127 # checkalivepidfile checks if the process of the pid stored in the
 128 # given pidfile is alive. It will return 0 on any file related error
 129 # or if a pid can not be extracted from the file. If the process of
 130 # the pid present in the file is alive it returns that positive pid,
 131 # if it is not alive it will return the negative value of the pid.
 132 #
 133 sub checkalivepidfile {
 134     my ($pidfile)=@_;
 135
 136     my $pid = pidfromfile($pidfile);
 137     my $ret = checkalivepid($pid);
 138     return $ret;
 139 }
 140
 141
 142 ######################################################################
 143 # signalpids signals processes in the second argument with the signal
 144 # given in the first argument. The second argument 'pids' is a string
 145 # of whitespace separated pids. Of the given pids only those that are
 146 # positive and are actually alive will be signalled, and no matter
 147 # how many times a pid is repeated it will only be signalled once.
 148 #
 149 sub signalpids {
 150     my ($signal, $pids)=@_;
 151
 152     if((not defined $signal) || (not defined $pids)) {
 153         return;
 154     }
 155     if($pids !~ /\s+/) {
 156         # avoid sorting if only one pid
 157         if(checkalivepid($pids) > 0) {
 158             kill($signal, $pids);
 159         }
 160         return;
 161     }
 162     my $prev = 0;
 163     for(sort({$a <=> $b} split(" ", $pids))) {
 164         if($_ =~ $pidpattern) {
 165             my $pid = $1;
 166             if($prev != $pid) {
 167                 $prev = $pid;
 168                 if(checkalivepid($pid) > 0) {
 169                     kill($signal, $pid);
 170                 }
 171             }
 172         }
 173     }
 174 }
 175
 176
 177 ######################################################################
 178 # signalpidfile signals the process of the pid stored in the given
 179 # pidfile with the signal given in the first argument if the process
 180 # with that pid is actually alive.
 181 #
 182 sub signalpidfile {
 183     my ($signal, $pidfile)=@_;
 184
 185     my $pid = pidfromfile($pidfile);
 186     if($pid > 0) {
 187         signalpids($signal, $pid);
 188     }
 189 }
 190
 191
 192 ######################################################################
 193 # waitdeadpid waits until all processes given in the first argument
 194 # are not alive, waiting at most timeout seconds. The first argument
 195 # 'pids' is a string of whitespace separated pids. Returns 1 when all
 196 # pids are not alive. Returns 0 when the specified timeout has expired
 197 # and at least one of the specified pids is still alive.
 198 #
 199 sub waitdeadpid {
 200     my ($pids, $timeout)=@_;
 201
 202     if(not defined $pids) {
 203         return 1;
 204     }
 205     if((not defined $timeout) || ($timeout < 1)) {
 206         $timeout = $DEFAULT_TIMEOUT_STOP;
 207     }
 208     while($timeout--) {
 209         my $alive = 0;
 210         for(split(" ", $pids)) {
 211             if($_ =~ $pidpattern) {
 212                 my $pid = $1;
 213                 if(checkalivepid($pid) > 0) {
 214                     $alive++;
 215                 }
 216             }
 217         }
 218         if($alive == 0) {
 219             return 1; # not a single pid is alive
 220         }
 221         sleep(1);
 222     }
 223     return 0; # at least one pid is still alive after timeout seconds
 224 }
 225
 226
 227 ######################################################################
 228 # waitalivepidfile waits until the given pidfile has a pid that is
 229 # alive, waiting at most timeout seconds. It returns the positive pid
 230 # When it is alive, otherwise it returns 0 when timeout seconds have
 231 # elapsed and the pidfile does not have a pid that is alive.
 232 #
 233 sub waitalivepidfile {
 234     my ($pidfile, $timeout)=@_;
 235
 236     if(not defined $pidfile) {
 237         return 0;
 238     }
 239     if((not defined $timeout) || ($timeout < 1)) {
 240         $timeout = $DEFAULT_TIMEOUT_START;
 241     }
 242     while($timeout--) {
 243         my $pid = checkalivepidfile($pidfile);
 244         if($pid > 0) {
 245             return $pid; # positive means it is alive
 246         }
 247         sleep(1);
 248     }
 249     return 0; # no pid in pidfile or not alive
 250 }
 251
 252
 253 ######################################################################
 254 # stopprocess ends the given pid(s), waiting for them to die. The 'pids'
 255 # argument is a string of whitespace separated pids. Returns 1 if all
 256 # of the processes have been successfully stopped. If unable to stop
 257 # any of them in DEFAULT_TIMEOUT_STOP seconds then it returns 0.
 258 #
 259 sub stopprocess {
 260     my ($pids)=@_;
 261
 262     if(not defined $pids) {
 263         return 1;
 264     }
 265     signalpids("KILL", $pids);
 266     if(waitdeadpid($pids, $ONE_HALF_STOP_TIMEOUT) == 0) {
 267         signalpids("KILL", $pids);
 268         if(waitdeadpid($pids, $ONE_THIRD_STOP_TIMEOUT) == 0) {
 269             signalpids("KILL", $pids);
 270             if(waitdeadpid($pids, $ONE_SIXTH_STOP_TIMEOUT) == 0) {
 271                 return 0; # at least one pid is still alive !!!
 272             }
 273         }
 274     }
 275     return 1; # not a single pid is alive
 276 }
 277
 278
 279 ######################################################################
 280 # stopprocesspidfile ends the test server process of the given pidfile,
 281 # waiting for it to die, and unlinking/deleting the given pidfile. If
 282 # the given process was not running or has been successfully stopped it
 283 # returns 1. If unable to stop it in DEFAULT_TIMEOUT_STOP seconds then
 284 # returns 0.
 285 #
 286 sub stopprocesspidfile {
 287     my ($pidfile)=@_;
 288
 289     if(not defined $pidfile) {
 290         return 1;
 291     }
 292     my $ret = 1; # assume success stopping it
 293     my $pid = checkalivepidfile($pidfile);
 294     if($pid > 0) {
 295         $ret = stopprocess($pid);
 296     }
 297     unlinkpidfiles($pidfile);
 298     return $ret;
 299 }
 300
 301
 302 ######################################################################
 303 # ftpkillslave ends a specific slave, waiting for it to die, and
 304 # unlinking/deleting its pidfiles. If the given ftpslave was not
 305 # running or has been successfully stopped it returns 1. If unable
 306 # to stop it in DEFAULT_TIMEOUT_STOP seconds then it returns 0.
 307 #
 308 sub ftpkillslave {
 309     my ($id, $ext)=@_;
 310
 311     if(not defined $id) {
 312         $id = "";
 313     }
 314     if(not defined $ext) {
 315         $ext = "";
 316     }
 317     my $ret = 1; # assume success stopping them
 318     my $pids = "";
 319     my $pidfiles = "";
 320     for my $base (('filt', 'data')) {
 321         my $pidfile = ".sock$base$id$ext.pid";
 322         my $pid = checkalivepidfile($pidfile);
 323         $pidfiles .= " $pidfile";
 324         if($pid > 0) {
 325             $pids .= " $pid";
 326         }
 327     }
 328     if($pids) {
 329         $ret = stopprocess($pids);
 330     }
 331     if($pidfiles) {
 332         unlinkpidfiles($pidfiles);
 333     }
 334     return $ret;
 335 }
 336
 337
 338 ######################################################################
 339 # ftpkillslaves ends all the ftpslave processes, waiting for them to
 340 # die, unlinking/deleting its pidfiles. If they were not running or
 341 # have been successfully stopped it returns 1. If unable to stop any
 342 # of them in DEFAULT_TIMEOUT_STOP seconds then returns 0.
 343 #
 344 sub ftpkillslaves {
 345
 346     my $ret = 1; # assume success stopping them
 347     my $pids = "";
 348     my $pidfiles = "";
 349     for my $ext (("", "ipv6")) {
 350         for my $id (("", "2")) {
 351             for my $base (('filt', 'data')) {
 352                 my $pidfile = ".sock$base$id$ext.pid";
 353                 my $pid = checkalivepidfile($pidfile);
 354                 $pidfiles .= " $pidfile";
 355                 if($pid > 0) {
 356                     $pids .= " $pid";
 357                 }
 358             }
 359         }
 360     }
 361     if($pids) {
 362         $ret = stopprocess($pids);
 363     }
 364     if($pidfiles) {
 365         unlinkpidfiles($pidfiles);
 366     }
 367     return $ret;
 368 }
 369
 370
 371 ######################################################################
 372 # library files end with 1; to make 'require' and 'use' succeed.
 373 1;
 374