line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################################### |
2
|
|
|
|
|
|
|
# Unix::Mgt |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
package Unix::Mgt; |
5
|
1
|
|
|
1
|
|
440
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
33
|
|
6
|
1
|
|
|
1
|
|
501
|
use IPC::System::Simple 'runx'; |
|
1
|
|
|
|
|
13015
|
|
|
1
|
|
|
|
|
79
|
|
7
|
1
|
|
|
1
|
|
589
|
use Capture::Tiny 'capture_merged'; |
|
1
|
|
|
|
|
43739
|
|
|
1
|
|
|
|
|
93
|
|
8
|
1
|
|
|
1
|
|
847
|
use String::Util qw{define nocontent}; |
|
1
|
|
|
|
|
4348
|
|
|
1
|
|
|
|
|
101
|
|
9
|
1
|
|
|
1
|
|
629
|
use Unix::SearchPathGuess 'cmd_path_guess'; |
|
1
|
|
|
|
|
2198
|
|
|
1
|
|
|
|
|
64
|
|
10
|
1
|
|
|
1
|
|
7
|
use Carp 'croak'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
70
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# debug tools |
13
|
|
|
|
|
|
|
# use Debug::ShowStuff ':all'; |
14
|
|
|
|
|
|
|
# use Debug::ShowStuff::ShowVar; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# version |
17
|
|
|
|
|
|
|
our $VERSION = '0.12'; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
21
|
|
|
|
|
|
|
# export |
22
|
|
|
|
|
|
|
# |
23
|
1
|
|
|
1
|
|
6
|
use base 'Exporter'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
77
|
|
24
|
1
|
|
|
1
|
|
6
|
use vars qw[@EXPORT_OK %EXPORT_TAGS]; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
722
|
|
25
|
|
|
|
|
|
|
push @EXPORT_OK, 'unix_mgt_err'; |
26
|
|
|
|
|
|
|
%EXPORT_TAGS = ('all' => [@EXPORT_OK]); |
27
|
|
|
|
|
|
|
# |
28
|
|
|
|
|
|
|
# export |
29
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
33
|
|
|
|
|
|
|
# opening POD |
34
|
|
|
|
|
|
|
# |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 NAME |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Unix::Mgt - lightweight Unix management tools |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 SYNOPSIS |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# get user account |
43
|
|
|
|
|
|
|
$user = Unix::Mgt::User->get('fred'); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# display some info |
46
|
|
|
|
|
|
|
print 'uid: ', $user->uid, "\n"; |
47
|
|
|
|
|
|
|
print join(', ', $user->groups()), "\n"; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# set some properties |
50
|
|
|
|
|
|
|
$user->gid('websters'); |
51
|
|
|
|
|
|
|
$user->shell('/bin/bash'); |
52
|
|
|
|
|
|
|
$user->add_to_group('postgres'); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# create user account |
55
|
|
|
|
|
|
|
$user = Unix::Mgt::User->create('vera'); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# get user account, creating it if necessary |
58
|
|
|
|
|
|
|
$user = Unix::Mgt::User->ensure('molly'); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# get group |
61
|
|
|
|
|
|
|
$group = Unix::Mgt::Group->get('www-data'); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# display some info |
64
|
|
|
|
|
|
|
print 'gid: ', $group->gid, "\n"; |
65
|
|
|
|
|
|
|
print join(', ', $group->members()), "\n"; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# add a member |
68
|
|
|
|
|
|
|
$group->add_member('tucker'); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head1 DESCRIPTION |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Unix::Mgt provides simple object-oriented tools for managing your Unixish |
73
|
|
|
|
|
|
|
system. Currently this module provides tools for managing users and groups. |
74
|
|
|
|
|
|
|
Other tools may follow as they evolve. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Unix::Mgt does not directly manipulate any of the system files such as |
77
|
|
|
|
|
|
|
C. This module uses Perl's built-in Unix functions such as |
78
|
|
|
|
|
|
|
C to get information, and Unix's built-in programs such as |
79
|
|
|
|
|
|
|
C. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head2 Early release |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
In the spirit of "release early, release often", I'm releasing this version |
84
|
|
|
|
|
|
|
of Unix::Mgt before it has all the features that might be expected. This |
85
|
|
|
|
|
|
|
version does not include methods for deleting users, removing them from groups, |
86
|
|
|
|
|
|
|
or other deletion oriented objectives. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# |
91
|
|
|
|
|
|
|
# opening POD |
92
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
97
|
|
|
|
|
|
|
# error id and message globals |
98
|
|
|
|
|
|
|
# |
99
|
|
|
|
|
|
|
our $err_id; |
100
|
|
|
|
|
|
|
our $err_msg; |
101
|
|
|
|
|
|
|
# |
102
|
|
|
|
|
|
|
# error id and message globals |
103
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
107
|
|
|
|
|
|
|
# set_err, reset_err |
108
|
|
|
|
|
|
|
# |
109
|
|
|
|
|
|
|
sub set_err { |
110
|
4
|
|
|
4
|
0
|
6
|
my ($class, $id, $msg) = @_; |
111
|
4
|
|
|
|
|
4
|
$err_id = $id; |
112
|
4
|
|
|
|
|
5
|
$err_msg = $msg; |
113
|
4
|
|
|
|
|
9
|
return undef; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub reset_err { |
117
|
6
|
|
|
6
|
0
|
7
|
undef $err_id; |
118
|
6
|
|
|
|
|
7
|
undef $err_msg; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub unix_mgt_err { |
122
|
0
|
0
|
|
0
|
0
|
0
|
if ($err_id) |
123
|
0
|
|
|
|
|
0
|
{ return $err_id . ': ' . $err_msg . "\n" } |
124
|
|
|
|
|
|
|
else |
125
|
0
|
|
|
|
|
0
|
{ return '' } |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
# |
128
|
|
|
|
|
|
|
# reset_err |
129
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
133
|
|
|
|
|
|
|
# called_sub |
134
|
|
|
|
|
|
|
# |
135
|
|
|
|
|
|
|
sub called_sub { |
136
|
4
|
|
|
4
|
0
|
3
|
my (@caller, $sub_name); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# TESTING |
139
|
|
|
|
|
|
|
# println subname(class=>1); ##i |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# get caller info |
142
|
4
|
|
|
|
|
25
|
@caller = caller(1); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# get subroutine name and make it look like a method call |
145
|
4
|
|
|
|
|
7
|
$sub_name = $caller[3]; |
146
|
4
|
|
|
|
|
34
|
$sub_name =~ s|^(.*)\:\:|$1\-\>|s; |
147
|
4
|
|
|
|
|
5
|
$sub_name .= '()'; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# return |
150
|
4
|
|
|
|
|
27
|
return $sub_name; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
# |
153
|
|
|
|
|
|
|
# called_sub |
154
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
158
|
|
|
|
|
|
|
# even_odd_params |
159
|
|
|
|
|
|
|
# |
160
|
|
|
|
|
|
|
sub even_odd_params { |
161
|
6
|
|
|
6
|
0
|
7
|
my $class = shift(@_); |
162
|
6
|
|
|
|
|
8
|
my $id = shift(@_); |
163
|
6
|
|
|
|
|
5
|
my ($name, %opts); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# get params: even number means all params (except class) are options, |
166
|
|
|
|
|
|
|
# odd number means first param is id |
167
|
6
|
100
|
|
|
|
14
|
if (@_ % 2) { |
168
|
4
|
|
|
|
|
6
|
($name, %opts) = @_; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
else { |
171
|
2
|
|
|
|
|
4
|
%opts = @_; |
172
|
2
|
|
|
|
|
4
|
$name = delete($opts{$id}); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# return |
176
|
6
|
|
|
|
|
15
|
return ($name, %opts); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
# |
179
|
|
|
|
|
|
|
# even_odd_params |
180
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
184
|
|
|
|
|
|
|
# run_cmd |
185
|
|
|
|
|
|
|
# |
186
|
|
|
|
|
|
|
sub run_cmd { |
187
|
0
|
|
|
0
|
0
|
0
|
my ($class, $err_id_use, $cmd_id, @args) = @_; |
188
|
0
|
|
|
|
|
0
|
my ($cmd, $out, $rv); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# TESTING |
191
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# get command |
194
|
0
|
|
|
|
|
0
|
$cmd = cmd_path_guess($cmd_id); |
195
|
0
|
0
|
|
|
|
0
|
$cmd or croak "do not find path for command $cmd_id"; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# run command |
198
|
|
|
|
|
|
|
$out = capture_merged{ |
199
|
0
|
|
|
0
|
|
0
|
$rv = runx(IPC::System::Simple::EXIT_ANY, $cmd, @args); |
200
|
0
|
|
|
|
|
0
|
}; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# if error |
203
|
0
|
0
|
|
|
|
0
|
if ($rv) { |
204
|
0
|
|
|
|
|
0
|
return $class->set_err( |
205
|
|
|
|
|
|
|
$err_id_use, |
206
|
|
|
|
|
|
|
"error running program $cmd: " . $out, |
207
|
|
|
|
|
|
|
); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# return success |
211
|
0
|
|
|
|
|
0
|
return 1; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
# |
214
|
|
|
|
|
|
|
# run_cmd |
215
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# |
219
|
|
|
|
|
|
|
# Unix::Mgt |
220
|
|
|
|
|
|
|
############################################################################### |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
############################################################################### |
225
|
|
|
|
|
|
|
# Unix::Mgt::UGCommon |
226
|
|
|
|
|
|
|
# |
227
|
|
|
|
|
|
|
package Unix::Mgt::UGCommon; |
228
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
78
|
|
229
|
1
|
|
|
1
|
|
7
|
use String::Util ':all'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
293
|
|
230
|
1
|
|
|
1
|
|
6
|
use Carp 'croak'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
59
|
|
231
|
1
|
|
|
1
|
|
6
|
use base 'Unix::Mgt'; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
119
|
|
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# debug tools |
234
|
|
|
|
|
|
|
# use Debug::ShowStuff ':all'; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
238
|
|
|
|
|
|
|
# object overloading |
239
|
|
|
|
|
|
|
# |
240
|
|
|
|
|
|
|
use overload |
241
|
2
|
|
|
2
|
|
492
|
'""' => sub{$_[0]->{'name'}}, # stringification |
242
|
1
|
|
|
1
|
|
7
|
fallback => 1; # operations not defined here |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
11
|
|
243
|
|
|
|
|
|
|
# |
244
|
|
|
|
|
|
|
# object overloading |
245
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
249
|
|
|
|
|
|
|
# normalize_name |
250
|
|
|
|
|
|
|
# |
251
|
|
|
|
|
|
|
sub normalize_name { |
252
|
4
|
|
|
4
|
|
5
|
my ($class, $name) = @_; |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# if defined, remove spaces at beginning and end |
255
|
4
|
50
|
|
|
|
7
|
if (defined $name) { |
256
|
4
|
|
|
|
|
8
|
$name =~ s|^\s+||sg; |
257
|
4
|
|
|
|
|
5
|
$name =~ s|\s+$||sg; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# return |
261
|
4
|
|
|
|
|
7
|
return $name; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
# |
264
|
|
|
|
|
|
|
# normalize_name |
265
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
269
|
|
|
|
|
|
|
# name_check |
270
|
|
|
|
|
|
|
# |
271
|
|
|
|
|
|
|
sub name_check { |
272
|
6
|
|
|
6
|
|
7
|
my ($class, $name, $id) = @_; |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# TESTING |
275
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# if name does not have content, that's an error |
278
|
6
|
100
|
|
|
|
14
|
if (nocontent $name) { |
279
|
2
|
|
|
|
|
25
|
return $class->set_err( |
280
|
|
|
|
|
|
|
$id, |
281
|
|
|
|
|
|
|
$class->called_sub() . ' requires a user name parameter' |
282
|
|
|
|
|
|
|
); |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# normalize |
286
|
4
|
|
|
|
|
49
|
$name = $class->normalize_name($name); |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# return |
289
|
4
|
|
|
|
|
5
|
return $name; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
# |
292
|
|
|
|
|
|
|
# name_check |
293
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
297
|
|
|
|
|
|
|
# mod_only |
298
|
|
|
|
|
|
|
# |
299
|
|
|
|
|
|
|
sub mod_only { |
300
|
0
|
|
|
0
|
|
0
|
my ($class, $name) = @_; |
301
|
0
|
|
|
|
|
0
|
my ($only); |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# TESTING |
304
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# get class |
307
|
0
|
0
|
|
|
|
0
|
if (ref $class) |
308
|
0
|
|
|
|
|
0
|
{ $class = ref($class) } |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# get hash with destrictions |
311
|
|
|
|
|
|
|
# KLUDGE: This is an awkward way to get the variable, but I didn't want |
312
|
|
|
|
|
|
|
# to remember how to work through package hashes. |
313
|
0
|
0
|
|
|
|
0
|
if ( $class eq 'Unix::Mgt::User' ) |
|
|
0
|
|
|
|
|
|
314
|
0
|
|
|
|
|
0
|
{ $only = $Unix::Mgt::User::MOD_ONLY } |
315
|
|
|
|
|
|
|
elsif ($class eq 'Unix::Mgt::Group') |
316
|
0
|
|
|
|
|
0
|
{ $only = $Unix::Mgt::Group::MOD_ONLY } |
317
|
|
|
|
|
|
|
else |
318
|
0
|
|
|
|
|
0
|
{ croak qq|do not know package "$class" for mod restrictions | } |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# if $only is defined, name must be in the hash |
321
|
0
|
0
|
|
|
|
0
|
if ($only) { |
322
|
|
|
|
|
|
|
# deref |
323
|
0
|
0
|
|
|
|
0
|
if (ref $name) |
324
|
0
|
|
|
|
|
0
|
{ $name = $name->{'name'} } |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# if no content in name, fail |
327
|
0
|
0
|
|
|
|
0
|
if (nocontent $name) |
328
|
0
|
|
|
|
|
0
|
{ croak 'no content in $name' } |
329
|
|
|
|
|
|
|
|
330
|
0
|
0
|
|
|
|
0
|
if (! exists($only->{$name})) { |
331
|
0
|
|
|
|
|
0
|
croak qq|cannot modify user "$name"|; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# else it's ok to mod that user |
336
|
0
|
|
|
|
|
0
|
return 1; |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
# |
339
|
|
|
|
|
|
|
# mod_only |
340
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
344
|
|
|
|
|
|
|
# ensure |
345
|
|
|
|
|
|
|
# |
346
|
|
|
|
|
|
|
sub ensure { |
347
|
0
|
|
|
0
|
|
0
|
my $class = shift(@_); |
348
|
0
|
|
|
|
|
0
|
my ($name, %opts) = $class->even_odd_params('name', @_); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# TESTING |
351
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# reset error globals |
354
|
0
|
|
|
|
|
0
|
$class->reset_err(); |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
# check and normalize name |
357
|
0
|
|
|
|
|
0
|
$name = $class->name_check($name, 'missing-user-name'); |
358
|
0
|
0
|
|
|
|
0
|
$name or return undef; |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# if user exists, return get method |
361
|
0
|
0
|
|
|
|
0
|
if (my @fields = $class->fields($name)) { |
362
|
0
|
|
|
|
|
0
|
return $class->get($name, fields=>\@fields) |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# else return create |
366
|
|
|
|
|
|
|
else { |
367
|
0
|
|
|
|
|
0
|
return $class->create($name); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
# |
371
|
|
|
|
|
|
|
# ensure |
372
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# |
376
|
|
|
|
|
|
|
# Unix::Mgt::UGCommon |
377
|
|
|
|
|
|
|
############################################################################### |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
############################################################################### |
382
|
|
|
|
|
|
|
# Unix::Mgt::User |
383
|
|
|
|
|
|
|
# |
384
|
|
|
|
|
|
|
package Unix::Mgt::User; |
385
|
1
|
|
|
1
|
|
778
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
386
|
1
|
|
|
1
|
|
31
|
use Carp 'croak'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
63
|
|
387
|
1
|
|
|
1
|
|
6
|
use String::Util ':all'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
231
|
|
388
|
1
|
|
|
1
|
|
7
|
use base 'Unix::Mgt::UGCommon'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1535
|
|
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
# debug tools |
391
|
|
|
|
|
|
|
# use Debug::ShowStuff ':all'; |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# safety mechanism for development |
394
|
|
|
|
|
|
|
our $MOD_ONLY; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
398
|
|
|
|
|
|
|
# POD |
399
|
|
|
|
|
|
|
# |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head1 Unix::Mgt::User |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
A Unix::Mgt::User object represents a user in the Unix system. The object |
404
|
|
|
|
|
|
|
allows you to get and set information about the user account. A user object |
405
|
|
|
|
|
|
|
is created in one of three ways: C, C, or C. Note that |
406
|
|
|
|
|
|
|
there is no C method. |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Unix::Mgt::User objects stringify to the account's name. For example, the |
409
|
|
|
|
|
|
|
following code would output C. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
$user = Unix::Mgt::User->get('miko'); |
412
|
|
|
|
|
|
|
print $user, "\n"; |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=cut |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# |
417
|
|
|
|
|
|
|
# POD |
418
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
422
|
|
|
|
|
|
|
# field_names |
423
|
|
|
|
|
|
|
# |
424
|
|
|
|
|
|
|
our @field_names = qw{ |
425
|
|
|
|
|
|
|
name |
426
|
|
|
|
|
|
|
passwd |
427
|
|
|
|
|
|
|
uid |
428
|
|
|
|
|
|
|
gid |
429
|
|
|
|
|
|
|
quota |
430
|
|
|
|
|
|
|
comment |
431
|
|
|
|
|
|
|
gecos |
432
|
|
|
|
|
|
|
dir |
433
|
|
|
|
|
|
|
shell |
434
|
|
|
|
|
|
|
expire |
435
|
|
|
|
|
|
|
}; |
436
|
|
|
|
|
|
|
# |
437
|
|
|
|
|
|
|
# field_names |
438
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
443
|
|
|
|
|
|
|
# get |
444
|
|
|
|
|
|
|
# |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=head2 get |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Unix::Mgt::User->get() retrieves user account information using C or |
449
|
|
|
|
|
|
|
C. The single param for this method is either the name or the uid of |
450
|
|
|
|
|
|
|
the user. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
$user = Unix::Mgt::User->get('vera'); |
453
|
|
|
|
|
|
|
$user = Unix::Mgt::User->get('1010'); |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
If the user is not found then the C error id is set in |
456
|
|
|
|
|
|
|
C<$Unix::Mgt::err_id> and undef is returned. |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=cut |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub get { |
461
|
4
|
|
|
4
|
|
7456
|
my $class = shift(@_); |
462
|
4
|
|
|
|
|
16
|
my ($name, %opts) = $class->even_odd_params('name', @_); |
463
|
4
|
|
|
|
|
5
|
my (@fields, $user); |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# TESTING |
466
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# reset error globals |
469
|
4
|
|
|
|
|
10
|
$class->reset_err(); |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
# check and normalize name |
472
|
4
|
|
|
|
|
10
|
$name = $class->name_check($name, 'missing-user-name'); |
473
|
4
|
100
|
|
|
|
12
|
$name or return undef; |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
# get fields |
476
|
3
|
|
|
|
|
7
|
@fields = $class->fields($name); |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# if user exists, get name, else throw error |
479
|
3
|
100
|
|
|
|
11
|
if (@fields) { |
480
|
2
|
|
|
|
|
4
|
$name = $fields[0]; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
else { |
483
|
1
|
|
|
|
|
4
|
return $class->set_err( |
484
|
|
|
|
|
|
|
'do-not-have-user', |
485
|
|
|
|
|
|
|
$class->called_sub() . qq|: do not find a user with name "$name"|, |
486
|
|
|
|
|
|
|
); |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
# create object |
490
|
2
|
|
|
|
|
7
|
$user = bless({}, $class); |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
# hold on to name |
493
|
2
|
|
|
|
|
96
|
$user->{'name'} = $name; |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# return |
496
|
2
|
|
|
|
|
6
|
return $user; |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
# |
499
|
|
|
|
|
|
|
# get |
500
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
504
|
|
|
|
|
|
|
# entry |
505
|
|
|
|
|
|
|
# |
506
|
|
|
|
|
|
|
sub entry { |
507
|
0
|
|
|
0
|
|
0
|
my ($user) = @_; |
508
|
0
|
|
|
|
|
0
|
my (@fields, %entry); |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# TESTING |
511
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
# get fields |
514
|
0
|
|
|
|
|
0
|
@fields = $user->fields($user->{'name'}); |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# if no fields, set error and return undef |
517
|
0
|
0
|
|
|
|
0
|
if (! @fields) { |
518
|
0
|
|
|
|
|
0
|
return $user->set_err( |
519
|
|
|
|
|
|
|
'do-not-have-user-entry-anymore', |
520
|
|
|
|
|
|
|
$user->called_sub() . ': do not have a user with name "' . $user->{'name'} . '"', |
521
|
|
|
|
|
|
|
); |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# set hash |
525
|
0
|
|
|
|
|
0
|
@entry{@field_names} = @fields; |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
# return |
528
|
0
|
|
|
|
|
0
|
return \%entry; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
# |
531
|
|
|
|
|
|
|
# entry |
532
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
536
|
|
|
|
|
|
|
# fields |
537
|
|
|
|
|
|
|
# |
538
|
|
|
|
|
|
|
sub fields { |
539
|
3
|
|
|
3
|
|
3
|
my ($class, $name) = @_; |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# TESTING |
542
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# return |
545
|
3
|
50
|
|
|
|
8
|
if ($name =~ m|^\d+$|s) |
546
|
0
|
|
|
|
|
0
|
{ return getpwuid($name) } |
547
|
|
|
|
|
|
|
else |
548
|
3
|
|
|
|
|
696
|
{ return getpwnam($name) } |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
# |
551
|
|
|
|
|
|
|
# fields |
552
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
556
|
|
|
|
|
|
|
# create |
557
|
|
|
|
|
|
|
# |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head2 create |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Unix::Mgt::User->create() creates a user account. The required param for this |
562
|
|
|
|
|
|
|
method is the name for the new account. |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
$user = Unix::Mgt::User->create('vera'); |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
If the C param is true, then the account is created as a system user, |
567
|
|
|
|
|
|
|
like this: |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
$user = Unix::Mgt::User->create('lanny', system=>1); |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
create() uses the Unix C program. |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
=cut |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
sub create { |
576
|
0
|
|
|
0
|
|
0
|
my $class = shift(@_); |
577
|
0
|
|
|
|
|
0
|
my ($name, %opts) = $class->even_odd_params('name', @_); |
578
|
0
|
|
|
|
|
0
|
my ($user, @cmd); |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
# TESTING |
581
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# reset error globals |
584
|
0
|
|
|
|
|
0
|
$class->reset_err(); |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
# check and normalize name |
587
|
0
|
|
|
|
|
0
|
$name = $class->name_check($name, 'missing-user-name'); |
588
|
0
|
0
|
|
|
|
0
|
$name or return undef; |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# if user exists, throw error |
591
|
0
|
0
|
|
|
|
0
|
if ($class->fields($name)) { |
592
|
0
|
|
|
|
|
0
|
return $class->set_err( |
593
|
|
|
|
|
|
|
'already-have-user', |
594
|
|
|
|
|
|
|
$class->called_sub() . qq|: already have a user with name "$name"|, |
595
|
|
|
|
|
|
|
); |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
# safety check |
599
|
0
|
|
|
|
|
0
|
$class->mod_only($name); |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
# build command |
602
|
|
|
|
|
|
|
# push @cmd, '--disabled-password'; |
603
|
|
|
|
|
|
|
# push @cmd, '--gecos', ''; |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
# if creating as system user |
606
|
0
|
0
|
|
|
|
0
|
if ($opts{'system'}) |
607
|
0
|
|
|
|
|
0
|
{ push @cmd, '--system' } |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
# add name |
610
|
0
|
|
|
|
|
0
|
push @cmd, $name; |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
# create user |
613
|
0
|
0
|
|
|
|
0
|
$class->run_cmd('error-creating-user', 'adduser', @cmd) or return undef; |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
# create object |
616
|
0
|
|
|
|
|
0
|
$user = bless({}, $class); |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
# hold on to name |
619
|
0
|
|
|
|
|
0
|
$user->{'name'} = $name; |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
# return |
622
|
0
|
|
|
|
|
0
|
return $user; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
# |
625
|
|
|
|
|
|
|
# create |
626
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
630
|
|
|
|
|
|
|
# POD for ensure() |
631
|
|
|
|
|
|
|
# |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
=head2 ensure |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
Unix::Mgt::User->ensure() gets a user account if it already exists, and |
636
|
|
|
|
|
|
|
creates the account if it does not. For example, the following lines ensures |
637
|
|
|
|
|
|
|
the C account: |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
$user = Unix::Mgt::User->ensure('molly'); |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
=cut |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# |
644
|
|
|
|
|
|
|
# POD for ensure() |
645
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
649
|
|
|
|
|
|
|
# field gets |
650
|
|
|
|
|
|
|
# |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
=head2 name |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
Returns the name of the user account. Currently this method cannot be used to |
655
|
|
|
|
|
|
|
set the account name. |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
print $user->name(), "\n"; |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=head2 uid |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
Returns the user's user id (uid). |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
print $user->uid(), "\n"; |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
=head2 passwd |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
Returns the password field from C. This method will not actually |
668
|
|
|
|
|
|
|
return a password, it will probably just return C<*>. |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
print $user->passwd(), "\n"; # probably outputs "*" |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=cut |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
sub field_get { |
675
|
0
|
|
|
0
|
|
0
|
my ($user, $key) = @_; |
676
|
0
|
|
|
|
|
0
|
my ($entry); |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
# TESTING |
679
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
# reset error |
682
|
0
|
|
|
|
|
0
|
$user->reset_err(); |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
# get entry |
685
|
0
|
|
|
|
|
0
|
$entry = $user->entry(); |
686
|
0
|
0
|
|
|
|
0
|
$entry or return undef; |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
# return |
689
|
0
|
|
|
|
|
0
|
return $entry->{$key}; |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
0
|
|
|
0
|
|
0
|
sub name { return shift->field_get('name') } |
693
|
0
|
|
|
0
|
|
0
|
sub uid { return shift->field_get('uid') } |
694
|
0
|
|
|
0
|
|
0
|
sub passwd { return shift->field_get('passwd') } |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
# |
697
|
|
|
|
|
|
|
# field gets |
698
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
702
|
|
|
|
|
|
|
# field get|sets |
703
|
|
|
|
|
|
|
# |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=head2 gid |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
Sets/gets the gid of the user's primary group. Called without params, it |
708
|
|
|
|
|
|
|
returns the user's gid: |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
print $user->gid(), "\n"; |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
Called with a single param, gid() sets, then returns the user's primary |
713
|
|
|
|
|
|
|
group id: |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
print $user->gid('1010'), "\n"; |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
If you want to get a Unix::Mgt::Group object representing the user's primary |
718
|
|
|
|
|
|
|
group, use $user->group(). |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=head2 dir |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Sets/gets the user's home directory. Called without params, it returns the |
723
|
|
|
|
|
|
|
directory name: |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
print $user->dir(), "\n"; |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
Called with a single param, dir() sets, then returns the user's home directory: |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
print $user->dir('/tmp'), "\n"; |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head2 shell |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
Sets/gets the user's default command line shell. Called without params, it |
734
|
|
|
|
|
|
|
returns the shell name: |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
print $user->shell(), "\n"; |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Called with a single param, shell() sets, then returns the user's shell: |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
print $user->shell('/bin/sh'), "\n"; |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=cut |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
sub field_get_set { |
745
|
0
|
|
|
0
|
|
0
|
my $user = shift(@_); |
746
|
0
|
|
|
|
|
0
|
my $field = shift(@_); |
747
|
0
|
|
|
|
|
0
|
my $option = shift(@_); |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
# TESTING |
750
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
# if a value was sent, set the field to that value |
753
|
0
|
0
|
|
|
|
0
|
if (@_) { |
754
|
0
|
|
|
|
|
0
|
my ($value) = @_; |
755
|
0
|
|
|
|
|
0
|
my (@cmd); |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
# safety check |
758
|
0
|
|
|
|
|
0
|
$user->mod_only($user->{'name'}); |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
# build command |
761
|
0
|
|
|
|
|
0
|
@cmd = ( |
762
|
|
|
|
|
|
|
"--$option", |
763
|
|
|
|
|
|
|
$value, |
764
|
|
|
|
|
|
|
$user->{'name'}, |
765
|
|
|
|
|
|
|
); |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
# run command |
768
|
0
|
0
|
|
|
|
0
|
$user->run_cmd("usermod-error-$field", 'usermod', @cmd) or return undef; |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
# return field |
772
|
0
|
|
|
|
|
0
|
return $user->field_get($field); |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
|
776
|
0
|
|
|
0
|
|
0
|
sub gid { return shift->field_get_set('gid', 'gid', @_) } |
777
|
0
|
|
|
0
|
|
0
|
sub dir { return shift->field_get_set('dir', 'home', @_) } |
778
|
0
|
|
|
0
|
|
0
|
sub shell { return shift->field_get_set('shell', 'shell', @_) } |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
# sub quota { return shift->field_get_set('quota') } |
781
|
|
|
|
|
|
|
# sub comment { return shift->field_get_set('comment', 'comment', @_) } |
782
|
|
|
|
|
|
|
# sub expire { return shift->field_get_set('expire', 'expiredate', @_) } |
783
|
|
|
|
|
|
|
# sub gecos { return shift->field_get_set('gecos') } |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
# |
786
|
|
|
|
|
|
|
# field get|sets |
787
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
791
|
|
|
|
|
|
|
# group |
792
|
|
|
|
|
|
|
# |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=head2 group |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
Sets/gets the user's primary group. When called without any params, C |
797
|
|
|
|
|
|
|
returns a Unix::Mgt::Group object representing the user's primary group: |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
$group = $user->group(); |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
When called with a single param, C sets the user's primary group. The |
802
|
|
|
|
|
|
|
param can be either the group's name or its gid: |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
$user->group('video'); |
805
|
|
|
|
|
|
|
$user->group(44); |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
=cut |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
sub group { |
810
|
0
|
|
|
0
|
|
0
|
my $user = shift(@_); |
811
|
0
|
|
|
|
|
0
|
my ($new_group, %opts) = $user->even_odd_params('new', @_); |
812
|
0
|
|
|
|
|
0
|
my ($entry, $gid, $group); |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
# TESTING |
815
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
# default options |
818
|
0
|
|
|
|
|
0
|
%opts = (object=>1, %opts); |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
# set new group |
821
|
0
|
0
|
|
|
|
0
|
if (defined $new_group) { |
822
|
0
|
|
|
|
|
0
|
my (@args, $success); |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
# reset error globals |
825
|
0
|
|
|
|
|
0
|
$user->reset_err(); |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
# build usermod arguments |
828
|
0
|
|
|
|
|
0
|
@args = ( |
829
|
|
|
|
|
|
|
'--gid', |
830
|
|
|
|
|
|
|
"$new_group", |
831
|
|
|
|
|
|
|
"$user" |
832
|
|
|
|
|
|
|
); |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
# change user's group |
836
|
0
|
|
|
|
|
0
|
$success = $user->run_cmd('error-setting-user-group', 'usermod', @args); |
837
|
0
|
0
|
|
|
|
0
|
$success or return 0; |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
# get gid |
841
|
0
|
|
|
|
|
0
|
$gid = $user->gid(); |
842
|
0
|
0
|
|
|
|
0
|
defined($gid) or return undef; |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
# get group |
845
|
0
|
|
|
|
|
0
|
$group = Unix::Mgt::Group->get($gid); |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
# return |
848
|
0
|
0
|
|
|
|
0
|
if ($opts{'object'}) |
849
|
0
|
|
|
|
|
0
|
{ return $group } |
850
|
|
|
|
|
|
|
else |
851
|
0
|
|
|
|
|
0
|
{ return $group->name } |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
# |
854
|
|
|
|
|
|
|
# group |
855
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
859
|
|
|
|
|
|
|
# secondary_groups |
860
|
|
|
|
|
|
|
# |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=head2 secondary_groups |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
C returns an array of the user's secondary groups. Each |
865
|
|
|
|
|
|
|
element in the array is a Unix::Mgt::Group object. |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
@groups = $user->secondary_groups(); |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=cut |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
sub secondary_groups { |
872
|
0
|
|
|
0
|
|
0
|
my ($user, %opts) = @_; |
873
|
0
|
|
|
|
|
0
|
my (%groups, @rv); |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
# TESTING |
876
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
# default options |
879
|
0
|
|
|
|
|
0
|
%opts = (object=>1, %opts); |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
# loop through all groups |
882
|
0
|
|
|
|
|
0
|
while (my @fields = getgrent()) { |
883
|
0
|
|
|
|
|
0
|
my (%group); |
884
|
0
|
|
|
|
|
0
|
@group{@Unix::Mgt::Group::field_names} = @fields; |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
# if there are any members, of the group, see if this user is in it |
887
|
0
|
0
|
|
|
|
0
|
if (my $member_str = $group{'members'}) { |
888
|
0
|
|
|
|
|
0
|
my (%members); |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
# parse out members |
891
|
0
|
|
|
|
|
0
|
$member_str = crunch($member_str); |
892
|
0
|
|
|
|
|
0
|
@members{split m|\s+|, $member_str} = (); |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
# if this user is in the membership |
895
|
0
|
0
|
|
|
|
0
|
if (exists $members{$user->{'name'}}) |
896
|
0
|
|
|
|
|
0
|
{ $groups{$group{'name'}} = 1 } |
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
# build return value |
901
|
0
|
|
|
|
|
0
|
foreach my $key (keys %groups) { |
902
|
0
|
|
|
|
|
0
|
my $group = Unix::Mgt::Group->get($key); |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
# set as just string if options indicate to do so |
905
|
0
|
0
|
|
|
|
0
|
if (! $opts{'object'}) |
906
|
0
|
|
|
|
|
0
|
{ $group = $group->{'name'} } |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
# add to return array |
909
|
0
|
|
|
|
|
0
|
push @rv, $group; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
# return |
913
|
0
|
|
|
|
|
0
|
return @rv; |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
# |
916
|
|
|
|
|
|
|
# secondary_groups |
917
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
921
|
|
|
|
|
|
|
# groups |
922
|
|
|
|
|
|
|
# |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=head2 groups |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
C returns an array of all of the groups the user is a member of. The |
927
|
|
|
|
|
|
|
first element in the array will be the user's primary group. |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
@groups = $user->groups(); |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=cut |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
sub groups { |
934
|
0
|
|
|
0
|
|
0
|
my ($user, %opts) = @_; |
935
|
0
|
|
|
|
|
0
|
my (@rv); |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
# TESTING |
938
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
# get user's primary group |
941
|
0
|
|
|
|
|
0
|
push @rv, $user->group(%opts); |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
# add user's secondary groups |
944
|
0
|
|
|
|
|
0
|
push @rv, $user->secondary_groups(%opts); |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
# return |
947
|
0
|
|
|
|
|
0
|
return @rv; |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
# |
950
|
|
|
|
|
|
|
# groups |
951
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
955
|
|
|
|
|
|
|
# add_to_group |
956
|
|
|
|
|
|
|
# |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=head2 add_to_group |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
C adds the user to a group. The group will be one of the user's |
961
|
|
|
|
|
|
|
secondary groups, not the primary group. |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
$user->add_to_group('video'); |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
=cut |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
sub add_to_group { |
968
|
0
|
|
|
0
|
|
0
|
my ($user, $group) = @_; |
969
|
0
|
|
|
|
|
0
|
my (@args, $success); |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
# TESTING |
972
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
# build command arguments |
975
|
0
|
|
|
|
|
0
|
@args = ( |
976
|
|
|
|
|
|
|
'--append', |
977
|
|
|
|
|
|
|
'--groups', |
978
|
|
|
|
|
|
|
"$group", |
979
|
|
|
|
|
|
|
"$user" |
980
|
|
|
|
|
|
|
); |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
# run command |
983
|
0
|
|
|
|
|
0
|
$success = $user->run_cmd( |
984
|
|
|
|
|
|
|
'error-adding-user-to-group', |
985
|
|
|
|
|
|
|
'usermod', @args); |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
# return success|failure |
988
|
0
|
|
|
|
|
0
|
return $success; |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
# |
991
|
|
|
|
|
|
|
# add_to_group |
992
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
# |
996
|
|
|
|
|
|
|
# Unix::Mgt::User |
997
|
|
|
|
|
|
|
############################################################################### |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
############################################################################### |
1002
|
|
|
|
|
|
|
# Unix::Mgt::Group |
1003
|
|
|
|
|
|
|
# |
1004
|
|
|
|
|
|
|
package Unix::Mgt::Group; |
1005
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
1006
|
1
|
|
|
1
|
|
3
|
use String::Util ':all'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
170
|
|
1007
|
1
|
|
|
1
|
|
5
|
use Carp 'croak'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
38
|
|
1008
|
1
|
|
|
1
|
|
4
|
use base 'Unix::Mgt::UGCommon'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1155
|
|
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
# debug tools |
1012
|
|
|
|
|
|
|
# use Debug::ShowStuff ':all'; |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
# safety mechanism for development |
1015
|
|
|
|
|
|
|
our $MOD_ONLY; |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1018
|
|
|
|
|
|
|
# POD |
1019
|
|
|
|
|
|
|
# |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=head1 Unix::Mgt::Group |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
A Unix::Mgt::Group object represents a group in the Unix system. The object |
1024
|
|
|
|
|
|
|
allows you to get and set information about the group. A group object is |
1025
|
|
|
|
|
|
|
created in one of three ways: C, C, or C. Note that |
1026
|
|
|
|
|
|
|
there is no C method. |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
Unix::Mgt::Group objects stringify to the groups's name. For example, the |
1029
|
|
|
|
|
|
|
following code would output C |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
$group = Unix::Mgt::Group->get('video'); |
1032
|
|
|
|
|
|
|
print $group, "\n"; |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
=cut |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
# |
1037
|
|
|
|
|
|
|
# POD |
1038
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1042
|
|
|
|
|
|
|
# field_names |
1043
|
|
|
|
|
|
|
# |
1044
|
|
|
|
|
|
|
our @field_names = qw{ |
1045
|
|
|
|
|
|
|
name |
1046
|
|
|
|
|
|
|
passwd |
1047
|
|
|
|
|
|
|
gid |
1048
|
|
|
|
|
|
|
members |
1049
|
|
|
|
|
|
|
}; |
1050
|
|
|
|
|
|
|
# |
1051
|
|
|
|
|
|
|
# field_names |
1052
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1056
|
|
|
|
|
|
|
# fields |
1057
|
|
|
|
|
|
|
# |
1058
|
|
|
|
|
|
|
sub fields { |
1059
|
1
|
|
|
1
|
|
2
|
my ($class, $name) = @_; |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
# TESTING |
1062
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
# return |
1065
|
1
|
50
|
|
|
|
5
|
if ($name =~ m|^\d+$|s) |
1066
|
0
|
|
|
|
|
0
|
{ return getgrgid($name) } |
1067
|
|
|
|
|
|
|
else |
1068
|
1
|
|
|
|
|
103
|
{ return getgrnam($name) } |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
# |
1071
|
|
|
|
|
|
|
# fields |
1072
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1076
|
|
|
|
|
|
|
# get |
1077
|
|
|
|
|
|
|
# |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=head2 get |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
Unix::Mgt::Group->get() retrieves group information using C or |
1082
|
|
|
|
|
|
|
C. The single param for this method is either the name or the gid of |
1083
|
|
|
|
|
|
|
the group. |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
$group = Unix::Mgt::Group->get('video'); |
1086
|
|
|
|
|
|
|
$group = Unix::Mgt::Group->get('44'); |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
If the group is not found then the C error id is set in |
1089
|
|
|
|
|
|
|
C<$Unix::Mgt::err_id> and undef is returned. |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=cut |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
sub get { |
1094
|
2
|
|
|
2
|
|
623
|
my $class = shift(@_); |
1095
|
2
|
|
|
|
|
19
|
my ($name, %opts) = $class->even_odd_params('name', @_); |
1096
|
2
|
|
|
|
|
3
|
my (@fields, $group); |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
# TESTING |
1099
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
# reset error globals |
1102
|
2
|
|
|
|
|
9
|
$class->reset_err(); |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
# check and normalize name |
1105
|
2
|
|
|
|
|
7
|
$name = $class->name_check($name, 'missing-group-name'); |
1106
|
2
|
100
|
|
|
|
7
|
$name or return undef; |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
# get fields |
1109
|
1
|
|
|
|
|
4
|
@fields = $class->fields($name); |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
# if group exists, set name, else throw error |
1112
|
1
|
50
|
|
|
|
4
|
if (@fields) { |
1113
|
0
|
|
|
|
|
0
|
$name = $fields[0]; |
1114
|
|
|
|
|
|
|
} |
1115
|
|
|
|
|
|
|
else { |
1116
|
1
|
|
|
|
|
4
|
return $class->set_err( |
1117
|
|
|
|
|
|
|
'do-not-have-group', |
1118
|
|
|
|
|
|
|
$class->called_sub() . qq|: do not find a group with name "$name"|, |
1119
|
|
|
|
|
|
|
); |
1120
|
|
|
|
|
|
|
} |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
# create object |
1123
|
0
|
|
|
|
|
|
$group = bless({}, $class); |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
# hold on to name |
1126
|
0
|
|
|
|
|
|
$group->{'name'} = $name; |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
# return |
1129
|
0
|
|
|
|
|
|
return $group; |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
# |
1132
|
|
|
|
|
|
|
# get |
1133
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1137
|
|
|
|
|
|
|
# create |
1138
|
|
|
|
|
|
|
# |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
=head2 create |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
Unix::Mgt::Group->create() creates a group. The required param for this method |
1143
|
|
|
|
|
|
|
is the name for the new group. |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
$group = Unix::Mgt::Group->create('websters'); |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
create() uses the Unix C program. |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
=cut |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
sub create { |
1152
|
0
|
|
|
0
|
|
|
my $class = shift(@_); |
1153
|
0
|
|
|
|
|
|
my ($name, %opts) = $class->even_odd_params('name', @_); |
1154
|
0
|
|
|
|
|
|
my ($group, @cmd); |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
# TESTING |
1157
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
# reset error globals |
1160
|
0
|
|
|
|
|
|
$class->reset_err(); |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
# check and normalize name |
1163
|
0
|
|
|
|
|
|
$name = $class->name_check($name, 'missing-group-name'); |
1164
|
0
|
0
|
|
|
|
|
$name or return undef; |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
# if user exists, throw error |
1167
|
0
|
0
|
|
|
|
|
if ($class->fields($name)) { |
1168
|
0
|
|
|
|
|
|
return $class->set_err( |
1169
|
|
|
|
|
|
|
'already-have-group', |
1170
|
|
|
|
|
|
|
$class->called_sub() . qq|: already have a group with name "$name"|, |
1171
|
|
|
|
|
|
|
); |
1172
|
|
|
|
|
|
|
} |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
# safety check |
1175
|
0
|
|
|
|
|
|
$class->mod_only($name); |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
# build command |
1178
|
|
|
|
|
|
|
# push @cmd, '--disabled-password'; |
1179
|
|
|
|
|
|
|
# push @cmd, '--gecos', ''; |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
# if creating as system group |
1182
|
0
|
0
|
|
|
|
|
if ($opts{'system'}) |
1183
|
0
|
|
|
|
|
|
{ push @cmd, '--system' } |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
# add name |
1186
|
0
|
|
|
|
|
|
push @cmd, $name; |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
# create user |
1189
|
0
|
0
|
|
|
|
|
$class->run_cmd('error-creating-user', 'groupadd', @cmd) or return undef; |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
# create object |
1192
|
0
|
|
|
|
|
|
$group = bless({}, $class); |
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
# hold on to name |
1195
|
0
|
|
|
|
|
|
$group->{'name'} = $name; |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
# return |
1198
|
0
|
|
|
|
|
|
return $group; |
1199
|
|
|
|
|
|
|
} |
1200
|
|
|
|
|
|
|
# |
1201
|
|
|
|
|
|
|
# create |
1202
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1206
|
|
|
|
|
|
|
# POD for ensure() |
1207
|
|
|
|
|
|
|
# |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
=head2 ensure |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
Unix::Mgt::Group->ensure() gets a group if it already exists, and creates the |
1212
|
|
|
|
|
|
|
group if it does not. For example, the following lines ensures |
1213
|
|
|
|
|
|
|
the C group: |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
$group = Unix::Mgt::User->ensure('wbesters'); |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
=cut |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
# |
1220
|
|
|
|
|
|
|
# POD for ensure() |
1221
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1225
|
|
|
|
|
|
|
# field gets |
1226
|
|
|
|
|
|
|
# |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
=head2 name |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
Returns the name of the group. Currently this method cannot be used to set the |
1231
|
|
|
|
|
|
|
group name. |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
print $group->name(), "\n"; |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
=head2 gid |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
Returns the groups's group id (gid). |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
print $group->gid(), "\n"; |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
=cut |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
sub field_get { |
1244
|
0
|
|
|
0
|
|
|
my ($group, $key) = @_; |
1245
|
0
|
|
|
|
|
|
my ($entry); |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
# TESTING |
1248
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
# reset error |
1251
|
0
|
|
|
|
|
|
$group->reset_err(); |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
# get entry |
1254
|
0
|
|
|
|
|
|
$entry = $group->entry(); |
1255
|
0
|
0
|
|
|
|
|
$entry or return undef; |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
# return |
1258
|
0
|
|
|
|
|
|
return $entry->{$key}; |
1259
|
|
|
|
|
|
|
} |
1260
|
|
|
|
|
|
|
|
1261
|
0
|
|
|
0
|
|
|
sub name { return shift->field_get('name') } |
1262
|
0
|
|
|
0
|
|
|
sub gid { return shift->field_get('gid') } |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
# |
1265
|
|
|
|
|
|
|
# field gets |
1266
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1270
|
|
|
|
|
|
|
# entry |
1271
|
|
|
|
|
|
|
# |
1272
|
|
|
|
|
|
|
sub entry { |
1273
|
0
|
|
|
0
|
|
|
my ($group) = @_; |
1274
|
0
|
|
|
|
|
|
my (@fields, %entry); |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
# TESTING |
1277
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
# get fields |
1280
|
0
|
|
|
|
|
|
@fields = $group->fields($group->{'name'}); |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
# if no fields, set error and return undef |
1283
|
0
|
0
|
|
|
|
|
if (! @fields) { |
1284
|
0
|
|
|
|
|
|
return $group->set_err( |
1285
|
|
|
|
|
|
|
'do-not-have-group-entry-anymore', |
1286
|
|
|
|
|
|
|
$group->called_sub() . ': do not have a group with name "' . $group->{'name'} . '"', |
1287
|
|
|
|
|
|
|
); |
1288
|
|
|
|
|
|
|
} |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
# set hash |
1291
|
0
|
|
|
|
|
|
@entry{@field_names} = @fields; |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
# return |
1294
|
0
|
|
|
|
|
|
return \%entry; |
1295
|
|
|
|
|
|
|
} |
1296
|
|
|
|
|
|
|
# |
1297
|
|
|
|
|
|
|
# entry |
1298
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1302
|
|
|
|
|
|
|
# members |
1303
|
|
|
|
|
|
|
# |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
=head2 members |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
C returns an array of all members of the group. Both users for whom |
1308
|
|
|
|
|
|
|
this is the primary group, and users for whom this is a secondary group are |
1309
|
|
|
|
|
|
|
returned. |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
@members = $group->members(); |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
The elements in the array are Unix::Mgt::User objects. |
1314
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
=cut |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
sub members { |
1318
|
0
|
|
|
0
|
|
|
my ($group, %opts) = @_; |
1319
|
0
|
|
|
|
|
|
my (%members, @rv); |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
# add users for whom this is their primary group |
1322
|
0
|
|
|
|
|
|
foreach my $user ($group->primary_members(%opts)) { |
1323
|
0
|
|
|
|
|
|
$members{"$user"} = $user; |
1324
|
|
|
|
|
|
|
} |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
# add users for whom this is a secondary group |
1327
|
0
|
|
|
|
|
|
foreach my $user ($group->secondary_members(%opts)) { |
1328
|
0
|
|
|
|
|
|
$members{"$user"} = $user; |
1329
|
|
|
|
|
|
|
} |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
# build return value |
1332
|
0
|
|
|
|
|
|
@rv = values(%members); |
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
# return |
1335
|
0
|
|
|
|
|
|
return @rv; |
1336
|
|
|
|
|
|
|
} |
1337
|
|
|
|
|
|
|
# |
1338
|
|
|
|
|
|
|
# members |
1339
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1343
|
|
|
|
|
|
|
# primary_members |
1344
|
|
|
|
|
|
|
# |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
=head2 primary_members |
1347
|
|
|
|
|
|
|
|
1348
|
|
|
|
|
|
|
C returns an array of users for whom this is the primary |
1349
|
|
|
|
|
|
|
group. |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
@members = $group->primary_members(); |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
The elements in the returned array are Unix::Mgt::User objects. |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
=cut |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
sub primary_members { |
1358
|
0
|
|
|
0
|
|
|
my ($group, %opts) = @_; |
1359
|
0
|
|
|
|
|
|
my ($gid, %members, @rv); |
1360
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
# TESTING |
1362
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
# default options |
1365
|
0
|
|
|
|
|
|
%opts = (object=>1, %opts); |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
# get gid |
1368
|
0
|
|
|
|
|
|
$gid = $group->gid(); |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
# get users for whom this i |
1371
|
0
|
|
|
|
|
|
while (my @fields = getpwent()) { |
1372
|
0
|
|
|
|
|
|
my (%user); |
1373
|
0
|
|
|
|
|
|
@user{@Unix::Mgt::User::field_names} = @fields; |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
# if the user is in the group, add to %members |
1376
|
0
|
0
|
0
|
|
|
|
if ( defined($user{'gid'}) && ($user{'gid'} eq $gid) ) { |
1377
|
0
|
|
|
|
|
|
$members{$user{'name'}} = 1; |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
} |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
# build return array of objects |
1382
|
0
|
0
|
|
|
|
|
if ($opts{'object'}) { |
1383
|
0
|
|
|
|
|
|
foreach my $name (keys %members) { |
1384
|
0
|
|
|
|
|
|
push @rv, Unix::Mgt::User->get($name); |
1385
|
|
|
|
|
|
|
} |
1386
|
|
|
|
|
|
|
} |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
# else build return array of names |
1389
|
|
|
|
|
|
|
else { |
1390
|
0
|
|
|
|
|
|
@rv = keys(%members); |
1391
|
|
|
|
|
|
|
} |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
# return |
1394
|
0
|
|
|
|
|
|
return @rv; |
1395
|
|
|
|
|
|
|
} |
1396
|
|
|
|
|
|
|
# |
1397
|
|
|
|
|
|
|
# primary_members |
1398
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1402
|
|
|
|
|
|
|
# secondary_members |
1403
|
|
|
|
|
|
|
# |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
=head2 secondary_members |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
C returns an array of users for whom this is a secondary group. |
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
@members = $group->secondary_members(); |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
The elements in the returned array are Unix::Mgt::User objects. |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
=cut |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
sub secondary_members { |
1416
|
0
|
|
|
0
|
|
|
my ($group, %opts) = @_; |
1417
|
0
|
|
|
|
|
|
my ($gid, $members_str, %members, @rv); |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
# TESTING |
1420
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
# default options |
1423
|
0
|
|
|
|
|
|
%opts = (object=>1, %opts); |
1424
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
# get users for whom this is a secondary group |
1426
|
0
|
|
|
|
|
|
$members_str = $group->entry->{'members'}; |
1427
|
0
|
0
|
|
|
|
|
defined($members_str) or return (); |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
# loop through members |
1430
|
|
|
|
|
|
|
NAME_LOOP: |
1431
|
0
|
|
|
|
|
|
foreach my $name (split m|\s+|s, $members_str) { |
1432
|
0
|
0
|
|
|
|
|
if (hascontent $name) { |
1433
|
0
|
|
|
|
|
|
my $user = Unix::Mgt::User->get($name); |
1434
|
0
|
|
|
|
|
|
$members{$user->{'name'}} = 1; |
1435
|
|
|
|
|
|
|
} |
1436
|
|
|
|
|
|
|
} |
1437
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
# build return array of objects |
1439
|
0
|
0
|
|
|
|
|
if ($opts{'object'}) { |
1440
|
0
|
|
|
|
|
|
foreach my $name (keys %members) { |
1441
|
0
|
|
|
|
|
|
push @rv, Unix::Mgt::User->get($name); |
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
} |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
# else build return array of names |
1446
|
|
|
|
|
|
|
else { |
1447
|
0
|
|
|
|
|
|
@rv = keys(%members); |
1448
|
|
|
|
|
|
|
} |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
# return |
1451
|
0
|
|
|
|
|
|
return @rv; |
1452
|
|
|
|
|
|
|
} |
1453
|
|
|
|
|
|
|
# |
1454
|
|
|
|
|
|
|
# secondary_members |
1455
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1459
|
|
|
|
|
|
|
# add_member |
1460
|
|
|
|
|
|
|
# |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
=head2 add_member |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
C adds a user to the group as a secondary group. The single |
1465
|
|
|
|
|
|
|
param can be a user name, uid, or Unix::Mgt::User object. |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
$group->add_member('miko'); |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
If the user is already a member of the group then nothing is done and no error |
1470
|
|
|
|
|
|
|
is set. |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
=cut |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
sub add_member { |
1475
|
0
|
|
|
0
|
|
|
my ($group, $user) = @_; |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
# TESTING |
1478
|
|
|
|
|
|
|
# println subname(method=>1); ##i |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
# get user object |
1481
|
0
|
0
|
|
|
|
|
if (! ref $user) |
1482
|
0
|
|
|
|
|
|
{ $user = Unix::Mgt::User->get($user) } |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
# add user to group |
1485
|
0
|
|
|
|
|
|
return $user->add_to_group($group); |
1486
|
|
|
|
|
|
|
} |
1487
|
|
|
|
|
|
|
# |
1488
|
|
|
|
|
|
|
# add_member |
1489
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
# |
1493
|
|
|
|
|
|
|
# Unix::Mgt::Group |
1494
|
|
|
|
|
|
|
############################################################################### |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
# return true |
1499
|
|
|
|
|
|
|
1; |
1500
|
|
|
|
|
|
|
|
1501
|
|
|
|
|
|
|
__END__ |