File Coverage

blib/lib/AnyEvent/FTP/Server.pm

Criterion	Covered	Total	%
statement	60	97	61.8
branch	2	4	50.0
condition	1	2	50.0
subroutine	14	20	70.0
pod	1	2	50.0
total	78	125	62.4

package AnyEvent::FTP::Server;

use strict;
use warnings;
use 5.010;
use Moo;
use AnyEvent::Handle;
use AnyEvent::Socket qw( tcp_server );
use AnyEvent::FTP::Server::Connection;
use Socket qw( unpack_sockaddr_in inet_ntoa );

# ABSTRACT: Simple asynchronous ftp server
our $VERSION = '0.17'; # VERSION


$AnyEvent::FTP::Server::VERSION //= 'dev';

with 'AnyEvent::FTP::Role::Event';

__PACKAGE__->define_events(qw( bind connect ));


has hostname => (
  is       => 'ro',
);


has port => (
  is      => 'ro',
  default => sub { 21 },
);


has default_context => (
  is      => 'ro',
  default => sub { 'AnyEvent::FTP::Server::Context::FSRW' },
);


has welcome => (
  is      => 'ro',
  default => sub { [ 220 => "aeftpd $AnyEvent::FTP::Server::VERSION" ] },
);


has bindport => (
  is => 'rw',
);


has inet => (
  is      => 'ro',
  default => sub { 0 },
);

sub BUILD
{
  eval 'use ' . shift->default_context;
  die $@ if $@;
}


sub start
{
  my($self) = @_;
  $self->inet ? $self->_start_inet : $self->_start_standalone;
}

sub _start_inet
{
  my($self) = @_;

  my $con = AnyEvent::FTP::Server::Connection->new(
    context => $self->{default_context}->new,
    ip      => do {
      my $sockname = getsockname STDIN;
      my ($sockport, $sockaddr) = unpack_sockaddr_in ($sockname);
      inet_ntoa ($sockaddr);
    },
  );

  my $handle;
  $handle = AnyEvent::Handle->new(
    fh => *STDIN,
      on_error => sub {
        my($hdl, $fatal, $msg) = @_;
        $con->close;
        $_[0]->destroy;
        undef $handle;
        undef $con;
      },
      on_eof   => sub {
        $con->close;
        $handle->destroy;
        undef $handle;
        undef $con;
      },
  );

  $self->emit(connect => $con);

  STDOUT->autoflush(1);
  STDIN->autoflush(1);

  $con->on_response(sub {
    my($raw) = @_;
    print STDOUT $raw;
  });

  $con->on_close(sub {
    close STDOUT;
    exit;
  });

  $con->send_response(@{ $self->welcome });

  $handle->on_read(sub {
    $handle->push_read( line => sub {
      my($handle, $line) = @_;
      $con->process_request($line);
    });
  });

  $self;
}

sub _start_standalone
{
  my($self) = @_;

  my $prepare = sub {
    my($fh, $host, $port) = @_;
    $self->bindport($port);
    $self->emit(bind => $port);
  };

  my $connect = sub {
    my($fh, $host, $port) = @_;

    my $con = AnyEvent::FTP::Server::Connection->new(
      context => $self->{default_context}->new,
      ip => do {
        my($port, $addr) = unpack_sockaddr_in getsockname $fh;
        inet_ntoa $addr;
      },
    );

    my $handle;
    $handle = AnyEvent::Handle->new(
      fh       => $fh,
      on_error => sub {
        my($hdl, $fatal, $msg) = @_;
        $con->close;
        $_[0]->destroy;
        undef $handle;
        undef $con;
      },
      on_eof   => sub {
        $con->close;
        $handle->destroy;
        undef $handle;
        undef $con;
      },
    );

    $self->emit(connect => $con);

    $con->on_response(sub {
      my($raw) = @_;
      $handle->push_write($raw);
    });

    $con->on_close(sub {
      $handle->push_shutdown;
    });

    $con->send_response(@{ $self->welcome });

    $handle->on_read(sub {
      $handle->push_read( line => sub {
        my($handle, $line) = @_;
        $con->process_request($line);
      });
    });

  };

  tcp_server $self->hostname, $self->port || undef, $connect, $prepare;

  $self;
}

1;

__END__