# File	  : Net::FTPSSL
# Author  : kral <kral at paranici dot org>
# Created : 01 March 2005
# Version : 0.04
# Revision: $Id: FTPSSL.pm,v 1.24 2005/10/23 14:37:12 kral Exp $

package Ssl::FTPSSL;

use strict;
use warnings;
use vars qw( $VERSION @EXPORT );
use base ( 'Exporter', 'IO::Socket::SSL' );
use Time::Local;
use IO::Socket::INET;
use Net::SSLeay::Handle;
use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
use Carp qw( carp croak );
use Errno qw/ EINTR /;

$VERSION = "0.04";
@EXPORT  = qw( IMP_CRYPT EXP_CRYPT );

use constant IMP_CRYPT => "I";
use constant EXP_CRYPT => "E";

use constant CMD_INFO    => 1;
use constant CMD_OK      => 2;
use constant CMD_MORE    => 3;
use constant CMD_REJECT  => 4;
use constant CMD_ERROR   => 5;
use constant CMD_PENDING => 0;
use constant MODE_BINARY => "I";
use constant MODE_ASCII  => "A";

sub new {
  my $self         = shift;
  my $type         = ref($self) || $self;
  my $host         = shift;
  my %arg          = @_;
  my $port         = $arg{Port} || 'ftp(21)';
  my $debug        = $arg{Debug} || 0;
  my $timeout      = $arg{Timeout} || 120;
  my $buf_size     = $arg{Buffer} || 10240;
  my $encrypt_mode = $arg{Encryption} || EXP_CRYPT;
  my $clear_sock;
  croak "Host undefined" unless $host;

  croak "Encryption mode unknow!"
    if ( $encrypt_mode ne IMP_CRYPT && $encrypt_mode ne EXP_CRYPT );

  # We start with a clear connection, 'cause I don't know if the
  # connection will be implicit or explicit.
  

  my $socket = IO::Socket::INET->new(
    PeerAddr => $host,
    PeerPort => $port,
    Proto    => 'tcp',
    Timeout  => $timeout
    )
    or return undef;

  $socket->autoflush(1);


  # In explicit mode, FTPSSL send an AUTH SSL command, catch the messages
  # and then transform the clear connection in a crypted one.
  # TODO: Let the user select the encryption type. (SSL, TLS)

  if ( $encrypt_mode eq EXP_CRYPT ) {
    return undef unless ( response($socket) == CMD_OK );
    command( $socket, "AUTH", "TLS" );
    response($socket);
  }

  my $obj = $type->start_SSL( $socket, SSL_version => "TLSv1" )
    or croak IO::Socket::SSL::errstr();


  # This is made for catch the banner when the connection
  # is implicitly crypted.

if ( $encrypt_mode eq IMP_CRYPT ) {
    return undef unless ( response($socket) == CMD_OK );
  }
  ${*$obj}{'debug'}    = $debug;
  ${*$obj}{'timeout'}  = $timeout;
  ${*$obj}{'buf_size'} = $buf_size;
  ${*$obj}{'type'}     = 'A';

  return $obj;

}

#-----------------------------------------------------------------------
# TODO:
# - Adding ACCT (Account) support (response 332 on password)
sub login {
  my $self = shift;
  my ( $user, $pass ) = @_;

  return 0 unless $self->user($user);

  return 0 unless $self->password($pass);
  return 1;
}

#-----------------------------------------------------------------------

sub user {
  my ( $self, $user ) = @_;
  my $resp = $self->_user($user);
  if ( !defined $resp ) {
     return 0;
  }
  unless ( $resp == CMD_OK || $resp == CMD_MORE ) {  return 0; }
  return 1;
}

sub password {
  my ( $self, $pass ) = @_;
  my $resp = $self->_passwd($pass);
  if ( !defined $resp) {
     return 0;
  }
  unless ( $resp == CMD_OK || $resp == CMD_MORE ) { return 0; }
  return 1;
}

sub quit {
  my $self = shift;
  $self->_quit() or return 0;
  $self->close();
  return 1;
}

