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;
#use Time::HiRes qw( gettimeofday ); # not available in perl 5.6

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


my $ftpdnum="";

# open and close each time to allow removal at any time
sub logmsg {
 # if later than perl 5.6 is used
 #   my ($seconds, $microseconds) = gettimeofday;
    my $seconds = time();
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
        localtime($seconds);
    open(FTPLOG, ">>log/ftpd$ftpdnum.log");
    printf FTPLOG ("%02d:%02d:%02d ", $hour, $min, $sec);
    print FTPLOG @_;
    close(FTPLOG);
}

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
}

my $verbose=0; # set to 1 for debugging
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";

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/) {
    die "unsupported protocol selected";
}

sub catch_zap {
    my $signame = shift;
    ftpkillslaves(1);
    unlink($pidfile);
    if($serverlogslocked) {
        $serverlogslocked = 0;
        clear_advisor_read_lock($SERVERLOGS_LOCK);
    }
    exit;
}
$SIG{INT} = \&catch_zap;
$SIG{TERM} = \&catch_zap;

my $sfpid;

local(*SFREAD, *SFWRITE);

sub sysread_or_die {
    my $FH     = shift;
    my $scalar = shift;
    my $length = shift;
    my $fcaller;
    my $lcaller;
    my $result;

    $result = sysread($$FH, $$scalar, $length);

    if(not defined $result) {
        ($fcaller, $lcaller) = (caller)[1,2];
        logmsg "Failed to read input\n";
        logmsg "Error: ftp$ftpdnum$ext sysread error: $!\n";
        kill(9, $sfpid);
        waitpid($sfpid, 0);
        unlink($pidfile);
        if($serverlogslocked) {
            $serverlogslocked = 0;
            clear_advisor_read_lock($SERVERLOGS_LOCK);
        }
        die "Died in sysread_or_die() at $fcaller " .
            "line $lcaller. ftp$ftpdnum$ext sysread error: $!\n";
    }
    elsif($result == 0) {
        ($fcaller, $lcaller) = (caller)[1,2];
        logmsg "Failed to read input\n";
        logmsg "Error: ftp$ftpdnum$ext read zero\n";
        kill(9, $sfpid);
        waitpid($sfpid, 0);
        unlink($pidfile);
        if($serverlogslocked) {
            $serverlogslocked = 0;
            clear_advisor_read_lock($SERVERLOGS_LOCK);
        }
        die "Died in sysread_or_die() at $fcaller " .
            "line $lcaller. ftp$ftpdnum$ext read zero\n";
    }

    return $result;
}

sub startsf {
    my $cmd="./server/sockfilt --port $port --logfile log/sockctrl$ftpdnum$ext.log --pidfile .sockfilt$ftpdnum$ext.pid $ipv6";
    $sfpid = open2(*SFREAD, *SFWRITE, $cmd);