package ftpcp;

use strict;
use warnings;

require ftpcp::single;
require ftpcp::single::fake;
use Carp;

use FileHandle;
require File::Temp;

my $g_has_io_scalar = eval {require IO::Scalar;1};
if($g_has_io_scalar) {
  require ftpcp::scalar_fix;
} else {
  require IO::Scalar::Fake;
}
use Socket;

our $lie_to_me=0;

our $VERSION='$Revision: 13298 $';
our $DEFAULT_PORT=21;
our $OVERRIDE_PORT=undef;
our $OVERRIDE_HOST=undef;
our $DEBUG = 0;
my %dir_cached;
my %special_perm_map=(
  9=>['t'=>oct(1000)],
  6=>['s'=>oct(2000)],
  3=>['s'=>oct(4000)]
);
my $TMPDIR="/var/tmp";
my $user_re=qr/[\w\.\@\-]+/;
my $server_re=qr/[\w\.\-]+/;

STDERR->autoflush(1);

=head1 NAME

  ftpcp

=head1 DESCRIPTION

  An rcp-alike function(set?) for FTP.

=head2 SYNOPSIS

  ftpcp->new->connect($server, $username, $password)->cat_fh($server, $username, $path, \*STDOUT);

=head1 VARIABLES

$lie_to_me

If this is set "true", all operations are short-circuited and considered "successful"... unless you use one of the overrides below.

$OVERRIDE_PORT

Overrides the port used (for testing)

$OVERRIDE_HOST

Overrides the host used (for testing)

=cut

sub _die_no_connection {
  confess "No established connection to server '$_[0]', user '$_[1]'";
}

sub _validate_argc {
  my ($min, $max, @args) = @_;
  shift(@args); # OO
  if($DEBUG) {
    my @caller = caller(1);
    if($caller[3]=~/connect/) {
      warn "$caller[3](...)";
    } else {
      warn "$caller[3](".join(", ", @args).")";
    }
  }
  my $argc = scalar(@args);
  die "Too many args: $argc > $max" if $max and $argc > $max;
  die "Too few args: $argc < $min" if $argc < $min;
  return
}

# Canonicalises paths for servers which cannot do so themselves.
sub __cpath {
  my ($self, $path) = @_;
  return $path unless $self->{_canonicalise_paths};
  $path=~s# /+ $ ##x;
  $path=~s#^[.]/+##;
  return $path;
}

sub __dir_cached {
  my($ftp,$path)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless($dir_cached{$path}) {
    $dir_cached{$path}=[$ftp->dir($path)];
  }
  return @{$dir_cached{$path}};
}

sub __dir_no_enter {
  my($ftp,$path)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  return $ftp->dir("-ld", $path);
}

# Note that, although undocumented, you can do $ftp->dir("-lR", $foo)
# This is implemented in proftpd, NOT in 'ls'.
sub __dir_recursive {
  my($self, $server, $user, $path, $callback)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));

  my $ftp = $self->{connections}{$server}{$user};

  my $fh = $self->open_fh_any($server, $user, ["LIST", "-lR", $path]);

  my $first_line = <$fh>;
  if($first_line!~/:\r?\n?$/) {
    my @junk = <$fh>;
    $fh->close();
    # Clearly not actual ls -lR.
    # Quick and dirty recursive mode.
    my @lines;
    my @dirs_to_check = ($path);
    while(@dirs_to_check) {
      # Breadth first: shift + push
      my ($d) = shift @dirs_to_check;
      warn $d if $DEBUG;
      my @r = (
        "$d:",
        $ftp->dir("-l", $d)
      );
      push @dirs_to_check, map {
        $_->{filename}
      } grep {
        $_->{type} eq "d"
      } __parse_ls(@r);
      if($callback) {
        $callback->(@r);
      } else {
        push @lines, @r;
      }
    }
    return @lines;
  } elsif($callback) {
    $callback->($first_line);
    $callback->($_) for <$fh>;
    $fh->close;
    return;
  } else {
    return($first_line, <$fh>);
  }
}

sub __mkdir {
  my($ftp_h,$path,$mode)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));

  # "ls" MUST be called in array context, otherwise it can return true-but-empty
  my @content = $ftp_h->ls($path);
  return if @content;

  $ftp_h->mkdir($path,1);
  $ftp_h->site("chmod",$mode,$path);
}

sub __mv_alt {
    # 'Special' move routine
    my $dest=pop;
    my @sources=@_;
    return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
    for my $filename (@sources) {
      my $t_file=$filename;
      $t_file=~s{ ^.*/ftp.\w.\w+?-([^/]+)/?$ }{$1}x;
      if(-d $filename) {
        opendir DIR, $filename or die "$filename: $!";
        my @dir_list=map {"$filename/$_"} grep {!m/^\.\.?$/} readdir DIR;
        closedir DIR;
        __mv_alt(@dir_list,$filename);
      }
      if(-d $dest) {
        $t_file="$dest/$t_file"
      } else {
        $t_file="$dest";
      }
      system("/bin/mv",$filename,"$t_file");
    }
}

