File Coverage

blib/lib/Doit/User.pm
Criterion Covered Total %
statement 47 145 32.4
branch 15 112 13.3
condition 3 29 10.3
subroutine 5 14 35.7
pod 0 5 0.0
total 70 305 22.9


line stmt bran cond sub pod time code
1             # -*- perl -*-
2              
3             #
4             # Author: Slaven Rezic
5             #
6             # Copyright (C) 2017 Slaven Rezic. All rights reserved.
7             # This package is free software; you can redistribute it and/or
8             # modify it under the same terms as Perl itself.
9             #
10             # Mail: slaven@rezic.de
11             # WWW: http://www.rezic.de/eserte/
12             #
13              
14             package Doit::User;
15              
16 1     1   488 use strict;
  1         2  
  1         27  
17 1     1   4 use warnings;
  1         2  
  1         35  
18             our $VERSION = '0.032';
19              
20 1     1   4 use Exporter 'import';
  1         10  
  1         42  
21             our @EXPORT_OK = qw(as_user);
22              
23 1     1   5 use Doit::Log;
  1         2  
  1         1548  
24              
25             {
26             my(%uid_cache, %gid_cache, %homedir_cache);
27              
28             sub as_user (&$;@) {
29 7     7 0 4806 my($code, $user, %opts) = @_;
30 7 100       21 my $cache = exists $opts{cache} ? delete $opts{cache} : 1;
31 7 100       22 error "Unhandled options: " . join(" ", %opts) if %opts;
32              
33 6         8 my($uid, $gid, $homedir);
34 6 100       12 if ($cache) {
35 5         12 ($uid, $gid, $homedir) = ($uid_cache{$user}, $gid_cache{$user}, $homedir_cache{$user});
36             }
37 6 50 66     24 if (!defined $uid || !defined $gid || !defined $homedir) {
      33        
38 3         253 ($uid, $gid, $homedir) = ((getpwnam $user)[2,3,7]);
39 3 100       15 if (!defined $uid) {
40 1         6 error "Cannot get uid of user '$user'";
41             }
42 2         14 ($gid) = $gid =~ m{^(\d+)}; # only the first one
43 2 100       8 if ($cache) {
44 1         3 $uid_cache{$user} = $uid;
45 1         3 $gid_cache{$user} = $gid;
46 1         3 $homedir_cache{$user} = $homedir;
47             }
48             }
49              
50             # change first the gid, then the uid!
51 5 50       91 local $( = $gid; { my $errno = $!; if ($( != $gid) { error "Can't set real group id (wanted: $gid, is: $(): $errno" } }
  5         13  
  5         17  
  5         36  
  0         0  
52 5 50       221 local $) = $gid; { my $errno = $!; if ($) != $gid) { error "Can't set effective group id (wanted: $gid, is: $)): $errno" } }
  5         14  
  5         26  
  5         38  
  0         0  
53 5 50       61 local $< = $uid; { my $errno = $!; if ($< != $uid) { error "Can't set real user id (wanted: $uid, is: $<) : $errno" } }
  5         11  
  5         16  
  5         47  
  0         0  
54 5 50       80 local $> = $uid; { my $errno = $!; if ($> != $uid) { error "Can't set effective user id (wanted: $uid, is: $>): $errno" } }
  5         11  
  5         15  
  5         34  
  0         0  
55 5         28 local $ENV{HOME} = $homedir;
56 5         20 local $ENV{USER} = $user;
57 5         14 local $ENV{LOGNAME} = $user;
58              
59 5         14 $code->();
60             }
61             }
62              
63 0     0 0   sub new { bless {}, shift }
64 0     0 0   sub functions { qw(user_account user_add_user_to_group) }
65              
66             sub user_account {
67 0     0 0   my($self, %opts) = @_;
68              
69 0 0         error "Only supported for linux and freebsd" if $^O !~ /^(linux|freebsd)$/;
70              
71 0           my $username = delete $opts{username};
72 0 0         if (!defined $username) { error "'username' is mandatory" }
  0            
73 0   0       my $ensure = delete $opts{ensure} || 'present';
74 0           my $uid = delete $opts{uid};
75 0 0         my @groups = @{ delete $opts{groups} || [] };
  0            
76 0           my $home = delete $opts{home};
77 0           my $shell = delete $opts{shell};
78 0 0         my @ssh_keys = @{ delete $opts{ssh_keys} || [] };
  0            
79             ## XXX maybe support some day (taken from Rex):
80             # expire - Date when the account will expire. Format: YYYY-MM-DD
81             # password - Cleartext password for the user.
82             # crypt_password - Crypted password for the user. Available on Linux, OpenBSD and NetBSD.
83             # system - Create a system user.
84             # create_home - If the home directory should be created. Valid parameters are TRUE, FALSE.
85             # comment
86 0 0         error "Unhandled options: " . join(" ", %opts) if %opts;
87              
88 0           my($got_username, $got_passwd, $got_uid, $got_gid, $got_quota,
89             $got_comment, $got_gcos, $got_home, $got_shell, $got_expire) = getpwnam($username);
90              
91 0 0         if ($ensure eq 'absent') {
    0          
92 0 0         if (defined $got_username) {
93             my $sys_userdel =
94 0     0     ( $^O eq 'linux' ? sub { $self->system('userdel', $username) } # XXX what about --remove?
95 0     0     : $^O eq 'freebsd' ? sub { $self->system('pw', 'userdel', $username) } # XXX what about -r?
96 0     0     : sub { error "userdel NYI for $^O" }
97 0 0         );
    0          
98 0           $sys_userdel->();
99             }
100             } elsif ($ensure ne 'present') {
101 0           error "Valid values for 'ensure': 'absent', 'present' (got: '$ensure')\n";
102             } else {
103 0           my($cmd, @args);
104 0 0         if (defined $got_username) {
105 0           $cmd = 'usermod';
106             } else {
107 0           $cmd = 'useradd';
108             }
109 0 0 0       if (defined $uid &&
      0        
110             (
111             (defined $got_uid && $got_uid != $uid)
112             || (!defined $got_uid)
113             )
114             ) {
115 0 0         push @args, ($^O eq 'linux' ? '--uid' : $^O eq 'freebsd' ? '-u' : error "NYI"), $uid;
    0          
116             }
117 0 0         if ($cmd eq 'useradd') {
118 0 0         if ($^O eq 'linux') {
    0          
119 0           push @args, '--user-group';
120             } elsif ($^O eq 'freebsd') {
121             # done automatically
122             }
123             }
124             ## XXX?
125             #if (defined $uid &&
126             # (
127             # (defined $got_gid && $got_gid != $uid)
128             # || (!defined $got_gid)
129             # )
130             # ) {
131             # push @args, '--gid', $uid; # XXX what if uid should be != gid?
132             #}
133 0 0 0       if (defined $home &&
    0 0        
134             (
135             (defined $got_home && $got_home ne $home)
136             || (!defined $got_home)
137             )
138             ) {
139 0 0         push @args, ($^O eq 'linux' ? ('--home', $home, ($cmd eq 'usermod' ? '--move-home' : '--create-home')) :
    0          
    0          
140             $^O eq 'freebsd' ? ('-d', $home, '-m') :
141             error "NYI");
142             } elsif ($cmd eq 'useradd') {
143 0 0         push @args, ($^O eq 'linux' ? ($cmd eq 'usermod' ? '--move-home' : '--create-home') :
    0          
    0          
144             $^O eq 'freebsd' ? ('-m') :
145             error "NYI");
146             }
147 0 0 0       if (defined $shell &&
      0        
148             (
149             (defined $got_shell && $got_shell ne $shell)
150             || (!defined $got_shell)
151             )
152             ) {
153 0 0         push @args, ($^O eq 'linux' ? '--shell' :
    0          
154             $^O eq 'freebsd' ? '-s' :
155             error "NYI"), $shell;
156             }
157 0 0         if (@groups) {
158 0           my @got_groups = sort _get_user_groups($username);
159 0           my @want_groups = sort @groups;
160 0 0         if ("@want_groups" ne "@got_groups") {
161 0 0         push @args, ($^O eq 'linux' ? '--groups' :
    0          
162             $^O eq 'freebsd' ? '-G' :
163             error "NYI"), join(",", @groups);
164             }
165             }
166 0 0 0       if ($cmd eq 'useradd' || @args) {
167 0           local $ENV{PATH} = "/usr/sbin:$ENV{PATH}";
168 0 0         if ($^O eq 'linux') {
    0          
169 0           $self->system($cmd, @args, $username);
170             } elsif ($^O eq 'freebsd') {
171 0           $self->system('pw', $cmd, @args, '-n', $username);
172             }
173             }
174              
175 0 0         if (!$self->is_dry_run) {
176 0           ($got_username, $got_passwd, $got_uid, $got_gid, $got_quota,
177             $got_comment, $got_gcos, $got_home, $got_shell, $got_expire) = getpwnam($username);
178 0 0         if (!defined $got_username) {
179 0           error "Something went wrong: $cmd did not fail, but user '$username' does not exist";
180             }
181             } else {
182 0 0         if (defined $home) {
183 0           $got_home = $home;
184             } else {
185 0           $got_home = "/home/$username";
186             }
187             }
188              
189 0 0         if (@ssh_keys) {
190 0           $self->mkdir("$got_home/.ssh");
191 0           $self->chmod(0700, "$got_home/.ssh");
192 0           $self->chown($username, $username, "$got_home/.ssh");
193 0           $self->create_file_if_nonexisting("$got_home/.ssh/authorized_keys");
194 0           $self->chmod(0600, "$got_home/.ssh/authorized_keys");
195 0           $self->chown($username, $username, "$got_home/.ssh/authorized_keys");
196             $self->change_file("$got_home/.ssh/authorized_keys",
197 0           (map { +{ add_if_missing => $_ } } @ssh_keys),
  0            
198             );
199             }
200             }
201             }
202              
203             sub user_add_user_to_group {
204 0     0 0   my($self, %opts) = @_;
205 0           my $username = delete $opts{username};
206 0 0         if (!defined $username) { error "username is mandatory" }
  0            
207 0           my $group = delete $opts{group};
208 0 0         if (!defined $group) { error "group is mandatory" }
  0            
209 0           my %user_groups = map{($_,1)} _get_user_groups($username);
  0            
210 0           my $changes = 0;
211 0 0         if (!$user_groups{$group}) {
212 0 0         if ($^O eq 'linux') {
    0          
213 0           $self->system('usermod', '--append', '--groups', $group, $username);
214 0           $changes = 1;
215             } elsif ($^O eq 'freebsd') {
216 0           $self->system('pw', 'groupmod', '-m', $username, '-n', $group);
217 0           $changes = 1;
218             } else {
219 0           error "user_add_user_to_group NYI for $^O";
220             }
221             }
222 0           $changes;
223             }
224              
225             sub _get_user_groups {
226 0     0     my $username = shift;
227 0           my @groups;
228 0           require POSIX;
229 0           require List::Util;
230 0           while (my($gname,undef,undef,$members) = getgrent) {
231 0 0         next if $gname eq $username; # don't deal with primary groups
232 0 0   0     if (List::Util::first(sub { $_ eq $username }, split /\s+/, $members)) {
  0            
233 0           push @groups, $gname;
234             }
235             }
236 0           endgrent;
237 0           @groups;
238             }
239              
240             1;
241              
242             __END__