sub port
{
 my $self =shift;
 my $ok;
 $self->_protp();
 $self->_PORT("127,0,0,1,35,40");
 
my $port = "9000";
 
 
${*$self}{'flag'} = 1;

my $listen;
#my $cntx =  ${*$self}{'_SSL_ctx'};
 if(!($listen  = IO::Socket::SSL->new( Listen => 5,
                                   LocalAddr => 'localhost',
                                   LocalPort => 9000,
                                   Proto     => 'tcp',
                                  SSL_version => "TLSv1",
                               #    SSL_verify_mode => 0x00,
                               #    SSL_key_file => '/home/joydeep/ers-3.0.2-20051107/servers/default20/ssl/sushil.key',
                               #    SSL_passwd_cb => sub {return "password"},
                               #    SSL_cert_file =>'/home/joydeep/ers-3.0.2-20051107/servers/default20/ssl/sushil.cert',
			#		SSL_reuse_ctx => $cntx
                                 )) ) {
 

 warn "unable to create socket: ", &IO::Socket::SSL::errstr, "\n";
    exit(0);
}

${*$self}{'data_ch'} = \*$listen;
return 1;

#}
# 
# ${*$self}{'net_ftp_listen'} = $listen;
# print "$listen\n"; 
# 
# my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost));
#
# my  $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
# print "$port\n";
# ${*$self}{'net_ftp_intern_port'} = 1;
# ${*$self}{'flag'}= 1;
# $ok = $self->_PORT($port);
# ${*$self}{'net_ftp_port'} = $port;
# print $ok;
 #$ok; 
}
sub pasv {
  my $self = shift;

  #$self->_pbsz();
  $self->_protp();

  $self->command("PASV");
  my $msg = $self->getline();
  print "<<< " . $msg if ${*$self}{'debug'};

  unless ( substr( $msg, 0, 1 ) == CMD_OK ) { return 0; }

  $msg =~ m/(\d+)\s(.*)\(((\d+,?)+)\)\.?/
    ;    # [227] [Entering Passive Mode] ([h1,h2,h3,h4,p1,p2]).
  my @address = split( /,/, $3 );

  my $host = join( '.', @address[ 0 .. 3 ] );
  my $port = $address[4] * 256 + $address[5];
  my $host1 = join(',',@address[0 .. 5]);
  
  my $socket = Net::SSLeay::Handle->make_socket( $host, $port )
    or croak "Can't open $host:$port";

  unless ($socket) { croak "Can't open $host:$port"; }

  ${*$self}{'data_ch'} = \*$socket;

  return 1;
}
sub pasv_xfer {
  my $self = shift;
    $self->_protp();

  $self->command("PASV");
  my $msg = $self->getline();
  print "<<< " . $msg if ${*$self}{'debug'};

  unless ( substr( $msg, 0, 1 ) == CMD_OK ) { return 0; }

  $msg =~ m/(\d+)\s(.*)\(((\d+,?)+)\)\.?/
    ;    # [227] [Entering Passive Mode] ([h1,h2,h3,h4,p1,p2]).
  my @address = split( /,/, $3 );
  my $host_ip_port = join(',',@address[0 .. 5]);
 
  return $host_ip_port;
 
}


sub list {
  my $self = shift;
  my $path = shift;
  my ( $tmp, $dati, $io, $size );
  $dati ='';
##For the PORT Command
#  if(${*$self}{'flag'} == 1) {
#	$self->_list($path);
#  	my $pkg = ${*$self}{'data_ch'};
#	my $socket = $pkg->accept();
#	print "after accept";
#       while ( $tmp = $socket->getline() )
#	{ 
#          $dati .= $tmp;
#	}       
#	$socket->close();
#
#  }
##For the PASV Command
# else 
    if ($self->_list($path)){
#	$self->_list($path);
	$size = ${*$self}{'buf_size'};
	$io   = new IO::Handle;
	tie( *$io, "Net::SSLeay::Handle", ${*$self}{'data_ch'} );
	$io->autoflush(1);
	while ( $tmp = $io->getline() ) 
	{
	      $dati .= $tmp;
	}
	   $io->close(); 
  
}

  #$io->close();
  $self->response;    # For catch "226 Closing data connection."

  return $dati ? split( /\n/, $dati ) : ();
}