sub __parse_ls {
  my @lines=@_;
  my $options;
  if(@lines > 0 and ref $lines[$#lines]) {
    $options = pop @lines;
  } else {
    $options = {};
  }
  my @rv;
  my $context = $options->{context} || "";
  ## NOTE: although we never get the first line of context, every later
  ## directory DOES! So use __strip_common_prefix above when recursive.
  for my $line (@lines) {
    my $parsed;
    if($line=~/^$/) {
      next;
    } elsif($line=~/^[a-z-][rwxsSt-]{9} .+:$/) {
      # This is an anti-pattern for the below, to catch actual directory
      # entries which end with colons.
      #
      # In the future, a better test would be for "total \d" on the next line.
    } elsif($line=~/^(.+):$/) {
      $context = "$1/";
      $parsed = 1;
    }

    my $out;
    if(not $parsed) {

      my($permissions, $hardlinks, $user, $group, $size, $month, $day, $time, $filename)=split(/\s+/,$line,9);
      (my $type=$permissions)=~s/(.).+$/$1/;
      my $link;
      if($permissions=~/^l/) {
        ($filename, $link) = split(/ -> /, $filename);
      }

      next unless defined($filename) and $filename ne ""; # Can happen with a dangling symlink I suppose?

      # Skip all lines referring to dirs that have already been covered.
      next if $context and $filename=~/^\.\.?$/;

      $out = {
        'link'=>$link,
        type=>$type,
        mode=>__perm_to_mode($permissions),
        hardlinks=>$hardlinks,
        user=>$user,
        group=>$group,
        size=>$size,
        month=>$month,
        day=>$day,
        timestamp=>$time,
        filename=>$context.$filename
      };
    }
    if($options->{callback}) {
      $options->{callback}->($out, $context);
    } elsif($out) {
      push @rv, $out;
    }
  }
  if($DEBUG and not $options->{callback}) {
    warn scalar(@rv) . " of " . scalar(@lines) . " lines parsed";
  }
  return @rv;
}

sub __perm_to_mode {
  my ($mode)=@_;
  my @modebits=split(//,$mode);
  my $mode_octal=0;
  for my $pos (keys %special_perm_map) {
    if(lc $modebits[$pos] eq $special_perm_map{$pos}[0]) {
      $mode_octal|=$special_perm_map{$pos}[1];
      $modebits[$pos]=($modebits[$pos] eq $special_perm_map{$pos}[0])?"x":"-"
    } 
  }
  for(1 .. 9) {
    if($modebits[$_] ne "-") {
      $mode_octal|=1<<(9-$_);
    }
  }
  return $mode_octal;
}

sub __rmdir {
  my($ftp_h,$path)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  $ftp_h->rmdir($path,1);
}

sub __strip_common_prefix {
  my ($prefix, @parsed_ls) = @_;
  $prefix=~s# /+ $ ##x;
  for(@parsed_ls) {
    $_->{filename}=~s#^$prefix/##;
  }
  return @parsed_ls;
}

# _flush_dir_for($full_path)
#
# Flushes the cache for the directory in which $full_path is found.
sub _flush_dir_for {
  my ( $self, $server, $user, $full_path )=@_;
  my ($path) = $full_path =~ m# ^ (.*) / $ #x;
  $self->flush_cache($server, $user, $path);
}

sub _ftp_get {
  my ($self,$user, $server, $r_path)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  my $prefix=$TMPDIR;
  return $self->_ftp_get_r($ftp_h,$r_path, $prefix);
}

sub _ftp_get_r {
  my ($self, $ftp_h, $r_path, $prefix)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  $prefix||=$TMPDIR;
  $r_path=~s# /+ $ ##x;
  my @op=__dir_cached($ftp_h, $self->__cpath($r_path));
  my $file_part;
  if($r_path=~m# ^ .* / ([^/]+) $ #x) {
    $file_part = $1;
  } else {
    warn "Unexpected path: $r_path";
    $file_part = $r_path;
  }

  my @op_parsed=__parse_ls @op;

  return unless @op;
  my $tmp_fn;

  my $filename_match = (
      $op_parsed[0]{filename} eq $self->__cpath($r_path) or
      $op_parsed[0]{filename} eq $file_part # For servers which are confused about the WD
    );

  if(@op<=1 and $filename_match) {
    # It's a file.
    my($lsitem)=@op_parsed;
    (my $fh,$tmp_fn)=File::Temp::mkstemps("$prefix/ftp.f.XXXXXX","-$file_part");
    $ftp_h->get($self->__cpath($r_path), $fh);
    $fh->close();
    chmod $lsitem->{mode}||oct(644), $tmp_fn;
  } else {
    if($DEBUG and @op==1) {
      warn join(" != ", $op_parsed[0]{filename}, $self->__cpath($r_path));
    }
    # It's a directory.
    $tmp_fn=File::Temp::mkdtemp("$prefix/ftp.d.XXXXXX");
    system("/bin/mv",$tmp_fn,"$tmp_fn-$file_part");
    $tmp_fn="$tmp_fn-$file_part";
    my($r_above);
    ($r_above=$r_path)=~s# ([^/]+) $ ##x;
    my ($self_lsitem)=grep {$_->{filename} eq $file_part} __parse_ls __dir_cached($ftp_h, $self->__cpath($r_above));
    for my $lsitem (@op_parsed) {
      next if $lsitem->{filename}=~m/^\.\.?$/;
      $self->_ftp_get_r($ftp_h, "$r_path/$lsitem->{filename}", $tmp_fn);
    }
    chmod $self_lsitem->{mode}||oct(755), $tmp_fn;
  }
  return $tmp_fn;
}

sub _ftp_put {
  my ($self,$user, $server, $r_path, @files)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  
  return $self->_ftp_put_r($ftp_h,$r_path, @files);
}

sub _ftp_put_r {
  my($self,$ftp_h,$path,@files)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  __mkdir($ftp_h, $self->__cpath($path), 711);
  for my $file (@files) {
    next if grep {$file=~m# (^|/) $_ $ #x} @{$self->{excludes}};
    (my $r_file=$file);
    $r_file=~s{ ^$TMPDIR/ftp\.\w\.\w*?-([^/]+)/?$ }{$path/$1}x or
      $r_file=~s{ ^.*?/([^/]+)/?$ }{$path/$1}x;
    if(-d $file) {
      if($self->{_put_flat}) {
        $r_file=$path;
      } else {
        __mkdir($ftp_h, $self->__cpath($r_file), 711);
      }
      opendir DIR, $file;
      my @sub_files=map {"$file/$_"} grep {!m/^\.\.?$/} readdir DIR;
      closedir DIR;
      $self->{_put_flat}=0;
      $self->_ftp_put_r($ftp_h,$r_file,@sub_files);
    } else {
      $self->{_put_flat}=0;
      $ftp_h->binary(); # ProFTPd apparently defaults to ASCII nowadays.
      $ftp_h->put($file, $self->__cpath($r_file));
    }
    my $mode=sprintf("%o",(CORE::stat $file)[2] & ~oct(22));
    $ftp_h->site("chmod",$mode,$self->__cpath($r_file));
  }
}

sub _parse_path_and_get {
  my($self, $path)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  if($path=~/^($user_re)\@($server_re):(.+)/) {
    my($user,$server,$r_path)=($1,$2,$3);
    my $filename=$self->_ftp_get($user, $server, $r_path);
    return ($filename,1);
  } else {
    return ($path,0);
  }
}

sub _parse_path_and_put {
  my($self, $path, %source_files)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));

  my @to_cp=grep {!$source_files{$_}} keys %source_files;
  my @to_mv=grep {$source_files{$_}} keys %source_files;

  if($path=~/^($user_re)\@($server_re):(.+)/) {
    my($user,$server,$r_path)=($1,$2,$3);
    $self->_ftp_put($user, $server, $r_path, @to_cp, @to_mv);
    die "Dangerous file listed!" if grep {!m#^$TMPDIR/#} @to_mv;
    system("/bin/rm","-rf",@to_mv) if @to_mv;

    return 1;
  } else {
    if(keys %source_files>1) {
      if(!-d $path) {
        die "Destination '$path' is not a directory";
      }
    }
    system("/bin/cp", "-f", @to_cp, $path) if @to_cp;
    __mv_alt(@to_mv, $path);
    return 0;
  }
}

sub _stat {
  return( (ls(@_)) [0] );
}

=head1 CLASS METHODS

=head2 new()

Just creates the object.

=cut

sub new {
  my $class=shift;
  my $self={excludes=>[], connections=>{}};
  return bless($self,$class);
}

=head1 INSTANCE METHODS

=head2 DESTROY

Closes all connections.

=cut

sub DESTROY {
  my $self=shift;
  for my $server (keys %{$self->{connections}}) {
    for my $user (keys %{$self->{connections}{$server}}) {
      $self->disconnect($server, $user);
    }
  }
}

=head2 cat($server, $user, $path)

Returns (as a scalar) the contents of the file in question.

=cut

sub cat {
  _validate_argc(3,3,@_);
  my($self, $server, $user, $path)=@_;
  return "" if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  my $file=$self->_ftp_get($user, $server, $path);
  return unless $file;
  local $/=undef;
  if(open(my $f, "<", $file)) {
    unlink $file;
    my $data=<$f>;
    close $f;
    return $data;
  } else {
    unlink $file;
    return;
  }
}

=head2 cat_fh($server, $user, $path, $fh)

The inner part of cat_quick below. Useful for cases where you don't even
want local memory storage.

=cut

sub cat_fh {
  _validate_argc(4,4,@_);
  my($self, $server, $user, $path, $fh)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));

  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};

  $ftp_h->get($self->__cpath($path), $fh);
  return 1;
}

