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 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 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 # pidexists checks if a process with a given pid exists and is alive.
  52 # This will return the positive pid if the process exists and is alive.
  53 # This will return the negative pid if the process exists differently.
  54 # This will return 0 if the process could not be found.
  55 #
  56 sub pidexists {
  57     my $pid = $_[0];
  58
  59     if($pid > 0) {
  60         # verify if currently existing and alive
  61         if(kill(0, $pid)) {
  62             return $pid;
  63         }
  64
  65         # verify if currently existing Windows process
  66         if($^O eq "msys") {
  67             my $filter = "PID eq $pid";
  68             my $result = `tasklist -fi \"$filter\" 2>nul`;
  69             if(index($result, "$pid") != -1) {
  70                 return -$pid;
  71             }
  72         }
  73     }
  74
  75     return 0;
  76 }
  77
  78 #######################################################################
  79 # pidterm asks the process with a given pid to terminate gracefully.
  80 #
  81 sub pidterm {
  82     my $pid = $_[0];
  83
  84     if($pid > 0) {
  85         # signal the process to terminate
  86         kill("TERM", $pid);
  87
  88         # request the process to quit
  89         if($^O eq "msys") {
  90             my $filter = "PID eq $pid";
  91             my $result = `tasklist -fi \"$filter\" 2>nul`;
  92             if(index($result, "$pid") != -1) {
  93                 system("taskkill -fi \"$filter\" >nul 2>&1");
  94             }
  95         }
  96     }
  97 }
  98
  99 #######################################################################
 100 # pidkill kills the process with a given pid mercilessly andforcefully.
 101 #
 102 sub pidkill {
 103     my $pid = $_[0];
 104
 105     if($pid > 0) {
 106         # signal the process to terminate
 107         kill("KILL", $pid);
 108
 109         # request the process to quit
 110         if($^O eq "msys") {
 111             my $filter = "PID eq $pid";
 112             my $result = `tasklist -fi \"$filter\" 2>nul`;
 113             if(index($result, "$pid") != -1) {
 114                 system("taskkill -f -fi \"$filter\" >nul 2>&1");
 115                 # Windows XP Home compatibility
 116                 system("tskill $pid >nul 2>&1");
 117             }
 118         }
 119     }
 120 }
 121
 122 #######################################################################
 123 # processexists checks if a process with the pid stored in the given
 124 # pidfile exists and is alive. This will return 0 on any file related
 125 # error or if a pid can not be extracted from the given file. When a
 126 # process with the same pid as the one extracted from the given file
 127 # is currently alive this returns that positive pid. Otherwise, when
 128 # the process is not alive, will return the negative value of the pid.
 129 #
 130 sub processexists {
 131     use POSIX ":sys_wait_h";
 132     my $pidfile = $_[0];
 133
 134     # fetch pid from pidfile
 135     my $pid = pidfromfile($pidfile);
 136
 137     if($pid > 0) {
 138         # verify if currently alive
 139         if(pidexists($pid)) {
 140             return $pid;
 141         }
 142         else {
 143             # get rid of the certainly invalid pidfile
 144             unlink($pidfile) if($pid == pidfromfile($pidfile));
 145             # reap its dead children, if not done yet
 146             waitpid($pid, &WNOHANG);
 147             # negative return value means dead process
 148             return -$pid;
 149         }
 150     }
 151     return 0;
 152 }
 153
 154 #######################################################################
 155 # killpid attempts to gracefully stop processes in the given pid list
 156 # with a SIGTERM signal and SIGKILLs those which haven't died on time.
 157 #
 158 sub killpid {
 159     use POSIX ":sys_wait_h";
 160     my ($verbose, $pidlist) = @_;
 161     my @requested;
 162     my @signalled;
 163     my @reapchild;
 164
 165     # The 'pidlist' argument is a string of whitespace separated pids.
 166     return if(not defined($pidlist));
 167
 168     # Make 'requested' hold the non-duplicate pids from 'pidlist'.
 169     @requested = split(' ', $pidlist);
 170     return if(not @requested);
 171     if(scalar(@requested) > 2) {
 172         @requested = sort({$a <=> $b} @requested);
 173     }
 174     for(my $i = scalar(@requested) - 2; $i >= 0; $i--) {
 175         if($requested[$i] == $requested[$i+1]) {
 176             splice @requested, $i+1, 1;
 177         }
 178     }
 179
 180     # Send a SIGTERM to processes which are alive to gracefully stop them.
 181     foreach my $tmp (@requested) {
 182         chomp $tmp;
 183         if($tmp =~ /^(\d+)$/) {
 184             my $pid = $1;
 185             if($pid > 0) {
 186                 if(pidexists($pid)) {
 187                     print("RUN: Process with pid $pid signalled to die\n")
 188                         if($verbose);
 189                     pidterm($pid);
 190                     push @signalled, $pid;
 191                 }
 192                 else {
 193                     print("RUN: Process with pid $pid already dead\n")
 194                         if($verbose);
 195                     # if possible reap its dead children
 196                     waitpid($pid, &WNOHANG);
 197                     push @reapchild, $pid;
 198                 }
 199             }
 200         }
 201     }
 202
 203     # Allow all signalled processes five seconds to gracefully die.
 204     if(@signalled) {
 205         my $twentieths = 5 * 20;
 206         while($twentieths--) {
 207             for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) {
 208                 my $pid = $signalled[$i];
 209                 if(!pidexists($pid)) {
 210                     print("RUN: Process with pid $pid gracefully died\n")
 211                         if($verbose);
 212                     splice @signalled, $i, 1;
 213                     # if possible reap its dead children
 214                     waitpid($pid, &WNOHANG);
 215                     push @reapchild, $pid;
 216                 }
 217             }
 218             last if(not scalar(@signalled));
 219             select(undef, undef, undef, 0.05);
 220         }
 221     }
 222
 223     # Mercilessly SIGKILL processes still alive.
 224     if(@signalled) {
 225         foreach my $pid (@signalled) {
 226             if($pid > 0) {
 227                 print("RUN: Process with pid $pid forced to die with SIGKILL\n")
 228                     if($verbose);
 229                 pidkill($pid);
 230                 # if possible reap its dead children
 231                 waitpid($pid, &WNOHANG);
 232                 push @reapchild, $pid;
 233             }
 234         }
 235     }
 236
 237     # Reap processes dead children for sure.
 238     if(@reapchild) {
 239         foreach my $pid (@reapchild) {
 240             if($pid > 0) {
 241                 waitpid($pid, 0);
 242             }
 243         }
 244     }
 245 }
 246
 247 #######################################################################
 248 # killsockfilters kills sockfilter processes for a given server.
 249 #
 250 sub killsockfilters {
 251     my ($proto, $ipvnum, $idnum, $verbose, $which) = @_;
 252     my $server;
 253     my $pidfile;
 254     my $pid;
 255
 256     return if($proto !~ /^(ftp|imap|pop3|smtp)$/);
 257
 258     die "unsupported sockfilter: $which"
 259         if($which && ($which !~ /^(main|data)$/));
 260
 261     $server = servername_id($proto, $ipvnum, $idnum) if($verbose);
 262
 263     if(!$which || ($which eq 'main')) {
 264         $pidfile = mainsockf_pidfilename($proto, $ipvnum, $idnum);
 265         $pid = processexists($pidfile);
 266         if($pid > 0) {
 267             printf("* kill pid for %s-%s => %d\n", $server,
 268                 ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose);
 269             pidkill($pid);
 270             waitpid($pid, 0);
 271         }
 272         unlink($pidfile) if(-f $pidfile);
 273     }
 274
 275     return if($proto ne 'ftp');
 276
 277     if(!$which || ($which eq 'data')) {
 278         $pidfile = datasockf_pidfilename($proto, $ipvnum, $idnum);
 279         $pid = processexists($pidfile);
 280         if($pid > 0) {
 281             printf("* kill pid for %s-data => %d\n", $server,
 282                 $pid) if($verbose);
 283             pidkill($pid);
 284             waitpid($pid, 0);
 285         }
 286         unlink($pidfile) if(-f $pidfile);
 287     }
 288 }
 289
 290 #######################################################################
 291 # killallsockfilters kills sockfilter processes for all servers.
 292 #
 293 sub killallsockfilters {
 294     my $verbose = $_[0];
 295
 296     for my $proto (('ftp', 'imap', 'pop3', 'smtp')) {
 297         for my $ipvnum (('4', '6')) {
 298             for my $idnum (('1', '2')) {
 299                 killsockfilters($proto, $ipvnum, $idnum, $verbose);
 300             }
 301         }
 302     }
 303 }
 304
 305
 306 sub set_advisor_read_lock {
 307     my ($filename) = @_;
 308
 309     if(open(FILEH, ">$filename")) {
 310         close(FILEH);
 311         return;
 312     }
 313     printf "Error creating lock file $filename error: $!";
 314 }
 315
 316
 317 sub clear_advisor_read_lock {
 318     my ($filename) = @_;
 319
 320     if(-f $filename) {
 321         unlink($filename);
 322     }
 323 }
 324
 325
 326 1;