File Coverage

blib/lib/Passwd/Unix.pm
Criterion Covered Total %
statement 146 456 32.0
branch 44 300 14.6
condition 30 165 18.1
subroutine 34 68 50.0
pod 38 38 100.0
total 292 1027 28.4


line stmt bran cond sub pod time code
1             package Passwd::Unix;
2              
3 2     2   178022 use parent qw( Exporter::Tiny );
  2         617  
  2         12  
4 2     2   4043 use warnings;
  2         4  
  2         48  
5 2     2   10 use strict;
  2         4  
  2         36  
6             #-----------------------------------------------------------------------
7 2     2   17 use Config;
  2         4  
  2         70  
8 2     2   475 use Crypt::Password;
  2         5351  
  2         282  
9 2     2   847 use IO::Compress::Bzip2 qw( bzip2 $Bzip2Error );
  2         33697  
  2         283  
10 2     2   1035 use Path::Tiny;
  2         15746  
  2         112  
11 2     2   582 use Tie::Array::CSV;
  2         41986  
  2         74  
12             #-----------------------------------------------------------------------
13 2     2   30 use constant DAY => 86400;
  2         9  
  2         159  
14 2     2   17 use constant SEP => q[:];
  2         6  
  2         102  
15              
16 2     2   11 use constant ALG => q[sha512];
  2         4  
  2         111  
17 2     2   13 use constant BCK => 1;
  2         4  
  2         103  
18 2     2   20 use constant CMP => 1;
  2         3  
  2         96  
19 2     2   13 use constant DBG => 0;
  2         2  
  2         93  
20 2     2   12 use constant WRN => 0;
  2         3  
  2         114  
21 2     2   12 use constant MSK => 0022;
  2         36  
  2         97  
22              
23 2     2   11 use constant PWD => q[/etc/passwd];
  2         5  
  2         94  
24 2     2   11 use constant GRP => q[/etc/group];
  2         4  
  2         100  
25 2     2   11 use constant PSH => q[/etc/shadow];
  2         3  
  2         94  
26 2     2   10 use constant GSH => q[/etc/gshadow];
  2         4  
  2         12463  