=head2 cat_quick($server, $user, $path)

Returns (as a scalar) the contents of the file in question. Should be quicker
than plain cat() above as it doesn't use a temporary file.

=cut

sub cat_quick {
  _validate_argc(3,3,@_);
  my($self, $server, $user, $path)=@_;

  my $data = "";
  my $fh = $g_has_io_scalar ? new IO::Scalar(\$data) : new IO::Scalar::Fake(\$data);
  $self->cat_fh($server, $user, $path, $fh);
  $fh->close();
  return $data;
}

=head2 catput($server, $user, $path, $data)

Uploads the given data as a file.

=cut

sub catput {
  _validate_argc(4,4,@_);
  my($self, $server, $user, $path, $data)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  my($fh, $file)=File::Temp::mkstemp("$TMPDIR/ftp.u.XXXXXX");
  print $fh $data;
  close $fh;
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  $ftp_h->binary(); # ProFTPd apparently defaults to ASCII nowadays.
  my $rv=$ftp_h->put($file, $self->__cpath($path));
  unless($rv) {
    warn "$path: Upload failed: ".$ftp_h->message;
  }
  $self->_flush_dir_for($server, $user, $path);
  unlink $file;
  return $rv;
}

=head2 cd_to_wd($server, $user, $start_path, $cd_path)

=head2 cd_to_wd($server, $user, $start_path, $cd_path, $no_slash)

CDs into $start_path then $cd_path and then tells you where you are.

This will die if either path is invalid.

If $no_slash is true and $cd_path starts with a slash it will be
treated as if relative to ".", ie. cd_to_wd(..., "foo/bar", "/baz", 1)
is equivalent to cd_to_wd(..., ".", "baz").

=cut

sub cd_to_wd {
  _validate_argc(4,5,@_);
  my($self, $server, $user, $start_path, $cd_path, $no_slash)=@_;

  if($no_slash and $cd_path=~m#^/#) {
    $start_path=".";
    $cd_path=~s#^/##;
  }

  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  my $wd = $ftp_h->pwd();
  $ftp_h->cwd($self->__cpath($start_path)) or die;
  $ftp_h->cwd($self->__cpath($cd_path)) or die;
  my $new_wd = $ftp_h->pwd();
  $ftp_h->cwd($self->__cpath($wd));
  return $new_wd;
}

=head2 chmod($server, $user, $path, $mode)

Chmods the file or directory. Note that $mode is passed verbatim, so you probably actually do
want "644" or whatever.

=cut

sub chmod {
  _validate_argc(4,4,@_);
  my($self, $server, $user, $path, $mode)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  my $rv = $ftp_h->site("chmod",$mode,$self->__cpath($path));
  return $rv;
}

