API tools faq
paste
Advertisement
Guest User

Untitled

a guest
May 16th, 2017
83
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 35.37 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl -w
  2.  
  3. package FTP::Connection;
  4.  
  5. use strict;
  6. use warnings;
  7.  
  8. use IO::Handle;
  9. use IO::Select;
  10. use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
  11. use Net::SSLeay::Handle;
  12. use Socket;
  13. use IO::Socket::INET;
  14. use Acme::Damn; #needed to change IO::Socket::INET sockets to GLOBs that Net::SSLeay::Handle can understand
  15.  
  16. use Time::HiRes qw(time sleep);
  17. use File::Basename;
  18. use Encode;
  19. use Data::Dumper;
  20.  
  21. my $ftps = 0;
  22.  
  23. sub new {
  24.     my $class = shift;
  25.  
  26.     my %params = @_;
  27.     my $self = {
  28.         #default settings
  29.         name             => 'ftp' . $ftps++,
  30.         debug            => 0,
  31.         encrypt_data     => undef,
  32.         encrypt_fxp      => 0, #turn this off by default as many ftp servers don't implement this in a sane way
  33.         encrypted        => undef,
  34.         passive          => 1,
  35.         default_dir      => '/',
  36.         local_addr       => undef,
  37.         port_range       => [20000,21000],
  38.         override_pasv_ip => 1,
  39.         #user-supplied settings
  40.         host             => undef,
  41.         port             => 21,
  42.         user             => undef,
  43.         pass             => undef,
  44.         %params,
  45.         #non-overridable settings
  46.         handle           => undef,
  47.         handle_encrypted => undef,
  48.         orig_handle      => undef,
  49.         lasterror        => undef,
  50.         feats            => undef,
  51.         current_dir      => undef,
  52.  
  53.     };
  54.     bless($self, $class);
  55.  
  56.     if (not defined $self->{'host'}) { $self->debug(0,"Could not create $class: no host set."); return undef; }
  57.     if (not defined $self->{'user'}) { $self->debug(0,"Could not create $class: no user set."); return undef; }
  58.  
  59.     $self->debug(5, "Created object:\n" . Dumper($self));
  60.  
  61.     if ($self->__connect()) { return $self; }
  62.    
  63.     return undef;
  64. }
  65.  
  66. # NLST
  67. # LIST
  68. # MLSD
  69.  
  70. sub list {
  71.     my $self   = shift;
  72.     my $dir    = shift;
  73.     my %params = @_;
  74.     my ($code, $msg, $longmsg);
  75.     my %options = (
  76.         full => 0,
  77.         utf8 => 0,
  78.         %params,
  79.     );
  80.  
  81.     $self->__connect();
  82.  
  83.     $self->debug(5,"Getting LIST.");
  84.  
  85.     if ($self->__check_feats('UTF8')) {
  86.         $self->debug(5,"Setting UTF8 mode.");
  87.         ($code) = $self->get_reply('OPTS UTF8 ON');
  88.         if ($code == 200) {
  89.             $options{'utf8'} = 1;
  90.         }
  91.     }
  92.     else { $self->debug(5,"Server does not support UTF8 mode."); }
  93.  
  94.     $self->debug(5,"Checking directory.");
  95.     if (!$self->__change_dir($dir)) { return undef; }
  96.  
  97.     $self->debug(5,"Setting up data connection.");
  98.     my $data = $self->__setup_data();
  99.     if (not defined $data) { return undef; }
  100.     $data->{'utf8'} = $options{'utf8'};
  101.  
  102.     $self->debug(5,"Setting transfer options.");
  103.     $self->get_reply('REST 0');
  104.     $self->get_reply('TYPE A');
  105.     $self->get_reply('LIST');
  106.     #$self->get_reply('NLST');
  107.  
  108.     $self->debug(5,"Getting actual LIST data.");
  109.     my $start = time;
  110.     my $files = $self->__get_data($data);
  111.     my $size  = length($$files);
  112.     my $speed = $self->__calculate_speed($start,$size);
  113.     $self->get_reply();
  114.     $self->debug(5,"Got $size bytes @ $speed b/s.");
  115.  
  116.     my @list = $self->__parse_files($files,\%options);
  117.  
  118.     return @list;
  119. }
  120.  
  121. sub nlst {
  122.     my $self   = shift;
  123.     my $dir    = shift;
  124.     my %params = @_;
  125.     my ($code, $msg, $longmsg);
  126.     my %options = (
  127.         full => 0,
  128.         utf8 => 0,
  129.         %params,
  130.     );
  131.  
  132.     $self->__connect();
  133.  
  134.     $self->debug(5,"Getting LIST.");
  135.  
  136.     if ($self->__check_feats('UTF8')) {
  137.         $self->debug(5,"Setting UTF8 mode.");
  138.         ($code) = $self->get_reply('OPTS UTF8 ON');
  139.         if ($code == 200) {
  140.             $options{'utf8'} = 1;
  141.         }
  142.     }
  143.     else { $self->debug(5,"Server does not support UTF8 mode."); }
  144.  
  145.     $self->debug(5,"Checking directory.");
  146.     if (!$self->__change_dir($dir)) { return undef; }
  147.  
  148.     $self->debug(5,"Setting up data connection.");
  149.     my $data = $self->__setup_data();
  150.     if (not defined $data) { return undef; }
  151.     $data->{'utf8'} = $options{'utf8'};
  152.  
  153.     $self->debug(5,"Setting transfer options.");
  154.     $self->get_reply('REST 0');
  155.     $self->get_reply('TYPE A');
  156.     #$self->get_reply('LIST');
  157.     $self->get_reply('NLST');
  158.  
  159.     $self->debug(5,"Getting actual LIST data.");
  160.     my $start = time;
  161.     my $files = $self->__get_data($data);
  162.     my $size  = length($$files);
  163.     my $speed = $self->__calculate_speed($start,$size);
  164.     $self->get_reply();
  165.     $self->debug(5,"Got $size bytes @ $speed b/s.");
  166.  
  167.     $files = $$files;
  168.     #$files =~ s/\r//g;
  169.     my @files = split(/\r\n/,$files);
  170.     return @files;
  171. }
  172.  
  173. sub get {
  174.     my $self        = shift;
  175.     my $rfile       = shift;
  176.     my ($dir,$file) = $self->__separate_dir_and_fn($rfile);
  177.     if ($file eq "") { die "Could not get filename from $rfile."; }
  178.     my $lfile       = shift;
  179.     if ((not defined $lfile) || ($lfile eq "")) { $lfile = $file; }
  180.     my %params      = @_;
  181.     my ($code, $msg, $longmsg);
  182.     my %options     = (
  183.         resume => 0,
  184.         %params,
  185.     );
  186.  
  187.     $self->__connect();
  188.  
  189.     $self->debug(5,"Getting $rfile -> $lfile.");
  190.  
  191.     if ($self->__check_feats('UTF8')) {
  192.         $self->debug(5,"Setting UTF8 mode.");
  193.         ($code) = $self->get_reply('OPTS UTF8 ON');
  194.         if ($code == 200) { $options{'utf8'} = 1; }
  195.     }
  196.  
  197.     $self->debug(5,"Checking directory.");
  198.     if (!$self->__change_dir($dir)) { return undef; }
  199.  
  200.     my $fh;
  201.     if (!open($fh, ">$lfile")) {
  202.         $self->debug(0,"Could not open $lfile for writing: $!");
  203.         return undef;
  204.     }
  205.     binmode $fh;
  206.  
  207.     $self->debug(5,"Setting up data connection.");
  208.     my $data = $self->__setup_data($fh);
  209.     if (not defined $data) {
  210.         close $fh;
  211.         return undef;
  212.     }
  213.  
  214.     $self->debug(5,"Setting transfer options.");
  215.     $self->get_reply('TYPE I');
  216.     ($code) = $self->get_reply('REST ' . $options{'resume'});
  217.     if ($code == 350) {
  218.         seek $fh, $options{'resume'}, 0;
  219.     }
  220.     $self->get_reply("RETR $file");
  221.  
  222.     my $start = time;
  223.     my $size = $self->__get_data($data);
  224.     close $fh;
  225.     if (not defined $size) {
  226.         $self->debug(0,"Could not save $lfile.");
  227.         return 0;
  228.     }
  229.     my $speed = $self->__calculate_speed($start, $size);
  230.     $self->debug(0,"Saved $lfile [$size bytes @ $speed b/s].");
  231.     return $size;
  232. }
  233.  
  234. sub put {
  235.     my $self         = shift;
  236.     my $lfile        = shift;
  237.     my $lfile_name   = fileparse($lfile);
  238.     my $rfile        = shift;
  239.     my ($dir, $file) = $self->__separate_dir_and_fn($rfile);
  240.     if ($file eq "") { $file = $lfile_name; }
  241.     if ($dir  eq "") { die "Could not get directory from $rfile."; }
  242.     my %params  = @_;
  243.     my ($code, $msg, $longmsg);
  244.     my %options = (
  245.         resume => 0,
  246.         %params,
  247.     );
  248.  
  249.     $self->debug(0,"Putting $lfile to server as $file in $dir.");
  250.  
  251.     if ($self->__check_feats('UTF8')) {
  252.         $self->debug(5,"Setting UTF8 mode.");
  253.         ($code) = $self->get_reply('OPTS UTF8 ON');
  254.         if ($code == 200) { $options{'utf8'} = 1; }
  255.     }
  256.  
  257.     $self->debug(5,"Checking directory.");
  258.     if (!$self->__change_dir($dir)) {
  259.         $self->__make_dir($dir) or return undef;
  260.     }
  261.  
  262.     my $fh;
  263.     if (!open($fh, "<$lfile")) {
  264.         return $self->debug(0,"Could not open $lfile for reading: $!");
  265.     }
  266.     binmode $fh;
  267.  
  268.     $self->debug(5,"Setting up data connection.");
  269.     my $data = $self->__setup_data($fh);
  270.     if (not defined $data) {
  271.         close $fh;
  272.         return undef;
  273.     }
  274.  
  275.     $self->debug(5,"Setting transfer options.");
  276.     $self->get_reply('TYPE I');
  277.     ($code) = $self->get_reply('REST ' . $options{'resume'});
  278.     if ($code == 350) {
  279.         seek $fh, $options{'resume'}, 0;
  280.     }
  281.     ($code, $msg) = $self->get_reply("STOR $file");
  282.     if (($code != 110) && ($code != 125) && ($code != 150)) {
  283.         return $self->debug(0,"Could not transfer $lfile_name: $code $msg.");
  284.     }
  285.  
  286.     my $start = time;
  287.     my $size = $self->__put_data($data);
  288.     close $fh;
  289.     if (not defined $size) {
  290.         return $self->debug(0,"Could not transfer $lfile_name.");
  291.     }
  292.     $self->get_reply();
  293.     my $speed = $self->__calculate_speed($start, $size);
  294.     $self->debug(0,"Uploaded $file [$size bytes @ $speed b/s].");
  295.     return $size;
  296. }
  297.  
  298. sub rename {
  299.     my $self = shift;
  300.     my $from = shift;
  301.     my $to   = shift;
  302.    
  303.     my ($code, $msg, $longmsg) = $self->get_reply("RNFR $from");
  304.     if ($code == 350) {
  305.         ($code) = $self->get_reply("RNTO $to");
  306.         if ($code == 250) {
  307.             return 1;
  308.         }
  309.         return 0;
  310.     }
  311.     return 0;
  312. }
  313.  
  314. sub fxp {
  315.     my $self           = shift;
  316.     my $origin         = $self;
  317.     my $destination    = shift;
  318.     my $ofn            = shift;
  319.     my $dfn            = shift;
  320.     my %params         = @_;
  321.     my %options        = (
  322.         resume     => 0,
  323.         %params,
  324.     );
  325.     my ($code, $msg, $longmsg);
  326.     my ($odir, $ofile) = $origin->__separate_dir_and_fn($ofn);
  327.     if ($ofile eq "") { $self->debug(0,"FXP transfer failed. Could not determine origin filename from\n$ofn."); return undef; }
  328.     my ($ddir, $dfile) = $destination->__separate_dir_and_fn($dfn);
  329.  
  330.     if ($dfile eq "") { $dfile = $ofile; }
  331.     if ($dfile eq "") {
  332.         $self->debug(0,"FXP transfer failed. Could not determine destination filename from either\n$ofn or\n$dfn.");
  333.         return undef;
  334.     }
  335.  
  336.     $self->debug(3,"Setting up FXP transfers...");
  337.  
  338.     my $fxp = {
  339.         origin => {
  340.             serv    => $origin,
  341.             passive => undef,
  342.             port    => undef,
  343.             encrypt => undef,
  344.         },
  345.         destination => {
  346.             serv    => $destination,
  347.             passive => undef,
  348.             port    => undef,
  349.             encrypt => undef,
  350.         },
  351.         encryption => $origin->{'encrypt_fxp'} || $destination->{'encrypt_fxp'},
  352.     };
  353.     if (($fxp->{'encryption'}) && ((!$origin->{'handle_encrypted'}) || (!$destination->{'handle_encrypted'}))) {
  354.         return $self->debug(0,"Secure FXP requested, but not all ftp connections are encrypted. Aborting.");
  355.     }
  356.  
  357.     #verify filename
  358.     my @files;
  359.     (@files = $origin->nlst($odir) and ($ofile ~~ @files)) or return $self->debug(0,"File not found. Aborting FXP.\n@files\n$ofile");
  360.  
  361.     my ($passive, $port, $pasv, $encryption_status);
  362.     my $bootstrap = 0;
  363.     BOOTSTRAP: {
  364.         if (!$origin->__change_dir($odir)) { return undef; }
  365.         if (!$destination->__change_dir($ddir)) { $destination->__make_dir($ddir) or return undef; }
  366.         $encryption_status = $self->__setup_fxp_encryption($fxp);
  367.         if (($encryption_status == -1) || (($fxp->{'encryption'}) && ($encryption_status == 0))) {
  368.             return $self->debug(0,"FXP transfer needs encryption, but it is not supported on both servers."); }
  369.         $origin->get_reply('TYPE I'); $destination->get_reply('TYPE I');
  370.         ($code) = $origin->get_reply('REST ' . $options{'resume'});
  371.         if ($code != 350) { return $self->debug(0,"Could not resume FXP. Aborting."); }
  372.         ($code) = $destination->get_reply('REST ' . $options{'resume'});
  373.         if ($code != 350) { return $self->debug(0,"Could not resume FXP. Aborting."); }
  374.     }
  375.     if ((!$bootstrap) && ($self->__setup_fxp_passive($fxp))) {
  376.         $self->debug(0,"Normal PASV/PORT setup."); }
  377.     elsif (($bootstrap) && (not defined $fxp->{'destination'}->{'passive'}) && ($self->__setup_fxp_passive($fxp,$destination))) {
  378.         $self->debug(0,"Bootstrap PASV/PORT setup."); }
  379.     else { return $self->debug(0,"Could not set up passive connection on either server. Aborting."); }
  380.  
  381.     $passive = defined $fxp->{'origin'}->{'passive'} ? $fxp->{'origin'}->{'passive'} : $fxp->{'destination'}->{'passive'};
  382.     $port    = defined $fxp->{'origin'}->{'passive'} ? $destination : $origin;
  383.     $pasv    = $port eq $origin ? $destination : $origin;
  384.     ($code, $msg) = $port->get_reply("PORT $passive");
  385.     if ($code != 200) { return $self->debug(0,"Fatal error, could not issue PORT command."); }
  386.  
  387.     $origin->__write("RETR $ofile");
  388.     $destination->__write("STOR $dfile");
  389.     ($code, $msg) = $port->get_reply();
  390.  
  391.     if ((!$bootstrap) && (($code == 425) || ($code == 426))) {
  392.         #connection problems, try changing who is passive.
  393.         $self->debug(0,"Remote server could not connect to passive server. Trying to switch.");
  394.         $pasv->__write('ABOR');
  395.         $pasv->__write('QUIT');
  396.         $pasv->{'handle'}->close();
  397.         $pasv->{'handle'} = undef;
  398.         $pasv->{'orig_handle'}->close if defined $pasv->{'orig_handle'};
  399.         $pasv->{'orig_handle'} = undef;
  400.         #$self->__fxp_passive_connect($fxp);
  401.  
  402.         $bootstrap = 1;
  403.         goto BOOTSTRAP;
  404.     }
  405.  
  406.     if (($code != 150) && ($code != 125) && ($code != 110)) {
  407.         my $filename = $port eq $origin ? "transfer $ofile" : "store $dfile";
  408.         $self->debug(0,"A -- Could not $filename: $code $msg. Aborting FXP.");
  409.         # here we must connect to PASV ourselves, or it won't react...
  410.         $pasv->__write('ABOR');
  411.         $pasv->__write('QUIT');
  412.         $pasv->{'handle'}->close();
  413.         $pasv->{'handle'} = undef;
  414.         $pasv->{'orig_handle'}->close if defined $pasv->{'orig_handle'};
  415.         $pasv->{'orig_handle'} = undef;
  416.         #$self->__fxp_passive_connect($fxp);
  417.         if (($encryption_status) && ($fxp->{'encryption_method'} eq 'SSCN')) { $fxp->{'encryption_instigator'}->get_reply('SSCN OFF'); }
  418.         return undef;
  419.     }
  420.     ($code, $msg) = $pasv->get_reply();
  421.     if (($code != 150) && ($code != 125) && ($code != 110)) {
  422.         my $filename = $pasv eq $origin ? "transfer $ofile" : "store $dfile";
  423.         $self->debug(0,"B -- Could not $filename: $code $msg. Aborting FXP.");
  424.         my $data;
  425.         $port->__write('ABOR');
  426.         my $i = 0;
  427.         do { $data = $port->__read(100) || ''; $i++; } until ($data =~ /^225 /m) || ($i > 10) ;
  428.         if ($data !~ /^225 /m) {
  429.             $port->__write('QUIT');
  430.             $port->{'handle'}->close();
  431.             $port->{'handle'} = undef;
  432.             $port->{'orig_handle'}->close if defined $port->{'orig_handle'};
  433.             $port->{'orig_handle'} = undef;
  434.             if (($encryption_status) && ($fxp->{'encryption_method'} eq 'SSCN')) {
  435.                 if ($fxp->{'encryption_instigator'} ne $port) { $fxp->{'encryption_instigator'}->get_reply('SSCN OFF'); }
  436.             }
  437.             return undef;
  438.         }
  439.         if (($encryption_status) && ($fxp->{'encryption_method'} eq 'SSCN')) { $fxp->{'encryption_instigator'}->get_reply('SSCN OFF'); }
  440.         return undef;
  441.     }
  442.     ($code, $msg) = $origin->get_reply();
  443.     if (($code != 226) && ($code != 250)) {
  444.         $self->debug(0,"C -- Could not transfer $ofile: $code $msg. Aborting FXP.");
  445.         $destination->get_reply('ABOR');
  446.         if (($encryption_status) && ($fxp->{'encryption_method'} eq 'SSCN')) { $fxp->{'encryption_instigator'}->get_reply('SSCN OFF'); }
  447.         return undef;
  448.     }
  449.     ($code) = $destination->get_reply();
  450.     if (($code != 226) && ($code != 250)) {
  451.         $self->debug(0,"D -- Could not store $dfile: $code $msg.");
  452.         if (($encryption_status) && ($fxp->{'encryption_method'} eq 'SSCN')) { $fxp->{'encryption_instigator'}->get_reply('SSCN OFF'); }
  453.         return undef;
  454.     }
  455.  
  456.     if (($encryption_status) && ($fxp->{'encryption_method'} eq 'SSCN')) { $fxp->{'encryption_instigator'}->get_reply('SSCN OFF'); }
  457.  
  458.     $self->debug(0,"Transfer complete, I hope :3");
  459.  
  460.     return 1;
  461. }
  462.  
  463. sub __setup_fxp_passive {
  464.     my $self        = shift;
  465.     my $fxp         = shift;
  466.     my $prio        = shift;
  467.     my $origin      = $fxp->{'origin'}->{'serv'};
  468.     my $destination = $fxp->{'destination'}->{'serv'};
  469.     my ($code, $msg);
  470.  
  471.     if (defined $prio) {
  472.         if ((defined $fxp->{'encryption_method'}) && ($fxp->{'encryption_method'} eq 'CPSV')) {
  473.             if (($fxp->{'encryption_instigator'} eq $prio) ||
  474.                (($fxp->{'encryption_instigator'} eq $origin) && ($prio->__check_feats('CPSV')))) #note: this means prio == dest
  475.             {
  476.                 $fxp->{'encryption_instigator'} = $prio;
  477.                 ($code, $msg) = $prio->get_reply('CPSV');
  478.             }
  479.             else { return 0; }
  480.         }
  481.         else {
  482.             ($code, $msg) = $prio->get_reply('PASV');
  483.         }
  484.         if (($code == 227) && ($msg =~ / \((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\) ?$/)) {
  485.             $fxp->{$prio eq $origin ? 'origin' : 'destination'}->{'passive'} = "$1,$2,$3,$4,$5,$6";
  486.             $fxp->{$prio eq $origin ? 'destination' : 'origin'}->{'passive'} = undef;
  487.         }
  488.         else { return 0; }
  489.     }
  490.     elsif ((not defined $fxp->{'origin'}->{'passive'}) && (not defined $fxp->{'destination'}->{'passive'})) {
  491.         if (!$self->__setup_fxp_passive($fxp, $origin)) {
  492.             return $self->__setup_fxp_passive($fxp, $destination);
  493.         }
  494.     }
  495.     return 1;
  496. }
  497.  
  498. sub __fxp_passive_connect {
  499.     my $self    = shift;
  500.     my $fxp     = shift;
  501.     my $pasv    = defined $fxp->{'origin'}->{'passive'} ? $fxp->{'origin'}->{'serv'}    : $fxp->{'destination'}->{'serv'};
  502.     my $passive = defined $fxp->{'origin'}->{'passive'} ? $fxp->{'origin'}->{'passive'} : $fxp->{'destination'}->{'passive'};
  503.     $passive =~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/;
  504.     my $host    = "$1.$2.$3.$4";
  505.     my $port    = $5*256+$6;
  506.     my $data    = '';
  507.  
  508.     $pasv->debug(0,"Connecting to PASV socket ourselves, to stop deadlock: $host:$port.");
  509.     my $handle = IO::Socket::INET->new("$host:$port");
  510.     if (not defined $handle) {
  511.         $pasv->debug(0,"Could not connect to PASV port: $host:$port.");
  512.     }
  513.     elsif (!$handle->opened()) {
  514.         $pasv->debug(0,"Could not open PASV port: $host:$port.");
  515.     }
  516.  
  517.     if (defined $fxp->{'encryption_instigator'}) {
  518.         $pasv->debug(0,"Negotiating SSL/TLS on socket.");
  519.         $handle = $pasv->__sslify($handle);
  520.     }
  521.  
  522.     $pasv->__write('ABOR');
  523.     do { $data = $pasv->__read(100) || ''; } until $data =~ /^225 /m;
  524. }
  525.  
  526. #return codes:
  527. # -1: need encryption, but one server doesn't support it
  528. # 0: neither server demands encryption
  529. # 1: encryption is set up
  530. sub __setup_fxp_encryption {
  531.     my $self        = shift;
  532.     my $fxp         = shift;
  533.     my $origin      = $fxp->{'origin'}->{'serv'};
  534.     my $destination = $fxp->{'destination'}->{'serv'};
  535.     my $method      = undef;
  536.     my $instigator  = undef;
  537.     my ($code, $msg, $longmsg);
  538.  
  539.     if ($origin->__check_feats('SSCN')) {         $method = 'SSCN'; $instigator = $origin; }
  540.     elsif ($destination->__check_feats('SSCN')) { $method = 'SSCN'; $instigator = $destination; }
  541.     elsif ($origin->__check_feats('CPSV')) {      $method = 'CPSV'; $instigator = $origin; }
  542.         elsif ($destination->__check_feats('CPSV')) { $method = 'CPSV'; $instigator = $destination; }
  543.     else {
  544.         #neither can instigate.
  545.         #does one of them *have* to?
  546.         if (($origin->__check_feats('PROT'))      && (!$origin->__fxp_encrypt(0)))      { return -1; } #yes >_<
  547.         if (($destination->__check_feats('PROT')) && (!$destination->__fxp_encrypt(0))) { return -1; } #yes >_<
  548.         #no~~
  549.         return 0;
  550.     }
  551.     if ($origin->__check_feats('PROT') && $origin->__fxp_encrypt(1)) {
  552.         if (!$destination->__check_feats('PROT')) {
  553.             #both can = NO
  554.             if ($origin->__fxp_encrypt(0)) { return 0; }
  555.             else { return -1; } #one has to >_<
  556.         }
  557.         elsif (!$destination->__fxp_encrypt(1)) {
  558.             #both can = NO
  559.             $destination->__fxp_encrypt(0);
  560.             if ($origin->__fxp_encrypt(0)) { return 0; }
  561.             else { return -1; } #one has to >_<
  562.         }
  563.     }
  564.         elsif ($destination->__check_feats('PROT')) {
  565.         #both can = NO
  566.         if ($destination->__fxp_encrypt(0)) { return 0; }
  567.         else { return -1; } #one has to >_<
  568.     }
  569.     else { return 0; }
  570.  
  571.     $fxp->{'encryption_instigator'} = $instigator;
  572.     $fxp->{'encryption_method'} = $method;
  573.     if ($method eq 'SSCN') {
  574.         ($code) = $instigator->get_reply('SSCN ON');
  575.         if ($code == 200) { return 1; }
  576.         else { return -1; } # one thinks it can, but it actually can't >_<
  577.     }
  578.     return 1;
  579. }
  580.  
  581. sub __fxp_encrypt {
  582.     my $self    = shift;
  583.     my $encrypt = shift;
  584.     my ($code);
  585.     if ($encrypt) {
  586.         ($code) = $self->get_reply('PROT P');
  587.     }
  588.     else {
  589.         ($code) = $self->get_reply('PROT C');
  590.     }
  591.     if ($code == 200) { return 1; }
  592.     else { return 0; }
  593. }
  594.  
  595.  
  596.  
  597. sub __separate_dir_and_fn {
  598.     my $self = shift;
  599.     my $spec = shift;
  600.  
  601.     if ($spec =~ /^(.*\/)([^\/]*)?$/) {
  602.         return ($1,$2);
  603.     }
  604. }
  605.  
  606. sub __calculate_speed {
  607.     my $self  = shift;
  608.     my $start = shift;
  609.     my $size  = shift; if (ref $size) { $size = length($$size); }
  610.     my $end   = time;
  611.     my $time  = $end - $start;
  612.  
  613.     return $size/$time;
  614. }
  615.  
  616. sub __parse_files {
  617.     my $self    = shift;
  618.     my $files   = shift;
  619.     my $options = shift;
  620.     my @files   = ();
  621.     my $full    = $options->{'full'};
  622.  
  623.     foreach (split(/\n/,$$files)) {
  624.         s/\r//g;
  625.         if (/^total \d+$/) { next; }
  626.         if ($full) { push @files, $_; }
  627.         else {
  628.             if (/^
  629.                 ([-ldcsp])            #the type
  630.                 ((?:[-r][-w][-x]){3}) #the access control list
  631.                 \s+(\d+)              #the number of links
  632.                 \s+(\S+)              #the user or uid
  633.                 \s+(\S+)              #the group or gid
  634.                 \s+(\d+)              #the size
  635.                 \s+(\S+\s+\S+\s+\S+)  #the date
  636.                 \s+(.+)$              #the actual dir or filename
  637.                 /x) {
  638.                 my $type  = $1;
  639.                 my $acl   = $2;
  640.                 my $links = $3;
  641.                 my $user  = $4;
  642.                 my $group = $5;
  643.                 my $size  = $6;
  644.                 my $date  = $7;
  645.                 my $file  = $8;
  646.                 if ($type eq 'l') { $file .= '@'; }
  647.                 if ($type eq 'd') { $file .= '/'; }
  648.                 if ($type eq 'c') { $file .= '#'; }
  649.                 if ($type eq 's') { $file .= '='; }
  650.                 if ($type eq 'p') { $file .= '|'; }
  651.                 push @files, $file;
  652.             }
  653.             else {
  654.                 $self->debug(0,"Could not parse LIST. Unrecognized format.");
  655.                 $self->debug(0,$$files);
  656.                 return undef;
  657.             }
  658.         }
  659.     }
  660.  
  661.     return @files;
  662. }
  663.  
  664. sub __change_dir {
  665.     my $self    = shift;
  666.     my $dir     = shift;
  667.  
  668.     $self->__connect();
  669.     my $old_dir = $self->{'current_dir'};
  670.  
  671.     if ($dir eq $old_dir) { return 1; }
  672.  
  673.     if ($self->__direct_change_dir($dir)) { return 1; }
  674.     if ($self->__direct_change_dir('/')) {
  675.         if ($self->__sequential_change_dir($dir)) { return 1; }
  676.     }
  677.     elsif ($self->__go_up_change_dir($dir)) { return 1; }
  678.  
  679.     $self->debug(0,"Could not change dir to $dir.");
  680.     return 0;
  681. }
  682.  
  683. sub __direct_change_dir {
  684.     my $self = shift;
  685.     my $dir  = shift;
  686.  
  687.     $self->__connect();
  688.  
  689.     my ($code, $msg, $longmsg) = $self->get_reply("CWD $dir");
  690.     if ($code == 250) {
  691.         $self->__set_current_dir();
  692.         return 1;
  693.     }
  694.     return 0;
  695. }
  696.  
  697. sub __sequential_change_dir {
  698.     my $self = shift;
  699.     my $dir  = shift;
  700.     my $switched = 0;
  701.  
  702.     $self->debug(5,"Sequentially changing to $dir.");
  703.     foreach (split(m!/!, $dir)) {
  704.         if ($_ eq "") { next; }
  705.         $switched = 0;
  706.         last unless $self->__go_to_sub_dir($_);
  707.         $switched = 1;
  708.     }
  709.     return $switched;
  710. }
  711.  
  712. sub __go_to_sub_dir {
  713.     my $self = shift;
  714.     my $dir  = shift;
  715.  
  716.     $self->__connect();
  717.  
  718.     my ($code, $msg, $longmsg) = $self->get_reply("CWD $dir");
  719.     if ($code == 250) {
  720.         $self->__set_current_dir();
  721.         return 1;
  722.     }
  723.     return 0;
  724. }
  725.  
  726. sub __go_up_change_dir {
  727.     my $self    = shift;
  728.     my $dir     = shift;
  729.     my $old_dir = $self->{'current_dir'};
  730.     my @new_dir = split(m!/!, $dir);
  731.     my @cur_dir = split(m!/!, $old_dir);
  732.  
  733.     while ($cur_dir[0] eq $new_dir[0]) {
  734.         shift @cur_dir;
  735.         shift @new_dir;
  736.     }
  737.     while (@cur_dir) {
  738.         if ($self->__go_up_dir()) { shift @cur_dir; }
  739.         else { return 0; }
  740.     }
  741.  
  742.     my $switched = 0;
  743.     foreach (@new_dir) {
  744.         $switched = 0;
  745.         last unless $self->__go_to_sub_dir($_);
  746.         $switched = 1;
  747.     }
  748.     return $switched;
  749. }
  750.  
  751. sub __go_up_dir {
  752.     my $self = shift;
  753.  
  754.     $self->__connect();
  755.  
  756.     my ($code) = $self->get_reply("CDUP");
  757.     if ($code == 200) {
  758.         $self->__set_current_dir();
  759.         return 1;
  760.     }
  761.  
  762.     $self->debug(0,"Could not go up to parent directory.");
  763.     return 0;
  764. }
  765.  
  766. sub __make_dir {
  767.     my $self     = shift;
  768.     my $dir      = shift;
  769.     my $cur_dir  = $self->{'current_dir'};
  770.     my @cur_dir  = split(/\//, $cur_dir);
  771.     my @want_dir = split(/\//, $dir);
  772.  
  773.     while ((@cur_dir && @want_dir) && ($cur_dir[0] eq $want_dir[0])) { shift @cur_dir; shift @want_dir; }
  774.  
  775.     while (@cur_dir) {
  776.         if ($self->__go_up_dir()) { shift @cur_dir; }
  777.         else { return 0; }
  778.     }
  779.  
  780.     foreach (@want_dir) {
  781.         if (!$self->__go_to_sub_dir($_)) {
  782.             my ($code, $msg) = $self->get_reply("MKD $_");
  783.             if ($code == 257) { $self->debug(0,"Created directory: " . $self->{'current_dir'} . "$dir."); }
  784.             else {
  785.                 $self->debug(0,"Could not create directory: " . $self->{'current_dir'} . "$dir:\n$code $msg");
  786.                 return 0;
  787.             }
  788.             $self->__go_to_sub_dir($_) or return 0;
  789.         }
  790.     }
  791.  
  792.     if ($self->{'current_dir'} eq $dir) { return 1; }
  793.     elsif (($self->{'current_dir'} . '/') eq $dir) { return 1; }
  794.     else { return 0; }
  795. }
  796.  
  797. sub debug {
  798.     my $self   = shift;
  799.     my $level  = shift;
  800.     my $msg    = shift;
  801.     my $name   = $self->{'name'};
  802.     my @caller = caller(1);
  803.     my $caller = $caller[3];
  804.  
  805.     if ($level <= $self->{'debug'}) {
  806.         #FTP::Connection::__socket_start_tls: == 35
  807.         foreach my $line (split(/\n/,$msg)) { warn sprintf("DEBUG [%d] - %-35s :[%s] %s\n",$level,$caller,$name,$line); }
  808.     }
  809.     return undef;
  810. }
  811.  
  812. sub __connect {
  813.     my $self = shift;
  814.  
  815.     if (defined $self->{'handle'}) {
  816.         my $socket = $self->{'handle'};
  817.         if ($socket->opened()) { return 1; }
  818.         else {
  819.             $self->debug(0,"Found stale socket. Will reconnect...");
  820.             $self->{'handle'} = undef;
  821.             undef $socket;
  822.         }
  823.     }
  824.  
  825.     my $host = $self->{'host'};
  826.     my $port = $self->{'port'};
  827.     my $status = $self->__get_socket($host,$port);
  828.  
  829.     if ($status == 2) { $self->debug(0,"Connected with SSL to $host:$port."); }
  830.     elsif ($status == 1) { $self->debug(0,"Connected without encryption to $host:$port."); }
  831.     else { return $self->debug(1,"Could not connect to $host:$port."); }
  832.     $self->{'handle_encrypted'} = $status == 2 ? 1 : 0;
  833.  
  834.     # Authenticating
  835.     if ($self->__authenticate()) { $self->debug(0,"Authenticated successfully."); }
  836.     else { return $self->debug(0,"Could not authenticate successfully."); }
  837.  
  838.     # Checking feats
  839.     $self->__check_feats();
  840.     my ($code,$msg) = $self->get_reply('REST 0');
  841.     if ($code == 350) { $self->__add_feat("REST"); }
  842.  
  843.     # Getting current dir. Sometimes servers will put you in weird places from the start.
  844.     $self->__set_current_dir();
  845.     return 1;
  846. }
  847.  
  848. sub __set_current_dir {
  849.     my $self = shift;
  850.  
  851.     my ($code, $msg) = $self->get_reply('PWD');
  852.     if ($code == 257) {
  853.         $msg =~ /^\"(\/.*)\"( |$)/;
  854.         my $dir = $1;
  855.         $dir =~ s/""/"/g;
  856.         if ($dir !~ /\/$/) { $dir .= '/'; }
  857.         $self->{'current_dir'} = $dir;
  858.         $self->debug(0,"Current dir: $dir");
  859.     }
  860.  
  861. }
  862.  
  863. sub __get_socket {
  864.     my $self = shift;
  865.     my $host = shift;
  866.     my $port = shift;
  867.     my $socket;
  868.  
  869.     $socket = Net::SSLeay::Handle->make_socket($host, $port) or die "Could not connect to $host:$port: $!\n";
  870.  
  871.     if (!$socket->opened()) {
  872.         $self->debug(0,"Could not open socket to $host:$port.");
  873.         return 0;
  874.     }
  875.  
  876.     if (not defined $self->{'local_addr'}) {
  877.         my $localaddr = getsockname($socket);
  878.         my ($local_port, $local_addr) = sockaddr_in($localaddr);
  879.         my $local_ip = inet_ntoa($local_addr);
  880.         $self->{'local_addr'} = $local_ip;
  881.     }
  882.  
  883.     $self->{'handle'} = $socket;
  884.     $self->debug(2,"Local addr: " . $self->{'local_addr'});
  885.     $self->debug(5, "Attempting to read Welcome MSG...");
  886.  
  887.     #read server welcome message...
  888.     my ($code, $msg, $longmsg) = $self->get_reply();
  889.     $self->debug(3, "Welcome MSG:\n$longmsg");
  890.  
  891.     if (defined $self->{'encrypted'} && !$self->{'encrypted'}) { #we should not encrypt our session even if possible
  892.         {select $socket; $| = 1; select STDOUT;}
  893.         return 1;
  894.     }
  895.  
  896.     #we should try to start an encrypted session...
  897.     ($code, $msg, $longmsg) = $self->get_reply("AUTH TLS");
  898.  
  899.     if ($code == 234) {
  900.         $self->__socket_start_tls();
  901.         {select $socket; $| = 1; select STDOUT;}
  902.         $self->get_reply("PBSZ 0");
  903.         return 2;
  904.     }
  905.     elsif ($self->{'encrypted'}) {
  906.         {select $socket; $| = 1; select STDOUT;}
  907.         $self->debug(0,"Desired encrypted session, but server did not support it.");
  908.         die "Could not start encrypted connection.";
  909.         return -1;
  910.     }
  911.     else { # could not get encrypted session, but it was not necessary.
  912.         {select $socket; $| = 1; select STDOUT;}
  913.         return 1;
  914.     }
  915. }
  916.  
  917. sub get_reply {
  918.     my $self = shift;
  919.     my $msg  = shift;
  920.  
  921.     if ((defined $msg) && ($msg ne "")) { $self->__write($msg); }
  922.     my $response = $self->__read();
  923.     if ($response eq '') { sleep 1; $response = $self->__read(); }
  924.  
  925.     my ($code, $longmsg); $msg = "";
  926.     foreach (split(/\n/,$response)) {
  927.         if (/^(\d\d\d)[- ](.*)$/) { $code = $1; $msg = $2; $longmsg .= "\n$msg"; }
  928.         else { $longmsg .= "\n$_"; }
  929.     }
  930.     if (not defined $longmsg) { $longmsg = ""; }
  931.     $longmsg =~ s/^\n//;
  932.     $msg =~ s/\r|\n//g;
  933.  
  934.     return ($code, $msg, $longmsg);
  935. }
  936.  
  937. sub __read {
  938.     my $self    = shift;
  939.     my $timeout = shift;
  940.     my $data    = "";
  941.     my $buf     = "";
  942.     my $socket  = $self->{'handle'};
  943.  
  944.     #$socket->blocking(1);
  945.     #do {
  946.     #   $buf = "";
  947.     #   sysread($socket,$buf,8192);
  948.     #   $socket->blocking(0);
  949.     #   $self->debug(5,"Buffer: $buf");
  950.     #   $data .= $buf;
  951.     #} until $buf eq "";
  952.    
  953.     if ($timeout) {
  954.         $socket->blocking(0);
  955.         $socket->autoflush(1);
  956.         $timeout = $timeout / 1000;
  957.  
  958.         my $s = IO::Select->new();
  959.         $s->add($socket);
  960.         my @ready = $s->can_read($timeout);
  961.  
  962.         if (@ready) {
  963.             $socket->sysread($data,8192);
  964.             $self->debug(5,"##> $data");
  965.         }
  966.         else { $self->debug(5,"!!> No data read."); }
  967.         $socket->blocking(1);
  968.         return $data;
  969.     }
  970.  
  971.  
  972.     while ($buf = <$socket>) { # seems that SSLeay can't handle nonblocking IO well
  973.         $self->debug(5,"--> $buf");
  974.         $data .= $buf;
  975.         if ($data =~ /(^|\n)\d\d\d [^\n]*\n$/) { last; }
  976.     }
  977.  
  978.     return $data;
  979. }
  980.  
  981.  
  982. sub __write {
  983.     my $self = shift;
  984.     my $msg = shift;
  985.     my $socket = $self->{'handle'};
  986.  
  987.     $self->debug(5,"<-- $msg");
  988.     print $socket "$msg\r\n";
  989.     #$socket->print("$msg\r\n");
  990. }
  991.  
  992. sub __socket_start_tls {
  993.     my $self   = shift;
  994.     my $socket = $self->{'handle'};
  995.  
  996.     $self->debug(2,"Negotiating TLS");
  997.     $self->{'handle'} = $self->__sslify($socket);
  998. }
  999.  
  1000. sub __sslify {
  1001.     my $self   = shift;
  1002.     my $socket = shift;
  1003.     $self->{'orig_handle'} = $socket;
  1004.  
  1005.     #$self->debug(5,"Socket type: " . ref $socket);
  1006.     if (ref $socket eq "IO::Socket::INET") {
  1007.         #$socket =~ s/IO::Socket::INET=//;
  1008.         $socket = damn $socket;
  1009.         #my $sock = IO::Handle->new_from_fd($socket,'+<');
  1010.         #$socket = *$sock;
  1011.         #$socket = $socket->fileno();
  1012.         #$self->debug(5,"Socket type: $socket");
  1013.     }
  1014.  
  1015.     my $handle = IO::Handle->new();
  1016.     tie(*$handle, "Net::SSLeay::Handle", $socket);
  1017.     return \*$handle;
  1018. }
  1019.  
  1020. sub __authenticate {
  1021.     my $self = shift;
  1022.     my $user = $self->{'user'};
  1023.     my $pass = $self->{'pass'};
  1024.  
  1025.     my ($code, $msg, $longmsg) = $self->get_reply("USER $user");
  1026.     $self->debug(2,"USER $user -> $code $msg");
  1027.     if ($code == 230) { return 1; }
  1028.     elsif ($code == 331) {
  1029.         ($code, $msg, $longmsg) = $self->get_reply("PASS $pass");
  1030.         if ($code ~~ [230,202]) { return 1; }
  1031.     }
  1032.     $self->debug(0,"Could not login!\n$code $longmsg");
  1033.     return 0;
  1034. }
  1035.  
  1036. sub __check_feats {
  1037.     my $self = shift;
  1038.     my $feat = shift;
  1039.  
  1040.     if (defined $feat) {
  1041.         foreach (@{$self->{'feats'}}) {
  1042.             if (/$feat/) { return 1; }
  1043.         }
  1044.         return 0;
  1045.     }
  1046.     else {
  1047.         #if (defined $self->{'feats'}) { return 0; } # FEATs already added.
  1048.  
  1049.         my ($code, $msg, $longmsg) = $self->get_reply("FEAT");
  1050.         $self->debug(3,"FEATS =>\n$longmsg");
  1051.         my @feats = ();
  1052.         if ($code == 211) {
  1053.             foreach (split(/\n/,$longmsg)) {
  1054.                 if (/^ (.*)$/) { push @feats, $1; }
  1055.             }
  1056.         }
  1057.         $self->{'feats'} = \@feats;
  1058.         return scalar(@feats);
  1059.     }
  1060. }
  1061.  
  1062. sub __add_feat {
  1063.     my $self  = shift;
  1064.     my $feat  = shift;
  1065.     my @feats = @{$self->{'feats'}};
  1066.  
  1067.     foreach (@feats) { if ($feat eq $_) { return 0; }}
  1068.     push @feats, $feat;
  1069.     $self->debug(3,"This server supports $feat.");
  1070.     $self->{'feats'} = \@feats;
  1071.     return 1;
  1072. }
  1073.  
  1074. sub __setup_data {
  1075.     my $self = shift;
  1076.     my $file = shift;
  1077.     my ($code, $msg, $longmsg);
  1078.     my $data = {
  1079.         passive   => undef,
  1080.         addr      => undef,
  1081.         port      => undef,
  1082.         encrypted => 0,
  1083.         socket    => undef,
  1084.         file      => $file,
  1085.         utf8      => 0,
  1086.     };
  1087.  
  1088.     if ($self->{'encrypted_data'}) {
  1089.         if ($self->{'handle_encrypted'}) {
  1090.             $self->setup_data_enc($data);
  1091.         }
  1092.         else {
  1093.             $self->debug(0,"Control socket not encrypted. Could not set up data encryption even though encrypt_data was set to 1.");
  1094.             return undef;
  1095.         }
  1096.         if (!$data->{'encrypted'}) {
  1097.             $self->debug(0,"Server does not support encrypted data transfers and encrypt_data was set to 1.");
  1098.             return undef;
  1099.         }
  1100.     }
  1101.     elsif ($self->{'handle_encrypted'}) {
  1102.         if (defined $self->{'encripted_data'} && !$self->{'encrypted_data'}) {
  1103.             $self->__setup_data_clear($data);
  1104.         }
  1105.         else {
  1106.             $self->__setup_data_enc($data);
  1107.         }
  1108.     }
  1109.     if ($data->{'encrypted'}) {
  1110.         $self->debug(3,"Data connection is encrypted.");
  1111.     }
  1112.     else {
  1113.         $self->debug(3,"Data connection is unencrypted.");
  1114.     }
  1115.  
  1116.     if ($self->{'passive'}) {
  1117.         $self->__setup_data_passive($data);
  1118.     }
  1119.     if (!$data->{'passive'}) {
  1120.         $self->__setup_data_port($data);
  1121.     }
  1122.  
  1123.     return $data;
  1124. }
  1125.  
  1126. sub __setup_data_enc {
  1127.     my $self = shift;
  1128.     my $data = shift;
  1129.  
  1130.     my ($code, $msg, $longmsg) = $self->get_reply('PROT P');
  1131.     if ($code == 200) { $data->{'encrypted'} = 1; }
  1132. }
  1133.  
  1134. sub __setup_data_clear {
  1135.     my $self = shift;
  1136.     my $data = shift;
  1137.  
  1138.     my ($code, $msg, $longmsg) = $self->get_reply('PROT C');
  1139.     if ($code != 200) { $self->__setup_data_enc($data); }
  1140. }
  1141.  
  1142. sub __setup_data_passive {
  1143.     my $self = shift;
  1144.     my $data = shift;
  1145.  
  1146.     #DEBUG [5] - FTP::Connection::__write            : Writing: PASV
  1147.     #DEBUG [5] - FTP::Connection::__read             : Buffer: 227 Entering Passive Mode (192,168,0,226,167,53)
  1148.     #DEBUG [0] - FTP::Connection::__setup_data_passive : Error connecting passively. Not supported by server.
  1149.  
  1150.     my ($code, $msg, $longmsg) = $self->get_reply('PASV');
  1151.     $self->debug(5,"Code: $code Msg: $msg");
  1152.     if (($code == 227) && ($msg =~ / \((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)$/)) {
  1153.         my $host = "$1.$2.$3.$4";
  1154.         my $port = $5*256+$6;
  1155.         $data->{'addr'} = $host;
  1156.         $data->{'port'} = $port;
  1157.         $self->__setup_data_connect($data);
  1158.     }
  1159.     else {
  1160.         $self->debug(0,"Error connecting passively. Not supported by server.");
  1161.     }
  1162. }
  1163.  
  1164. sub __setup_data_connect {
  1165.     my $self = shift;
  1166.     my $data = shift;
  1167.     my $host = $data->{'addr'};
  1168.     my $port = $data->{'port'};
  1169.  
  1170.     $self->debug(3,"Connecting data socket to $host:$port.");
  1171.     my $socket = Net::SSLeay::Handle->make_socket($host, $port);
  1172.     if (!$socket->opened()) {
  1173.         $self->debug(0,"Could not connect passively to $host:$port.");
  1174.         $data->{'passive'} = 0;
  1175.         return;
  1176.     }
  1177.     $self->debug(1,"Passive data socket connected to $host:$port.");
  1178.  
  1179.     #if ($data->{'encrypted'}) {
  1180.     #   $self->debug(3,"Negotiating TLS on data connection.");
  1181.     #   $socket = __sslify($socket);
  1182.     #}
  1183.  
  1184.     $data->{'socket'} = $socket;
  1185.     $data->{'passive'} = 1;
  1186. }
  1187.  
  1188. sub __setup_data_port {
  1189.     my $self = shift;
  1190.     my $data = shift;
  1191.     my $ip   = $self->{'local_addr'};
  1192.     my $port = $self->__setup_data_port_rnd();
  1193.  
  1194.     my $socket = IO::Socket::INET->new(
  1195.         Proto => 'tcp',
  1196.         Listen => 1,
  1197.         LocalHost => $ip,
  1198.         LocalPort => $port,
  1199.     );
  1200.     $self->debug(1,"Opening listening PORT on $ip:$port.");
  1201.  
  1202.     $ip =~ /(\d+).(\d+).(\d+).(\d+)/;
  1203.     my $ftp_ip = "$1,$2,$3,$4";
  1204.     my $ftp_port = int($port/256).",".$port%256;
  1205.     my ($code, $msg, $longmsg) = $self->get_reply("PORT $ftp_ip,$ftp_port");
  1206.  
  1207.     #if ($data->{'encrypted'}) {
  1208.     #   $self->debug(3,"Negotiating TLS on data connection.");
  1209.     #   $socket = __sslify($socket);
  1210.     #}
  1211.  
  1212.     $data->{'socket'} = $socket;
  1213. }
  1214.  
  1215. sub __setup_data_port_rnd {
  1216.     my $self = shift;
  1217.     my $lower = $self->{'port_range'}->[0];
  1218.     my $upper = $self->{'port_range'}->[1];
  1219.     my $range = $upper - $lower + 1;
  1220.  
  1221.     return int(rand($range)) + $lower;
  1222. }
  1223.  
  1224. sub __get_data {
  1225.     my $self   = shift;
  1226.     my $data   = shift;
  1227.     my $file   = $data->{'file'};
  1228.     my $socket = $data->{'socket'};
  1229.  
  1230.     if (!$data->{'passive'}) { #should we accept even earlier?
  1231.         my $new_socket = $socket->accept();
  1232.         $socket->close();
  1233.         $data->{'socket'} = $new_socket;
  1234.         $socket = $new_socket;
  1235.     }
  1236.  
  1237.     if ($data->{'encrypted'}) {
  1238.         $self->debug(3,"Negotiating TLS on data connection.");
  1239.         $socket = $self->__sslify($socket);
  1240.         $data->{'socket'} = $socket;
  1241.     }
  1242.  
  1243.     my $retr = "";
  1244.     my $size = 0;
  1245.     my $last_report = 0;
  1246.     my $buf = "";
  1247.     {
  1248.         local $/; #we want to slurp everything
  1249.         while ($buf = <$socket>) {
  1250.             if (defined $file) {
  1251.                 $self->debug(6,"Buffer: " . length($buf) . " bytes recieved.");
  1252.                 print $file $buf;
  1253.                 $size += length($buf);
  1254.                 if ($size > ($last_report+(1024*1024))) {
  1255.                     $self->debug(4,"Buffer: $size");
  1256.                     $last_report = $size;
  1257.                 }
  1258.             }
  1259.             else {
  1260.                 $self->debug(5,"Buffer: " . length($buf) . " bytes recieved.");
  1261.                 $retr .= $buf;
  1262.             }
  1263.         }
  1264.     }
  1265.  
  1266.     #if ($data->{'utf8'}) {
  1267.     #   $self->debug(3,"Converting list to UTF-8");
  1268.     #   $retr = decode("utf-8", $retr);
  1269.     #}
  1270.  
  1271.     return defined $file ? $size : \$retr;
  1272. }
  1273.  
  1274. sub __put_data {
  1275.     my $self   = shift;
  1276.     my $data   = shift;
  1277.     my $file   = $data->{'file'};
  1278.     my $socket = $data->{'socket'};
  1279.  
  1280.     if (!$data->{'passive'}) {
  1281.         my $new_socket = $socket->accept();
  1282.         $socket->close();
  1283.         $data->{'socket'} = $new_socket;
  1284.         $socket = $new_socket;
  1285.     }
  1286.  
  1287.     if ($data->{'encrypted'}) {
  1288.         $self->debug(3,"Negotiating TLS on data connection.");
  1289.         $socket = $self->__sslify($socket);
  1290.         $data->{'socket'} = $socket;
  1291.     }
  1292.  
  1293.     my $buf = "";
  1294.     my $size = 0;
  1295.     my $last_report = 0;
  1296.     while (my $bytes = sysread($file, $buf, 8192)) {
  1297.         print $socket $buf;
  1298.         $size += $bytes;
  1299.         $self->debug(6,"Buffer: $bytes bytes sent.");
  1300.         $buf = "";
  1301.         if ($size > ($last_report+(1024*1024))) {
  1302.             $self->debug(4,"Buffer: $size");
  1303.             $last_report = $size;
  1304.         }
  1305.     }
  1306.     $socket->flush();
  1307.     $socket->close();
  1308.     return $size;
  1309. }
  1310.  
  1311. 1;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!