sub nlst {
  my $self = shift;
  my $path = shift;
  my ( $tmp, $dati, $io, $size );

  unless ( $self->pasv() ) {
    croak "Can't set passive mode!: " . ${*$self}{'last_ftp_msg'};
  }

  if ( $self->_nlst($path) ) {

    $size = ${*$self}{'buf_size'};

    $io = new IO::Handle;
    tie( *$io, "Net::SSLeay::Handle", ${*$self}{'data_ch'} );

    $io->autoflush(1);

    while ( $tmp = $io->getline()) {
      #unless ( defined $len ) {
      #  next if $! == EINTR;
      #  croak "System read error on read while nlst(): $!\n";
      #}
      $dati .= $tmp;
    }
  }

  $io->close();
  $self->response;    # For catch "226 Closing data connection."

  return $dati ? split( /\n/, $dati ) : ();
}
sub restart
{
  @_ == 2 || croak 'usage: $self->restart( BYTE_OFFSET )';

  my($self,$where) = @_;
  ${*$self}{'net_ftp_rest'} = $where;

  return undef;
}

sub get {
  my $self     = shift;
  my $file_rem = shift;
  my $file_loc = shift;
  my $where    = shift ;
  my ( $size, $localfd );
  $size = ${*$self}{'buf_size'} || 2048;

  unless ( $self->pasv() ) {
    croak "Can't set passive mode!";
  }
 #############New-Code for REST Command#####
  ${*$self}{'net_ftp_rest'} = $where if defined $where;
  my $rest = ${*$self}{'net_ftp_rest'};
 ###########################################
  if ( ref($file_loc) && ref($file_loc) eq "GLOB" ) {
    $localfd = \*$file_loc;
  }
  else {
     #$localfd = \*FD;
     unless(sysopen($localfd, $file_loc, O_CREAT | O_WRONLY | ($rest ? O_APPEND : O_TRUNC) )) {
     #unless ( open( $localfd, "> $file_loc" ) ) {
      $self->_abort();
      croak "Can't create local file!";
    }
  }

  if ( ${*$self}{'type'} eq MODE_BINARY ) {
    unless ( binmode $localfd ) {
      $self->_abort();
      croak "Can't set binary mode to local file!";
    }
  }
  
  if($rest) { 
    $self->_rest($rest);    
  } 

  if ( $self->_retr($file_rem) ){ 
    my ( $data, $written );
    my $io = new IO::Handle;
    tie( *$io, "Net::SSLeay::Handle", ${*$self}{'data_ch'} );
    $io->autoflush(1);
    while ( my $len = $io->read($data,$size ) ) {
      unless ( defined $len ) {
        next if $! == EINTR;
        croak "System read error on get(): $!\n";
      }
      $written = syswrite $localfd, $data, $len;
      croak "System write error on get(): $!\n" unless defined $written;
    }

    $io->close();
    my $return_code;
    $return_code=$self->response; 
    if ($return_code == 5) {
       return undef;
    }
    return 1;
  }
  return undef;
}