=head2 connect($server, $username, $password)

=head2 connect($server, $username, $password, $passive)

=head2 connect($server, $username, $password, \%options)

Connects to the FTP server, allowing it to be used in other
methods. Returns $self on success to support chaining.

PASV (passive mode) is off by default due to a SYN/RST race with ProFTPd,
but in cases where you're actually behind NAT, you may want to set it
to true.

If you provide \%options, the keys are:

=over

=item canonicalise_paths

Flips path canonicalisation on.

PLEASE NOTE this will currently apply to the whole object, but SHOULD
be safe to have on anyway. For this reason, canonicalise_paths will not
be turned off if it is already on.

=item initial_action

If set, this is a callback called as: initial_action($net_ftp_object)
to perform on-connect actions. Happens after initial_wd if applicable.

=item initial_wd

If set, that directory will be entered before returning.

=item passive

As $passive above.

=back

Should you provide the same connection details multiple times in
sequence, the old ones will be replaced and the connection count will
be increased. Thus this will DWIM:

  $f->connect($server, $u1, $p1);
  $f->connect($server, $u2, $p2);
  $f->connect($server, $u3, $p3);
  $f->connect($server, $u1, $p1);
  $f->disconnect($server, $u1, $p1);
  $f->disconnect($server, $u3, $p3);
  $f->disconnect($server, $u2, $p2);
  $f->disconnect($server, $u1, $p1);

=cut

sub connect {
  require Net::FTP;
  _validate_argc(3,4,@_);
  my($self,$server,$user,$password, $passive_or_options)=@_;
  my ($passive, $options);
  if($passive_or_options and ref $passive_or_options) {
    $options = $passive_or_options;
    $passive = $options->{passive};
  } else {
    ($passive, $options) = ($passive_or_options, {});
  }
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  my $port = $DEFAULT_PORT;
  $port = $OVERRIDE_PORT if $OVERRIDE_PORT;
  my $actual_server = $server;
  $actual_server = $OVERRIDE_HOST if $OVERRIDE_HOST;
  warn "Override: $OVERRIDE_HOST:$port" if $OVERRIDE_HOST;
  
  # There is a SYN/RST race with ProFTPd in passive mode, so use active.
  my $ftp_h=Net::FTP->new($actual_server, Debug=>$DEBUG, BlockSize=>1048576, Port=>$port, Passive=>$passive?1:0) or return;
  unless($ftp_h->login($user,$password)) {
    warn "Login failed for '$user'";
    return;
  }
  $ftp_h->binary();
  $ftp_h->cwd($self->__cpath($options->{initial_wd})) if $options->{initial_wd};

  # Autodetect dirstyle switch.
  if( $ftp_h->site("help") == 2 and $ftp_h->message=~/DIRSTYLE/) {
    $ftp_h->site("dirstyle"); # Should switch to UNIX style.
  }

  if($options->{initial_action}) {
    $options->{initial_action}->($ftp_h);
  }
  
  $self->{connection_count}{$server}{$user}++;
  $self->{connections}{$server}{$user}=$ftp_h;
  $self->{connection_flags}{$server}{$user}={
    passive => $passive,
  };
  $self->{_canonicalise_paths} ||= $options->{canonicalise_paths};
  return $self;
}

=head2 copy($server, $user, @old_paths, $new_path)

Copies files. If you ask for multiple files and do not provide a new
path with a trailing slash, nothing will be done.

If $new_path does contain a trailing slash, it will be treated as "move into
the directory $new_path".

This doesn't copy directories. Files are copied via upload followed
by download.

=cut

