File Coverage

blib/lib/Unix/Mgt.pm
Criterion Covered Total %
statement 122 324 37.6
branch 14 96 14.5
condition 0 3 0.0
subroutine 32 60 53.3
pod 0 6 0.0
total 168 489 34.3


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__