#!/usr/bin/perl

{
    package Net::FTPServer::Atrex::DirHandle;

    use strict;
    use warnings;
    use Net::FTPServer::Full::DirHandle;
    use Net::FTPServer::Full::FileHandle;
    use Net::FTPServer::InMem::DirHandle;
    use Net::FTPServer::InMem::FileHandle;
    use Data::Dumper;

    our @ISA = qw(Net::FTPServer::Full::DirHandle);

    sub open {
        my $self = shift;
        my $filename = shift;
        my $mode = shift;
        if ($filename =~ /^atx.*\.txt$/ || $mode eq 'r') {
            return $self->SUPER::open($filename, $mode);
        }

        my $content = "";
          return new IO::Scalar (\$content);
    }
}

{
    package Net::FTPServer::Virtual::DirHandle;

    use strict;
    use warnings;

    use Net::FTPServer::Full::DirHandle;
    use Net::FTPServer::Full::FileHandle;
    use Net::FTPServer::InMem::DirHandle;
    use Net::FTPServer::InMem::FileHandle;
    use Data::Dumper;
    use vars qw(%dirs %files);

    our @ISA = qw(Net::FTPServer::InMem::DirHandle);

    sub get {
        my $self = shift;
        my $filename = shift;
        warn $filename;
        if ($filename eq 'images') {
            return new Net::FTPServer::Full::DirHandle($self->{ftps}, 
+$self->{ftps}->config("image directory"));
        } elsif ($filename eq 'atrex') {
            return new Net::FTPServer::Atrex::DirHandle($self->{ftps},
+ $self->{ftps}->config("import directory"));
        }
        return $self->SUPER::get($filename);
    }
}

{
    package Net::FTPServer::Opencart;

    use strict;
    use warnings;

    use Cwd;
    use File::Slurp;
    use Digest::MD5 qw(md5_hex);
    use Net::FTPServer::InMem::Server;
    use Net::FTPServer::InMem::DirHandle;
    use Net::FTPServer::InMem::FileHandle;
    use Data::Dumper;

    our @ISA = qw(Net::FTPServer::InMem::Server);

    sub post_configuration_hook {
        my $self = shift;
        if (my $external_ip = $self->config("external ip")) {
            my $subname = "_PASV_command";
            $self->{command_table}{PASV} = \&$subname;
            $external_ip =~ s/\./\,/g;
            $self->{external_ip} = $external_ip;
        }
    }

    sub authentication_hook {
        my $self = shift;
        my $username = shift;
        my $password = shift;
        my $user_is_anon = shift;

        # Deny anonymous access.
        return -1 if $user_is_anon;

        # Verify access against our config username/password combinati
+ons.
        return 0 if $username eq $self->config("username") && md5_hex(
+$password) eq $self->config("password");

        # Unsuccessful login.
        return -1;
    }

    sub user_login_hook {
    }

    sub root_directory_hook {
        my $self = shift;
        if (!$self->{__root_directory}) {
            my $root = $self->{__root_directory} = Net::FTPServer::Vir
+tual::DirHandle->new($self);
            $root->mkdir('atrex');
            $root->mkdir('images');
            $root->mkdir('includes');
            my $includes = $root->get('includes');
            if (my $handle = $includes->open("version.php", "w")) {
                my $content = <<'CONTENT';
...
CONTENT

                $handle->print($content);
                close($handle);
            }

            if (my $handle = $includes->open("configure.php", "w")) {
                my $content = <<'CONTENT';
...
CONTENT

                $content =~ s/_HTTP_SERVER_/$self->config("catalog url
+")/e;
                $handle->print($content);
                close($handle);
            }
        }
        return $self->{__root_directory};
    }

    sub _PASV_command {
        no warnings qw(redefine);

        my $self = shift;
        my $cmd = shift;
        my $rest = shift;
        my $reply = \&Net::FTPServer::reply;
        local *Net::FTPServer::reply = sub {
            my $self = shift;
            my $code = shift;
            my $message = shift;
            $message =~ s/\d+,\d+,\d+,\d+(,\d+,\d+)/$self->{external_i
+p}$1/;
            $reply->($self, $code, $message);
        };
        $self->SUPER::_PASV_command($cmd, $rest);
    }
}

{
    package main;

    use strict;
    use warnings;


    my $ftpd =  Net::FTPServer::Opencart->run();
}
[download]