sub copy {
  _validate_argc(4,0,@_);
  my $new_path = pop(@_);
  my($self, $server, $user, @old_paths)=@_;
  return unless @old_paths;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  if($new_path!~m# / $ #x and @old_paths>1) {
    warn "This looks like a copy of multiple files (".scalar(@old_paths).
      ") to a non-directory $new_path";
    return;
  }
  for my $old_path (@old_paths) {
    $old_path=~s# /+ $ ##x; # Just in case.
    next unless $old_path;
    (my $old_path_short = $old_path)=~s#.*/##;
    my $new_path_full = ($new_path=~m# / $ #x) ?
      "$new_path/$old_path_short" :
      $new_path;

    my ($fh,$tmp_file) = File::Temp::mkstemp("/tmp/ftp.copy.XXXXXX");

    return unless eval {
      if($ftp_h->get($self->__cpath($old_path), $tmp_file)) {
        $ftp_h->put($tmp_file, $self->__cpath($new_path_full));
      } elsif($ftp_h->code == 550) {
        # Is a directory
        warn "Unable to copy directory";
        die;
      }
    }
  }
  return scalar(@old_paths);
}

=head2 copy_haltoncollide($server, $user, @old_paths, $new_path)

As copy() but it will abort if there is any kind of name collission.

=cut

sub copy_haltoncollide {
  _validate_argc(4,0,@_);
  my $new_path = pop(@_);
  my($self, $server, $user, @old_paths)=@_;
  return unless @old_paths;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  return if($new_path!~m# / $ #x and @old_paths>1);
  for my $old_path (@old_paths) {
    $old_path=~s# /+ $ ##x; # Just in case.
    next unless $old_path;
    (my $old_path_short = $old_path)=~s#.*/##;
    my $new_path_full = ($new_path=~m# / $ #x) ?
      "$new_path/$old_path_short" :
      $new_path;
    return if $self->_stat($server, $user, $new_path_full);
  }
  return $self->copy($server, $user, @old_paths, $new_path);
}

=head2 cp(@sources, $dest)

A pseudo-URL-aware cp. If it sees 'user@host:file' style filenames, it considers them to be FTP addresses;
otherwise, local files. You probably don't want to use this.

=cut

sub cp {
  _validate_argc(2,0,@_);
  my $dest=pop;
  my($self,@sources)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  my $rv;
  eval {
    my %source_files=map {$self->_parse_path_and_get($_)} @sources;
    my($dest_file, $dest_can_mv)=$self->_parse_path_and_put($dest, %source_files);
  } or warn $@;
  return $rv;
}

=head2 disconnect($server, $user)

Just disconnects from the FTP server.

=cut

sub disconnect {
  _validate_argc(2,2,@_);
  my($self,$server,$user)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  return unless($server and $user);
  $self->{connection_count}{$server}{$user}--;
  return if $self->{connection_count}{$server}{$user} > 0;
  my $ftp_h=$self->{connections}{$server}{$user};
  $ftp_h->quit() if $ftp_h;
  delete $self->{connections}{$server}{$user};
  delete $self->{connection_count}{$server}{$user};
  return $self;
}

=head2 duplicate($server, $user, @old_paths)

Copies files to an automatic new name. Operates similarly to copy above
except that it doesn't reject directories outright: instead they just
get an empty directory created.

Returns a hash of old directory names to new ones, to allow you to clean
up the rest of the copy.

=cut

sub duplicate {
  _validate_argc(3,0,@_);
  my($self, $server, $user, @old_paths)=@_;
  return unless @old_paths;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  my %old_d_to_new;
  for my $old_path (@old_paths) {
    $old_path=~s#^[.]/+##;
    $old_path=~s#/[.]/#/#g;
    $old_path=~s#//+#/#g;
    $old_path=~s# /+ $ ##x; # Just in case.
    next unless $old_path;

    my ($s) = $self->ls_ld($server, $user, $old_path);

    my $filename;
    if($s->{type} eq "-") {
      my ($fh,$tmp_file) = File::Temp::mkstemp("/tmp/ftp.copy.XXXXXX");

      $ftp_h->binary(); # ProFTPd apparently defaults to ASCII nowadays.
      $ftp_h->get($self->__cpath($old_path), $tmp_file);

      # Need to STOU in the named path in case $HOME is not writable(!)
      (my $path_d = $old_path)=~s# [^/]+ $ ##x;
      my $cwd_success = $ftp_h->cwd($self->__cpath($path_d));
      die "Could not enter $path_d!" if ( not $cwd_success );

      $filename = $ftp_h->put_unique($tmp_file);
      # Apparently we sometimes get nothing for no reason.
      unless($filename) {
        ($filename=$tmp_file)=~s#.*/##;
      }
      $filename = $path_d . $filename if $filename;
      $ftp_h->cwd($self->__cpath("/"));
    } elsif($s->{type} eq "d") {
      # Nothing
    } else {
      die "Unimplemented file type $s->{type} for $old_path";
    }
    (my $new_path = $old_path)=~s#(.*?[^./])([.]|$)#$1 Copy 1$2#;
    my $i=1;
    my $out_filename;
    do {
      die if $i >= 100;
      unless($self->stat($server, $user, $new_path)) {
        $out_filename = $new_path;
        if($s->{type} eq "-") {
          $ftp_h->rename($self->__cpath($filename), $self->__cpath($new_path));
        } elsif($s->{type} eq "d") {
          $ftp_h->mkdir($self->__cpath($new_path));
        }
        $self->chmod($server, $user, $new_path, sprintf('%lo', $s->{mode}));
      }
      $i++;
      $new_path=~s/( Copy )[0-9]*/$1$i/;
    } while($i<100 and not $out_filename);
    if($s->{type} eq "d") {
      $old_d_to_new{$old_path} = $out_filename;
    }
  }
  return %old_d_to_new;
}

=head2 excludes($pattern, $pattern, ...)

Configures the instance not to upload any files or directories matching any pattern.

=cut

sub excludes {
  my($self, @patterns)=@_;
  $self->{excludes}=[@patterns];
}

=head2 flush_cache($server,$user,$path)

Flushes the cached directory listings for $path.
If no $path is given, the whole tree is flushed.

=cut

sub flush_cache {
  my ( $self, $server, $user, $path ) = @_;
  _validate_argc(2,3,@_);
  if ( $path ){
    delete $dir_cached{$path};
  } else {
    %dir_cached = ();
  }
}

=head2 ils($server,$user,$path)

Same as ls but intended to treat path as case-insensitive. For use with Windows
to test for conflicting differently cased paths.

Uses server side bash path character class expansion.

=cut

sub ils {
  _validate_argc(3,3,@_);
  my($self,$server,$user,$path)=@_;
  return unless $path;
  # assume case sensitivity limited to ascii ranges
  my %uc_to_lc=map {$_=>lc($_)}("A".."Z");
  map {$path=~s/(?:$_|\l$_)/[$_$uc_to_lc{$_}]/g;} keys %uc_to_lc;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  return map {$_->{filename}} __parse_ls(__dir_cached($self->{connections}{$server}{$user}, $self->__cpath($path) ));
}

=head2 ls($server,$user,$path)

Returns the list of filenames (in a directory...).

=cut

sub ls {
  _validate_argc(3,3,@_);
  my($self,$server,$user,$path)=@_;
  return unless $path;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  return map {$_->{filename}} __parse_ls(__dir_cached($self->{connections}{$server}{$user}, $self->__cpath($path) ));
}

=head2 ls_l($server,$user,$path)

Returns a list of hashrefs representing the contents of a directory.

Keys are:

      link - Where the symlink points to (if it is one)
      type - File type ("-" "l" or "d", probably)
      mode - Permissions number
      hardlinks - Number of hard links!
      user - Owner (name)
      group - Group (name)
      size - Size (bytes?)
      month - Month last modified
      day - Day last modified
      timestamp - Time last modified
      filename - The name of the file, directory, or whatever.

=cut

sub ls_l {
  _validate_argc(3,3,@_);
  my($self,$server,$user,$path)=@_;
  return unless $path;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  return __parse_ls(__dir_cached($self->{connections}{$server}{$user}, $self->__cpath($path) ));
}

=head2 ls_lR($server,$user,$path)

=head2 ls_lR($server,$user,$path, \&callback)

As ls_l above, but recursive. Only use this if you actually want everything!

If you provide a callback, it will be called for each line (with that
line as the only argument) instead of returning. For example, the
following two lines are equivalent:

  $f->ls_lR($server,$user,$path, sub {warn $_[0]->{filename}});

  warn $_->{filename} for $f->ls_lR($server,$user,$path);


=cut

sub ls_lR {
  _validate_argc(3,4,@_);
  my($self,$server,$user,$path, $callback)=@_;
  return unless $path;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  if($callback) {
    my ($ls_context);
    $self->__dir_recursive($server, $user, $self->__cpath($path), sub {
      my (@dirs_raw) = @_;
      __parse_ls(@dirs_raw, {
        context => $ls_context,
        callback => sub {
          my ($f, $context) = @_;
          $ls_context = $context;
          $callback->( __strip_common_prefix($path, $f) ) if $f;
        }
      })
    });
    return;
  } else {
    return __strip_common_prefix($path, __parse_ls($self->__dir_recursive($server, $user, $self->__cpath($path) )));
  }
}

=head2 ls_lR_ts($server,$user,$path)

=head2 ls_lR_ts($server,$user,$path, \&callback)

As ls_lR above, but with the "mtime" field for free.

If you provide a callback, it will be called for each line (with that
line as the only argument) instead of returning.

=cut

sub ls_lR_ts {
  _validate_argc(3,4,@_);
  my($self,$server,$user,$path, $callback)=@_;
  return unless $path;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));

  require Time::Local;
  my @time = localtime;
  my @short_months = qw/
    Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
  /;
  my %sm; $sm{$short_months[$_]} = $_ for 0..$#short_months;

  my @results;

  $self->ls_lR($server,$user,$path, sub {
    my ($f) = @_;

    my $seconds = 0;
    my ($years, $months, $days, $hours, $minutes);

    $months = $sm{$f->{month}};
    $days = $f->{day};

    if( $f->{timestamp} =~/:/) {
      # "Recent" is less than 180 days old.
      ($hours, $minutes) = split(/:/, $f->{timestamp});
      if($months > $time[4]) {
        $years = $time[5]+1900 - 1; # Last year
      } else {
        $years = $time[5]+1900; # This year
      }
    } else {
      ($hours, $minutes) = (0, 0);
      $years = $f->{timestamp};
    }
    # GMT on the server
    $f->{mtime} = Time::Local::timegm($seconds, $minutes, $hours, $days, $months, $years-1900);
    if($callback) {
      $callback->($f);
    } else {
      push @results, $f;
    }
  });
  return if $callback;
  return @results;
}

=head2 ls_l_ts($server,$user,$path)

As ls_l above, but with the "mtime" field for free.

=cut


sub ls_l_ts {
  _validate_argc(3,3,@_);
  my($self,$server,$user,$path)=@_;
  return unless $path;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  my @results =
    __parse_ls(__dir_cached($self->{connections}{$server}{$user}, $self->__cpath($path)));
  require Time::Local;
  my @time = localtime;
  my @short_months = qw/
    Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
  /;
  my %sm; $sm{$short_months[$_]} = $_ for 0..$#short_months;

  for(@results) {
    my $seconds = 0;
    my ($years, $months, $days, $hours, $minutes);

    $months = $sm{$_->{month}};
    $days = $_->{day};

    if( $_->{timestamp} =~/:/) {
      # "Recent" is less than 180 days old.
      ($hours, $minutes) = split(/:/, $_->{timestamp});
      if($months > $time[4]) {
        $years = $time[5]+1900 - 1; # Last year
      } else {
        $years = $time[5]+1900; # This year
      }
    } else {
      ($hours, $minutes) = (0, 0);
      $years = $_->{timestamp};
    }
    # GMT on the server
    $_->{mtime} = Time::Local::timegm($seconds, $minutes, $hours, $days, $months, $years-1900);
  }
  return @results;
}

=head2 ls_ld($server,$user,$path)

As ls_l above, but will not enter directories.

=cut

sub ls_ld {
  _validate_argc(3,3,@_);
  my($self,$server,$user,$path)=@_;
  return unless $path;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  return __parse_ls(__dir_no_enter($self->{connections}{$server}{$user}, $self->__cpath($path)));
}

=head2 mkdir($server, $user, $path, $mode)

Makes a directory, rather like system mkdir(). $mode is merely a string, so
pseudo-octal is safe (nay, required!) here.

=cut

sub mkdir {
  _validate_argc(3,4,@_);
  my($self, $server, $user, $path, $mode)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  $mode = "711" unless defined $mode; # Some callers aren't passing a mode.
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  return __mkdir($ftp_h, $self->__cpath($path), $mode);
}

=head2 mktemps($server, $user, $path, $suffix, $data)

=head2 mktemps($server, $user, $path, $suffix, $data, $mode, $check_path)

Uploads the given data to "$path/$random_filename.$suffix", with mode (fake-octal, sadly) $mode.
Dies if $check_path is true, and it fails to enter the directory.

Returns the generated filename.

=cut

sub mktemps {
  _validate_argc(5,7,@_);
  my($self, $server, $user, $path, $suffix, $data, $mode, $check_path)=@_;
  return if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  $mode||=644;
  my($fh, $file)=File::Temp::mkstemp("$TMPDIR/ftp.u.XXXXXX");
  print $fh $data;
  close $fh;
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  my $cwd_success = $ftp_h->cwd($self->__cpath($path));
  die "Could not enter $path!" if ( $check_path and not $cwd_success );
  $ftp_h->binary(); # ProFTPd apparently defaults to ASCII nowadays.
  my $rv=$ftp_h->put_unique($file);
  # Apparently we sometimes get nothing for no reason.
  unless($rv) {
    ($rv=$file)=~s#.*/##;
  }
  unlink $file;
  $ftp_h->site("chmod",$mode,$self->__cpath($rv));
  $ftp_h->rename($self->__cpath($rv), $self->__cpath("$rv.$suffix"));
  $ftp_h->cwd($self->__cpath("/"));
  return "$path/$rv.$suffix";
}

=head2 mktemps_put($server, $user, $path, $suffix, $local_filename, $mode)

As mktemps() only it cats the file for you.

=cut

sub mktemps_put {
  _validate_argc(6,7,@_);
  my ( $self, $server, $user, $path, $suffix, $local_filename, $mode,
      $check_path ) = @_;
  open(my $f, "<", $local_filename) or die "$local_filename: $!";
  local $/=undef;
  my $data=<$f>;
  close $f;
  return $self->mktemps($server, $user, $path, $suffix, $data, $mode,
      $check_path);
}

=head2 mktemps_with_logging(...)

See ftpcp::jarrod

DEPRECATED: please use mktemps_with_logging in hosting_helper.pm,
available directly through your HostingCommon object.

Only use this directly from places where HI.pm is available. 
If HI.pm is not available use mktemps() below.

=cut

sub mktemps_with_logging {
  require ftpcp::jarrod;
  return ftpcp::jarrod::mktemps_with_logging(@_);
}

=head2 open_connection($server, $user)

Opens a connection for a PORT command. You shouldn't need to do this manually,
but if you do you MUST remember to call ->shutdown() yourself.

This is not recommended because apparently proftpd can jam if you try to use
the same socket too much.

=cut

sub open_connection {
  _validate_argc(2,2,@_);
  my($self, $server, $user)=@_;
  return "" if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));

  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};

  require ftpcp::filehandle;
  require IO::Socket::INET;
  my @tried_ports;
  for(my $i=0; $i<10; $i++) {
    my $port = int(49152 + rand(65535-49152));
    my $s = new IO::Socket::INET(
      Listen=>1,
      LocalAddr=>$ftp_h->sockhost.":".$port,
      Proto=>"tcp",
      Type=>SOCK_STREAM,
    );
    return $s if $s;
    push @tried_ports, $port;
  }
  warn "Could not allocate a port, tried: ".join(", ", sort @tried_ports);
  return;
}

