ftpserver.pl

#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) 1998 - 2009, 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.
#
# 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
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
# $Id$
###########################################################################

# This is a server designed for the curl test suite.
#
# In December 2009 we started remaking the server to support more protocols
# that are similar in spirit. Like POP3, IMAP and SMTP in addition to the
# FTP it already supported since a long time.
#
# It is meant to exercise curl, it is not meant to be a fully working
# or even very standard compliant server.
#
# You may optionally specify port on the command line, otherwise it'll
# default to port 8921.
#
# All socket/network/TCP related stuff is done by the 'sockfilt' program.
#

use strict;
use IPC::Open2;

require "getpart.pm";
require "ftp.pm";

#BEGIN {
#    if($] > 5.006) {
#        use Time::HiRes qw( gettimeofday );
#    }
#}

#**********************************************************************
# global vars...
#
my $verbose = 0; # set to 1 for debugging
my $ftpdnum="";
my $logfilename = 'log/logfile.log'; # Override this for each test server

my $pasvbadip=0;
my $retrweirdo=0;
my $retrnosize=0;
my $srcdir=".";
my $nosave=0;
my $controldelay=0; # set to 1 to delay the control connect data sending to
 # test that curl deals with that nicely
my $slavepid; # for the DATA connection sockfilt slave process
my $ipv6;
my $ext; # append to log/pid file names
my $grok_eprt;
my $port = 8921; # just a default
my $listenaddr = "127.0.0.1"; # just a default
my $pidfile = ".ftpd.pid"; # a default, use --pidfile

my $SERVERLOGS_LOCK="log/serverlogs.lock"; # server logs advisor read lock
my $serverlogslocked=0;

my $proto="ftp";

my $sfpid;

local(*SFREAD, *SFWRITE);

#**********************************************************************
# global vars used for signal handling
#
my $got_exit_signal = 0; # set if program should finish execution ASAP
my $exit_signal;         # first signal handled in exit_signal_handler

#**********************************************************************
# exit_signal_handler will be triggered to indicate that the program
# should finish its execution in a controlled way as soon as possible.
# For now, program will also terminate from within this handler.
#
sub exit_signal_handler {
    my $signame = shift;
    local $!; # preserve errno
    if($got_exit_signal == 0) {
        $got_exit_signal = 1;
        $exit_signal = $signame;
    }
    $SIG{$signame} = \&exit_signal_handler;
    # For now, simply mimic old behavior.
    ftpkillslaves($verbose);
    unlink($pidfile);
    if($serverlogslocked) {
        $serverlogslocked = 0;
        clear_advisor_read_lock($SERVERLOGS_LOCK);
    }
    exit;
}

#**********************************************************************
# getlogfilename returns a log file name depending on given arguments.
#
sub getlogfilename {
    my ($proto, $ipversion, $ssl, $instance, $sockfilter) = @_;
    my $filename;

    # For now, simply mimic old behavior.
    $filename = "log/ftpd$ftpdnum.log";

    return $filename;
}

#**********************************************************************
# logmsg is general message logging subroutine for our test servers.
#
sub logmsg {
    my $now;
#   if($] > 5.006) {
#       my ($seconds, $usec) = gettimeofday();
#       my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
#           localtime($seconds);
#       $now = sprintf("%02d:%02d:%02d.%06d ", $hour, $min, $sec, $usec);
#   }
#   else {
        my $seconds = time();
        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
            localtime($seconds);
        $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
#   }
    if(open(LOGFILEFH, ">>$logfilename")) {
        print LOGFILEFH $now;
        print LOGFILEFH @_;
        close(LOGFILEFH);
    }
}

sub ftpmsg {
  # append to the server.input file
  open(INPUT, ">>log/server$ftpdnum.input") ||
    logmsg "failed to open log/server$ftpdnum.input\n";

  print INPUT @_;
  close(INPUT);

  # use this, open->print->close system only to make the file
  # open as little as possible, to make the test suite run
  # better on windows/cygwin
}

do {
    if($ARGV[0] eq "-v") {
        $verbose=1;
    }
    elsif($ARGV[0] eq "-s") {
        $srcdir=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "--id") {
        $ftpdnum=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "--proto") {
        # ftp pop3 imap smtp
        $proto=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "--pidfile") {
        $pidfile=$ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "--ipv6") {
        $ipv6="--ipv6";
        $ext="ipv6";
        $grok_eprt = 1;
    }
    elsif($ARGV[0] eq "--port") {
        $port = $ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "--addr") {
        $listenaddr = $ARGV[1];
        $listenaddr =~ s/^\[(.*)\]$/$1/;
        shift @ARGV;
    }
} while(shift @ARGV);

# a dedicated protocol has been selected, check that it's a fine one
if($proto !~ /^(ftp|imap|pop3|smtp)\z/) {