sub put {
  my $self     = shift;
  my $file_loc = shift;
  my $file_rem = shift;
  my ( $size, $localfd );

  $size = ${*$self}{'buf_size'} || 2048;

  unless ( $self->pasv() ) {
    croak "Can't set passive mode!: " . ${*$self}{'last_ftp_msg'};
  }

  if ( ref($file_loc) && ref($file_loc) eq "GLOB" ) {
    $localfd = \*$file_loc;
    croak "If you had passed a stream, you must specify the remote filename."
      unless $file_rem;
  }
  else {
    unless ( open( $localfd, "< $file_loc" ) ) {
      #print "Test";
      #$self->_abort();
      #croak "Can't open local file!";
      print "Local File does not exits\n";
      return undef;
    }
  }

  unless ($file_rem) {
    require File::Basename;
    $file_rem = File::Basename::basename($file_loc);
  }

  if ( ${*$self}{'type'} eq MODE_BINARY ) {
    unless ( binmode $localfd ) {
     # $self->_abort();
     # croak "Can't set binary mode to local file!";
     print "Local File does not exits\n";
     return undef;  
    }
  }

  # If alloc_size is already set, I skip this part
 # unless ( defined ${*$self}{'alloc_size'} ) {
  #  if ( -f $file_loc ) {
   #   my $size = -s $file_loc;
   #   $self->alloc($size);
   # }
 # }

 # delete ${*$self}{'alloc_size'};

  if ( $self->_stor($file_rem) ) {

    my ( $data, $written );
    my $io = new IO::Handle;
    tie( *$io, "Net::SSLeay::Handle", ${*$self}{'data_ch'} );

    $io->autoflush(1);

    while ( ( my $len = sysread $localfd, $data, $size ) ) {
      unless ( defined $len ) {
        next if $! == EINTR;
        croak "System read error on put(): $!\n";
      }
      $written = $io->write($data, $len);
      croak "System write error on put(): $!\n" unless defined $written;
    }

    $io->close();
    $self->response;    # For catch "226 Closing data connection."
    return 1;

  }

  return undef;
}

sub uput {              # Unique put (STOU command)
  my $self     = shift;
  my $file_loc = shift;
  my $file_rem = shift;
  my ( $size, $localfd );

  $size = ${*$self}{'buf_size'} || 2048;

  unless ( $self->pasv() ) {
    $self->_abort();
    croak "Can't set passive mode!: " . ${*$self}{'last_ftp_msg'};
  }

  if ( ref($file_loc) && ref($file_loc) eq "GLOB" ) {
    $localfd = \*$file_loc;
  }
  else {
    unless ( open( $localfd, "< $file_loc" ) ) {
      $self->_abort();
      croak "Can't open local file!";
    }
  }

  if ( ${*$self}{'type'} eq 'I' ) {
    unless ( binmode $localfd ) {
      $self->_abort();
      croak "Can't set binary mode to local file!";
    }
  }

  unless ( defined ${*$self}{'alloc_size'} ) {
    if ( -f $file_loc ) {
      my $size = -s $file_loc;
      $self->alloc($size);
    }
  }

  delete ${*$self}{'alloc_size'};

  if ( $self->_stou($file_rem) ) {

    my ( $data, $written );
    my $io = new IO::Handle;
    tie( *$io, "Net::SSLeay::Handle", ${*$self}{'data_ch'} );

    $io->autoflush(1);

    while ( ( my $len = sysread $localfd, $data, $size ) ) {
      unless ( defined $len ) {
        next if $! == EINTR;
        croak "System read error on put(): $!\n";
      }
      $written = syswrite $io, $data, $len;
      croak "System write error on put(): $!\n" unless defined $written;
    }

    $io->close();
    $self->response;    # For catch "226 Closing data connection."
    return 1;

  }

  return undef;
}

sub alloc {
  my $self = shift;
  my $size = shift;

  if ( $self->_alloc($size) ) {
    ${*$self}{'alloc_size'} = $size;
  }
  else {
    return 0;
  }

  return 1;

}

sub delete {
  my $self = shift;
  $self->command( "DELE", @_ );
  return ( $self->response == CMD_OK );
}

sub auth {
  my $self = shift;
  $self->command( "AUTH", "TLS" );
  return ( $self->response == CMD_OK );
}