=head2 open_fh($server, $user, $path)

=head2 open_fh($server, $user, $path, $connection)

Returns a filehandle (ish) which can be used to read a file.

If set, $connection is a socket created with open_connection() above. You should
use OO style FH operations with the return, eg. $fh->close().

=cut

sub open_fh {
  _validate_argc(3,4,@_);
  my($self, $server, $user, $path, $connection)=@_;
  return $self->open_fh_any($server, $user, ["RETR", $self->__cpath($path)], $connection);
}

=head2 open_fh_any($server, $user, \@action)

=head2 open_fh_any($server, $user, \@action, $connection)

Returns a filehandle (ish) which can be used to read the results of a
command. This is the core of open_fh.

If set, $connection is a socket created with open_connection() above. You
should use OO style FH operations with the return, eg. $fh->close().

=cut

sub open_fh_any {
  _validate_argc(3,4,@_);
  my($self, $server, $user, $action, $connection)=@_;
  return "" if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));

  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};

  my $passive = $self->{connection_flags}{$server}{$user}{passive};

  my $receive_fh;

  if($passive) {
    my $response;

    my $receive_conn;
    if($connection) {
      $receive_conn = $connection
    } else {
      $receive_conn = $self->open_passive_connection($server, $user);
    }

    ($response) = $ftp_h->quot(@$action);
    # 150 for success.
    unless($response==1) {
      warn "Response was: $response on for ".join(" ", @$action);
      $receive_conn->close unless $connection;
      return;
    }
    $receive_fh = $receive_conn;
    bless($receive_fh, "ftpcp::filehandle");
    $receive_fh->ftp($ftp_h);

  } else {
    my $response;

    my $receive_conn;
    if($connection) {
      $receive_conn = $connection
    } else {
      $receive_conn = $self->open_connection($server, $user);
    }
    ($response) = $ftp_h->port(
      join(",", 
        split(/\./, $receive_conn->sockhost),
        map { ($_>>8, $_&0xff) } $receive_conn->sockport
      )
    );
    # 200 for success. But the above is just true/false.
    unless($response) {
      warn "Response was: $response";
      $receive_conn->close unless $connection;
      return;
    }

    ($response) = $ftp_h->quot(@$action);
    # 150 for success.
    unless($response==1) {
      warn "Response was: $response on for ".join(" ", @$action);
      $receive_conn->close unless $connection;
      return;
    }
    $receive_fh = $receive_conn->accept();
    bless($receive_fh, "ftpcp::filehandle");
    $receive_fh->ftp($ftp_h);
    $receive_fh->parent($receive_conn) unless $connection;
  }
  return $receive_fh;
}

