File Coverage

blib/lib/AnyEvent/FTP/Server/OS/UNIX.pm
Criterion Covered Total %
statement 11 25 44.0
branch 0 2 0.0
condition n/a
subroutine 4 7 57.1
pod 2 3 66.6
total 17 37 45.9


line stmt bran cond sub pod time code
1             package AnyEvent::FTP::Server::OS::UNIX;
2              
3 1     1   800 use strict;
  1         2  
  1         24  
4 1     1   4 use warnings;
  1         2  
  1         20  
5 1     1   13 use 5.010;
  1         2  
6 1     1   3 use Moo;
  1         3  
  1         4  
7              
8             # ABSTRACT: UNIX implementations for AnyEvent::FTP
9             our $VERSION = '0.19'; # VERSION
10              
11              
12             sub BUILDARGS
13             {
14 0     0 0   my($class, $query) = @_;
15 0           my($name, $pw, $uid, $gid, $quota, $comment, $gcos, $dir, $shell, $expire) = getpwnam $query;
16 0 0         die "user not found" unless $name;
17              
18             return {
19 0           name => $name,
20             uid => $uid,
21             gid => $gid,
22             home => $dir,
23             shell => $shell,
24             }
25             }
26              
27              
28             has $_ => ( is => 'ro', required => 1 ) for (qw( name uid gid home shell ));
29              
30              
31             has groups => (
32             is => 'ro',
33             lazy => 1,
34             default => sub {
35             my $name = shift->name;
36             my @groups;
37             setgrent;
38             my @grent;
39             while(@grent = getgrent)
40             {
41             my($group,$pw,$gid,$members) = @grent;
42             foreach my $member (split /\s+/, $members)
43             {
44             push @groups, $gid if $member eq $name;
45             }
46             }
47             \@groups;
48             },
49             );
50              
51              
52             sub jail
53             {
54 0     0 1   my($self) = @_;
55 0           chroot $self->home;
56 0           return $self;
57             }
58              
59              
60             sub drop_privileges
61             {
62 0     0 1   my($self) = @_;
63              
64 0           $) = join ' ', $self->gid, $self->gid, @{ $self->groups };
  0            
65 0           $> = $self->uid;
66              
67 0           $( = $self->gid;
68 0           $< = $self->uid;
69              
70 0           return $self;
71             }
72              
73             1;
74              
75             __END__