File Coverage

lib/Ubic/Credentials/OS/POSIX.pm
Criterion Covered Total %
statement 106 166 63.8
branch 30 76 39.4
condition 4 12 33.3
subroutine 20 22 90.9
pod 12 12 100.0
total 172 288 59.7


line stmt bran cond sub pod time code
1             package Ubic::Credentials::OS::POSIX;
2             $Ubic::Credentials::OS::POSIX::VERSION = '1.60';
3 37     37   114 use strict;
  37         42  
  37         803  
4 37     37   109 use warnings;
  37         37  
  37         751  
5              
6 37     37   460 use parent qw(Ubic::Credentials);
  37         254  
  37         204  
7              
8             # ABSTRACT: POSIX-specific credentials implementation
9              
10              
11 37     37   1713 use List::MoreUtils qw(uniq);
  37         38  
  37         147  
12              
13 37     37   9239 use Params::Validate qw(:all);
  37         53  
  37         4118  
14 37     37   131 use Carp;
  37         40  
  37         45597  
15              
16             sub new {
17 186     186 1 243 my $class = shift;
18 186         2483 my $params = validate(@_, {
19             user => 0,
20             group => 0,
21             service => { optional => 1, isa => 'Ubic::Service' },
22             });
23              
24 186         565 my $self = {};
25 186 50       473 if (defined $params->{user}) {
    100          
26 0 0       0 if (defined $params->{service}) {
27 0         0 croak "Only one of 'user' and 'service' parameters should be specified";
28             }
29 0         0 $self->{user} = $params->{user};
30 0 0       0 $self->{group} = $params->{group} if defined $params->{group};
31             }
32             elsif (defined $params->{service}) {
33 92         316 $self->{user} = $params->{service}->user;
34 92         240 my @group = $params->{service}->group;
35 92 50       186 $self->{group} = [ @group ] if @group;
36             }
37             else {
38 94         343 $self->{real_user_id} = $<;
39 94         193 $self->{effective_user_id} = $>;
40 94         463 $self->{real_group_id} = [ split / /, $( ];
41 94         311 $self->{effective_group_id} = [ split / /, $) ];
42             # TODO - derive user from real_user_id when user is not specified (or from effective_user_id?!)
43             }
44              
45 186         961 return bless $self => $class;
46             }
47              
48             sub user {
49 200     200 1 180 my $self = shift;
50 200 50       377 unless (defined $self->{user}) {
51 0         0 my $user = getpwuid($>);
52 0 0       0 unless (defined $user) {
53 0         0 die "failed to get user name by uid $>";
54             }
55 0         0 $self->{user} = $user;
56             }
57 200         342 return $self->{user};
58             }
59              
60             sub group {
61 108     108 1 106 my $self = shift;
62 108 100       191 unless (defined $self->{group}) {
63 92         170 $self->_user2group;
64             }
65 108 50       271 unless (ref $self->{group}) {
66 0         0 $self->{group} = [ $self->{group} ];
67             }
68 108         94 return @{ $self->{group} };
  108         243  
69             }
70              
71             sub _user2uid {
72 32     32   30 my $self = shift;
73 32         66 my $user = $self->user;
74 32         1496 my $id = scalar getpwnam($user);
75 32 50       108 unless (defined $id) {
76 0         0 die "user $user not found";
77             }
78 32         120 return $id;
79             }
80              
81             sub real_user_id {
82 34     34 1 43 my $self = shift;
83 34 100       231 return $self->{real_user_id} if defined $self->{real_user_id};
84 16         37 return $self->_user2uid;
85             }
86              
87             sub effective_user_id {
88 110     110 1 327 my $self = shift;
89 110 100       411 return $self->{effective_user_id} if defined $self->{effective_user_id};
90 16         42 return $self->_user2uid;
91             }
92              
93             sub _group2gid {
94 32     32   41 my $self = shift;
95 32         62 my @group = $self->group;
96 32         31 my @gid;
97 32         88 for my $group (@group) {
98 32         888 my $gid = getgrnam($group);
99 32 50       85 unless (defined $gid) {
100 0         0 croak "group $group not found";
101             }
102 32         80 push @gid, $gid;
103             }
104 32 50       534 @gid = (@gid, @gid) if @gid == 1; # otherwise $) = "1 0"; $) = "1" leaves 0 in group list
105 32         180 return @gid;
106             }
107              
108             sub real_group_id {
109 34     34 1 36 my $self = shift;
110 34 100       72 return @{ $self->{real_group_id} } if defined $self->{real_group_id};
  18         59  
111 16         32 return $self->_group2gid;
112             }
113              
114             sub effective_group_id {
115 110     110 1 113 my $self = shift;
116 110 100       225 return @{ $self->{effective_group_id} } if defined $self->{effective_group_id};
  94         247  
117 16         41 return $self->_group2gid;
118             }
119              
120             sub _user2group {
121 92     92   80 my $self = shift;
122 92         130 my $user = $self->user;
123 92 50       173 confess "user not defined" unless defined $user;
124              
125 92         5031 my @pwnam = getpwnam $user;
126 92 50       276 unless (@pwnam) {
127 0         0 die "getpwnam failed for user $user";
128             }
129 92         98 my $group_id = $pwnam[3];
130 92         2127 my $main_group = getgrgid($group_id);
131 92 50       214 unless ($main_group) {
132 0         0 die "failed to get group name by gid $group_id";
133             }
134              
135             # TODO - can getgrent fail?
136 92         1570 setgrent();
137 92         101 my @groups;
138 92         1121 while (my @grent = getgrent()) {
139 4048         3355 my @users = split / /, $grent[3];
140 4048 50       13752 push @groups, $grent[0] if grep { $_ eq $user } @users;
  92         513  
141             }
142 92         874 endgrent();
143              
144 92         509 $self->{group} = [ $main_group, @groups ];
145             }
146              
147             sub set_effective {
148 76     76 1 91 my $self = shift;
149              
150 76         207 my $current_creds = Ubic::Credentials->new;
151 76         158 my $euid = $current_creds->effective_user_id();
152 76         151 my ($egid) = $current_creds->effective_group_id();
153 76         456 $egid =~ s/^(\d+).*/$1/;
154              
155 76         3730 my $current_user = getpwuid($euid);
156 76 50       233 unless (defined $current_user) {
157 0         0 die "failed to get current user name by euid $euid";
158             }
159 76         2649 my $current_group = getgrgid($egid);
160 76 50       197 unless (defined $current_group) {
161 0         0 die "failed to get current group name by egid $egid";
162             }
163              
164 76         221 my $user = $self->user;
165 76         143 my ($group) = $self->group;
166              
167 76 50       163 if ($group ne $current_group) {
168 0         0 $self->{old_egid} = $);
169 0         0 my $new_gid = getgrnam($group);
170 0 0       0 unless (defined $new_gid) {
171 0         0 die "group $group not found";
172             }
173              
174             # AccessGuard don't need to handle supplementary groups correctly, so this is ok
175 0         0 $) = "$new_gid 0";
176 0         0 my ($current_gid) = $) =~ /^(\d+)/;
177 0 0       0 if ($current_gid != $new_gid) {
178 0         0 die "Failed to change group from $current_group to $group: $!";
179             }
180             }
181              
182 76 50       408 if ($user ne $current_user) {
183 0         0 $self->{old_euid} = $>;
184 0 0       0 if ($current_user ne 'root') {
185 0         0 die "Can't change user from $current_user to $user";
186             }
187 0         0 my $new_uid = getpwnam($user);
188 0 0       0 unless (defined $new_uid) {
189 0         0 die "user $user not found";
190             }
191 0         0 $> = $new_uid;
192 0 0       0 if ($> != $new_uid) {
193 0         0 die "Failed to change user from $current_user to $user: $!";
194             }
195             }
196             }
197              
198             sub _groups_equal {
199 34     34   64 my ($self, $g1, $g2) = @_;
200 34         85 my ($main1, @other1) = split / /, $g1;
201 34         72 my ($main2, @other2) = split / /, $g2;
202 34   33     535 return ($main1 == $main2 and join(' ', sort { $a <=> $b } uniq($main1, @other1)) eq join(' ', sort { $a <=> $b } uniq($main2, @other2)));
203             }
204              
205              
206             sub reset_effective {
207 76     76 1 86 my $self = shift;
208              
209 76 50       194 if (defined $self->{old_euid}) {
210 0         0 $> = $self->{old_euid}; # return euid back to normal
211 0 0       0 if ($> != $self->{old_euid}) {
212 0         0 warn "Failed to restore euid from $> to $self->{old_euid}: $!";
213             }
214             }
215 76 50       492 if (defined $self->{old_egid}) {
216 0         0 $) = $self->{old_egid}; # return egid back to normal
217 0 0       0 if ($) != $self->{old_egid}) {
218 0         0 warn "Failed to restore egid from '$)' to '$self->{old_egid}': $!";
219             }
220             }
221             }
222              
223             sub eq {
224 17     17 1 31 my ($self, $other) = @_;
225 17 50 33     46 if (
      33        
      33        
226             $self->effective_user_id == $other->effective_user_id
227             and $self->real_user_id == $other->real_user_id
228             and $self->_groups_equal(join(" ", $self->effective_group_id), join(" ", $other->effective_group_id))
229             and $self->_groups_equal(join(" ", $self->real_group_id), join(" ", $other->real_group_id))
230             ) {
231 17         60 return 1;
232             }
233             else {
234 0           return;
235             }
236             }
237              
238             sub set {
239 0     0 1   my ($self) = @_;
240 0           my @effective_gid = $self->effective_group_id;
241 0           $) = "@effective_gid";
242 0 0         unless ($self->_groups_equal($), "@effective_gid")) {
243 0           die "Failed to set effective gid to @effective_gid: $!";
244             }
245 0           my $new_euid = $self->effective_user_id;
246 0           $> = $new_euid;
247 0 0         unless ($> == $new_euid) {
248 0           die "Failed to set effective uid to $new_euid: $!";
249             }
250 0           my @real_gid = $self->real_group_id;
251 0           $( = $real_gid[0];
252 0 0         unless ($self->_groups_equal($(, "@real_gid")) {
253 0           die "Failed to set real gid to @real_gid: $! (\$( = $(, real_gid = @real_gid)";
254             }
255 0           my $new_ruid = $self->real_user_id;
256 0           $< = $new_ruid;
257 0 0         unless ($< == $new_ruid) {
258 0           die "Failed to set real uid to $new_ruid: $!";
259             }
260             }
261              
262             sub as_string {
263 0     0 1   my $self = shift;
264 0           my $user = $self->user;
265 0           my ($group) = $self->group; # ignore complementary groups for the sake of readability
266 0           return "$user:$group";
267             }
268              
269              
270             1;
271              
272             __END__