=head2 open_passive_connection($server, $user)

Opens a connection via a PASV command. You shouldn't need to do this manually.

=cut

sub open_passive_connection {
  _validate_argc(2,2,@_);
  my($self, $server, $user)=@_;
  return "" if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));

  require ftpcp::filehandle;
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};

  my ($response) = $ftp_h->quot("PASV");
  if($response==2) {
    die unless $ftp_h->message=~/[^\d,]((?:\d+,)+\d+)[^\d,]/;
    my @parts = split(/,/, $1);
    my $ip_address = join(".", @parts[0..3]);
    my $port = $parts[4]*256 + $parts[5];
    return new IO::Socket::INET($ip_address.":".$port);
  } else {
    die;
  }
}

=head2 put_flat($val)

Sets put_flat mode to $val||1 ... which means that for the next PUT transaction (only) it will put
*the contents of* an uploaded directory into the upload location, rather than the directory itself.

=cut

sub put_flat {
  my($self, $val)=@_;
  $self->{_put_flat}=$val||1;
}

=head2 rename($server, $user, @old_paths, $new_path)

Moves (renames) files. If you ask for multiple files and do not provide a new
path with a trailing slash, nothing will be done.

If $new_path does contain a trailing slash, it will be treated as "move into
the directory $new_path".

