AnyEvent-FTP

 view release on metacpan or  search on metacpan

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

use 5.010;
use Moo;

# ABSTRACT: UNIX implementations for AnyEvent::FTP
our $VERSION = '0.20'; # VERSION


sub BUILDARGS
{
  my($class, $query) = @_;
  my($name, $pw, $uid, $gid, $quota, $comment, $gcos, $dir, $shell, $expire) = getpwnam $query;
  die "user not found" unless $name;

  return {
    name  => $name,
    uid   => $uid,
    gid   => $gid,
    home  => $dir,
    shell => $shell,
  }
}


has $_ => ( is => 'ro', required => 1 ) for (qw( name uid gid home shell ));


has groups => (
  is      => 'ro',
  lazy    => 1,
  default => sub {
    my $name = shift->name;
    my @groups;
    setgrent;
    my @grent;
    while(@grent = getgrent)
    {
      my($group,$pw,$gid,$members) = @grent;
      foreach my $member (split /\s+/, $members)
      {
        push @groups, $gid if $member eq $name;
      }
    }
    \@groups;
  },
);


sub jail
{
  my($self) = @_;
  chroot $self->home;
  return $self;
}


sub drop_privileges
{
  my($self) = @_;

  $) = join ' ', $self->gid, $self->gid, @{ $self->groups };
  $> = $self->uid;

  $( = $self->gid;
  $< = $self->uid;

  return $self;
}

1;

__END__

=pod

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

=head1 ATTRIBUTES

=head2 name

The user's username

=head2 uid

The user's UID

=head2 gid

The user's GID

=head2 home

The user's home directory

=head2 shell

The user's shell

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

  my @permstrs = @perms[($mode&0700)>>6, ($mode&0070)>>3, $mode&0007];
  my $ftype = $ftype[($mode & 0170000)>>12];

  if ($setids) {
    if ($setids & 01) {		# Sticky bit
      $permstrs[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e;
    }
    if ($setids & 04) {		# Setuid bit
      $permstrs[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
    }
    if ($setids & 02) {		# Setgid bit
      $permstrs[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
    }
  }

  join '', $ftype, @permstrs;
}

# ------ define variables
my $Arg = "";		# file/directory name argument from @ARGV
my $ArgCount = 0;	# file/directory argument count
my $Attributes = "";	# File::stat from STDOUT (isatty() kludge)
my %Attributes = ();	# File::stat directory entry attributes
my %DirEntries = ();	# hash of dir entries and stat attributes
my $Getgrgid = "";	# getgrgid() for this platform
my $Getpwuid = "";	# getpwuid() for this platform
my @Dirs = ();		# directories in ARGV
my @Files = ();		# non-directories in ARGV
my $First = 1;		# first directory entry on command line
my $Maxlen = 1;		# longest string we've seen
my $Now = time;		# time we were invoked
my %Options = ();	# option/flag arguments
my $SixMonths =		# long listing time if < 6 months, else year
 60*60*24*(365/2);
my $VERSION = '0.70';	# because we're V7-compatible :)
my $WinSize = "\0" x 8;	# window size buffer
my $TIOCGWINSZ =	# get window size via ioctl()
 0x40087468;		# should be require sys/ioctl.pl,
			# but that won't exist on all platforms
my $WinCols = 0;	# window columns of output
my $WinRows = 0;	# window rows of output
my $Xpixel = 0;		# window start X
my $Ypixel = 0;		# window start Y

# ------ compensate for lack of getpwuid/getgrgid on some platforms
eval { my $dummy = ""; $dummy = (getpwuid(0))[0] };
if ($@) {
	$Getpwuid = sub { return ($_[0], 0); };
	$Getgrgid = sub { return ($_[0], 0); };
} else {
	$Getpwuid = sub { return getpwuid($_[0]); };
	$Getgrgid = sub { return getgrgid($_[0]); };
}

# ------ functions

# ------ get directory entries
sub DirEntries {
	my $Options = shift;	# option arguments hashref
	local *DH;		# directory handle
	my %Attributes = ();	# entry/attributes hash
	my @Entries = ();	# entries in original order

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

			  &$Getpwuid($Attributes->{$Entry}->uid);
				if (defined($Uid)) {
					printf("%-8s ", $Uid);
				} else {
					printf("%-8d ",
				 $Attributes->{$Entry}->uid);
				}
			}
			if (exists($Options->{'n'})) {
				printf("%-8d ",
				 $Attributes->{$Entry}->gid);
			} else {
				$Gid =
			  &$Getgrgid($Attributes->{$Entry}->gid);
				if (defined($Gid)) {
					printf("%-8s ", $Gid);
				} else {
					printf("%-8d ",
				 $Attributes->{$Entry}->gid);
				}
			}
			if ($Attributes->{$Entry}->mode & 0140000) {
				printf("%9d ",
				 $Attributes->{$Entry}->size);
			} else {
				printf("%4x,%4x ",
				 (($Attributes->{$Entry}->dev
				  & 0xFFFF000) > 16),
				 $Attributes->{$Entry}->dev

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

When used with B<-s>, list file/directory size in 1024-byte blocks.

=item -l

Long format listing of mode -- # of links, owner name, group name,
size in bytes, time of last modification, and name.

=item -n

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.)

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

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