27             #=======================================================================
28             our $VERSION = '1.07';
29             our @EXPORT_OK = qw(
30            
31             backup
32             compress
33             debug
34             warnings
35             error
36            
37             encpass
38            
39             exists_user
40             exists_group
41            
42             passwd_file
43             group_file
44             shadow_file
45             gshadow_file
46            
47             user
48             uid
49             gid
50             gecos
51             home
52             shell
53             passwd
54             rename
55            
56             del
57             del_user
58            
59             group
60             del_group
61            
62             users
63             users_from_shadow
64            
65             minuid
66             mingid
67            
68             maxuid
69             maxgid
70            
71             unused_uid
72             unused_gid
73            
74             groups
75             groups_from_gshadow
76            
77             reset
78            
79             default_umask
80             );
81             #======================================================================
82             my $Self = __PACKAGE__->new();
83             #======================================================================
84             sub new {
85 3     3 1 643 my ( $class, %opt ) = @_;
86            
87 3         8 my $self = bless { }, $class;
88            
89 3   100     60 $self->algorithm ( $opt{ algorithm } // ALG );
90 3   100     30 $self->backup ( $opt{ backup } // BCK );
91 3   100     17 $self->compress ( $opt{ compress } // CMP );
92 3   50     18 $self->debug ( $opt{ debug } // DBG );
93 3   50     16 $self->default_umask( $opt{ umask } // MSK );
94 3   100     32 $self->warnings ( $opt{ warnings } // WRN );
95            
96            
97 3   100     13 $self->passwd_file ( $opt{ passwd } // PWD );
98 3   100     23 $self->group_file ( $opt{ group } // GRP );
99 3   100     40 $self->shadow_file ( $opt{ shadow } // PSH );
100 3   100     22 $self->gshadow_file ( $opt{ gshadow } // GSH );
101            
102 3         8 return $self;
103             }
104             #=======================================================================
105             sub _err {
106 0     0   0 my ( $self, @str ) = @_;
107            
108 0         0 $self->{ err } = join( q[], @str );
109 0 0       0 warn $self->{ err } if $self->{ wrn };
110            
111 0         0 return;
112             }
113             #=======================================================================
114             sub _dat {
115 0     0   0 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime( time );
116            
117 0         0 $year += 1900;
118 0         0 $mon += 1;
119            
120 0 0       0 $sec = q[0] . $sec if $sec =~ /^\d$/o;
121 0 0       0 $min = q[0] . $min if $min =~ /^\d$/o;
122 0 0       0 $hour = q[0] . $hour if $hour =~ /^\d$/o;
123 0 0       0 $mday = q[0] . $mday if $mday =~ /^\d$/o;
124 0 0       0 $mon = q[0] . $mon if $mon =~ /^\d$/o;
125            
126 0         0 return $year . q[.] . $mon . q[.] . $mday . q[-] . $hour . q[.] . $min . q[.] . $sec;
127             }
128             #=======================================================================
129             sub _bck {
130 0     0   0 my ( $self ) = @_;
131            
132             #-------------------------------------------------------------------
133 0 0       0 return unless $self->{ bck };
134            
135             #-------------------------------------------------------------------
136 0         0 my $dir = path( $self->{ pwd } . q[.bak], _dat() );
137            
138 0 0       0 if( $dir->exists ){
139 0 0       0 return $self->_err( $dir . " is a file. It should be a directory.\n" ) if $dir->is_file;
140             }else{
141 0         0 $dir->mkpath;
142             }
143            
144             #-------------------------------------------------------------------
145 0         0 for my $dis ( qw( pwd grp psh gsh ) ){
146 0         0 my $src = path( $self->{ $dis } );
147 0         0 my $dst = $dir->child( $src->basename . q[.bz2] );
148            
149 0 0       0 if( $self->{ cmp } ){
150 0         0 $dst->touch;
151 0         0 $dst->chmod( $src->stat->mode );
152 0 0       0 bzip2 $src->stringify => $dst->stringify or return $self->_err( $Bzip2Error );
153             }else{
154 0         0 $src->copy( $dst );
155             }
156             }
157            
158             #-------------------------------------------------------------------
159 0         0 return 1;
160             }
161             #=======================================================================
162             sub del_group {
163             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
164 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
165             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
166 0         0 my ( @val ) = @_;
167            
168 0 0       0 return $self->_err( q[Supplied value is undefined.] ) unless @val;
169             #return $self->_err( q[Supplied group does not exists.] ) unless _exs( $self->{ grp }, $val );
170 0 0       0 return $self->_err( q[Unsufficient permissions.] ) unless open my $fhd, '>>', $self->{ gsh };
171            
172 0         0 close( $fhd );
173            
174             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
175 0 0       0 $self->_bck or return;
176             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
177            
178             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
179             tie my @ary, q[Tie::Array::CSV], $self->{ grp }, {
180 0         0 tie_file => {
181             autochomp => 1,
182             },
183             text_csv => {
184             sep_char => SEP,
185             binary => 1,
186             quote_char => undef,
187             },
188             };
189             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
190             tie my @yra, q[Tie::Array::CSV], $self->{ gsh }, {
191 0         0 tie_file => {
192             autochomp => 1,
193             },
194             text_csv => {
195             sep_char => SEP,
196             binary => 1,
197             quote_char => undef,
198             },
199             };
200             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
201 0         0 for my $val ( @val ){
202 0         0 my $sav;
203 0         0 for my $idx ( 0 .. $#ary ){
204 0 0       0 next if $ary[ $idx ][ 0 ] ne $val;
205 0         0 splice @ary, $idx, 1;
206 0         0 $sav = $idx;
207 0         0 last;
208             }
209             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
210 0 0       0 if( $yra[ $sav ][ 0 ] eq $val ){
211 0         0 splice @yra, $sav, 1;
212             }else{
213 0         0 for my $idx ( 0 .. $#yra ){
214 0 0       0 next if $yra[ $idx ][ 0 ] ne $val;
215 0         0 splice @yra, $idx, 1;
216 0         0 last;
217             }
218             }
219             }
220             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
221 0         0 return 1;
222             }
223             #=======================================================================
224             #*del_user = { };
225             *del_user = \&del;
226             #-----------------------------------------------------------------------
227             sub del {
228             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
229 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
230             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
231 0         0 my ( @val ) = @_;
232            
233 0 0       0 return $self->_err( q[Supplied value is undefined.] ) unless @val;
234             #return $self->_err( q[Supplied user does not exists.] ) unless _exs( $self->{ pwd }, $val );
235 0 0       0 return $self->_err( q[Unsufficient permissions.] ) unless open my $fhd, '>>', $self->{ psh };
236            
237 0         0 close( $fhd );
238            
239             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
240 0 0       0 $self->_bck or return;
241             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
242            
243             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
244             tie my @ary, q[Tie::Array::CSV], $self->{ pwd }, {
245 0         0 tie_file => {
246             autochomp => 1,
247             },
248             text_csv => {
249             sep_char => SEP,
250             binary => 1,
251             quote_char => undef,
252             },
253             };
254             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
255             tie my @yra, q[Tie::Array::CSV], $self->{ psh }, {
256 0         0 tie_file => {
257             autochomp => 1,
258             },
259             text_csv => {
260             sep_char => SEP,
261             binary => 1,
262             quote_char => undef,
263             },
264             };
265             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
266 0         0 for my $val ( @val ){
267 0         0 my $usr;
268             my $sav;
269 0         0 for my $idx ( 0 .. $#ary ){
270 0 0       0 next if $ary[ $idx ][ 0 ] ne $val;
271 0         0 $usr = splice @ary, $idx, 1;
272 0         0 $sav = $idx;
273 0         0 last;
274             }
275             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
276 0 0       0 if( $yra[ $sav ][ 0 ] eq $val ){
277 0         0 splice @yra, $sav, 1;
278             }else{
279 0         0 for my $idx ( 0 .. $#yra ){
280 0 0       0 next if $yra[ $idx ][ 0 ] ne $val;
281 0         0 splice @yra, $idx, 1;
282 0         0 last;
283             }
284             }
285             }
286             #+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
287 0         0 untie @ary;
288 0         0 untie @yra;
289            
290 0         0 @ary = ( );
291 0         0 @yra = ( );
292            
293             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
294             tie @ary, q[Tie::Array::CSV], $self->{ grp }, {
295 0         0 tie_file => {
296             autochomp => 1,
297             },
298             text_csv => {
299             sep_char => SEP,
300             binary => 1,
301             quote_char => undef,
302             },
303             };
304             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
305             tie @yra, q[Tie::Array::CSV], $self->{ gsh }, {
306 0         0 tie_file => {
307             autochomp => 1,
308             },
309             text_csv => {
310             sep_char => SEP,
311             binary => 1,
312             quote_char => undef,
313             },
314             };
315             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
316 0         0 for my $val ( @val ){
317 0         0 my $sav;
318 0         0 for my $idx ( 0 .. $#ary ){
319 0 0       0 next if $ary[ $idx ][ 3 ] !~ /\b$val\b/;
320 0         0 $ary[ $idx ][ 3 ] = join( q[,], grep { $_ ne $val } split( /\s*,\s*/, $ary[ $idx ][ 3 ] ) );
  0         0  
321             }
322             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
323 0         0 for my $idx ( 0 .. $#yra ){
324 0 0       0 next if $ary[ $idx ][ 3 ] !~ /\b$val\b/;
325 0         0 $ary[ $sav ][ 3 ] = join( q[,], grep { $_ ne $val } split( /\s*,\s*/, $ary[ $sav ][ 3 ] ) );
  0         0  
326             }
327             }
328             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
329 0         0 return 1;
330             }
331             #=======================================================================
332             sub rename {
333             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
334 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
335             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
336 0         0 my ( $usr, $val ) = @_;
337            
338 0 0 0     0 return $self->_err( q[Supplied value is undefined.] ) unless defined $usr and defined $val;
339 0 0       0 return $self->_err( q[Supplied user does not exists.] ) unless _exs( $self->{ pwd }, $usr );
340            
341 0         0 _set( $self->{ pwd }, $usr, 0, $val );
342 0         0 _set( $self->{ psh }, $usr, 0, $val );
343            
344 0         0 return;
345             }
346             #=======================================================================
347             sub passwd {
348             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
349 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
350             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
351 0         0 my ( $usr, $val ) = @_;
352            
353 0 0 0     0 return $self->_err( q[Supplied value is undefined.] ) unless defined $usr and defined $val;
354 0 0       0 return $self->_err( q[Supplied user does not exists.] ) unless _exs( $self->{ pwd }, $usr );
355            
356 0 0       0 if( defined $val ){
357 0         0 return $self->_set( $self->{ psh }, $usr, 1, $val );
358             }else{
359 0         0 return $self->_get( $self->{ psh }, $usr, 1 );
360             }
361             }
362             #=======================================================================
363             sub shell {
364             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
365 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
366             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
367 0         0 my ( $usr, $val ) = @_;
368            
369 0 0 0     0 return $self->_err( q[Supplied value is undefined.] ) unless defined $usr and defined $val;
370 0 0       0 return $self->_err( q[Supplied user does not exists.] ) unless _exs( $self->{ pwd }, $usr );
371            
372 0 0       0 if( defined $val ){
373 0         0 return $self->_set( $self->{ pwd }, $usr, 6, $val );
374             }else{
375 0         0 return $self->_get( $self->{ pwd }, $usr, 6 );
376             }
377             }
378             #=======================================================================
379             sub home {
380             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
381 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
382             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
383 0         0 my ( $usr, $val ) = @_;
384            
385 0 0 0     0 return $self->_err( q[Supplied value is undefined.] ) unless defined $usr and defined $val;
386 0 0       0 return $self->_err( q[Supplied user does not exists.] ) unless _exs( $self->{ pwd }, $usr );
387            
388 0 0       0 if( defined $val ){
389 0         0 return $self->_set( $self->{ pwd }, $usr, 5, $val );
390             }else{
391 0         0 return $self->_get( $self->{ pwd }, $usr, 5 );
392             }
393             }
394             #=======================================================================
395             sub gecos {
396             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
397 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
398             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
399 0         0 my ( $usr, $val ) = @_;
400            
401 0 0 0     0 return $self->_err( q[Supplied value is undefined.] ) unless defined $usr and defined $val;
402 0 0       0 return $self->_err( q[Supplied user does not exists.] ) unless _exs( $self->{ pwd }, $usr );
403            
404 0 0       0 if( defined $val ){
405 0         0 return $self->_set( $self->{ pwd }, $usr, 4, $val );
406             }else{
407 0         0 return $self->_get( $self->{ pwd }, $usr, 4 );
408             }
409             }
410             #=======================================================================
411             sub gid {
412             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
413 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
414             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
415 0         0 my ( $usr, $val ) = @_;
416            
417 0 0 0     0 return $self->_err( q[Supplied value is undefined.] ) unless defined $usr and defined $val;
418 0 0       0 return $self->_err( q[Supplied user does not exists.] ) unless _exs( $self->{ pwd }, $usr );
419            
420 0 0       0 if( defined $val ){
421 0         0 return $self->_set( $self->{ pwd }, $usr, 3, $val );
422             }else{
423 0         0 return $self->_get( $self->{ pwd }, $usr, 3 );
424             }
425             }
426             #=======================================================================
427             sub uid {
428             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
429 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
430             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
431 0         0 my ( $usr, $val ) = @_;
432            
433 0 0 0     0 return $self->_err( q[Supplied value is undefined.] ) unless defined $usr and defined $val;
434 0 0       0 return $self->_err( q[Supplied user does not exists.] ) unless _exs( $self->{ pwd }, $usr );
435            
436 0 0       0 if( defined $val ){
437 0         0 return $self->_set( $self->{ pwd }, $usr, 2, $val );
438             }else{
439 0         0 return $self->_get( $self->{ pwd }, $usr, 2 );
440             }
441             }
442             #=======================================================================
443             sub _set {
444 0     0   0 my ( $self, $pth, $usr, $pos, $val ) = @_;
445              
446 0 0       0 return $self->_err( q[Unsufficient permissions.] ) unless open my $fhd, '>>', $pth;
447 0         0 close( $fhd );
448            
449             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
450 0 0       0 $self->_bck or return;
451             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
452            
453 0         0 tie my @ary, q[Tie::Array::CSV], $pth, {
454             tie_file => {
455             autochomp => 1,
456             },
457             text_csv => {
458             sep_char => SEP,
459             binary => 1,
460             quote_char => undef,
461             },
462             };
463              
464 0         0 for my $idx ( 0 .. $#ary ){
465 0 0       0 next if $ary[ $idx ][ 0 ] ne $usr;
466 0         0 $ary[ $idx ][ $pos ] = $val;
467             }
468            
469 0         0 return 1;
470             }
471             #=======================================================================
472             sub _get {
473 0     0   0 my ( $self, $pth, $usr, $pos ) = @_;
474            
475 0 0       0 return $self->_err( q[Unsufficient permissions.] ) unless open my $fhd, '<', $pth;
476            
477 0         0 while( <$fhd> ){
478 0         0 my @tmp = split /:/;
479 0 0       0 next if $tmp[ 0 ] ne $usr;
480 0         0 return $tmp[ $pos ];
481             }
482 0         0 close( $fhd );
483            
484 0         0 return;
485             }
486             #=======================================================================
487             sub group {
488             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
489 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
490             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
491 0         0 my ( @arg ) = @_;
492            
493             #-------------------------------------------------------------------
494 0 0       0 if( @arg == 3 ){
    0          
495 0 0       0 return $self->_err( q[Unsufficient permissions.] ) unless open my $fhd, '>>', $self->{ gsh };
496 0         0 close( $fhd );
497            
498             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
499 0 0       0 $self->_bck or return;
500             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
501            
502             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
503             tie my @ary, q[Tie::Array::CSV], $self->{ grp }, {
504 0         0 tie_file => {
505             autochomp => 1,
506             },
507             text_csv => {
508             sep_char => SEP,
509             binary => 1,
510             quote_char => undef,
511             },
512             };
513             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
514             tie my @yra, q[Tie::Array::CSV], $self->{ gsh }, {
515 0         0 tie_file => {
516             autochomp => 1,
517             },
518             text_csv => {
519             sep_char => SEP,
520             binary => 1,
521             quote_char => undef,
522             },
523             };
524             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
525 0         0 my $lst = join( q[,], @{ $arg[ 2 ] } );
  0         0  
526            
527 0 0       0 if( _exs( $self->{ grp }, $arg[ 0 ] ) ){
528 0         0 my $sav;
529 0         0 for my $idx ( 0 .. $#ary ){
530 0 0       0 next if $ary[ $idx ][ 0 ] ne $arg[ 0 ];
531 0         0 $ary[ $idx ][ 2 ] = $arg[ 1 ];
532 0         0 $ary[ $idx ][ 3 ] = $lst;
533 0         0 $sav = $idx;
534 0         0 last;
535             }
536 0 0       0 if( $yra[ $sav ][ 0 ] eq $arg[ 0 ] ){
537 0         0 $yra[ $sav ][ 3 ] = $lst;
538             }else{
539 0         0 for my $idx ( 0 .. $#yra ){
540 0 0       0 next if $yra[ $idx ][ 0 ] ne $arg[ 0 ];
541 0         0 $yra[ $idx ][ 3 ] = $lst;
542 0         0 last;
543             }
544             }
545             }else{
546 0         0 push @ary, [
547             $arg[ 0 ],
548             q[x],
549             $arg[ 1 ],
550             $lst
551             ];
552            
553 0         0 push @yra, [
554             $arg[ 0 ],
555             q[!],
556             q[],
557             $lst
558             ];
559             }
560             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
561 0         0 return 1;
562             }
563             #-------------------------------------------------------------------
564             elsif( @arg == 1 ){
565 0 0       0 open( my $fhd, '<', $self->{ grp } ) or die $!;
566 0         0 my @grp = ( undef, [ ] );
567 0         0 while( <$fhd> ){
568 0         0 my @tmp = split /:/;
569 0 0       0 next if $tmp[ 0 ] ne $arg[ 0 ];
570            
571 0         0 chomp $tmp[ 3 ];
572            
573 0         0 $grp[ 0 ] = $tmp[ 2 ];
574 0         0 $grp[ 1 ] = [ split( /\s*,\s*/, $tmp[ 3 ] ) ];
575            
576 0         0 last;
577             }
578 0         0 close( $fhd );
579            
580 0 0       0 return wantarray ? @grp : \@grp;
581             }
582             #-------------------------------------------------------------------
583             }
584             #=======================================================================
585             sub user {
586             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
587 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
588             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
589 0         0 my ( @arg ) = @_;
590            
591             #-------------------------------------------------------------------
592 0 0       0 if( @arg == 7 ){
    0          
593 0 0       0 return $self->_err( q[Unsufficient permissions.] ) unless open my $fhd, '>>', $self->{ psh };
594 0         0 close( $fhd );
595            
596             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
597 0 0       0 $self->_bck or return;
598             #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
599            
600             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
601 0         0 my $pwd = $arg[ 1 ];
602 0         0 $arg[ 1 ] = q[x];
603             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
604             tie my @ary, q[Tie::Array::CSV], $self->{ pwd }, {
605 0         0 tie_file => {
606             autochomp => 1,
607             },
608             text_csv => {
609             sep_char => SEP,
610             binary => 1,
611             quote_char => undef,
612             },
613             };
614             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
615             tie my @yra, q[Tie::Array::CSV], $self->{ psh }, {
616 0         0 tie_file => {
617             autochomp => 1,
618             },
619             text_csv => {
620             sep_char => SEP,
621             binary => 1,
622             quote_char => undef,
623             },
624             };
625             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
626 0 0       0 if( _exs( $self->{ pwd }, $arg[ 0 ] ) ){
627 0         0 my $sav;
628 0         0 for my $idx ( 0 .. $#ary ){
629 0 0       0 next if $ary[ $idx ][ 0 ] ne $arg[ 0 ];
630 0         0 $ary[ $idx ][ $_ ] = $arg[ $_ ] for 1 .. 6;
631 0         0 $sav = $idx;
632 0         0 last;
633             }
634             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
635 0 0       0 if( $yra[ $sav ][ 0 ] eq $arg[ 0 ] ){
636 0         0 $yra[ $sav ][ 1 ] = $pwd;
637             }else{
638 0         0 for my $idx ( 0 .. $#yra ){
639 0 0       0 next if $yra[ $idx ][ 0 ] ne $arg[ 0 ];
640 0         0 $yra[ $idx ][ 1 ] = $pwd;
641 0         0 last;
642             }
643             }
644             }else{
645 0         0 push @ary, \@arg;
646 0         0 push @yra, [
647             $arg[ 0 ],
648             $pwd,
649             int( time / DAY ),
650             0,
651             99999,
652             7,
653             q[], q[], q[]
654             ];
655             }
656             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
657 0         0 return 1;
658             }
659             #-------------------------------------------------------------------
660             elsif( @arg == 1 ){
661 0         0 my @usr;
662 0 0       0 open( my $fhd, '<', $self->{ pwd } ) or die $!;
663 0         0 while( <$fhd> ){
664 0         0 my @tmp = split /:/;
665 0 0       0 next if $tmp[ 0 ] ne $arg[ 0 ];
666 0         0 $usr[ $_ - 1 ] = $tmp[ $_ ] for 1 .. 6;
667 0         0 last;
668             }
669 0         0 close( $fhd );
670            
671 0 0       0 chomp $usr[ $#usr ] if @usr;
672            
673             #if( $> == 0 ){
674 0 0       0 if( open( my $fhd, '<', $self->{ psh } ) ){
675 0         0 while( <$fhd> ){
676 0         0 my @tmp = split /:/;
677 0 0       0 next if $tmp[ 0 ] ne $arg[ 0 ];
678 0         0 $usr[ 0 ] = $tmp[ 1 ];
679 0         0 last;
680             }
681 0         0 close( $fhd );
682             }
683             #}
684            
685 0 0       0 return wantarray ? @usr : \@usr;
686             }
687             #-------------------------------------------------------------------
688             }
689             #=======================================================================
690             sub _unu {
691 0     0   0 my ( $pth, $min, $max ) = @_;
692            
693 0         0 my %all;
694 0 0       0 open( my $fhd, '<', $pth ) or die $!;
695 0         0 while( <$fhd> ){
696 0         0 $all{ ( split /:/ )[ 2 ] } = 1;
697             }
698 0         0 close( $fhd );
699            
700 0         0 for( my $idx = $min; $idx <= $max; $idx++ ){
701 0 0       0 return $idx if not exists $all{ $idx };
702             }
703             }
704             #=======================================================================
705             sub unused_uid {
706             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
707 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
708             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
709 0         0 my ( $min, $max ) = @_;
710            
711 0   0     0 return _unu( $self->{ pwd }, $min || 0, $max || ( 2 ** ( $Config{ intsize } * 8 ) ) );
      0        
712             }
713             #=======================================================================
714             sub unused_gid {
715             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
716 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
717             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
718 0         0 my ( $min, $max ) = @_;
719            
720 0   0     0 return _unu( $self->{ grp }, $min || 0, $max || ( 2 ** ( $Config{ intsize } * 8 ) ) );
      0        
721             }
722             #=======================================================================
723             sub _min {
724 0     0   0 my ( $pth, $min ) = @_;
725            
726 0         0 my %all;
727 0 0       0 open( my $fhd, '<', $pth ) or die $!;
728 0         0 while( <$fhd> ){
729 0         0 $all{ ( split /:/ )[ 2 ] } = 1;
730             }
731 0         0 close( $fhd );
732            
733 0         0 for( ;; ){
734 0 0       0 return $min if exists $all{ $min };
735 0         0 $min++;
736             };
737             }
738             #=======================================================================
739             sub minuid {
740             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
741 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
742             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
743 0         0 my ( $val ) = @_;
744            
745 0   0     0 return _min( $self->{ pwd }, $val || 0 );
746             }
747             #=======================================================================
748             sub mingid {
749             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
750 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
751             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
752 0         0 my ( $val ) = @_;
753            
754 0   0     0 return _min( $self->{ grp }, $val || 0 );
755             }
756             #=======================================================================
757             sub _max {
758 0     0   0 my ( $pth ) = @_;
759            
760 0         0 my $max = 0;
761 0 0       0 open( my $fhd, '<', $pth ) or die $!;
762 0         0 while( <$fhd> ){
763 0         0 my @tmp = split /:/;
764 0 0       0 $max = $tmp[ 2 ] if $tmp[ 2 ] > $max;
765             }
766 0         0 close( $fhd );
767            
768 0         0 return $max;
769             }
770             #======================================================================
771             sub maxuid {
772             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
773 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
774             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
775            
776 0         0 return _max( $self->{ pwd } );
777             }
778             #======================================================================
779             sub maxgid {
780             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
781 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
782             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
783            
784 0         0 return _max( $self->{ grp } );
785             }
786             #=======================================================================
787             sub _exs {
788 0     0   0 my ( $pth, $val, $pos ) = @_;
789            
790 0   0     0 $pos //= 0;
791            
792 0 0       0 open( my $fhd, '<', $pth ) or die $!;
793 0         0 while( <$fhd> ){
794 0         0 my @tmp = split /:/;
795 0 0       0 return 1 if $tmp[ $pos ] eq $val;
796             }
797 0         0 close( $fhd );
798              
799 0         0 return;
800             }
801             #======================================================================
802             sub exists_user {
803             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
804 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
805             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
806 0         0 my ( $val ) = @_;
807            
808 0 0       0 return unless defined $val;
809 0         0 return _exs( $self->{ pwd }, $val );
810             }
811             #======================================================================
812             sub exists_group {
813             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
814 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
815             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
816 0         0 my ( $val ) = @_;
817            
818 0 0       0 return unless defined $val;
819 0         0 return _exs( $self->{ grp }, $val );
820             }
821             #=======================================================================
822             sub reset {
823             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
824 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
825             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
826            
827 0         0 $self->passwd_file ( PWD );
828 0         0 $self->group_file ( GRP );
829 0         0 $self->shadow_file ( PSH );
830 0         0 $self->gshadow_file ( GSH );
831            
832 0         0 return 1;
833             }
834             #=======================================================================
835             sub encpass {
836             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
837 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
838             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
839 0         0 my ( $val ) = @_;
840            
841 0 0       0 return unless defined $val;
842 0         0 return password( $val, undef, $self->{ alg } );
843             }
844             #=======================================================================
845             sub algorithm {
846             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
847 3 50 33 3 1 26 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
848             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
849 3         7 my ( $val ) = @_;
850            
851 3 50       12 return $self->{ alg } unless defined $val;
852              
853 3 100       20 my $alg = $val eq q[md5] ? $val :
    50          
    50          
854             $val eq q[blowfish] ? $val :
855             $val eq q[sha256] ? $val : q[sha512];
856            
857 3         37 $self->{ alg } = $alg;
858            
859 3         8 return $self->{ alg };
860             }
861             #=======================================================================
862             sub default_umask {
863             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
864 3 50 33 3 1 24 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
865             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
866 3         6 my ( $val ) = @_;
867            
868 3 50       7 return $self->{ msk } unless defined $val;
869            
870 3 50       8 $self->{ msk } = $val ? 1 : 0;
871            
872 3         6 return $self->{ msk };
873             }
874             #=======================================================================
875             sub backup {
876             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
877 3 50 33 3 1 15 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
878             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
879 3         9 my ( $val ) = @_;
880            
881 3 50       21 return $self->{ bck } unless defined $val;
882            
883 3 100       10 $self->{ bck } = $val ? 1 : 0;
884            
885 3         7 return $self->{ bck };
886             }
887             #=======================================================================
888             sub compress {
889             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
890 3 50 33 3 1 16 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
891             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
892 3         11 my ( $val ) = @_;
893            
894 3 50       10 return $self->{ cmp } unless defined $val;
895            
896 3 100       11 $self->{ cmp } = $val ? 1 : 0;
897            
898 3         5 return $self->{ cmp };
899             }
900             #=======================================================================
901             sub warnings {
902             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
903 3 50 33 3 1 16 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
904             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
905 3         9 my ( $val ) = @_;
906            
907 3 50       8 return $self->{ wrn } unless defined $val;
908            
909 3 100       22 $self->{ wrn } = $val ? 1 : 0;
910            
911 3         6 return $self->{ wrn };
912             }
913             #=======================================================================
914             sub debug {
915             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
916 3 50 33 3 1 25 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
917             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
918 3         7 my ( $val ) = @_;
919            
920 3 50       15 return $self->{ dbg } unless defined $val;
921            
922 3 50       10 $self->{ dbg } = $val ? 1 : 0;
923            
924 3         5 return $self->{ dbg };
925             }
926             #=======================================================================
927             sub error {
928             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
929 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
930             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
931 0         0 my ( $val ) = @_;
932            
933 0         0 return $self->{ err };
934             }
935             #=======================================================================
936             sub passwd_file {
937             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
938 3 50 33 3 1 14 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
939             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
940 3         6 my ( $val ) = @_;
941            
942 3 50       14 return $self->{ pwd } unless defined $val;
943            
944 3         17 my $pth = path( $val );
945 3 50       191 die q[Password file cannot be a directory.] if $pth->is_dir;
946            
947 3 50       193 $pth->touchpath unless $pth->exists;
948            
949 3         77 $self->{ pwd } = $pth->absolute->canonpath;
950            
951 3         301 return $self->{ pwd };
952             }
953             #=======================================================================
954             sub group_file {
955             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
956 3 50 33 3 1 55 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
957             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
958 3         7 my ( $val ) = @_;
959            
960 3 50       9 return $self->{ grp } unless defined $val;
961            
962 3         10 my $pth = path( $val );
963 3 50       119 die q[Group file cannot be a directory.] if $pth->is_dir;
964            
965 3 50       73 $pth->touchpath unless $pth->exists;
966            
967 3         45 $self->{ grp } = $pth->absolute->canonpath;
968            
969 3         163 return $self->{ grp };
970             }
971             #=======================================================================
972             sub shadow_file {
973             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
974 3 50 33 3 1 33 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
975             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
976 3         7 my ( $val ) = @_;
977            
978 3 50       8 return $self->{ psh } unless defined $val;
979            
980 3         8 my $pth = path( $val );
981 3 50       117 die q[Shadowed passwd file (aka "shadow") file cannot be a directory.] if $pth->is_dir;
982            
983 3 50       63 $pth->touchpath unless $pth->exists;
984            
985 3         50 $self->{ psh } = $pth->absolute->canonpath;
986            
987 3         142 return $self->{ psh };
988             }
989             #=======================================================================
990             sub gshadow_file {
991             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
992 3 50 33 3 1 17 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
993             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
994 3         7 my ( $val ) = @_;
995            
996 3 50       13 return $self->{ gsh } unless defined $val;
997            
998 3         11 my $pth = path( $val );
999 3 50       115 die q[Shadowed group file (aka "gshadow") file cannot be a directory.] if $pth->is_dir;
1000            
1001 3 50       70 $pth->touchpath unless $pth->exists;
1002            
1003 3         53 $self->{ gsh } = $pth->absolute->canonpath;
1004            
1005 3         137 return $self->{ gsh };
1006             }
1007             #=======================================================================
1008             sub _lst {
1009 2     2   18 my ( $pth ) = @_;
1010            
1011 2         5 my @ary;
1012 2 50       83 open( my $fhd, '<', $pth ) or die $!;
1013 2         98 push @ary, ( split( /:/, $_ ) )[ 0 ] while <$fhd>;
1014 2         24 close($fhd);
1015            
1016 2 50       29 return wantarray ? @ary : \@ary;
1017             }
1018             #=======================================================================
1019             sub groups {
1020             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1021 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
1022             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1023 0         0 return _lst( $self->{ grp } );
1024             }
1025             #=======================================================================
1026             sub groups_from_gshadow {
1027             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1028 0 0 0 0 1 0 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
1029             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1030 0         0 return _lst( $self->{ gsh } );
1031             }
1032             #=======================================================================
1033             sub users {
1034             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1035 1 50 33 1 1 1477 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
1036             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1037 1         5 return _lst( $self->{ pwd } );
1038             }
1039             #=======================================================================
1040             sub check_sanity {
1041 0     0 1 0 return 1;
1042             }
1043             #=======================================================================
1044             sub users_from_shadow {
1045             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1046 1 50 33 1 1 313 my $self = scalar @_ && ref $_[0] eq __PACKAGE__ ? shift : $Self;
1047             #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1048 1         4 return _lst( $self->{ psh } );
1049             }
1050             #======================================================================
1051              
1052             =head1 NAME
1053              
1054             Passwd::Unix - access to standard unix files
1055              
1056             =head1 SYNOPSIS
1057              
1058             use Passwd::Unix;
1059            
1060             my $pu = Passwd::Unix->new;
1061            
1062             my $err = $pu->user(
1063             "example",
1064             $pu->encpass("my_secret"),
1065             $pu->unused_uid,
1066             $pu->unused_gid,
1067             "My User",
1068             "/home/example",
1069             "/bin/bash"
1070             );
1071            
1072             $pu->passwd("example", $pu->encpass( "newsecret") );
1073             foreach my $user ($pu->users) {
1074             print "Username: $user\nFull Name: ", $pu->gecos($user), "\n\n";
1075             }
1076            
1077             my $uid = $pu->uid('example');
1078             $pu->del("example");
1079              
1080             # or
1081              
1082             use Passwd::Unix qw(
1083             algorithm backup check_sanity compress del del_group del_user
1084             encpass exists_group exists_user gecos gid group group_file
1085             groups groups_from_gshadow home maxgid maxuid mingid minuid
1086             passwd passwd_file rename reset shadow_file shell uid user
1087             users users_from_shadow warnings
1088             );
1089            
1090             my $err = user( "example", encpass("my_secret"), unused_uid(), unused_gid(),
1091             "My User", "/home/example", "/bin/bash" );
1092             passwd("example",encpass("newsecret"));
1093             foreach my $user ( users() ) {
1094             print "Username: $user\nFull Name: ", gecos( $user ), "\n\n";
1095             }
1096            
1097             my $uid = uid( 'example' );
1098             del( 'example' );
1099              
1100             =head1 ABSTRACT
1101              
1102             Passwd::Unix provides an abstract object-oriented and function interface to
1103             standard Unix files, such as /etc/passwd, /etc/shadow, /etc/group. Additionally
1104             this module provides environment for testing software without using
1105             system critical files in /etc/ dir (you can specify other files than
1106             /etc/passwd etc.).
1107              
1108             =head1 DESCRIPTION
1109              
1110             The Passwd::Unix module provides an abstract interface to /etc/passwd,
1111             /etc/shadow, /etc/group, /etc/gshadow format files. It is inspired by
1112             Unix::PasswdFile module (that one does not handle /etc/shadow file).
1113              
1114             B
1115             newer hash algorithms and so on), however with compatibility in mind.
1116             Despite this some incompatibilities can occur.>
1117              
1118             =head1 SUBROUTINES/METHODS
1119              
1120             =over 4
1121              
1122             =item B 1, param1 => 0... ] )>
1123              
1124             Constructor. Possible parameters are:
1125              
1126             =over 8
1127              
1128             =item B - path to passwd file; default C
1129              
1130             =item B - path to shadow file; default C
1131              
1132             =item B - path to group file; default C
1133              
1134             =item B - path to gshadow file if any; default C
1135              
1136             =item B - hash algorithm, possible values: md5, blowfish, sha256, sha512; default C
1137              
1138             =item B - not used anymore; left only for compatibility reason
1139              
1140             =item B - not used anymore; left only for compatibility reason
1141              
1142             =item B - boolean; if set to C<1>, backup will be made; default C<1>
1143              
1144             =item B - boolean; if set to C<1>, backup compression will be made; default C<1>
1145              
1146             =item B - boolean; if set to C<1>, important warnings will be displayed; default C<0>
1147              
1148             =back
1149              
1150             =item B
1151              
1152             This method allows to specify algorithm for password generation. Possible values: C, C, C, C
1153              
1154             =item B
1155              
1156             This method allows to specify if backups files have to be made before every modyfication (C<1> for on, C<0> for off).
1157              
1158             =item B
1159              
1160             This method allows to specify if compression to backup files has to be made (C<1> for on, C<0> for off).
1161              
1162             =item B
1163              
1164             This function was left only for compatibility reason. Currently it does nothing (always returns 1).
1165              
1166             =item B
1167              
1168             This function was left only for compatibility reason. Currently it does nothing.
1169              
1170             =item B
1171              
1172             This function was left only for compatibility reason. Currently it does nothing.
1173              
1174             =item B
1175              
1176             This method is an alias for C. It's for transition only.
1177              
1178             =item B
1179              
1180             This method will delete the list of users. It has no effect if the
1181             supplied users do not exist.
1182              
1183             =item B
1184              
1185             This method will delete the list of groups. It has no effect if the
1186             supplied groups do not exist.
1187              
1188             =item B
1189              
1190             This method will encrypt plain text into unix style password.
1191              
1192             =item B
1193              
1194             This method returns the last error (even if "warnings" is disabled).
1195              
1196             =item B
1197              
1198             This method checks if specified user exists. It returns C on failure and C<1> on success.
1199              
1200             =item B
1201              
1202             This method checks if specified group exists. It returns C on failure and C<1> on success.
1203              
1204             =item B
1205              
1206             Read or modify a user's GECOS string (typically full name).
1207             Returns the result of operation (C<1> or C) if GECOS was specified.
1208             Otherwhise returns the GECOS if any.
1209              
1210             =item B
1211              
1212             Read or modify a user's GID. Returns the result of operation (C<1> or C) if GID was specified otherwhise returns the GID if any.
1213              
1214             =item B
1215              
1216             This method can add, modify, or return information about a group.
1217             Supplied with a single groupname parameter, it will return a two element
1218             list consisting of (GID, ARRAYREF), where ARRAYREF is a ref to array
1219             consisting names of users in this GROUP. It will return undef and ref to empty array (C) if no such group
1220             exists. If you supply all three parameters, the named group will be
1221             created or modified if it already exists.
1222              
1223             =item B
1224              
1225             This method, if called with an argument, sets path to the I file.
1226             Otherwise returns the current PATH.
1227              
1228             =item B
1229              
1230             This method returns a list of all existing groups.
1231              
1232             =item B
1233              
1234             This method returns a list of all existing groups in a gshadow file.
1235              
1236             =item B
1237              
1238             This method, if called with an argument, sets path to the I file.
1239             Otherwise returns the current PATH.
1240              
1241             =item B
1242              
1243             Read or modify a user's home directory. Returns the result of operation
1244             (C<1> or C) if HOMEDIR was specified otherwhise returns the HOMEDIR if any.
1245              
1246             =item B
1247              
1248             This method returns the maximum UID in use.
1249              
1250             =item B
1251              
1252             This method returns the maximum GID in use.
1253              
1254             =item B
1255              
1256             This method returns the minimum UID in use, that is greater then spupplied.
1257              
1258             =item B
1259              
1260             This method returns the minimum GID in use, that is greater then spupplied.
1261              
1262             =item B
1263              
1264             Read or modify a user's password. If you have a plaintext password,
1265             use the encpass method to encrypt it before passing it to this method.
1266             Returns the result of operation (C<1> or C) if PASSWD was specified.
1267             Otherwhise returns the PASSWD if any.
1268              
1269             =item B
1270              
1271             This method, if called with an argument, sets path to the I file.
1272             Otherwise returns the current PATH.
1273              
1274             =item B
1275              
1276             This method changes the username for a user. If NEWNAME corresponds to
1277             an existing user, that user will be overwritten. It returns C on
1278             failure and C<1> on success.
1279              
1280             =item B
1281              
1282             This method sets paths to files I, I, I, I to the
1283             default values.
1284              
1285             =item B
1286              
1287             Read or modify a user's shell. Returns the result of operation (C<1> or C) if SHELL was specified otherwhise returns the SHELL if any.
1288              
1289             =item B
1290              
1291             Read or modify a user's UID. Returns the result of operation (C<1> or C) if UID was specified otherwhise returns the UID if any.
1292              
1293             =item B
1294              
1295             This method can add, modify, or return information about a user.
1296             Supplied with a single username parameter, it will return a six element
1297             list consisting of (PASSWORD, UID, GID, GECOS, HOMEDIR, SHELL), or
1298             undef if no such user exists. If you supply all seven parameters,
1299             the named user will be created or modified if it already exists.
1300              
1301             =item B
1302              
1303             This method returns a list of all existing usernames.
1304              
1305             =item B
1306              
1307             This method returns a list of all existing usernames in a shadow file.
1308              
1309             =item B
1310              
1311             This method, if called with an argument, sets path to the I file.
1312             Otherwise returns the current PATH.
1313              
1314             =item B
1315              
1316             This method returns the first unused UID in a given range. The default MINUID is 0. The default MAXUID is maximal integer value (computed from C<$Config{ intsize }> ).
1317              
1318             =item B
1319              
1320             This method returns the first unused GID in a given range. The default MINGID is 0. The default MAXGID is maximal integer value (computed from C<$Config{ intsize }> ).
1321              
1322             =item B
1323              
1324             This method allows to specify if warnings has to be displayed (C<1> for on, C<0> for off). Whether you can check last warning/failure by calling C.
1325              
1326             =back
1327              
1328             =head1 DEPENDENCIES
1329              
1330             =over 4
1331              
1332             =item Crypt::Password
1333              
1334             =item IO::Compress::Bzip2
1335              
1336             =item Path::Tiny
1337              
1338             =item Tie::Array::CSV
1339              
1340             =back
1341              
1342             =head1 TODO
1343              
1344             Preparation of tests.
1345              
1346             =head1 INCOMPATIBILITIES
1347              
1348             None known.
1349              
1350             =head1 BUGS AND LIMITATIONS
1351              
1352             None. I hope.
1353              
1354             =head1 THANKS
1355              
1356             =over 4
1357              
1358             =item Thanks to Jonas Genannt for many suggestions and patches!
1359              
1360             =item Thanks to Christian Kuelker for suggestions and reporting some bugs :-).
1361              
1362             =item Thanks to Steven Haryanto for suggestions.
1363              
1364             =item BIG THANKS to Lopes Victor for reporting some bugs and his exact sugesstions :-)
1365              
1366             =item Thanks to Foudil BRÉTEL for some remarks, suggestions as well as supplying relevant patch!
1367              
1368             =item BIG thanks to Artem Russakovskii for reporting a bug.
1369              
1370             =back
1371              
1372             =head1 AUTHOR
1373              
1374             Strzelecki Lukasz
1375              
1376             =head1 LICENCE AND COPYRIGHT
1377              
1378             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
1379              
1380             See http://www.perl.com/perl/misc/Artistic.html