view release on metacpan or  search on metacpan

inc/Net/FTP.pm  view on Meta::CPAN

#line 1
# Net::FTP.pm
#
# Versions up to 2.77_2 Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>.
# All rights reserved.
# Changes in Version 2.77_3 onwards Copyright (C) 2013-2015 Steve Hay.  All
# rights reserved.
# This module is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself, i.e. under the terms of either the GNU General
# Public License or the Artistic License, as specified in the F<LICENCE> file.
#
# Documentation (at end) improved 1996 by Nathan Torkington <gnat@frii.com>.

package Net::FTP;

use 5.008001;

use strict;
use warnings;

use Carp;
use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
use IO::Socket;
use Net::Cmd;
use Net::Config;
use Socket;
use Time::Local;

our $VERSION = '3.10';

our $IOCLASS;
my $family_key;
BEGIN {
  # Code for detecting if we can use SSL
  my $ssl_class = eval {
    require IO::Socket::SSL;
    # first version with default CA on most platforms
    no warnings 'numeric';
    IO::Socket::SSL->VERSION(2.007);
  } && 'IO::Socket::SSL';

  my $nossl_warn = !$ssl_class &&
    'To use SSL please install IO::Socket::SSL with version>=2.007';

  # Code for detecting if we can use IPv6
  my $inet6_class = eval {
    require IO::Socket::IP;
    no warnings 'numeric';
    IO::Socket::IP->VERSION(0.25);
  } && 'IO::Socket::IP' || eval {
    require IO::Socket::INET6;
    no warnings 'numeric';
    IO::Socket::INET6->VERSION(2.62);
  } && 'IO::Socket::INET6';

  sub can_ssl   { $ssl_class };
  sub can_inet6 { $inet6_class };

  $IOCLASS = $ssl_class || $inet6_class || 'IO::Socket::INET';
  $family_key =
    ( $ssl_class ? $ssl_class->can_ipv6 : $inet6_class || '' )
      eq 'IO::Socket::IP'
      ? 'Family' : 'Domain';
}

our @ISA = ('Exporter','Net::Cmd',$IOCLASS);

use constant TELNET_IAC => 255;
use constant TELNET_IP  => 244;
use constant TELNET_DM  => 242;

use constant EBCDIC => $^O eq 'os390';

sub new {
  my $pkg = shift;
  my ($peer, %arg);
  if (@_ % 2) {
    $peer = shift;
    %arg  = @_;
  }
  else {
    %arg  = @_;
    $peer = delete $arg{Host};
  }

  my $host      = $peer;
  my $fire      = undef;
  my $fire_type = undef;

  if (exists($arg{Firewall}) || Net::Config->requires_firewall($peer)) {
         $fire = $arg{Firewall}
      || $ENV{FTP_FIREWALL}
      || $NetConfig{ftp_firewall}
      || undef;

    if (defined $fire) {
      $peer = $fire;
      delete $arg{Port};
           $fire_type = $arg{FirewallType}
        || $ENV{FTP_FIREWALL_TYPE}
        || $NetConfig{firewall_type}
        || undef;
    }
  }

  my %tlsargs;
  if (can_ssl()) {
    # for name verification strip port from domain:port, ipv4:port, [ipv6]:port
    (my $hostname = $host) =~s{(?<!:):\d+$}{};
    %tlsargs = (
      SSL_verifycn_scheme => 'ftp',
      SSL_verifycn_name => $hostname,
      # use SNI if supported by IO::Socket::SSL
      $pkg->can_client_sni ? (SSL_hostname => $hostname):(),
      # reuse SSL session of control connection in data connections
      SSL_session_cache => Net::FTP::_SSL_SingleSessionCache->new,
    );
    # user defined SSL arg
    $tlsargs{$_} = $arg{$_} for(grep { m{^SSL_} } keys %arg);

  } elsif ($arg{SSL}) {