tests/ftp.pm

   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
  23 use strict;
  24 use warnings;
  25
  26 use 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 #
  38 sub 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 # processexists checks if a process with the pid stored in the given
  52 # pidfile exists and is alive. This will return 0 on any file related
  53 # error or if a pid can not be extracted from the given file. When a
  54 # process with the same pid as the one extracted from the given file
  55 # is currently alive this returns that positive pid. Otherwise, when
  56 # the process is not alive, will return the negative value of the pid.
  57 #
  58 sub processexists {
  59     use POSIX ":sys_wait_h";
  60     my $pidfile = $_[0];
  61
  62     # fetch pid from pidfile
  63     my $pid = pidfromfile($pidfile);
  64
  65     if($pid > 0) {
  66         # verify if currently alive
  67         if(kill(0, $pid)) {
  68             return $pid;
  69         }
  70         else {
  71             # get rid of the certainly invalid pidfile
  72             unlink($pidfile) if($pid == pidfromfile($pidfile));
  73             # reap its dead children, if not done yet
  74             waitpid($pid, &WNOHANG);
  75             # negative return value means dead process
  76             return -$pid;
  77         }
  78     }
  79     return 0;
  80 }
  81
  82 #######################################################################
  83 # killpid attempts to gracefully stop processes in the given pid list
  84 # with a SIGTERM signal and SIGKILLs those which haven't died on time.
  85 #
  86 sub killpid {
  87     use POSIX ":sys_wait_h";
  88     my ($verbose, $pidlist) = @_;
  89     my @requested;
  90     my @signalled;
  91     my @reapchild;
  92
  93     # The 'pidlist' argument is a string of whitespace separated pids.
  94     return if(not defined($pidlist));
  95
  96     # Make 'requested' hold the non-duplicate pids from 'pidlist'.
  97     @requested = split(' ', $pidlist);
  98     return if(not @requested);
  99     if(scalar(@requested) > 2) {
 100         @requested = sort({$a <=> $b} @requested);
 101     }
 102     for(my $i = scalar(@requested) - 2; $i >= 0; $i--) {
 103         if($requested[$i] == $requested[$i+1]) {
 104             splice @requested, $i+1, 1;
 105         }
 106     }
 107
 108     # Send a SIGTERM to processes which are alive to gracefully stop them.
 109     foreach my $tmp (@requested) {
 110         chomp $tmp;
 111         if($tmp =~ /^(\d+)$/) {
 112             my $pid = $1;
 113             if($pid > 0) {
 114                 if(kill(0, $pid)) {
 115                     print("RUN: Process with pid $pid signalled to die\n")
 116                         if($verbose);
 117                     kill("TERM", $pid);
 118                     push @signalled, $pid;
 119                 }
 120                 else {
 121                     print("RUN: Process with pid $pid already dead\n")
 122                         if($verbose);
 123                     # if possible reap its dead children
 124                     waitpid($pid, &WNOHANG);
 125                     push @reapchild, $pid;
 126                 }
 127             }
 128         }
 129     }
 130
 131     # Allow all signalled processes five seconds to gracefully die.
 132     if(@signalled) {
 133         my $twentieths = 5 * 20;
 134         while($twentieths--) {
 135             for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) {
 136                 my $pid = $signalled[$i];
 137                 if(!kill(0, $pid)) {
 138                     print("RUN: Process with pid $pid gracefully died\n")
 139                         if($verbose);
 140                     splice @signalled, $i, 1;
 141                     # if possible reap its dead children
 142                     waitpid($pid, &WNOHANG);
 143                     push @reapchild, $pid;
 144                 }
 145             }
 146             last if(not scalar(@signalled));
 147             select(undef, undef, undef, 0.05);
 148         }
 149     }
 150
 151     # Mercilessly SIGKILL processes still alive.
 152     if(@signalled) {
 153         foreach my $pid (@signalled) {
 154             if($pid > 0) {
 155                 print("RUN: Process with pid $pid forced to die with SIGKILL\n")
 156                     if($verbose);
 157                 kill("KILL", $pid);
 158                 # if possible reap its dead children
 159                 waitpid($pid, &WNOHANG);
 160                 push @reapchild, $pid;
 161             }
 162         }
 163     }
 164
 165     # Reap processes dead children for sure.
 166     if(@reapchild) {
 167         foreach my $pid (@reapchild) {
 168             if($pid > 0) {
 169                 waitpid($pid, 0);
 170             }
 171         }
 172     }
 173 }
 174
 175 #######################################################################
 176 # killsockfilters kills sockfilter processes for a given server.
 177 #
 178 sub killsockfilters {
 179     my ($proto, $ipvnum, $idnum, $verbose, $which) = @_;
 180     my $server;
 181     my $pidfile;
 182     my $pid;
 183
 184     return if($proto !~ /^(ftp|imap|pop3|smtp)$/);
 185
 186     die "unsupported sockfilter: $which"
 187         if($which && ($which !~ /^(main|data)$/));
 188
 189     $server = servername_id($proto, $ipvnum, $idnum) if($verbose);
 190
 191     if(!$which || ($which eq 'main')) {
 192         $pidfile = mainsockf_pidfilename($proto, $ipvnum, $idnum);
 193         $pid = processexists($pidfile);
 194         if($pid > 0) {
 195             printf("* kill pid for %s-%s => %d\n", $server,
 196                 ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose);
 197             kill("KILL", $pid);
 198             waitpid($pid, 0);
 199         }
 200         unlink($pidfile) if(-f $pidfile);
 201     }
 202
 203     return if($proto ne 'ftp');
 204
 205     if(!$which || ($which eq 'data')) {
 206         $pidfile = datasockf_pidfilename($proto, $ipvnum, $idnum);
 207         $pid = processexists($pidfile);
 208         if($pid > 0) {
 209             printf("* kill pid for %s-data => %d\n", $server,
 210                 $pid) if($verbose);
 211             kill("KILL", $pid);
 212             waitpid($pid, 0);
 213         }
 214         unlink($pidfile) if(-f $pidfile);
 215     }
 216 }
 217
 218 #######################################################################
 219 # killallsockfilters kills sockfilter processes for all servers.
 220 #
 221 sub killallsockfilters {
 222     my $verbose = $_[0];
 223
 224     for my $proto (('ftp', 'imap', 'pop3', 'smtp')) {
 225         for my $ipvnum (('4', '6')) {
 226             for my $idnum (('1', '2')) {
 227                 killsockfilters($proto, $ipvnum, $idnum, $verbose);
 228             }
 229         }
 230     }
 231 }
 232
 233
 234 sub set_advisor_read_lock {
 235     my ($filename) = @_;
 236
 237     if(open(FILEH, ">$filename")) {
 238         close(FILEH);
 239         return;
 240     }
 241     printf "Error creating lock file $filename error: $!";
 242 }
 243
 244
 245 sub clear_advisor_read_lock {
 246     my ($filename) = @_;
 247
 248     if(-f $filename) {
 249         unlink($filename);
 250     }
 251 }
 252
 253
 254 1;