=cut

sub rename {
  _validate_argc(4,0,@_);
  my $new_path = pop(@_);
  my($self, $server, $user, @old_paths)=@_;
  return unless @old_paths;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  return if($new_path!~m# / $ #x and @old_paths>1);
  for my $old_path (@old_paths) {
    $old_path=~s# /+ $ ##x; # Just in case.
    next unless $old_path;
    (my $old_path_short = $old_path)=~s#.*/##;
    my $new_path_full = ($new_path=~m# / $ #x) ?
      "$new_path/$old_path_short" : 
      $new_path;
    unless($ftp_h->rename($self->__cpath($old_path), $self->__cpath($new_path_full))) {
      warn "Rename: $old_path -> $new_path_full: ".$ftp_h->message;
      return;
    }
  }
  return scalar(@old_paths);
}

=head2 rename_haltoncollide($server, $user, @old_paths, $new_path)

As rename(), but it will abort if there is any kind of name collission.

=cut

sub rename_haltoncollide {
  _validate_argc(4,0,@_);
  my $new_path = pop(@_);
  my($self, $server, $user, @old_paths)=@_;
  return unless @old_paths;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  return if($new_path!~m# / $ #x and @old_paths>1);
  for my $old_path (@old_paths) {
    $old_path=~s# /+ $ ##x; # Just in case.
    next unless $old_path;
    (my $old_path_short = $old_path)=~s#.*/##;
    my $new_path_full = ($new_path=~m# / $ #x) ?
      "$new_path/$old_path_short" : 
      $new_path;
    return if $self->_stat($server, $user, $new_path_full);
  }
  return $self->rename($server, $user, @old_paths, $new_path);
}

=head2 replace($server, $user, $path, \&callback)

=head2 replace($server, $user, $path, \&callback, $swap_if_needed)

Replaces the contents of a file. Essentially this is:

  catput(..., callback( cat(...) ));

It is perfectly fine to call this as catput-that-takes-a-sub; should
the file not exist, you can expect the input data to be undefined.

Should your callback return an undefined value, no work will be done,
but this should be taken as merely "there will be no attempt to write
undef content if the file does not exist".

It's possible that in some cases (windows) that you will not be able
to replace the file but will be able to move it. If this is happening,
set $swap_if_needed to true.

=cut

sub replace {
  _validate_argc(4,5,@_);
  my($self, $server, $user, $path, $callback, $swap_if_needed)=@_;
  
  my $to_write = $callback->( $self->cat($server, $user, $path) );
  return unless defined $to_write;
  my $rv = $self->catput($server, $user, $path, $to_write);
  return $rv if $rv;
  if($swap_if_needed) {
    my $temp_filename = $self->mktemps($server, $user, ".", "tmp", $to_write);
    $self->rm($server, $user, $temp_filename, "$path.old");
    $self->rename($server, $user, $path, "$path.old");
    $rv = $self->rename($server, $user, $temp_filename, $path);
  }
  return $rv;
}

=head2 rm($server, $user, @paths)

Deletes the file(s), or empty directories, in question.

Returns true only on complete success.

=cut

sub rm {
  _validate_argc(3,0,@_);
  my($self, $server, $user, @paths)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  for(@paths) {
    return unless($ftp_h->delete($self->__cpath($_)) or $ftp_h->rmdir($self->__cpath($_), 0));
  }
  return 1;
}

=head2 rm_r($server, $user, @paths)

Deletes the file(s), or full directories, in question.

Returns true only on complete success.

=cut

sub rm_r {
  _validate_argc(3,0,@_);
  my($self, $server, $user, @paths)=@_;
  return $self->rm_r_interactive($server, $user, undef, @paths);
}

=head2 rm_r_interactive($server, $user, \&callback, @paths)

As rm_r, except that callback($path) is called whenever a path is
removed. Providing an undefined callback is valid.

=cut

sub rm_r_interactive {
  _validate_argc(4,0,@_);
  my($self, $server, $user, $callback, @paths)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  for(@paths) {
    next if m#/ \. \.? /? $ #x; # No dot or dot-dot.
    if($ftp_h->delete($self->__cpath($_))) {
      $callback->( $self->__cpath($_) ) if $callback;
    } else {
      my @subpaths = $self->ls($server,$user,"$_/");
      for my $sp (@subpaths) {
        next if $sp=~/^\.\.?$/;
        return unless $self->rm_r_interactive($server,$user,$callback, "$_/$sp");
      }
      return unless $ftp_h->rmdir($self->__cpath($_), 0);
      $callback->( $self->__cpath($_) ) if $callback;
    }
  }
  return 1;
}

=head2 rmdir($server, $user, $path)

Removes a directory, rather like system rmdir().

=cut

sub rmdir {
  _validate_argc(3,3,@_);
  my($self, $server, $user, $path)=@_;
  return 1 if($lie_to_me and not($OVERRIDE_PORT or $OVERRIDE_HOST));
  unless(exists $self->{connections}{$server}{$user}) {
    _die_no_connection($server, $user);
  }
  my $ftp_h=$self->{connections}{$server}{$user};
  return __rmdir($ftp_h, $self->__cpath($path));
}

=head2 stat($server,$user,$path)

Literally: (ls($server,$user,$path))[0]

In other words, it returns the filename if it exists.

=cut

sub stat {
  _validate_argc(3,3,@_);
  return _stat(@_);
}

1;