The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use IO::Async::Test;
use IO::Async::Loop;
use IO::Async::OS;
use IO::Async::Stream;

use Net::Async::FTP;
use t::TestFTP;

BEGIN {
   # File::Listing tries to parse timestamps in the local timezone. To make
   # the tests repeatable, we'll force it to GMT
   $ENV{TZ} = "GMT";
}

my $CRLF = "\x0d\x0a"; # because \r\n isn't portable

my $loop = IO::Async::Loop->new();
testing_loop( $loop );

my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!";

my $ftp = Net::Async::FTP->new( handle => $S1 );

$loop->add( $ftp );

# We won't log in.. our pseudo-server will just accept any command

my $list_response = "drwxr-xr-x   2 user     user            0 Feb  1  2005 .$CRLF" .
                    "-rw-r--r--   1 user     user          100 Feb  2  2005 file$CRLF" .
                    "-rw-r--r--   1 user     user          200 Feb  3  2005 other$CRLF";

# ->list futures
{
   my $f;

   $f = $ftp->list(
      path => "some/dir",
   );

   my $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "PASV$CRLF", 'PASV preceeds LIST' );

   my $D = accept_dataconn( $S2 );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "LIST some/dir$CRLF", 'LIST command' );

   $D->syswrite( $list_response );
   $D->close;

   $S2->syswrite( "226 Closing data connection$CRLF" );

   wait_for { $f->is_ready };

   my $list = $f->get;
   is( $list, "drwxr-xr-x   2 user     user            0 Feb  1  2005 .$CRLF" .
              "-rw-r--r--   1 user     user          100 Feb  2  2005 file$CRLF" .
              "-rw-r--r--   1 user     user          200 Feb  3  2005 other$CRLF",
       '$list after 226' );

   $f = $ftp->list_parsed(
      path => "some/dir",
   );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "PASV$CRLF", 'PASV preceeds LIST' );

   $D = accept_dataconn( $S2 );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "LIST some/dir$CRLF", 'LIST command' );

   $D->syswrite( $list_response );
   $D->close;

   $S2->syswrite( "226 Closing data connection$CRLF" );

   wait_for { $f->is_ready };

   my @files = $f->get;
   is_deeply( \@files,
              [
                 { name => "file",  type => "f", size => 100, mtime => 1107302400, mode => 0100644 },
                 { name => "other", type => "f", size => 200, mtime => 1107388800, mode => 0100644 },
              ],
              '@files after 226' );
}

# ->nlst futures
{
   my $f;

   $f = $ftp->nlst(
      path => "other/dir",
   );

   my $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "PASV$CRLF", 'PASV preceeds NLST' );

   my $D = accept_dataconn( $S2 );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "NLST other/dir$CRLF", 'NLST command' );

   $D->syswrite( "foo${CRLF}bar${CRLF}splot${CRLF}" );
   $D->close;

   $S2->syswrite( "226 Closing data connection$CRLF" );

   wait_for { $f->is_ready };

   my $names = $f->get;
   is( $names, "foo${CRLF}bar${CRLF}splot${CRLF}", '$names after 226' );

   $f = $ftp->namelist(
      path => "other/dir",
   );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "PASV$CRLF", 'PASV preceeds NLST' );

   $D = accept_dataconn( $S2 );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "NLST other/dir$CRLF", 'NLST command' );

   $D->syswrite( "foo${CRLF}bar${CRLF}splot${CRLF}" );
   $D->close;

   $S2->syswrite( "226 Closing data connection$CRLF" );

   wait_for { $f->is_ready };

   my @names = $f->get;
   is_deeply( \@names,
              [qw( foo bar splot )],
              '@names after 226' );
}

# Legacy callbacks
{
   my $done;
   my $list;

   $ftp->list(
      path => "some/dir",
      on_list => sub { $list = shift; $done = 1; },
   );

   my $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "PASV$CRLF", 'PASV preceeds LIST' );

   my $D = accept_dataconn( $S2 );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "LIST some/dir$CRLF", 'LIST command' );

   $D->syswrite( $list_response );
   $D->close;

   $S2->syswrite( "226 Closing data connection$CRLF" );

   wait_for { $done };

   is( $done, 1, '$done after 226' );
   is( $list, "drwxr-xr-x   2 user     user            0 Feb  1  2005 .$CRLF" .
              "-rw-r--r--   1 user     user          100 Feb  2  2005 file$CRLF" .
              "-rw-r--r--   1 user     user          200 Feb  3  2005 other$CRLF",
       '$list after 226' );

   my @files;
   $done = 0;

   $ftp->list_parsed(
      path => "some/dir",
      on_list => sub { @files = @_; $done = 1; },
   );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "PASV$CRLF", 'PASV preceeds LIST' );

   $D = accept_dataconn( $S2 );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "LIST some/dir$CRLF", 'LIST command' );

   $D->syswrite( $list_response );
   $D->close;

   $S2->syswrite( "226 Closing data connection$CRLF" );

   wait_for { $done };

   is( $done, 1, '$done after 226' );
   is_deeply( \@files,
              [
                 { name => "file",  type => "f", size => 100, mtime => 1107302400, mode => 0100644 },
                 { name => "other", type => "f", size => 200, mtime => 1107388800, mode => 0100644 },
              ],
              '@files after 226' );

   $done = 0;
   my $names;

   $ftp->nlst(
      path => "other/dir",
      on_list => sub { $names = shift; $done = 1; },
   );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "PASV$CRLF", 'PASV preceeds NLST' );

   $D = accept_dataconn( $S2 );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "NLST other/dir$CRLF", 'NLST command' );

   $D->syswrite( "foo${CRLF}bar${CRLF}splot${CRLF}" );
   $D->close;

   $S2->syswrite( "226 Closing data connection$CRLF" );

   wait_for { $done };

   is( $done, 1, '$done after 226' );
   is( $names, "foo${CRLF}bar${CRLF}splot${CRLF}", '$names after 226' );

   $done = 0;
   my @names;

   $ftp->namelist(
      path => "other/dir",
      on_names => sub { @names = @_; $done = 1; },
   );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "PASV$CRLF", 'PASV preceeds NLST' );

   $D = accept_dataconn( $S2 );

   $server_stream = "";
   wait_for_stream { $server_stream =~ m/$CRLF/ } $S2 => $server_stream;

   is( $server_stream, "NLST other/dir$CRLF", 'NLST command' );

   $D->syswrite( "foo${CRLF}bar${CRLF}splot${CRLF}" );
   $D->close;

   $S2->syswrite( "226 Closing data connection$CRLF" );

   wait_for { $done };

   is( $done, 1, '$done after 226' );
   is_deeply( \@names,
              [qw( foo bar splot )],
              '@names after 226' );
}

done_testing;