AnyEvent-FTP

 view release on metacpan or  search on metacpan

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

  # to have their own store you could subclass
  # and redefine the store method as apropriate
  state $store = {};
  $store;
}


has cwd => (
  is      => 'rw',
  default => sub {
    Path::Class::Dir->new_foreign('Unix', '/');
  },
);


sub _first_index (&@)
{
  my $f = shift;
  foreach my $i ( 0 .. $#_ )
  {
    local *_ = \$_[$i];
    return $i if $f->();
  }
  return -1;
}

sub find
{
  my($self, $path) = @_;
  $path = Path::Class::Dir->new_foreign('Unix', $path) unless ref $path;
  $path = Path::Class::Dir->new_foreign('Unix', $self->cwd, $path)
    unless $path->is_absolute;

  my $store = $self->store;

  return $store if $path eq '/';

  my @list = $path->components;

  while(1)
  {

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

  $self->{rename_from};
}


sub help_cwd { 'CWD <sp> pathname' }

sub cmd_cwd
{
  my($self, $con, $req) = @_;

  my $dir = Path::Class::Dir->new_foreign('Unix', $req->args)->cleanup;
  $dir = $dir->absolute($self->cwd) unless $dir->is_absolute;

  my @list = grep !/^\.$/, $dir->components;

  while(1)
  {
    my $i = _first_index { $_ eq '..' } @list;
    last if $i == -1;
    if($i > 1)
    {
      splice @list, $i-1, 2;
    }
    else
    {
      splice @list, $i, 1;
    }
  }


  $dir = Path::Class::Dir->new_foreign('Unix', @list);

  if(ref($self->find($dir)) eq 'HASH')
  {
    $self->cwd($dir);
    $con->send_response(250 => 'CWD command successful');
  }
  else
  {
    $con->send_response(550 => 'CWD error');
  }

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

  $self->done;
}


sub help_size { 'SIZE <sp> pathname' }

sub cmd_size
{
  my($self, $con, $req) = @_;

  my $file = $self->find(Path::Class::File->new_foreign('Unix', $req->args));

  if(defined($file) && !ref($file))
  {
    $con->send_response(213 => length $file);
  }
  elsif(defined $file)
  {
    $con->send_response(550 => $req->args . ": not a regular file");
  }
  else

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

  $self->done;
}


sub help_mkd { 'MKD <sp> pathname' }

sub cmd_mkd
{
  my($self, $con, $req) = @_;

  my $path = Path::Class::Dir->new_foreign('Unix', $req->args);
  my $file = $self->find($path->parent);
  if($path->basename ne '' && defined($file) && ref($file) eq 'HASH')
  {
    if(exists $file->{$path->basename})
    {
      $con->send_response(521 => "\"$path\" directory exists");
    }
    else
    {
      $file->{$path->basename} = {};

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

}


sub help_rmd { 'RMD <sp> pathname' }

sub cmd_rmd
{
  my($self, $con, $req) = @_;

  # TODO: be more picky about rmd and file or dele a directory
  my $path = Path::Class::Dir->new_foreign('Unix', $req->args);
  my $file = $self->find($path->parent);
  if(defined($file) && ref($file) eq 'HASH')
  {
    if(exists $file->{$path->basename})
    {
      delete $file->{$path->basename};
      $con->send_response(250 => "RMD command successful");
    }
    else
    {

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

}


sub help_dele { 'DELE <sp> pathname' }

sub cmd_dele
{
  my($self, $con, $req) = @_;

  my $path = Path::Class::File->new_foreign('Unix', $req->args);
  my $file = $self->find($path->parent);
  if(defined($file) && ref($file) eq 'HASH')
  {
    if(exists $file->{$path->basename})
    {
      delete $file->{$path->basename};
      $con->send_response(250 => "File removed");
    }
    else
    {

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

  $self->done;
}


sub help_rnfr { 'RNFR <sp> pathname' }

sub cmd_rnfr
{
  my($self, $con, $req) = @_;

  my $path = Path::Class::File->new_foreign('Unix', $req->args);
  my $dir = $self->find($path->parent);
  if(ref($dir) eq 'HASH')
  {
    if(exists $dir->{$path->basename})
    {
      $self->rename_from([$dir,$path->basename]);
      $con->send_response(350 => 'File or directory exists, ready for destination name');
    }
    else
    {

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

  my $from = $self->rename_from;

  unless(defined $from)
  {
    $con->send_response(503 => 'Bad sequence of commands');
    $self->done;
    return;
  }

  my $path = Path::Class::File->new_foreign('Unix', $req->args);
  my $dir = $self->find($path->parent);

  if(ref($dir) eq 'HASH')
  {
    if(exists $dir->{$path->basename})
    {
      $con->send_response(550 => 'File already exists');
    }
    else
    {

lib/AnyEvent/FTP/Server/Context/Memory.pm  view on Meta::CPAN

  }

  eval {
    $con->send_response(150 => "Opening ASCII mode data connection for file list");
    my @list;
    if($dir)
    {
      my $h = $self->find($dir);
      if(ref($h) eq 'HASH')
      {
        $dir = Path::Class::Dir->new_foreign('Unix', $dir);
        @list = map { $dir->file($_) } sort keys %$h;
      }
      else
      {
        $dir = Path::Class::File->new_foreign('Unix', $dir);
        @list = "$dir";
      }
    }
    else
    {
      my $h = $self->find($self->cwd);
      die 'unable to find cwd' unless defined $h;
      @list = sort keys %$h;
    }
    $self->data->push_write(join '', map { $_ . "\015\012" } @list);

lib/AnyEvent/FTP/Server/OS/UNIX.pm  view on Meta::CPAN

=head1 VERSION

version 0.20

=head1 SYNOPSIS

 use AnyEvent::FTP::Server::OS::UNIX;
 
 # interface using user fred
 my $unix = AnyEvent::FTP::Server::OS::UNIX->new('fred');
 $unix->jail;            # chroot
 $unix->drop_privileges; # transform into user fred

=head1 DESCRIPTION

This class provides some utility functionality for interacting with the
UNIX and UNIX like operating systems.

=head1 ATTRIBUTES

=head2 name

lib/AnyEvent/FTP/Server/OS/UNIX.pm  view on Meta::CPAN

The user's shell

=head2 groups

List of groups (as GIDs) that the user also belongs to.

=head1 METHODS

=head2 jail

 $unix->jail;

C<chroot> to the users' home directory.  Requires root and the chroot function.

=head2 drop_privileges

 $unix->drop_privileges;

Drop super user privileges

=head1 AUTHOR

Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>

Contributors:

Ryo Okamoto

share/ppt/ls.pl  view on Meta::CPAN

List numeric uid and gid (default on platforms without getpwuid()).

=item -r

Reverse sorting order.

=item -s

List file/directory size in 512-byte blocks.  (May not mean much
on non-Unix systems.)

=item -t

Sort by descending last modification time.

=item -u

Sort by descending last access time.

=back

=head1 ENVIRONMENT

=head1 BUGS

The file metadata from stat() is used, which may not necessarily
mean much on non-Unix systems.  Specifically, the uid, gid, inode,
and block numbers may be meaningless (or less than meaningful
at least).

The B<-l> option does not yet list the major and minor
device numbers for special files, but it does list
the value of the 'dev' field as 2 hex 16-bit words.
Doing this properly would
probably require filesystem type probing.

=head1 AUTHOR

t/anyevent_ftp_server_context_memory__cdup.t  view on Meta::CPAN

$t->command_ok('NOOP')
  ->code_is(200);

is $context->cwd, "/", "cwd = /";

$t->command_ok('CDUP')
  ->code_is(250);

is $context->cwd, "/", "cwd = /";

$context->cwd(Path::Class::Dir->new_foreign('Unix', '/top/foo/bar/stuff'));

$t->command_ok('CDUP')
  ->code_is(250);

is $context->cwd, "/top/foo/bar", "cwd = /top/foo/bar";

$context->cwd(Path::Class::Dir->new_foreign('Unix', '/bogus/directory'));

$t->command_ok('CDUP')
  ->code_is(550);

done_testing;

t/anyevent_ftp_server_context_memory__pwd.t  view on Meta::CPAN

$t->on_connect(sub { $context = shift->context });

# force a connect
$t->command_ok('NOOP')
  ->code_is(200);

$t->command_ok('PWD')
  ->code_is(257)
  ->message_is('"/" is the current directory');

$context->cwd(Path::Class::Dir->new_foreign("Unix", '', qw( foo bar baz )));

$t->command_ok('PWD')
  ->code_is(257)
  ->message_is('"/foo/bar/baz" is the current directory');

done_testing;