sub pwd {
  my $self = shift;
  my $path;

  $self->command("PWD");
  $self->response();
  if ( ${*$self}{'last_ftp_msg'} =~ /\"(.*)\".*/ )
  {    # 257 "/<PATH>/" is current directory.
    ( $path = $1 ) =~
      s/\"\"/\"/g;    # "Quote-doubling" convention - RFC 959, Appendix II
    return $path;
  }
  else {
    return undef;
  }
}

sub cwd {
  my $self = shift;
  $self->command( "CWD", @_ );
  return ( $self->response == CMD_OK );
}

sub noop {
  my $self = shift;
  $self->command("NOOP");
  return ( $self->response == CMD_OK );
}

sub rename {
  my $self     = shift;
  my $old_name = shift;
  my $new_name = shift;

  return 0 unless $self->_rnfr($old_name);
  return 0 unless $self->_rnto($new_name);
  return 1;

}

sub cdup {
  my $self = shift;
  $self->command("CDUP");
  return ( $self->response == CMD_OK );
}


# TODO: Make mkdir() working with recursion.
sub mkdir {
	my $self = shift;
	my $dir = shift;
	$self->command("MKD", $dir);
	return ( $self->response == CMD_OK );	
}

# TODO: Make rmdir() working with recursion.
sub rmdir {
	my $self = shift;
	my $dir = shift;
	$self->command("RMD", $dir);
	return ( $self->response == CMD_OK );	
}

sub site {
  my $self = shift;
  my $args = shift;

  $self->command("SITE", $args);
  return ( $self->response == CMD_OK );
}

sub mdtm
{
 my $self  = shift;
 my $file = shift;

 # Server Y2K bug workaround
 #
 # sigh; some idiotic FTP servers use ("19%d",tm.tm_year) instead of
 # ("%d",tm.tm_year+1900).  This results in an extra digit in the
 # string returned. To account for this we allow an optional extra
 # digit in the year. Then if the first two digits are 19 we use the
 # remainder, otherwise we subtract 1900 from the whole year.

 $self->_MDTM($file) && $self->message =~ /((\d\d)(\d\d\d?))(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
    ? timegm($8,$7,$6,$5,$4-1,$2 eq '19' ? $3 : ($1-1900))
    : undef;
}

sub size {
  my $self  = shift;
  my $file = shift;
  my $io;
  if($self->supported("SIZE")) {
    return $self->_SIZE($file)
        ? ($self->message =~ /(\d+)\s*(bytes?\s*)?$/)[0]
        : undef;
 }
 elsif($self->supported("STAT")) {
   my @msg;
   return undef
       unless $self->_STAT($file) && (@msg = $self->message) == 3;
   my $line;
   foreach $line (@msg) {
     return (split(/\s+/,$line))[4]
         if $line =~ /^[-rwxSsTt]{10}/
   }
 }
 else {
   my @files = $self->list($file);
   if(@files) {
     return (split(/\s+/,$1))[4]
         if $files[0] =~ /^([-rwxSsTt]{10}.*)$/;
   }
 }
 undef;

}

sub supported {
    @_ == 2 or croak 'usage: $ftp->supported( CMD )';
    my $self = shift;
    my $cmd = uc shift;
    my $hash = ${*$self}{'net_ftp_supported'} ||= {};

    return $hash->{$cmd}
        if exists $hash->{$cmd};

    return $hash->{$cmd} = 0
        unless $self->_HELP($cmd);

    my $text = $self->message;
    if($text =~ /following\s+commands/i) {
        $text =~ s/^.*\n//;
        while($text =~ /(\*?)(\w+)(\*?)/sg) {
            $hash->{"\U$2"} = !length("$1$3");
        }
    }
    else {
        $hash->{$cmd} = $text !~ /unimplemented/i;
    }

    $hash->{$cmd} ||= 0;

}

sub message
{
 @_ == 1 or croak 'usage: $obj->message()';

 my $self = shift;

 wantarray ? @{${*$self}{'net_cmd_resp'}}
           : join("", @{${*$self}{'net_cmd_resp'}});
}
sub append {
  my $self     = shift;
  my $file_loc = shift;
  my $file_rem = shift;
  my ( $size, $localfd );

  $size = ${*$self}{'buf_size'} || 2048;

  unless ( $self->pasv() ) {
    croak "Can't set passive mode!: " . ${*$self}{'last_ftp_msg'};
  }

  if ( ref($file_loc) && ref($file_loc) eq "GLOB" ) {
    $localfd = \*$file_loc;
    croak "If you had passed a stream, you must specify the remote filename."
      unless $file_rem;
  }
  else {
    unless ( open( $localfd, "< $file_loc" ) ) {
      #print "Test";
      #$self->_abort();
      #croak "Can't open local file!";
      print "Local File does not exits\n";
      return undef;
    }
  }

  unless ($file_rem) {
    require File::Basename;
    $file_rem = File::Basename::basename($file_loc);
  }

  if ( ${*$self}{'type'} eq MODE_BINARY ) {
    unless ( binmode $localfd ) {
     # $self->_abort();
     # croak "Can't set binary mode to local file!";
     print "Local File does not exits\n";
     return undef;
    }
  }
   if ( $self->_append($file_rem) ) {
    my ( $data, $written );
    my $io = new IO::Handle;
    tie( *$io, "Net::SSLeay::Handle", ${*$self}{'data_ch'} );

    $io->autoflush(1);
     while ( ( my $len = sysread $localfd, $data, $size ) ) {
           unless ( defined $len ) {
                      next if $! == EINTR;
                      croak "System read error on put(): $!\n";
           }
     $written = $io->write($data, $len);
     croak "System write error on put(): $!\n" unless defined $written;
    }

    $io->close();
    $self->response;    # For catch "226 Closing data connection."
    return 1;

  }

  return undef;

}

sub help {
   my $self = shift;
   $self->command( "HELP" );
   return ( $self->response == CMD_OK );
}

sub syst {
   my $self = shift;
   $self->command( "SYST" );
   return ( $self->response == CMD_OK );
}
sub A {
 my $self = shift;
 $self->command("TYPE A");
 return ( $self->response() == CMD_OK);
}

sub B {
 my $self = shift;
 $self->command("TYPE B");
 return ( $self->response() == CMD_ERROR);
}

sub E {
 my $self = shift;
 $self->command("TYPE E");
 return ( $self->response() == CMD_ERROR);
}

sub I {
 my $self = shift;
 $self->command("TYPE I");
 return ( $self->response() == CMD_OK);
}

sub foo {
 my $self = shift;
 $self->command("TYPE FOO");
 return ( $self->response() == CMD_ERROR);
}


#-----------------------------------------------------------------------
#  Type setting function
#-----------------------------------------------------------------------

sub ascii {
  my $self = shift;
  ${*$self}{'type'} = MODE_ASCII;
  return $self->_type('A');
}

sub binary {
  my $self = shift;
  ${*$self}{'type'} = MODE_BINARY;
  return $self->_type('I');
}

#-----------------------------------------------------------------------
#  Internal functions
#-----------------------------------------------------------------------

sub _user {
  my $self = shift;
  $self->command( "USER", @_ );
  return $self->response;
}

sub _passwd {
  my $self = shift;
  $self->command( "PASS", @_ );
  return $self->response;
}

sub _quit {
  my $self = shift;
  $self->command("QUIT");
  return ( $self->response );
}

sub _protp {
  my $self = shift;
  $self->command( "PROT", "P" );
  return ( $self->response == CMD_OK );
}

sub _pbsz {
  my $self = shift;
  $self->command( "PBSZ", "0" );
  return ( $self->response == CMD_OK );
}

sub _nlst {
  my $self = shift;
  $self->command( "NLST", @_ );
  return ( $self->response == CMD_INFO );
}

sub _list {
  my $self = shift;
  $self->command( "LIST", @_ );
  return ( $self->response == CMD_INFO );
}

sub _type {
  my $self = shift;
  $self->command( "TYPE", @_ );
  return ( $self->response == CMD_OK );
}

sub _retr {
  my $self = shift;
  $self->command( "RETR", @_ );
  return ( $self->response == CMD_INFO );
}

sub _rest {
  my $self = shift;
  $self->command( "REST", @_ );
  return ( $self->response == CMD_INFO );
}
sub _stor {
  my $self = shift;
  $self->command( "STOR", @_ );
  return ( $self->response == CMD_INFO );
}

sub _stou {
  my $self = shift;
  $self->command( "STOU", @_ );
  return ( $self->response == CMD_INFO );
}

sub _abort {
  my $self = shift;
  $self->command("ABOR");
  return ( $self->response == CMD_OK );
}

sub _alloc {
  my $self = shift;
  $self->command( "ALLO", @_ );
  return ( $self->response == CMD_OK );
}

sub _rnfr {
  my $self = shift;
  $self->command( "RNFR", @_ );
  return ( $self->response == CMD_MORE );
}

sub _rnto {
  my $self = shift;
  $self->command( "RNTO", @_ );
  return ( $self->response == CMD_OK );
}
sub _PORT {
 my $self = shift;
 $self->command("PORT", @_);
 return ( $self->response == CMD_INFO);
}
sub _SIZE { 
 my $self = shift;
 $self->command("SIZE",@_);
 return ( $self->response() == CMD_OK );
}
sub _STAT { 
 my $self = shift;
 $self->command("STAT",@_);
 return ( $self->response() == CMD_OK );
}
sub _HELP { 
 my $self = shift;
 $self->command("HELP",@_);
 return ( $self->response() == CMD_OK );
}
sub _MDTM { 
 my $self = shift;
 $self->command("MDTM",@_);
 return ( $self->response() == CMD_OK );
 }
sub _append {
 my $self = shift;
 $self->command("APPE",@_);
 return ( $self->response() == CMD_INFO);
}

#-----------------------------------------------------------------------
#  Messages handler
#-----------------------------------------------------------------------

sub command {
  my $self = shift;
  my @args;
  my $data;
  @args = grep defined($_), @_;
     # remove undef values from the list. Maybe I have to find out why those undef were passed.
  $data = join(
    " ",
    map {
      /\n/
        ? do { my $n = $_; $n =~ tr/\n/ /; $n }
        : $_;
      } @args
  );
  $data .= "\015\012";

  print STDERR ">>> +++ " . $data
  if ref($self) eq "Ssl::FTPSSL" && ${*$self}{'debug'};
  my $written;
  my $len = length $data;

  $written = $self->print($data);
  unless ( defined $written ) {
    carp "Can't write on socket: $!";
    $self->close;
    return undef;
  }
  ${*$self}{'net_cmd_resp'} = [];      # the response
  return 1;

}

sub response {
  my $self = shift;
  my ( $data, $code );
  ${*$self}{'net_cmd_resp'} ||= [];
        my $SELF = substr($self, 0, 16);  	
        if($SELF eq 'IO::Socket::INET') {
           $self->recv($data,1024);
        }
        else {
           $data =$self->readline();
        }
#                unless( defined $data ) {
#                croak "Can't read on socket: $!";
#        }
    if ( !defined $data ) {
       return undef;
    } 
	my @lines = split( "\015\012", $data );
        push(@{${*$self}{'net_cmd_resp'}},$data);
  foreach my $line ( @lines ) {

    $line =~ m/^(\d+)(\-?)(.*)$/s;
    $code = $1;
    print STDERR "<<< *** " . $line ."\n"
      if ref($self) eq "Ssl::FTPSSL" && ${*$self}{'debug'};

    if ( ref($self) eq "Ssl::FTPSSL" ) {
      ${*$self}{'last_ftp_msg'} = $line;
    }

    last if $2 ne '-';

  }
  return substr( $code, 0, 1 );

}

sub last_message {
  my $self = shift;
  return ${*$self}{'last_ftp_msg'};
}



__END__

=head1 NAME

Net::FTPSSL - A FTP over SSL/TLS class

=head1 VERSION 0.04

=head1 SYNOPSIS

  use Net::FTPSSL;

  my $ftps = Net::FTPSSL->new('ftp.yoursecureserver.com', 
                              Port => 21,
                              Encryption => 'E',
                              Debug => 1) 
    or die "Can't open ftp.yoursecureserver.com";

  $ftps->login('anonymous', 'user@localhost') 
    or die "Can't login: ", $ftps->$last_message();

  $ftps->cwd("/pub") or die "Can't change directory: ", $ftps->last_message;

  $ftps->get("file") or die "Can't get file: ", $ftps->last_message;

  $ftps->quit();
	
=head1 DESCRIPTION

C<Net::FTPSSL> is a class implementing a simple FTP client over a Secure
Shell Layer (SSL) connection written in Perl as described in RFC959 and
RFC2228.

=head1 CONSTRUCTOR

=over 4

=item new ( HOST [, OPTIONS ])

Creates a new B<Net::FTPSSL> object and opens a connection with the
C<HOST>. C<HOST> is the address of the FTP server and it's a required
argument. OPTIONS are passed in a hash like fashion, using key and value
pairs.

C<OPTIONS> are:

B<Port> - The port number to connect to on the remote FTP server.
Default value is 21.

B<Encryption> - The connection can be implicitly (B<IMP_CRYPT>) or
explicitly (B<EXP_CRYPT>) encrypted.
In explicit cases the connection begins clear and became encrypted after an
"AUTH" command is sent. Default value is EXP_CRYPT.

B<Timeout> - Set a connection timeout value. Default value is 120.

B<Buffer> - This is the block size that Net::FTPSSL will use when a transfer is
made. Default value is 10240.

B<Debug> - This set the debug informations option on/off. Default is off.

=back

=head1 METHODS

All the methods return I<true> or I<false>, true when the operation was
a succes and false when failed. Methods like B<list> or B<nlst> return an
empty array when fail.

=over 4

=item login(USER, PASSWORD)

Use the given informations to log into the FTP server.

=item list([DIRECTORY])

This method returns a list of files in this format:

 total 5
 drwxrwx--- 1 owner group          512 May 31 11:16 .
 drwxrwx--- 1 owner group          512 May 31 11:16 ..
 drwxrwx--- 1 owner group          512 Oct 27  2004 foo
 drwxrwx--- 1 owner group          512 Oct 27  2004 pub
 drwxrwx--- 1 owner group          512 Mar 29 12:09 bar

If DIRECTORY is omitted, the method will return the list of the current
directory.

=item nlst([DIRECTORY])

Same as C<list> but returns the list in this format:

 foo
 pub
 bar

Personally, I suggest to use list instead of nlst.

=item ascii

Sets the transfer file in ASCII mode.

=item binary

Sets the transfer file in binary mode. No transformation will be done.

=item get(REMOTE_FILE, LOCAL_FILE)

Retrives the REMOTE_FILE from the ftp server. LOCAL_FILE may be a filename or a
filehandle.	Return undef if it fails.

=item put(LOCAL_FILE, [REMOTE_FILE])

Stores the LOCAL_FILE into the remote ftp server. LOCAL_FILE may be filehandle,
but in this case REMOTE_FILE is required. Return undef if it fails.

=item delete(REMOTE_FILE)

Deletes the indicated REMOTE_FILE.

=item cwd(DIR)

Attempts to change directory to the directory given in DIR.

=item pwd

Returns the full pathname of the current directory.

=item cdup

Changs directory to the parent of the current directory.

=item mkdir(DIR)

Creates the indicated directory. No recursion at the moment.

=item rmdir(DIR)

Removes the empty indicated directory. No recursion at the moment.

=item noop

It specifies no action other than the server send an OK reply.

=back

=head1 AUTHOR

Marco Dalla Stella - <kral at paranoici dot org>

=head1 SEE ALSO

L<Net::Cmd>

L<Net::FTP>

L<Net::SSLeay::Handle>

L<IO::Socket::SSL>

RFC 2228 - L<ftp://ftp.rfc-editor.org/in-notes/rfc2228.txt>

=head1 CREDITS

Graham Barr <gbarr at pobox dot com> - for have written such a great
collection of modules (libnet).

=head1 BUGS

I'm currently testing the module with proftpd and Titan FTP. I'm having a lot
of trouble with the second at the moment. Put or get phases seem to work ok
(sysread and syswrite don't return any errors) but the server doesn't receive
all the sent data. I'm working on it.

=head1 COPYRIGHT

Copyright (c) 2005 Marco Dalla Stella. All rights reserved.  This
program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut
