1## no critic (InputOutput::RequireBriefOpen)
2
3package Unix::Passwd::File;
4
5our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
6our $DATE = '2020-04-29'; # DATE
7our $DIST = 'Unix-Passwd-File'; # DIST
8our $VERSION = '0.251'; # VERSION
9
10use 5.010001;
11use strict;
12use warnings;
13use experimental 'smartmatch';
14#use Log::ger;
15
16use File::Flock::Retry;
17use List::Util qw(max first);
18use List::MoreUtils qw(firstidx);
19
20our @ISA       = qw(Exporter);
21our @EXPORT_OK = qw(
22                       add_delete_user_groups
23                       add_group
24                       add_user
25                       add_user_to_group
26                       delete_group
27                       delete_user
28                       delete_user_from_group
29                       get_group
30                       get_max_gid
31                       get_max_uid
32                       get_user
33                       get_user_groups
34                       group_exists
35                       is_member
36                       list_groups
37                       list_users
38                       list_users_and_groups
39                       modify_group
40                       modify_user
41                       set_user_groups
42                       set_user_password
43                       user_exists
44               );
45
46our %SPEC;
47
48$SPEC{':package'} = {
49    v => 1.1,
50    summary => 'Manipulate /etc/{passwd,shadow,group,gshadow} entries',
51};
52
53my %common_args = (
54    etc_dir => {
55        summary => 'Specify location of passwd files',
56        schema  => ['str*' => {default=>'/etc'}],
57        tags    => ['common'],
58    },
59);
60my %write_args = (
61    backup => {
62        summary => 'Whether to backup when modifying files',
63        description => <<'_',
64
65Backup is written with `.bak` extension in the same directory. Unmodified file
66will not be backed up. Previous backup will be overwritten.
67
68_
69        schema  => ['bool' => {default=>0}],
70    },
71);
72
73our $re_user   = qr/\A[A-Za-z0-9._-]+\z/;
74our $re_group  = $re_user;
75our $re_field  = qr/\A[^\n:]*\z/;
76our $re_posint = qr/\A[1-9][0-9]*\z/;
77
78our %passwd_fields = (
79    user => {
80        summary => 'User (login) name',
81        schema  => ['unix::username*' => {match => $re_user}],
82        pos     => 0,
83    },
84    pass => {
85        summary => 'Password, generally should be "x" which means password is '.
86            'encrypted in shadow',
87        schema  => ['str*' => {match => $re_field}],
88        pos     => 1,
89    },
90    uid => {
91        summary => 'Numeric user ID',
92        schema  => 'unix::uid*',
93        pos     => 2,
94    },
95    gid => {
96        summary => 'Numeric primary group ID for this user',
97        schema  => 'unix::gid*',
98        pos     => 3,
99    },
100    gecos => {
101        summary => 'Usually, it contains the full username',
102        schema  => ['str*' => {match => $re_field}],
103        pos     => 4,
104    },
105    home => {
106        summary => 'User\'s home directory',
107        schema  => ['dirname*' => {match => $re_field}],
108        pos     => 5,
109    },
110    shell => {
111        summary => 'User\'s shell',
112        schema  => ['filename*' => {match=>qr/\A[^\n:]*\z/}],
113        pos     => 6,
114    },
115);
116our @passwd_field_names;
117for (keys %passwd_fields) {
118    $passwd_field_names[$passwd_fields{$_}{pos}] = $_;
119    delete $passwd_fields{$_}{pos};
120}
121
122our %shadow_fields = (
123    user => {
124        summary => 'User (login) name',
125        schema  => ['unix::username*' => {match => $re_user}],
126        pos     => 0,
127    },
128    encpass => {
129        summary => 'Encrypted password',
130        schema  => ['str*' => {match => $re_field}],
131        pos     => 1,
132    },
133    last_pwchange => {
134        summary => 'The date of the last password change, '.
135            'expressed as the number of days since Jan 1, 1970.',
136        schema  => 'int',
137        pos     => 2,
138    },
139    min_pass_age => {
140        summary => 'The number of days the user will have to wait before she '.
141            'will be allowed to change her password again',
142        schema  => 'int',
143        pos     => 3,
144    },
145    max_pass_age => {
146        summary => 'The number of days after which the user will have to '.
147            'change her password',
148        schema  => 'int',
149        pos     => 4,
150    },
151    pass_warn_period => {
152        summary => 'The number of days before a password is going to expire '.
153            '(see max_pass_age) during which the user should be warned',
154        schema  => 'int',
155        pos     => 5,
156    },
157    pass_inactive_period => {
158        summary => 'The number of days after a password has expired (see '.
159            'max_pass_age) during which the password should still be accepted '.
160                '(and user should update her password during the next login)',
161        schema  => 'int',
162        pos     => 6,
163    },
164    expire_date => {
165        summary => 'The date of expiration of the account, expressed as the '.
166            'number of days since Jan 1, 1970',
167        schema  => 'int',
168        pos     => 7,
169    },
170    reserved => {
171        summary => 'This field is reserved for future use',
172        schema  => ['str*' => {match => $re_field}],
173        pos     => 8,
174    }
175);
176our @shadow_field_names;
177for (keys %shadow_fields) {
178    $shadow_field_names[$shadow_fields{$_}{pos}] = $_;
179    delete $shadow_fields{$_}{pos};
180}
181
182our %group_fields = (
183    group => {
184        summary => 'Group name',
185        schema  => ['unix::groupname*' => {match => $re_group}],
186        pos     => 0,
187    },
188    pass => {
189        summary => 'Password, generally should be "x" which means password is '.
190            'encrypted in gshadow',
191        schema  => ['str*' => {match => $re_field}],
192        pos     => 1,
193    },
194    gid => {
195        summary => 'Numeric group ID',
196        schema  => 'unix::gid*',
197        pos     => 2,
198    },
199    members => {
200        summary => 'List of usernames that are members of this group, '.
201            'separated by commas',
202        schema  => ['str*' => {match => $re_field}],
203        pos     => 3,
204    },
205);
206our @group_field_names;
207for (keys %group_fields) {
208    $group_field_names[$group_fields{$_}{pos}] = $_;
209    delete $group_fields{$_}{pos};
210}
211
212our %gshadow_fields = (
213    group => {
214        summary => 'Group name',
215        schema  => ['unix::groupname*' => {match => $re_group}],
216        pos     => 0,
217    },
218    encpass => {
219        summary => 'Encrypted password',
220        schema  => ['str*' => {match=> $re_field}],
221        pos     => 1,
222    },
223    admins => {
224        summary => 'It must be a comma-separated list of user names, or empty',
225        schema  => ['str*' => {match => $re_field}],
226        pos     => 2,
227    },
228    members => {
229        summary => 'List of usernames that are members of this group, '.
230            'separated by commas; You should use the same list of users as in '.
231                '/etc/group.',
232        schema  => ['str*' => {match => $re_field}],
233        pos     => 3,
234    },
235);
236our @gshadow_field_names;
237for (keys %gshadow_fields) {
238    $gshadow_field_names[$gshadow_fields{$_}{pos}] = $_;
239    delete $gshadow_fields{$_}{pos};
240}
241
242sub _arg_from_field {
243    my ($fields, $name, %extra) = @_;
244    my %spec = %{ $fields->{$name} };
245    $spec{$_} = $extra{$_} for keys %extra;
246    ($name => \%spec);
247}
248
249sub _backup {
250    my ($fh, $path) = @_;
251    seek $fh, 0, 0 or return [500, "Can't seek: $!"];
252    open my($bak), ">", "$path.bak" or return [500, "Can't open $path.bak: $!"];
253    while (<$fh>) { print $bak $_ }
254    close $bak or return [500, "Can't write $path.bak: $!"];
255    # XXX set ctime & mtime of backup file?
256    [200];
257}
258
259# all public functions in this module use the _routine(), which contains the
260# basic flow, to avoid duplication of code. admittedly this makes _routine()
261# quite convoluted, as it tries to accomodate all the functions' logic in a
262# single routine. _routine() accepts these special arguments for flow control:
263#
264# - _read_shadow   = 0*/1/2 (2 means optional, don't exit if fail)
265# - _read_passwd   = 0*/1
266# - _read_gshadow  = 0*/1/2 (2 means optional, don't exit if fail)
267# - _read_group    = 0*/1
268# - _lock          = 0*/1 (whether to lock)
269# - _after_read    = code (executed after reading all passwd/group files)
270# - _after_read_passwd_entry = code (executed after reading a line in passwd)
271# - _after_read_group_entry = code (executed after reading a line in group)
272# - _write_shadow  = 0*/1
273# - _write_passwd  = 0*/1
274# - _write_gshadow = 0*/1
275# - _write_group   = 0*/1
276#
277# all the hooks are fed $stash, sort of like a bag or object containing all
278# data. should return enveloped response. _routine() will return with response
279# if response is non success. _routine() will also return immediately if
280# $stash{exit} is set.
281#
282# to write, we open once but with mode '+<' instead of '<'. we read first then
283# we seek back to beginning and write from in-memory data. if
284# $stash{write_passwd} and so on is set to false, _routine() cancels the write
285# (can be used e.g. when there is no change so no need to write).
286#
287# final result is in $stash{res} or non-success result returned by hook.
288sub _routine {
289    my %args = @_;
290
291    my $etc     = $args{etc_dir} // "/etc";
292    my $detail  = $args{detail};
293    my $wfn     = $args{with_field_names} // 1;
294    my @locks;
295    my ($fhp, $fhs, $fhg, $fhgs);
296    my %stash;
297
298    my $e = eval {
299
300        if ($args{_lock}) {
301            for (qw/passwd shadow group gshadow/) {
302                push @locks, File::Flock::Retry->lock("$etc/$_", {retries=>3});
303            }
304        }
305
306        # read files
307
308        my @shadow;
309        my %shadow;
310        my @shadowh;
311        $stash{shadow}   = \@shadow;
312        $stash{shadowh}  = \@shadowh;
313        if ($args{_read_shadow} || $args{_write_shadow}) {
314            unless (open $fhs, ($args{_write_shadow} ? "+":"")."<",
315                    "$etc/shadow") {
316                if ($args{_read_shadow} == 2 && !$args{_write_shadow}) {
317                    goto L1;
318                } else {
319                    return [500, "Can't open $etc/shadow: $!"];
320                }
321            }
322            while (<$fhs>) {
323                chomp;
324                next unless /\S/; # skip empty line
325                my @r = split /:/, $_, scalar(keys %shadow_fields);
326                push @shadow, \@r;
327                $shadow{$r[0]} = \@r;
328                if ($wfn) {
329                    my %r;
330                    @r{@shadow_field_names} = @r;
331                    push @shadowh, \%r;
332                }
333            }
334        }
335
336      L1:
337        my @passwd;
338        my @passwdh;
339        $stash{passwd}   = \@passwd;
340        $stash{passwdh}  = \@passwdh;
341        if ($args{_read_passwd} || $args{_write_passwd}) {
342            open $fhp, ($args{_write_passwd} ? "+":"")."<", "$etc/passwd"
343                or return [500, "Can't open $etc/passwd: $!"];
344            while (<$fhp>) {
345                chomp;
346                next unless /\S/; # skip empty line
347                my @r = split /:/, $_, scalar(keys %passwd_fields);
348                push @passwd, \@r;
349                if ($wfn) {
350                    my %r;
351                    @r{@shadow_field_names} = @{ $shadow{$r[0]} }
352                        if $shadow{$r[0]};
353                    @r{@passwd_field_names} = @r;
354                    push @passwdh, \%r;
355                }
356                if ($args{_after_read_passwd_entry}) {
357                    my $res = $args{_after_read_passwd_entry}->(\%stash);
358                    return $res if $res->[0] != 200;
359                    return if $stash{exit};
360                }
361            }
362        }
363
364        my @gshadow;
365        my %gshadow;
366        my @gshadowh;
367        $stash{gshadow}  = \@gshadow;
368        $stash{gshadowh} = \@gshadowh;
369        if ($args{_read_gshadow} || $args{_write_gshadow}) {
370            unless (open $fhgs, ($args{_write_gshadow} ? "+":"")."<",
371                    "$etc/gshadow") {
372                if ($args{_read_gshadow} == 2 && !$args{_write_gshadow}) {
373                    goto L2;
374                } else {
375                    return [500, "Can't open $etc/gshadow: $!"];
376                }
377            }
378            while (<$fhgs>) {
379                chomp;
380                next unless /\S/; # skip empty line
381                my @r = split /:/, $_, scalar(keys %gshadow_fields);
382                push @gshadow, \@r;
383                $gshadow{$r[0]} = \@r;
384                if ($wfn) {
385                    my %r;
386                    @r{@gshadow_field_names} = @r;
387                    push @gshadowh, \%r;
388                }
389            }
390        }
391
392      L2:
393        my @group;
394        my @grouph;
395        $stash{group}    = \@group;
396        $stash{grouph}   = \@grouph;
397        if ($args{_read_group} || $args{_write_group}) {
398            open $fhg, ($args{_write_group} ? "+":"")."<",
399                "$etc/group"
400                    or return [500, "Can't open $etc/group: $!"];
401            while (<$fhg>) {
402                chomp;
403                next unless /\S/; # skip empty line
404                my @r = split /:/, $_, scalar(keys %group_fields);
405                push @group, \@r;
406                if ($wfn) {
407                    my %r;
408                    @r{@gshadow_field_names} = @{ $gshadow{$r[0]} }
409                        if $gshadow{$r[0]};
410                    @r{@group_field_names}   = @r;
411                    push @grouph, \%r;
412                }
413                if ($args{_after_read_group_entry}) {
414                    my $res = $args{_after_read_group_entry}->(\%stash);
415                    return $res if $res->[0] != 200;
416                    return if $stash{exit};
417                }
418            }
419        }
420
421        if ($args{_after_read}) {
422            my $res = $args{_after_read}->(\%stash);
423            return $res if $res->[0] != 200;
424            return if $stash{exit};
425        }
426
427        # write files
428
429        if ($args{_write_shadow} && ($stash{write_shadow}//1)) {
430            if ($args{backup}) {
431                my $res = _backup($fhs, "$etc/shadow");
432                return $res if $res->[0] != 200;
433            }
434            seek $fhs, 0, 0 or return [500, "Can't seek in $etc/shadow: $!"];
435            for (@shadow) {
436                print $fhs join(":", map {$_//""} @$_), "\n";
437            }
438            truncate $fhs, tell($fhs);
439            close $fhs or return [500, "Can't close $etc/shadow: $!"];
440            chmod 0640, "$etc/shadow"; # check error?
441        }
442
443        if ($args{_write_passwd} && ($stash{write_passwd}//1)) {
444            if ($args{backup}) {
445                my $res = _backup($fhp, "$etc/passwd");
446                return $res if $res->[0] != 200;
447            }
448            seek $fhp, 0, 0 or return [500, "Can't seek in $etc/passwd: $!"];
449            for (@passwd) {
450                print $fhp join(":", map {$_//""} @$_), "\n";
451            }
452            truncate $fhp, tell($fhp);
453            close $fhp or return [500, "Can't close $etc/passwd: $!"];
454            chmod 0644, "$etc/passwd"; # check error?
455        }
456
457        if ($args{_write_gshadow} && ($stash{write_gshadow}//1)) {
458            if ($args{backup}) {
459                my $res = _backup($fhgs, "$etc/gshadow");
460                return $res if $res->[0] != 200;
461            }
462            seek $fhgs, 0, 0 or return [500, "Can't seek in $etc/gshadow: $!"];
463            for (@gshadow) {
464                print $fhgs join(":", map {$_//""} @$_), "\n";
465            }
466            truncate $fhgs, tell($fhgs);
467            close $fhgs or return [500, "Can't close $etc/gshadow: $!"];
468            chmod 0640, "$etc/gshadow"; # check error?
469        }
470
471        if ($args{_write_group} && ($stash{write_group}//1)) {
472            if ($args{backup}) {
473                my $res = _backup($fhg, "$etc/group");
474                return $res if $res->[0] != 200;
475            }
476            seek $fhg, 0, 0 or return [500, "Can't seek in $etc/group: $!"];
477            for (@group) {
478                print $fhg join(":", map {$_//""} @$_), "\n";
479            }
480            truncate $fhg, tell($fhg);
481            close $fhg or return [500, "Can't close $etc/group: $!"];
482            chmod 0644, "$etc/group"; # check error?
483        }
484
485        [200, "OK"];
486    }; # eval
487    $e = [500, "Died: $@"] if $@;
488
489    # release the locks
490    undef @locks;
491
492    $stash{res} //= $e if $e && $e->[0] != 200;
493    $stash{res} //= $e if $e && $e->[0] != 200;
494    $stash{res} //= [500, "BUG: res not set"];
495
496    $stash{res};
497}
498
499$SPEC{list_users} = {
500    v => 1.1,
501    summary => 'List Unix users in passwd file',
502    args => {
503        %common_args,
504        detail => {
505            summary => 'If true, return all fields instead of just usernames',
506            schema => ['bool' => {default => 0}],
507        },
508        with_field_names => {
509            summary => 'If false, don\'t return hash for each entry',
510            schema => [bool => {default=>1}],
511            description => <<'_',
512
513By default, when `detail=>1`, a hashref is returned for each entry containing
514field names and its values, e.g. `{user=>"titin", pass=>"x", uid=>500, ...}`.
515With `with_field_names=>0`, an arrayref is returned instead: `["titin", "x",
516500, ...]`.
517
518_
519        },
520    },
521};
522sub list_users {
523    my %args = @_;
524    my $detail = $args{detail};
525    my $wfn    = $args{with_field_names} // ($detail ? 1:0);
526
527    _routine(
528        %args,
529        _read_passwd     => 1,
530        _read_shadow     => $detail ? 2:0,
531        with_field_names => $wfn,
532        _after_read      => sub {
533            my $stash = shift;
534
535            my @rows;
536            my $passwd  = $stash->{passwd};
537            my $passwdh = $stash->{passwdh};
538
539            for (my $i=0; $i < @$passwd; $i++) {
540                if (!$detail) {
541                    push @rows, $passwd->[$i][0];
542                } elsif ($wfn) {
543                    push @rows, $passwdh->[$i];
544                } else {
545                    push @rows, $passwd->[$i];
546                }
547            }
548
549            $stash->{res} = [200, "OK", \@rows];
550            $stash->{res}[3]{'table.fields'} = [\@passwd_field_names]
551                if $detail;
552            $stash->{exit}++;
553            [200];
554        },
555    );
556}
557
558$SPEC{get_user} = {
559    v => 1.1,
560    summary => 'Get user details by username or uid',
561    description => <<'_',
562
563Either `user` OR `uid` must be specified.
564
565The function is not dissimilar to Unix's `getpwnam()` or `getpwuid()`.
566
567_
568    args_rels => {
569        'choose_one' => [qw/user uid/],
570    },
571    args => {
572        %common_args,
573        user => {
574            schema => 'unix::username*',
575        },
576        uid => {
577            schema => 'unix::uid*',
578        },
579        with_field_names => {
580            summary => 'If false, don\'t return hash',
581            schema => [bool => {default=>1}],
582            description => <<'_',
583
584By default, a hashref is returned containing field names and its values, e.g.
585`{user=>"titin", pass=>"x", uid=>500, ...}`. With `with_field_names=>0`, an
586arrayref is returned instead: `["titin", "x", 500, ...]`.
587
588_
589        },
590    },
591};
592sub get_user {
593    my %args = @_;
594    my $wfn  = $args{with_field_names} // 1;
595    my $user = $args{user};
596    my $uid  = $args{uid};
597    return [400, "Please specify user OR uid"]
598        unless defined($user) xor defined($uid);
599
600    _routine(
601        %args,
602        _read_passwd     => 1,
603        _read_shadow     => 2,
604        with_field_names => $wfn,
605        detail           => 1,
606        _after_read_passwd_entry => sub {
607            my $stash = shift;
608
609            my @rows;
610            my $passwd  = $stash->{passwd};
611            my $passwdh = $stash->{passwdh};
612
613            if (defined($user) && $passwd->[-1][0] eq $user ||
614                    defined($uid) && $passwd->[-1][2] == $uid) {
615                $stash->{res} = [200,"OK", $wfn ? $passwdh->[-1]:$passwd->[-1]];
616                $stash->{exit}++;
617            }
618            [200];
619        },
620        _after_read => sub {
621            my $stash = shift;
622            [404, "Not found"];
623        },
624    );
625}
626
627$SPEC{user_exists} = {
628    v => 1.1,
629    summary => 'Check whether user exists',
630    args_rels => {
631        choose_one => [qw/user uid/],
632    },
633    args => {
634        %common_args,
635        user => {
636            schema => 'unix::username*',
637        },
638        uid => {
639            schema => 'unix::uid*',
640        },
641    },
642    result_naked => 1,
643    result => {
644        schema => 'bool*',
645    },
646};
647sub user_exists {
648    my %args = @_;
649    my $res = get_user(%args);
650    if ($res->[0] == 404) { return 0 }
651    elsif ($res->[0] == 200) { return 1 }
652    else { return undef }
653}
654
655$SPEC{list_groups} = {
656    v => 1.1,
657    summary => 'List Unix groups in group file',
658    args => {
659        %common_args,
660        detail => {
661            summary => 'If true, return all fields instead of just group names',
662            schema => ['bool' => {default => 0}],
663        },
664        with_field_names => {
665            summary => 'If false, don\'t return hash for each entry',
666            schema => [bool => {default=>1}],
667            description => <<'_',
668
669By default, when `detail=>1`, a hashref is returned for each entry containing
670field names and its values, e.g. `{group=>"titin", pass=>"x", gid=>500, ...}`.
671With `with_field_names=>0`, an arrayref is returned instead: `["titin", "x",
672500, ...]`.
673
674_
675        },
676    },
677};
678sub list_groups {
679    my %args = @_;
680    my $detail = $args{detail};
681    my $wfn    = $args{with_field_names} // ($detail ? 1:0);
682
683    _routine(
684        %args,
685        _read_group      => 1,
686        _read_gshadow    => $detail ? 2:0,
687        with_field_names => $wfn,
688        _after_read      => sub {
689            my $stash = shift;
690
691            my @rows;
692            my $group    = $stash->{group};
693            my $grouph   = $stash->{grouph};
694
695            for (my $i=0; $i < @$group; $i++) {
696                if (!$detail) {
697                    push @rows, $group->[$i][0];
698                } elsif ($wfn) {
699                    push @rows, $grouph->[$i];
700                } else {
701                    push @rows, $group->[$i];
702                }
703            }
704
705            $stash->{res} = [200, "OK", \@rows];
706            $stash->{res}[3]{'table.fields'} = [\@group_field_names] if $detail;
707            $stash->{exit}++;
708            [200];
709        },
710    );
711}
712
713$SPEC{get_group} = {
714    v => 1.1,
715    summary => 'Get group details by group name or gid',
716    description => <<'_',
717
718Either `group` OR `gid` must be specified.
719
720The function is not dissimilar to Unix's `getgrnam()` or `getgrgid()`.
721
722_
723    args_rels => {
724        choose_one => [qw/group gid/],
725    },
726    args => {
727        %common_args,
728        group => {
729            schema => 'unix::username*',
730        },
731        gid => {
732            schema => 'unix::gid*',
733        },
734        with_field_names => {
735            summary => 'If false, don\'t return hash',
736            schema => [bool => {default=>1}],
737            description => <<'_',
738
739By default, a hashref is returned containing field names and its values, e.g.
740`{group=>"titin", pass=>"x", gid=>500, ...}`. With `with_field_names=>0`, an
741arrayref is returned instead: `["titin", "x", 500, ...]`.
742
743_
744        },
745    },
746};
747sub get_group {
748    my %args  = @_;
749    my $wfn   = $args{with_field_names} // 1;
750    my $gn    = $args{group};
751    my $gid   = $args{gid};
752    return [400, "Please specify group OR gid"]
753        unless defined($gn) xor defined($gid);
754
755    _routine(
756        %args,
757        _read_group      => 1,
758        _read_gshadow    => 2,
759        with_field_names => $wfn,
760        detail           => 1,
761        _after_read_group_entry => sub {
762            my $stash = shift;
763
764            my @rows;
765            my $group  = $stash->{group};
766            my $grouph = $stash->{grouph};
767
768            if (defined($gn) && $group->[-1][0] eq $gn ||
769                    defined($gid) && $group->[-1][2] == $gid) {
770                $stash->{res} = [200,"OK", $wfn ? $grouph->[-1]:$group->[-1]];
771                $stash->{exit}++;
772            }
773            [200];
774        },
775        _after_read => sub {
776            my $stash = shift;
777            [404, "Not found"];
778        },
779    );
780}
781
782$SPEC{list_users_and_groups} = {
783    v => 1.1,
784    summary => 'List Unix users and groups in passwd/group files',
785    description => <<'_',
786
787This is basically `list_users()` and `list_groups()` combined, so you can get
788both data in a single call. Data is returned in an array. Users list is in the
789first element, groups list in the second.
790
791_
792    args => {
793        %common_args,
794        detail => {
795            summary => 'If true, return all fields instead of just names',
796            schema => ['bool' => {default => 0}],
797        },
798        with_field_names => {
799            summary => 'If false, don\'t return hash for each entry',
800            schema => [bool => {default=>1}],
801        },
802    },
803};
804sub list_users_and_groups {
805    my %args = @_;
806    my $detail = $args{detail};
807    my $wfn    = $args{with_field_names} // ($detail ? 1:0);
808
809    _routine(
810        %args,
811        _read_passwd     => 1,
812        _read_shadow     => $detail ? 2:0,
813        _read_group      => 1,
814        _read_gshadow    => $detail ? 2:0,
815        with_field_names => $wfn,
816        _after_read      => sub {
817            my $stash = shift;
818
819            my @users;
820            my $passwd  = $stash->{passwd};
821            my $passwdh = $stash->{passwdh};
822            for (my $i=0; $i < @$passwd; $i++) {
823                if (!$detail) {
824                    push @users, $passwd->[$i][0];
825                } elsif ($wfn) {
826                    push @users, $passwdh->[$i];
827                } else {
828                    push @users, $passwd->[$i];
829                }
830            }
831
832            my @groups;
833            my $group   = $stash->{group};
834            my $grouph  = $stash->{grouph};
835            for (my $i=0; $i < @$group; $i++) {
836                if (!$detail) {
837                    push @groups, $group->[$i][0];
838                } elsif ($wfn) {
839                    push @groups, $grouph->[$i];
840                } else {
841                    push @groups, $group->[$i];
842                }
843            }
844
845            $stash->{res} = [200, "OK", [\@users, \@groups]];
846
847            $stash->{exit}++;
848            [200];
849        },
850    );
851}
852
853$SPEC{group_exists} = {
854    v => 1.1,
855    summary => 'Check whether group exists',
856    args_rels => {
857        choose_one => [qw/group gid/],
858    },
859    args => {
860        %common_args,
861        group => {
862            schema => 'unix::groupname*',
863        },
864        gid => {
865            schema => 'unix::gid*',
866        },
867    },
868    result_naked => 1,
869    result => {
870        schema => 'bool',
871    },
872};
873sub group_exists {
874    my %args = @_;
875    my $res = get_group(%args);
876    if ($res->[0] == 404) { return 0 }
877    elsif ($res->[0] == 200) { return 1 }
878    else { return undef }
879}
880
881$SPEC{get_user_groups} = {
882    v => 1.1,
883    summary => 'Return groups which the user belongs to',
884    args => {
885        %common_args,
886        user => {
887            schema => 'unix::username*',
888            req => 1,
889            pos => 0,
890        },
891        detail => {
892            summary => 'If true, return all fields instead of just group names',
893            schema => ['bool' => {default => 0}],
894        },
895        with_field_names => {
896            summary => 'If false, don\'t return hash for each entry',
897            schema => [bool => {default=>1}],
898            description => <<'_',
899
900By default, when `detail=>1`, a hashref is returned for each entry containing
901field names and its values, e.g. `{group=>"titin", pass=>"x", gid=>500, ...}`.
902With `with_field_names=>0`, an arrayref is returned instead: `["titin", "x",
903500, ...]`.
904
905_
906        },
907    },
908};
909# this is a routine to list groups, but filtered using a criteria. can be
910# refactored into a common routine (along with list_groups) if needed, to reduce
911# duplication.
912sub get_user_groups {
913    my %args = @_;
914    my $user = $args{user} or return [400, "Please specify user"];
915    my $detail = $args{detail};
916    my $wfn    = $args{with_field_names} // ($detail ? 1:0);
917
918    _routine(
919        %args,
920        _read_passwd     => 1,
921        _read_group      => 1,
922        _read_gshadow    => $detail ? 2:0,
923        with_field_names => $wfn,
924        _after_read      => sub {
925            my $stash = shift;
926
927            my $passwd = $stash->{passwd};
928            return [404, "User not found"]
929                unless first {$_->[0] eq $user} @$passwd;
930
931            my @rows;
932            my $group    = $stash->{group};
933            my $grouph   = $stash->{grouph};
934
935            for (my $i=0; $i < @$group; $i++) {
936                my @mm = split /,/, $group->[$i][3];
937                next unless $user ~~ @mm || $group->[$i][0] eq $user;
938                if (!$detail) {
939                    push @rows, $group->[$i][0];
940                } elsif ($wfn) {
941                    push @rows, $grouph->[$i];
942                } else {
943                    push @rows, $group->[$i];
944                }
945            }
946
947            $stash->{res} = [200, "OK", \@rows];
948
949            $stash->{exit}++;
950            [200];
951        },
952    );
953}
954
955$SPEC{is_member} = {
956    v => 1.1,
957    summary => 'Check whether user is member of a group',
958    args => {
959        %common_args,
960        user => {
961            schema => 'unix::username*',
962            req => 1,
963            pos => 0,
964        },
965        group => {
966            schema => 'unix::groupname*',
967            req => 1,
968            pos => 1,
969        },
970    },
971    result_naked => 1,
972    result => {
973        schema => 'bool',
974    },
975};
976sub is_member {
977    my %args = @_;
978    my $user  = $args{user}  or return undef;
979    my $group = $args{group} or return undef;
980    my $res = get_group(etc_dir=>$args{etc_dir}, group=>$group);
981    return undef unless $res->[0] == 200;
982    my @mm = split /,/, $res->[2]{members};
983    return $user ~~ @mm ? 1:0;
984}
985
986$SPEC{get_max_uid} = {
987    v => 1.1,
988    summary => 'Get maximum UID used',
989    args => {
990        %common_args,
991    },
992};
993sub get_max_uid {
994    my %args  = @_;
995    _routine(
996        %args,
997        _read_passwd     => 1,
998        detail           => 0,
999        with_field_names => 0,
1000        _after_read      => sub {
1001            my $stash = shift;
1002            my $passwd = $stash->{passwd};
1003            $stash->{res} = [200, "OK", max(
1004                map {$_->[2]} @$passwd
1005            )];
1006            $stash->{exit}++;
1007            [200];
1008        },
1009    );
1010}
1011
1012$SPEC{get_max_gid} = {
1013    v => 1.1,
1014    summary => 'Get maximum GID used',
1015    args => {
1016        %common_args,
1017    },
1018};
1019sub get_max_gid {
1020    require List::Util;
1021
1022    my %args  = @_;
1023    _routine(
1024        %args,
1025        _read_group      => 1,
1026        detail           => 0,
1027        with_field_names => 0,
1028        _after_read      => sub {
1029            my $stash = shift;
1030            my $group = $stash->{group};
1031            $stash->{res} = [200, "OK", List::Util::max(
1032                map {$_->[2]} @$group
1033            )];
1034            $stash->{exit}++;
1035            [200];
1036        },
1037    );
1038}
1039
1040sub _enc_pass {
1041    require Crypt::Password::Util;
1042    Crypt::Password::Util::crypt(shift);
1043}
1044
1045sub _add_group_or_user {
1046    my ($which, %args) = @_;
1047
1048    # TMP,schema
1049    my ($user, $gn);
1050    my $create_group = 1;
1051    if ($which eq 'user') {
1052        $user = $args{user} or return [400, "Please specify user"];
1053        $user =~ /$re_user/o
1054            or return [400, "Invalid user, please use $re_user"];
1055        $gn = $args{group} // $user;
1056        $create_group = 0 if $gn ne $user;
1057    }
1058    $gn //= $args{group};
1059    $gn or return [400, "Please specify group"];
1060    $gn =~ /$re_group/o
1061        or return [400, "Invalid group, please use $re_group"];
1062
1063    my $gid     = $args{gid};
1064    my $min_gid = $args{min_gid} //  1000; $min_gid =     0 if $min_gid<0;
1065    my $max_gid = $args{max_gid} // 65535; $max_gid = 65535 if $max_gid>65535;
1066    my $members;
1067    if ($which eq 'group') {
1068        $members = $args{members};
1069        if ($members && ref($members) eq 'ARRAY') {
1070            $members = join(",",@$members);
1071        }
1072        $members //= "";
1073        $members =~ /$re_field/o
1074            or return [400, "Invalid members, please use $re_field"];
1075    } else {
1076        $members = "$user";
1077    }
1078
1079    my ($uid, $min_uid, $max_uid);
1080    my ($pass, $gecos, $home, $shell);
1081    my ($encpass, $last_pwchange, $min_pass_age, $max_pass_age,
1082        $pass_warn_period, $pass_inactive_period, $expire_date);
1083    if ($which eq 'user') {
1084        $uid = $args{uid};
1085        $min_uid = $args{min_uid} //  1000; $min_uid =     0 if $min_uid<0;
1086        $max_uid = $args{max_uid} // 65535; $max_uid = 65535 if $min_uid>65535;
1087
1088        $pass = $args{pass} // "";
1089        if ($pass !~ /$re_field/o) { return [400, "Invalid pass"] }
1090
1091        $gecos = $args{gecos} // "";
1092        if ($gecos !~ /$re_field/o) { return [400, "Invalid gecos"] }
1093
1094        $home = $args{home} // "";
1095        if ($home !~ /$re_field/o) { return [400, "Invalid home"] }
1096
1097        $shell = $args{shell} // "";
1098        if ($shell !~ /$re_field/o) { return [400, "Invalid shell"] }
1099
1100        $encpass = $args{encpass} // ($pass eq '' ? '*' : _enc_pass($pass));
1101        if ($encpass !~ /$re_field/o) { return [400, "Invalid encpass"] }
1102
1103        $last_pwchange = int($args{last_pwchange} // time()/86400);
1104        $min_pass_age  = int($args{min_pass_age} // 0);
1105        $max_pass_age  = int($args{max_pass_age} // 99999);
1106        $pass_warn_period = int($args{max_pass_age} // 7);
1107        $pass_inactive_period = $args{pass_inactive_period} // "";
1108        if ($pass_inactive_period !~ /$re_field/o) {
1109            return [400, "Invalid pass_inactive_period"] }
1110        $expire_date = $args{expire_date} // "";
1111        if ($expire_date !~ /$re_field/o) {
1112            return [400, "Invalid expire_date"] }
1113    }
1114
1115    _routine(
1116        %args,
1117        _lock            => 1,
1118        _write_group     => 1,
1119        _write_gshadow   => 1,
1120        _write_passwd    => $which eq 'user',
1121        _write_shadow    => $which eq 'user',
1122        _after_read      => sub {
1123            my $stash = shift;
1124
1125            my $group   = $stash->{group};
1126            my $gshadow = $stash->{gshadow};
1127            my $write_g;
1128            my $cur_g = first { $_->[0] eq $gn } @$group;
1129
1130            if ($which eq 'group' && $cur_g) {
1131                return [412, "Group $gn already exists"] if $cur_g;
1132            } elsif ($cur_g) {
1133                $gid = $cur_g->[2];
1134            } elsif (!$create_group) {
1135                return [412, "Group $gn must already exist"];
1136            } else {
1137                my @gids = map { $_->[2] } @$group;
1138                if (!defined($gid)) {
1139                    for ($min_gid .. $max_gid) {
1140                        do { $gid = $_; last } unless $_ ~~ @gids;
1141                    }
1142                    return [412, "Can't find available GID"]
1143                        unless defined($gid);
1144                }
1145                push @$group  , [$gn, "x", $gid, $members];
1146                push @$gshadow, [$gn, "*", "", $members];
1147                $write_g++;
1148            }
1149            my $r = {gid=>$gid};
1150
1151            if ($which eq 'user') {
1152                my $passwd  = $stash->{passwd};
1153                my $shadow  = $stash->{shadow};
1154                return [412, "User $gn already exists"]
1155                    if first { $_->[0] eq $user } @$passwd;
1156                my @uids = map { $_->[2] } @$passwd;
1157                if (!defined($uid)) {
1158                    for ($min_uid .. $max_uid) {
1159                        do { $uid = $_; last } unless $_ ~~ @uids;
1160                    }
1161                    return [412, "Can't find available UID"]
1162                        unless defined($uid);
1163                }
1164                $r->{uid} = $uid;
1165                push @$passwd, [$user, "x", $uid, $gid, $gecos, $home, $shell];
1166                push @$shadow, [$user, $encpass, $last_pwchange, $min_pass_age,
1167                                $max_pass_age, $pass_warn_period,
1168                                $pass_inactive_period, $expire_date, ""];
1169
1170                # add user as member of group
1171                for my $l (@$group) {
1172                    next unless $l->[0] eq $gn;
1173                    my @mm = split /,/, $l->[3];
1174                    unless ($user ~~ @mm) {
1175                        $l->[3] = join(",", @mm, $user);
1176                        $write_g++;
1177                        last;
1178                    }
1179                }
1180            }
1181
1182            $stash->{write_group} = $stash->{write_gshadow} = 0 unless $write_g;
1183            $stash->{res} = [200, "OK", $r];
1184            [200];
1185        },
1186    );
1187}
1188
1189$SPEC{add_group} = {
1190    v => 1.1,
1191    summary => 'Add a new group',
1192    args => {
1193        %common_args,
1194        %write_args,
1195        group => {
1196            schema => 'unix::groupname*',
1197            req => 1,
1198            pos => 0,
1199        },
1200        gid => {
1201            summary => 'Pick a specific new GID',
1202            schema => 'unix::gid*',
1203            description => <<'_',
1204
1205Adding a new group with duplicate GID is allowed.
1206
1207_
1208        },
1209        min_gid => {
1210            summary => 'Pick a range for new GID',
1211            schema => [int => {between=>[0, 65535], default=>1000}],
1212            description => <<'_',
1213
1214If a free GID between `min_gid` and `max_gid` is not found, error 412 is
1215returned.
1216
1217_
1218         },
1219        max_gid => {
1220            summary => 'Pick a range for new GID',
1221            schema => [int => {between=>[0, 65535], default=>65535}],
1222            description => <<'_',
1223
1224If a free GID between `min_gid` and `max_gid` is not found, error 412 is
1225returned.
1226
1227_
1228        },
1229        members => {
1230            summary => 'Fill initial members',
1231        },
1232    },
1233};
1234sub add_group {
1235    _add_group_or_user('group', @_);
1236}
1237
1238$SPEC{add_user} = {
1239    v => 1.1,
1240    summary => 'Add a new user',
1241    args => {
1242        %common_args,
1243        %write_args,
1244        user => {
1245            schema => 'unix::username*',
1246            req => 1,
1247            pos => 0,
1248        },
1249        group => {
1250            summary => 'Select primary group '.
1251                '(default is group with same name as user)',
1252            schema => 'unix::groupname*',
1253            description => <<'_',
1254
1255Normally, a user's primary group with group with the same name as user, which
1256will be created if does not already exist. You can pick another group here,
1257which must already exist (and in this case, the group with the same name as user
1258will not be created).
1259
1260_
1261        },
1262        gid => {
1263            summary => 'Pick a specific GID when creating group',
1264            schema => 'int*',
1265            description => <<'_',
1266
1267Duplicate GID is allowed.
1268
1269_
1270        },
1271        min_gid => {
1272            summary => 'Pick a range for GID when creating group',
1273            schema => 'int*',
1274        },
1275        max_gid => {
1276            summary => 'Pick a range for GID when creating group',
1277            schema => 'int*',
1278        },
1279        uid => {
1280            summary => 'Pick a specific new UID',
1281            schema => 'int*',
1282            description => <<'_',
1283
1284Adding a new user with duplicate UID is allowed.
1285
1286_
1287        },
1288        min_uid => {
1289            summary => 'Pick a range for new UID',
1290            schema => [int => {between=>[0,65535], default=>1000}],
1291            description => <<'_',
1292
1293If a free UID between `min_uid` and `max_uid` is not found, error 412 is
1294returned.
1295
1296_
1297        },
1298        max_uid => {
1299            summary => 'Pick a range for new UID',
1300            schema => [int => {between=>[0,65535], default=>65535}],
1301            description => <<'_',
1302
1303If a free UID between `min_uid` and `max_uid` is not found, error 412 is
1304returned.
1305
1306_
1307        },
1308        map( {($_=>$passwd_fields{$_})} qw/pass gecos home shell/),
1309        map( {($_=>$shadow_fields{$_})}
1310                 qw/encpass last_pwchange min_pass_age max_pass_age
1311                   pass_warn_period pass_inactive_period expire_date/),
1312    },
1313};
1314sub add_user {
1315    _add_group_or_user('user', @_);
1316}
1317
1318sub _modify_group_or_user {
1319    my ($which, %args) = @_;
1320
1321    # TMP,schema
1322    my ($user, $gn);
1323    if ($which eq 'user') {
1324        $user = $args{user} or return [400, "Please specify user"];
1325    } else {
1326        $gn = $args{group} or return [400, "Please specify group"];
1327    }
1328
1329    if ($which eq 'user') {
1330        if (defined($args{uid}) && $args{uid} !~ /$re_posint/o) {
1331            return [400, "Invalid uid"] }
1332        if (defined($args{gid}) && $args{gid} !~ /$re_posint/o) {
1333            return [400, "Invalid gid"] }
1334        if (defined($args{gecos}) && $args{gecos} !~ /$re_field/o) {
1335            return [400, "Invalid gecos"] }
1336        if (defined($args{home}) && $args{home} !~ /$re_field/o) {
1337            return [400, "Invalid home"] }
1338        if (defined($args{shell}) && $args{shell} !~ /$re_field/o) {
1339            return [400, "Invalid shell"] }
1340        if (defined $args{pass}) {
1341            $args{encpass} = $args{pass} eq '' ? '*' : _enc_pass($args{pass});
1342            $args{pass} = "x";
1343        }
1344        if (defined($args{encpass}) && $args{encpass} !~ /$re_field/o) {
1345            return [400, "Invalid encpass"] }
1346        if (defined($args{last_pwchange}) && $args{last_pwchange} !~ /$re_posint/o) {
1347            return [400, "Invalid last_pwchange"] }
1348        if (defined($args{min_pass_age}) && $args{min_pass_age} !~ /$re_posint/o) {
1349            return [400, "Invalid min_pass_age"] }
1350        if (defined($args{max_pass_age}) && $args{max_pass_age} !~ /$re_posint/o) {
1351            return [400, "Invalid max_pass_age"] }
1352        if (defined($args{pass_warn_period}) && $args{pass_warn_period} !~ /$re_posint/o) {
1353            return [400, "Invalid pass_warn_period"] }
1354        if (defined($args{pass_inactive_period}) &&
1355                $args{pass_inactive_period} !~ /$re_posint/o) {
1356            return [400, "Invalid pass_inactive_period"] }
1357        if (defined($args{expire_date}) && $args{expire_date} !~ /$re_posint/o) {
1358            return [400, "Invalid expire_date"] }
1359    }
1360
1361    my ($gid, $members);
1362    if ($which eq 'group') {
1363        if (defined($args{gid}) && $args{gid} !~ /$re_posint/o) {
1364            return [400, "Invalid gid"] }
1365        if (defined $args{pass}) {
1366            $args{encpass} = $args{pass} eq '' ? '*' : _enc_pass($args{pass});
1367            $args{pass} = "x";
1368        }
1369        if (defined($args{encpass}) && $args{encpass} !~ /$re_field/o) {
1370            return [400, "Invalid encpass"] }
1371        if (defined $args{members}) {
1372            if (ref($args{members}) eq 'ARRAY') { $args{members} = join(",",@{$args{members}}) }
1373            $args{members} =~ /$re_field/o or return [400, "Invalid members"];
1374        }
1375        if (defined $args{admins}) {
1376            if (ref($args{admins}) eq 'ARRAY') { $args{admins} = join(",",@{$args{admins}}) }
1377            $args{admins} =~ /$re_field/o or return [400, "Invalid admins"];
1378        }
1379    }
1380
1381    _routine(
1382        %args,
1383        _lock            => 1,
1384        _write_group     => $which eq 'group',
1385        _write_gshadow   => $which eq 'group',
1386        _write_passwd    => $which eq 'user',
1387        _write_shadow    => $which eq 'user',
1388        _after_read      => sub {
1389            my $stash = shift;
1390
1391            my ($found, $changed);
1392            if ($which eq 'user') {
1393                my $passwd = $stash->{passwd};
1394                for my $l (@$passwd) {
1395                    next unless $l->[0] eq $user;
1396                    $found++;
1397                    for my $f (qw/pass uid gid gecos home shell/) {
1398                        if (defined $args{$f}) {
1399                            my $idx = firstidx {$_ eq $f} @passwd_field_names;
1400                            $l->[$idx] = $args{$f};
1401                            $changed++;
1402                        }
1403                    }
1404                    last;
1405                }
1406                return [404, "Not found"] unless $found;
1407                $stash->{write_passwd} = 0 unless $changed;
1408
1409                $changed = 0;
1410                my $shadow = $stash->{shadow};
1411                for my $l (@$shadow) {
1412                    next unless $l->[0] eq $user;
1413                    for my $f (qw/encpass last_pwchange min_pass_age max_pass_age
1414                                  pass_warn_period pass_inactive_period expire_date/) {
1415                        if (defined $args{$f}) {
1416                            my $idx = firstidx {$_ eq $f} @shadow_field_names;
1417                            $l->[$idx] = $args{$f};
1418                            $changed++;
1419                        }
1420                    }
1421                    last;
1422                }
1423                $stash->{write_shadow} = 0 unless $changed;
1424            } else {
1425                my $group = $stash->{group};
1426                for my $l (@$group) {
1427                    next unless $l->[0] eq $gn;
1428                    $found++;
1429                    for my $f (qw/pass gid members/) {
1430                        if ($args{_before_set_group_field}) {
1431                            $args{_before_set_group_field}->($l, $f, \%args);
1432                        }
1433                        if (defined $args{$f}) {
1434                            my $idx = firstidx {$_ eq $f} @group_field_names;
1435                            $l->[$idx] = $args{$f};
1436                            $changed++;
1437                        }
1438                    }
1439                    last;
1440                }
1441                return [404, "Not found"] unless $found;
1442                $stash->{write_group} = 0 unless $changed;
1443
1444                $changed = 0;
1445                my $gshadow = $stash->{gshadow};
1446                for my $l (@$gshadow) {
1447                    next unless $l->[0] eq $gn;
1448                    for my $f (qw/encpass admins members/) {
1449                        if (defined $args{$f}) {
1450                            my $idx = firstidx {$_ eq $f} @gshadow_field_names;
1451                            $l->[$idx] = $args{$f};
1452                            $changed++;
1453                        }
1454                    }
1455                    last;
1456                }
1457                $stash->{write_gshadow} = 0 unless $changed;
1458            }
1459            $stash->{res} = [200, "OK"];
1460            [200];
1461        },
1462    );
1463}
1464
1465$SPEC{modify_group} = {
1466    v => 1.1,
1467    summary => 'Modify an existing group',
1468    description => <<'_',
1469
1470Specify arguments to modify corresponding fields. Unspecified fields will not be
1471modified.
1472
1473_
1474    args => {
1475        %common_args,
1476        %write_args,
1477        _arg_from_field(\%group_fields, 'group', req=>1, pos=>0),
1478        _arg_from_field(\%group_fields, 'pass'),
1479        _arg_from_field(\%group_fields, 'gid'),
1480        _arg_from_field(\%group_fields, 'members'),
1481
1482        _arg_from_field(\%gshadow_fields, 'encpass'),
1483        _arg_from_field(\%gshadow_fields, 'admins'),
1484    },
1485};
1486sub modify_group {
1487    _modify_group_or_user('group', @_);
1488}
1489
1490$SPEC{modify_user} = {
1491    v => 1.1,
1492    summary => 'Modify an existing user',
1493    description => <<'_',
1494
1495Specify arguments to modify corresponding fields. Unspecified fields will not be
1496modified.
1497
1498_
1499    args => {
1500        %common_args,
1501        %write_args,
1502        _arg_from_field(\%passwd_fields, 'user', req=>1, pos=>0),
1503        _arg_from_field(\%passwd_fields, 'uid'),
1504        _arg_from_field(\%passwd_fields, 'gid'),
1505        _arg_from_field(\%passwd_fields, 'gecos'),
1506        _arg_from_field(\%passwd_fields, 'home'),
1507        _arg_from_field(\%passwd_fields, 'shell'),
1508
1509        _arg_from_field(\%shadow_fields, 'encpass'),
1510        _arg_from_field(\%shadow_fields, 'last_pwchange'),
1511        _arg_from_field(\%shadow_fields, 'min_pass_age'),
1512        _arg_from_field(\%shadow_fields, 'max_pass_age'),
1513        _arg_from_field(\%shadow_fields, 'pass_warn_period'),
1514        _arg_from_field(\%shadow_fields, 'pass_inactive_period'),
1515        _arg_from_field(\%shadow_fields, 'expire_date'),
1516    },
1517};
1518sub modify_user {
1519    _modify_group_or_user('user', @_);
1520}
1521
1522$SPEC{add_user_to_group} = {
1523    v => 1.1,
1524    summary => 'Add user to a group',
1525    args => {
1526        %common_args,
1527        user => {
1528            schema => 'unix::username*',
1529            req => 1,
1530            pos => 0,
1531        },
1532        group => {
1533            schema => 'unix::groupname*',
1534            req => 1,
1535            pos => 1,
1536        },
1537    },
1538};
1539sub add_user_to_group {
1540    my %args = @_;
1541    my $user = $args{user} or return [400, "Please specify user"];
1542    $user =~ /$re_user/o or return [400, "Invalid user"];
1543    my $gn   = $args{group}; # will be required by modify_group
1544
1545    # XXX check user exists
1546    _modify_group_or_user(
1547        'group',
1548        %args,
1549        _before_set_group_field => sub {
1550            my ($l, $f, $args) = @_;
1551            return unless $l->[0] eq $gn;
1552            my @mm = split /,/, $l->[3];
1553            return if $user ~~ @mm;
1554            push @mm, $user;
1555            $args->{members} = join(",", @mm);
1556        },
1557    );
1558}
1559
1560
1561$SPEC{delete_user_from_group} = {
1562    v => 1.1,
1563    summary => 'Delete user from a group',
1564    args => {
1565        %common_args,
1566        user => {
1567            schema => 'unix::username*',
1568            req => 1,
1569            pos => 0,
1570        },
1571        group => {
1572            schema => 'unix::groupname*',
1573            req => 1,
1574            pos => 1,
1575        },
1576    },
1577};
1578sub delete_user_from_group {
1579    my %args = @_;
1580    my $user = $args{user} or return [400, "Please specify user"];
1581    $user =~ /$re_user/o or return [400, "Invalid user"];
1582    my $gn   = $args{group}; # will be required by modify_group
1583
1584    # XXX check user exists
1585    _modify_group_or_user(
1586        'group',
1587        %args,
1588        _before_set_group_field => sub {
1589            my ($l, $f, $args) = @_;
1590            return unless $l->[0] eq $gn;
1591            my @mm = split /,/, $l->[3];
1592            return unless $user ~~ @mm;
1593            @mm = grep {$_ ne $user} @mm;
1594            $args->{members} = join(",", @mm);
1595        },
1596    );
1597}
1598
1599$SPEC{add_delete_user_groups} = {
1600    v => 1.1,
1601    summary => 'Add or delete user from one or several groups',
1602    description => <<'_',
1603
1604This can be used to reduce several `add_user_to_group()` and/or
1605`delete_user_from_group()` calls to a single call. So:
1606
1607    add_delete_user_groups(user=>'u',add_to=>['a','b'],delete_from=>['c','d']);
1608
1609is equivalent to:
1610
1611    add_user_to_group     (user=>'u', group=>'a');
1612    add_user_to_group     (user=>'u', group=>'b');
1613    delete_user_from_group(user=>'u', group=>'c');
1614    delete_user_from_group(user=>'u', group=>'d');
1615
1616except that `add_delete_user_groups()` does it in one pass.
1617
1618_
1619    args => {
1620        %common_args,
1621        user => {
1622            schema => 'unix::username*',
1623            req => 1,
1624            pos => 0,
1625        },
1626        add_to => {
1627            summary => 'List of group names to add the user as member of',
1628            schema => [array => {of=>'unix::groupname*', default=>[]}],
1629        },
1630        delete_from => {
1631            summary => 'List of group names to remove the user as member of',
1632            schema => [array => {of=>'unix::groupname*', default=>[]}],
1633        },
1634    },
1635};
1636sub add_delete_user_groups {
1637    my %args = @_;
1638    my $user = $args{user} or return [400, "Please specify user"];
1639    $user =~ /$re_user/o or return [400, "Invalid user"];
1640    my $add  = $args{add_to} // [];
1641    my $del  = $args{delete_from} // [];
1642
1643    # XXX check user exists
1644
1645    _routine(
1646        %args,
1647        _lock            => 1,
1648        _write_group     => 1,
1649        _after_read      => sub {
1650            my $stash = shift;
1651
1652            my $group = $stash->{group};
1653            my $changed;
1654
1655            for my $l (@$group) {
1656                my @mm = split /,/, $l->[-1];
1657                if ($l->[0] ~~ $add && !($user ~~ @mm)) {
1658                    $changed++;
1659                    push @mm, $user;
1660                }
1661                if ($l->[0] ~~ $del && $user ~~ @mm) {
1662                    $changed++;
1663                    @mm = grep {$_ ne $user} @mm;
1664                }
1665                if ($changed) {
1666                    $l->[-1] = join ",", @mm;
1667                }
1668            }
1669            $stash->{write_group} = 0 unless $changed;
1670            $stash->{res} = [200, "OK"];
1671            [200];
1672        },
1673    );
1674}
1675
1676$SPEC{set_user_groups} = {
1677    v => 1.1,
1678    summary => 'Set the groups that a user is member of',
1679    args => {
1680        %common_args,
1681        user => {
1682            schema => 'unix::username*',
1683            req => 1,
1684            pos => 0,
1685        },
1686        groups => {
1687            summary => 'List of group names that user is member of',
1688            schema => [array => {of=>'unix::groupname*', default=>[]}],
1689            req => 1,
1690            pos => 1,
1691            greedy => 1,
1692            description => <<'_',
1693
1694Aside from this list, user will not belong to any other group.
1695
1696_
1697        },
1698    },
1699};
1700sub set_user_groups {
1701    my %args = @_;
1702    my $user = $args{user} or return [400, "Please specify user"];
1703    $user =~ /$re_user/o or return [400, "Invalid user"];
1704    my $gg   = $args{groups} or return [400, "Please specify groups"];
1705
1706    # XXX check user exists
1707
1708    _routine(
1709        %args,
1710        _lock            => 1,
1711        _write_group     => 1,
1712        _after_read      => sub {
1713            my $stash = shift;
1714
1715            my $group = $stash->{group};
1716            my $changed;
1717
1718            for my $l (@$group) {
1719                my @mm = split /,/, $l->[-1];
1720                if ($l->[0] ~~ $gg && !($user ~~ @mm)) {
1721                    $changed++;
1722                    push @mm, $user;
1723                }
1724                if (!($l->[0] ~~ $gg) && $user ~~ @mm) {
1725                    $changed++;
1726                    @mm = grep {$_ ne $user} @mm;
1727                }
1728                if ($changed) {
1729                    $l->[-1] = join ",", @mm;
1730                }
1731            }
1732            $stash->{write_group} = 0 unless $changed;
1733            $stash->{res} = [200, "OK"];
1734            [200];
1735        },
1736    );
1737}
1738
1739$SPEC{set_user_password} = {
1740    v => 1.1,
1741    summary => 'Set user\'s password',
1742    args => {
1743        %common_args,
1744        %write_args,
1745        user => {
1746            schema => 'unix::username*',
1747            req => 1,
1748            pos => 0,
1749        },
1750        pass => {
1751            schema => 'str*',
1752            req => 1,
1753            pos => 1,
1754        },
1755    },
1756};
1757sub set_user_password {
1758    my %args = @_;
1759
1760    $args{user} or return [400, "Please specify user"];
1761    defined($args{pass}) or return [400, "Please specify pass"];
1762    modify_user(%args);
1763}
1764
1765sub _delete_group_or_user {
1766    my ($which, %args) = @_;
1767
1768    # TMP,schema
1769    my ($user, $gn);
1770    if ($which eq 'user') {
1771        $user = $args{user} or return [400, "Please specify user"];
1772        $gn = $user;
1773    }
1774    $gn //= $args{group};
1775    $gn or return [400, "Please specify group"];
1776
1777    _routine(
1778        %args,
1779        _lock            => 1,
1780        _write_group     => 1,
1781        _write_gshadow   => 1,
1782        _write_passwd    => $which eq 'user',
1783        _write_shadow    => $which eq 'user',
1784        _after_read      => sub {
1785            my $stash = shift;
1786            my ($i, $changed);
1787
1788            my $group = $stash->{group};
1789            $changed = 0; $i = 0;
1790            while ($i < @$group) {
1791                if ($which eq 'user') {
1792                    # also delete all mention of the user in any group
1793                    my @mm = split /,/, $group->[$i][3];
1794                    if ($user ~~ @mm) {
1795                        $changed++;
1796                        $group->[$i][3] = join(",", grep {$_ ne $user} @mm);
1797                    }
1798                }
1799                if ($group->[$i][0] eq $gn) {
1800                    $changed++;
1801                    splice @$group, $i, 1; $i--;
1802                }
1803                $i++;
1804            }
1805            $stash->{write_group} = 0 unless $changed;
1806
1807            my $gshadow = $stash->{gshadow};
1808            $changed = 0; $i = 0;
1809            while ($i < @$gshadow) {
1810                if ($which eq 'user') {
1811                    # also delete all mention of the user in any group
1812                    my @mm = split /,/, $gshadow->[$i][3];
1813                    if ($user ~~ @mm) {
1814                        $changed++;
1815                        $gshadow->[$i][3] = join(",", grep {$_ ne $user} @mm);
1816                    }
1817                }
1818                if ($gshadow->[$i][0] eq $gn) {
1819                    $changed++;
1820                    splice @$gshadow, $i, 1; $i--;
1821                    last;
1822                }
1823                $i++;
1824            }
1825            $stash->{write_gshadow} = 0 unless $changed;
1826
1827            if ($which eq 'user') {
1828                my $passwd = $stash->{passwd};
1829                $changed = 0; $i = 0;
1830                while ($i < @$passwd) {
1831                    if ($passwd->[$i][0] eq $user) {
1832                        $changed++;
1833                        splice @$passwd, $i, 1; $i--;
1834                        last;
1835                    }
1836                    $i++;
1837                }
1838                $stash->{write_passwd} = 0 unless $changed;
1839
1840                my $shadow = $stash->{shadow};
1841                $changed = 0; $i = 0;
1842                while ($i < @$shadow) {
1843                    if ($shadow->[$i][0] eq $user) {
1844                        $changed++;
1845                        splice @$shadow, $i, 1; $i--;
1846                        last;
1847                    }
1848                    $i++;
1849                }
1850                $stash->{write_shadow} = 0 unless $changed;
1851            }
1852
1853            $stash->{res} = [200, "OK"];
1854            [200];
1855        },
1856    );
1857}
1858
1859$SPEC{delete_group} = {
1860    v => 1.1,
1861    summary => 'Delete a group',
1862    args => {
1863        %common_args,
1864        %write_args,
1865        group => {
1866            schema => 'unix::username*',
1867            req => 1,
1868            pos => 0,
1869        },
1870    },
1871};
1872sub delete_group {
1873    _delete_group_or_user('group', @_);
1874}
1875
1876$SPEC{delete_user} = {
1877    v => 1.1,
1878    summary => 'Delete a user',
1879    args => {
1880        %common_args,
1881        %write_args,
1882        user => {
1883            schema => 'unix::username*',
1884            req => 1,
1885            pos => 0,
1886        },
1887    },
1888};
1889sub delete_user {
1890    _delete_group_or_user('user', @_);
1891}
1892
18931;
1894# ABSTRACT: Manipulate /etc/{passwd,shadow,group,gshadow} entries
1895
1896__END__
1897
1898=pod
1899
1900=encoding UTF-8
1901
1902=head1 NAME
1903
1904Unix::Passwd::File - Manipulate /etc/{passwd,shadow,group,gshadow} entries
1905
1906=head1 VERSION
1907
1908This document describes version 0.251 of Unix::Passwd::File (from Perl distribution Unix-Passwd-File), released on 2020-04-29.
1909
1910=head1 SYNOPSIS
1911
1912 use Unix::Passwd::File;
1913
1914 # list users. by default uses files in /etc (/etc/passwd, /etc/shadow, et al)
1915 my $res = list_users(); # [200, "OK", ["root", ...]]
1916
1917 # change location of files, return details
1918 $res = list_users(etc_dir=>"/some/path", detail=>1);
1919     # [200, "OK", [{user=>"root", uid=>0, ...}, ...]]
1920
1921 # also return detail, but return array entries instead of hash
1922 $res = list_users(detail=>1, with_field_names=>0);
1923     # [200, "OK", [["root", "x", 0, ...], ...]]
1924
1925 # get user/group information
1926 $res = get_group(user=>"paijo"); # [200, "OK", {user=>"paijo", uid=>501, ...}]
1927 $res = get_user(user=>"titin");  # [404, "Not found"]
1928
1929 # check whether user/group exists
1930 say user_exists(user=>"paijo");   # 1
1931 say group_exists(group=>"titin"); # 0
1932
1933 # get all groups that user is member of
1934 $res = get_user_groups(user=>"paijo"); # [200, "OK", ["paijo", "satpam"]]
1935
1936 # check whether user is member of a group
1937 $res = is_member(user=>"paijo", group=>"satpam"); # 1
1938
1939 # adding user/group, by default adding user will also add a group with the same
1940 # name
1941 $res = add_user (user =>"ujang", ...); # [200, "OK", {uid=>540, gid=>541}]
1942 $res = add_group(group=>"ujang", ...); # [412, "Group already exists"]
1943
1944 # modify user/group
1945 $res = modify_user(user=>"ujang", home=>"/newhome/ujang"); # [200, "OK"]
1946 $res = modify_group(group=>"titin"); # [404, "Not found"]
1947
1948 # deleting user will also delete user's group
1949 $res = delete_user(user=>"titin");
1950
1951 # change user password
1952 $res = set_user_password(user=>"ujang", pass=>"foobar");
1953 $res = modify_user(user=>"ujang", pass=>"foobar"); # same thing
1954
1955 # add/delete user to/from group
1956 $res = add_user_to_group(user=>"ujang", group=>"wheel");
1957 $res = delete_user_from_group(user=>"ujang", group=>"wheel");
1958
1959 # others
1960 $res = get_max_uid(); # [200, "OK", 65535]
1961 $res = get_max_gid(); # [200, "OK", 65534]
1962
1963=head1 DESCRIPTION
1964
1965This module can be used to read and manipulate entries in Unix system password
1966files (/etc/passwd, /etc/group, /etc/group, /etc/gshadow; but can also be told
1967to search in custom location, for testing purposes).
1968
1969This module uses a procedural (non-OO) interface. Each function in this module
1970open and read the passwd files once. Read-only functions like `list_users()` and
1971`get_max_gid()` open in read-only mode. Functions that might write to the files
1972like `add_user()` or `delete_group()` first lock `passwd` file, open in
1973read+write mode and also read the files in the first pass, then seek to the
1974beginning and write back the files.
1975
1976No caching is done so you should do your own if you need to.
1977
1978=head1 FUNCTIONS
1979
1980
1981=head2 add_delete_user_groups
1982
1983Usage:
1984
1985 add_delete_user_groups(%args) -> [status, msg, payload, meta]
1986
1987Add or delete user from one or several groups.
1988
1989This can be used to reduce several C<add_user_to_group()> and/or
1990C<delete_user_from_group()> calls to a single call. So:
1991
1992 add_delete_user_groups(user=>'u',add_to=>['a','b'],delete_from=>['c','d']);
1993
1994is equivalent to:
1995
1996 add_user_to_group     (user=>'u', group=>'a');
1997 add_user_to_group     (user=>'u', group=>'b');
1998 delete_user_from_group(user=>'u', group=>'c');
1999 delete_user_from_group(user=>'u', group=>'d');
2000
2001except that C<add_delete_user_groups()> does it in one pass.
2002
2003This function is not exported by default, but exportable.
2004
2005Arguments ('*' denotes required arguments):
2006
2007=over 4
2008
2009=item * B<add_to> => I<array[unix::groupname]> (default: [])
2010
2011List of group names to add the user as member of.
2012
2013=item * B<delete_from> => I<array[unix::groupname]> (default: [])
2014
2015List of group names to remove the user as member of.
2016
2017=item * B<etc_dir> => I<str> (default: "/etc")
2018
2019Specify location of passwd files.
2020
2021=item * B<user>* => I<unix::username>
2022
2023
2024=back
2025
2026Returns an enveloped result (an array).
2027
2028First element (status) is an integer containing HTTP status code
2029(200 means OK, 4xx caller error, 5xx function error). Second element
2030(msg) is a string containing error message, or 'OK' if status is
2031200. Third element (payload) is optional, the actual result. Fourth
2032element (meta) is called result metadata and is optional, a hash
2033that contains extra information.
2034
2035Return value:  (any)
2036
2037
2038
2039=head2 add_group
2040
2041Usage:
2042
2043 add_group(%args) -> [status, msg, payload, meta]
2044
2045Add a new group.
2046
2047This function is not exported by default, but exportable.
2048
2049Arguments ('*' denotes required arguments):
2050
2051=over 4
2052
2053=item * B<backup> => I<bool> (default: 0)
2054
2055Whether to backup when modifying files.
2056
2057Backup is written with C<.bak> extension in the same directory. Unmodified file
2058will not be backed up. Previous backup will be overwritten.
2059
2060=item * B<etc_dir> => I<str> (default: "/etc")
2061
2062Specify location of passwd files.
2063
2064=item * B<gid> => I<unix::gid>
2065
2066Pick a specific new GID.
2067
2068Adding a new group with duplicate GID is allowed.
2069
2070=item * B<group>* => I<unix::groupname>
2071
2072=item * B<max_gid> => I<int> (default: 65535)
2073
2074Pick a range for new GID.
2075
2076If a free GID between C<min_gid> and C<max_gid> is not found, error 412 is
2077returned.
2078
2079=item * B<members> => I<any>
2080
2081Fill initial members.
2082
2083=item * B<min_gid> => I<int> (default: 1000)
2084
2085Pick a range for new GID.
2086
2087If a free GID between C<min_gid> and C<max_gid> is not found, error 412 is
2088returned.
2089
2090
2091=back
2092
2093Returns an enveloped result (an array).
2094
2095First element (status) is an integer containing HTTP status code
2096(200 means OK, 4xx caller error, 5xx function error). Second element
2097(msg) is a string containing error message, or 'OK' if status is
2098200. Third element (payload) is optional, the actual result. Fourth
2099element (meta) is called result metadata and is optional, a hash
2100that contains extra information.
2101
2102Return value:  (any)
2103
2104
2105
2106=head2 add_user
2107
2108Usage:
2109
2110 add_user(%args) -> [status, msg, payload, meta]
2111
2112Add a new user.
2113
2114This function is not exported by default, but exportable.
2115
2116Arguments ('*' denotes required arguments):
2117
2118=over 4
2119
2120=item * B<backup> => I<bool> (default: 0)
2121
2122Whether to backup when modifying files.
2123
2124Backup is written with C<.bak> extension in the same directory. Unmodified file
2125will not be backed up. Previous backup will be overwritten.
2126
2127=item * B<encpass> => I<str>
2128
2129Encrypted password.
2130
2131=item * B<etc_dir> => I<str> (default: "/etc")
2132
2133Specify location of passwd files.
2134
2135=item * B<expire_date> => I<int>
2136
2137The date of expiration of the account, expressed as the number of days since Jan 1, 1970.
2138
2139=item * B<gecos> => I<str>
2140
2141Usually, it contains the full username.
2142
2143=item * B<gid> => I<int>
2144
2145Pick a specific GID when creating group.
2146
2147Duplicate GID is allowed.
2148
2149=item * B<group> => I<unix::groupname>
2150
2151Select primary group (default is group with same name as user).
2152
2153Normally, a user's primary group with group with the same name as user, which
2154will be created if does not already exist. You can pick another group here,
2155which must already exist (and in this case, the group with the same name as user
2156will not be created).
2157
2158=item * B<home> => I<dirname>
2159
2160User's home directory.
2161
2162=item * B<last_pwchange> => I<int>
2163
2164The date of the last password change, expressed as the number of days since Jan 1, 1970.
2165
2166=item * B<max_gid> => I<int>
2167
2168Pick a range for GID when creating group.
2169
2170=item * B<max_pass_age> => I<int>
2171
2172The number of days after which the user will have to change her password.
2173
2174=item * B<max_uid> => I<int> (default: 65535)
2175
2176Pick a range for new UID.
2177
2178If a free UID between C<min_uid> and C<max_uid> is not found, error 412 is
2179returned.
2180
2181=item * B<min_gid> => I<int>
2182
2183Pick a range for GID when creating group.
2184
2185=item * B<min_pass_age> => I<int>
2186
2187The number of days the user will have to wait before she will be allowed to change her password again.
2188
2189=item * B<min_uid> => I<int> (default: 1000)
2190
2191Pick a range for new UID.
2192
2193If a free UID between C<min_uid> and C<max_uid> is not found, error 412 is
2194returned.
2195
2196=item * B<pass> => I<str>
2197
2198Password, generally should be "x" which means password is encrypted in shadow.
2199
2200=item * B<pass_inactive_period> => I<int>
2201
2202The number of days after a password has expired (see max_pass_age) during which the password should still be accepted (and user should update her password during the next login).
2203
2204=item * B<pass_warn_period> => I<int>
2205
2206The number of days before a password is going to expire (see max_pass_age) during which the user should be warned.
2207
2208=item * B<shell> => I<filename>
2209
2210User's shell.
2211
2212=item * B<uid> => I<int>
2213
2214Pick a specific new UID.
2215
2216Adding a new user with duplicate UID is allowed.
2217
2218=item * B<user>* => I<unix::username>
2219
2220
2221=back
2222
2223Returns an enveloped result (an array).
2224
2225First element (status) is an integer containing HTTP status code
2226(200 means OK, 4xx caller error, 5xx function error). Second element
2227(msg) is a string containing error message, or 'OK' if status is
2228200. Third element (payload) is optional, the actual result. Fourth
2229element (meta) is called result metadata and is optional, a hash
2230that contains extra information.
2231
2232Return value:  (any)
2233
2234
2235
2236=head2 add_user_to_group
2237
2238Usage:
2239
2240 add_user_to_group(%args) -> [status, msg, payload, meta]
2241
2242Add user to a group.
2243
2244This function is not exported by default, but exportable.
2245
2246Arguments ('*' denotes required arguments):
2247
2248=over 4
2249
2250=item * B<etc_dir> => I<str> (default: "/etc")
2251
2252Specify location of passwd files.
2253
2254=item * B<group>* => I<unix::groupname>
2255
2256=item * B<user>* => I<unix::username>
2257
2258
2259=back
2260
2261Returns an enveloped result (an array).
2262
2263First element (status) is an integer containing HTTP status code
2264(200 means OK, 4xx caller error, 5xx function error). Second element
2265(msg) is a string containing error message, or 'OK' if status is
2266200. Third element (payload) is optional, the actual result. Fourth
2267element (meta) is called result metadata and is optional, a hash
2268that contains extra information.
2269
2270Return value:  (any)
2271
2272
2273
2274=head2 delete_group
2275
2276Usage:
2277
2278 delete_group(%args) -> [status, msg, payload, meta]
2279
2280Delete a group.
2281
2282This function is not exported by default, but exportable.
2283
2284Arguments ('*' denotes required arguments):
2285
2286=over 4
2287
2288=item * B<backup> => I<bool> (default: 0)
2289
2290Whether to backup when modifying files.
2291
2292Backup is written with C<.bak> extension in the same directory. Unmodified file
2293will not be backed up. Previous backup will be overwritten.
2294
2295=item * B<etc_dir> => I<str> (default: "/etc")
2296
2297Specify location of passwd files.
2298
2299=item * B<group>* => I<unix::username>
2300
2301
2302=back
2303
2304Returns an enveloped result (an array).
2305
2306First element (status) is an integer containing HTTP status code
2307(200 means OK, 4xx caller error, 5xx function error). Second element
2308(msg) is a string containing error message, or 'OK' if status is
2309200. Third element (payload) is optional, the actual result. Fourth
2310element (meta) is called result metadata and is optional, a hash
2311that contains extra information.
2312
2313Return value:  (any)
2314
2315
2316
2317=head2 delete_user
2318
2319Usage:
2320
2321 delete_user(%args) -> [status, msg, payload, meta]
2322
2323Delete a user.
2324
2325This function is not exported by default, but exportable.
2326
2327Arguments ('*' denotes required arguments):
2328
2329=over 4
2330
2331=item * B<backup> => I<bool> (default: 0)
2332
2333Whether to backup when modifying files.
2334
2335Backup is written with C<.bak> extension in the same directory. Unmodified file
2336will not be backed up. Previous backup will be overwritten.
2337
2338=item * B<etc_dir> => I<str> (default: "/etc")
2339
2340Specify location of passwd files.
2341
2342=item * B<user>* => I<unix::username>
2343
2344
2345=back
2346
2347Returns an enveloped result (an array).
2348
2349First element (status) is an integer containing HTTP status code
2350(200 means OK, 4xx caller error, 5xx function error). Second element
2351(msg) is a string containing error message, or 'OK' if status is
2352200. Third element (payload) is optional, the actual result. Fourth
2353element (meta) is called result metadata and is optional, a hash
2354that contains extra information.
2355
2356Return value:  (any)
2357
2358
2359
2360=head2 delete_user_from_group
2361
2362Usage:
2363
2364 delete_user_from_group(%args) -> [status, msg, payload, meta]
2365
2366Delete user from a group.
2367
2368This function is not exported by default, but exportable.
2369
2370Arguments ('*' denotes required arguments):
2371
2372=over 4
2373
2374=item * B<etc_dir> => I<str> (default: "/etc")
2375
2376Specify location of passwd files.
2377
2378=item * B<group>* => I<unix::groupname>
2379
2380=item * B<user>* => I<unix::username>
2381
2382
2383=back
2384
2385Returns an enveloped result (an array).
2386
2387First element (status) is an integer containing HTTP status code
2388(200 means OK, 4xx caller error, 5xx function error). Second element
2389(msg) is a string containing error message, or 'OK' if status is
2390200. Third element (payload) is optional, the actual result. Fourth
2391element (meta) is called result metadata and is optional, a hash
2392that contains extra information.
2393
2394Return value:  (any)
2395
2396
2397
2398=head2 get_group
2399
2400Usage:
2401
2402 get_group(%args) -> [status, msg, payload, meta]
2403
2404Get group details by group name or gid.
2405
2406Either C<group> OR C<gid> must be specified.
2407
2408The function is not dissimilar to Unix's C<getgrnam()> or C<getgrgid()>.
2409
2410This function is not exported by default, but exportable.
2411
2412Arguments ('*' denotes required arguments):
2413
2414=over 4
2415
2416=item * B<etc_dir> => I<str> (default: "/etc")
2417
2418Specify location of passwd files.
2419
2420=item * B<gid> => I<unix::gid>
2421
2422=item * B<group> => I<unix::username>
2423
2424=item * B<with_field_names> => I<bool> (default: 1)
2425
2426If false, don't return hash.
2427
2428By default, a hashref is returned containing field names and its values, e.g.
2429C<< {group=E<gt>"titin", pass=E<gt>"x", gid=E<gt>500, ...} >>. With C<< with_field_names=E<gt>0 >>, an
2430arrayref is returned instead: C<["titin", "x", 500, ...]>.
2431
2432
2433=back
2434
2435Returns an enveloped result (an array).
2436
2437First element (status) is an integer containing HTTP status code
2438(200 means OK, 4xx caller error, 5xx function error). Second element
2439(msg) is a string containing error message, or 'OK' if status is
2440200. Third element (payload) is optional, the actual result. Fourth
2441element (meta) is called result metadata and is optional, a hash
2442that contains extra information.
2443
2444Return value:  (any)
2445
2446
2447
2448=head2 get_max_gid
2449
2450Usage:
2451
2452 get_max_gid(%args) -> [status, msg, payload, meta]
2453
2454Get maximum GID used.
2455
2456This function is not exported by default, but exportable.
2457
2458Arguments ('*' denotes required arguments):
2459
2460=over 4
2461
2462=item * B<etc_dir> => I<str> (default: "/etc")
2463
2464Specify location of passwd files.
2465
2466
2467=back
2468
2469Returns an enveloped result (an array).
2470
2471First element (status) is an integer containing HTTP status code
2472(200 means OK, 4xx caller error, 5xx function error). Second element
2473(msg) is a string containing error message, or 'OK' if status is
2474200. Third element (payload) is optional, the actual result. Fourth
2475element (meta) is called result metadata and is optional, a hash
2476that contains extra information.
2477
2478Return value:  (any)
2479
2480
2481
2482=head2 get_max_uid
2483
2484Usage:
2485
2486 get_max_uid(%args) -> [status, msg, payload, meta]
2487
2488Get maximum UID used.
2489
2490This function is not exported by default, but exportable.
2491
2492Arguments ('*' denotes required arguments):
2493
2494=over 4
2495
2496=item * B<etc_dir> => I<str> (default: "/etc")
2497
2498Specify location of passwd files.
2499
2500
2501=back
2502
2503Returns an enveloped result (an array).
2504
2505First element (status) is an integer containing HTTP status code
2506(200 means OK, 4xx caller error, 5xx function error). Second element
2507(msg) is a string containing error message, or 'OK' if status is
2508200. Third element (payload) is optional, the actual result. Fourth
2509element (meta) is called result metadata and is optional, a hash
2510that contains extra information.
2511
2512Return value:  (any)
2513
2514
2515
2516=head2 get_user
2517
2518Usage:
2519
2520 get_user(%args) -> [status, msg, payload, meta]
2521
2522Get user details by username or uid.
2523
2524Either C<user> OR C<uid> must be specified.
2525
2526The function is not dissimilar to Unix's C<getpwnam()> or C<getpwuid()>.
2527
2528This function is not exported by default, but exportable.
2529
2530Arguments ('*' denotes required arguments):
2531
2532=over 4
2533
2534=item * B<etc_dir> => I<str> (default: "/etc")
2535
2536Specify location of passwd files.
2537
2538=item * B<uid> => I<unix::uid>
2539
2540=item * B<user> => I<unix::username>
2541
2542=item * B<with_field_names> => I<bool> (default: 1)
2543
2544If false, don't return hash.
2545
2546By default, a hashref is returned containing field names and its values, e.g.
2547C<< {user=E<gt>"titin", pass=E<gt>"x", uid=E<gt>500, ...} >>. With C<< with_field_names=E<gt>0 >>, an
2548arrayref is returned instead: C<["titin", "x", 500, ...]>.
2549
2550
2551=back
2552
2553Returns an enveloped result (an array).
2554
2555First element (status) is an integer containing HTTP status code
2556(200 means OK, 4xx caller error, 5xx function error). Second element
2557(msg) is a string containing error message, or 'OK' if status is
2558200. Third element (payload) is optional, the actual result. Fourth
2559element (meta) is called result metadata and is optional, a hash
2560that contains extra information.
2561
2562Return value:  (any)
2563
2564
2565
2566=head2 get_user_groups
2567
2568Usage:
2569
2570 get_user_groups(%args) -> [status, msg, payload, meta]
2571
2572Return groups which the user belongs to.
2573
2574This function is not exported by default, but exportable.
2575
2576Arguments ('*' denotes required arguments):
2577
2578=over 4
2579
2580=item * B<detail> => I<bool> (default: 0)
2581
2582If true, return all fields instead of just group names.
2583
2584=item * B<etc_dir> => I<str> (default: "/etc")
2585
2586Specify location of passwd files.
2587
2588=item * B<user>* => I<unix::username>
2589
2590=item * B<with_field_names> => I<bool> (default: 1)
2591
2592If false, don't return hash for each entry.
2593
2594By default, when C<< detail=E<gt>1 >>, a hashref is returned for each entry containing
2595field names and its values, e.g. C<< {group=E<gt>"titin", pass=E<gt>"x", gid=E<gt>500, ...} >>.
2596With C<< with_field_names=E<gt>0 >>, an arrayref is returned instead: C<["titin", "x",
2597500, ...]>.
2598
2599
2600=back
2601
2602Returns an enveloped result (an array).
2603
2604First element (status) is an integer containing HTTP status code
2605(200 means OK, 4xx caller error, 5xx function error). Second element
2606(msg) is a string containing error message, or 'OK' if status is
2607200. Third element (payload) is optional, the actual result. Fourth
2608element (meta) is called result metadata and is optional, a hash
2609that contains extra information.
2610
2611Return value:  (any)
2612
2613
2614
2615=head2 group_exists
2616
2617Usage:
2618
2619 group_exists(%args) -> bool
2620
2621Check whether group exists.
2622
2623This function is not exported by default, but exportable.
2624
2625Arguments ('*' denotes required arguments):
2626
2627=over 4
2628
2629=item * B<etc_dir> => I<str> (default: "/etc")
2630
2631Specify location of passwd files.
2632
2633=item * B<gid> => I<unix::gid>
2634
2635=item * B<group> => I<unix::groupname>
2636
2637
2638=back
2639
2640Return value:  (bool)
2641
2642
2643
2644=head2 is_member
2645
2646Usage:
2647
2648 is_member(%args) -> bool
2649
2650Check whether user is member of a group.
2651
2652This function is not exported by default, but exportable.
2653
2654Arguments ('*' denotes required arguments):
2655
2656=over 4
2657
2658=item * B<etc_dir> => I<str> (default: "/etc")
2659
2660Specify location of passwd files.
2661
2662=item * B<group>* => I<unix::groupname>
2663
2664=item * B<user>* => I<unix::username>
2665
2666
2667=back
2668
2669Return value:  (bool)
2670
2671
2672
2673=head2 list_groups
2674
2675Usage:
2676
2677 list_groups(%args) -> [status, msg, payload, meta]
2678
2679List Unix groups in group file.
2680
2681This function is not exported by default, but exportable.
2682
2683Arguments ('*' denotes required arguments):
2684
2685=over 4
2686
2687=item * B<detail> => I<bool> (default: 0)
2688
2689If true, return all fields instead of just group names.
2690
2691=item * B<etc_dir> => I<str> (default: "/etc")
2692
2693Specify location of passwd files.
2694
2695=item * B<with_field_names> => I<bool> (default: 1)
2696
2697If false, don't return hash for each entry.
2698
2699By default, when C<< detail=E<gt>1 >>, a hashref is returned for each entry containing
2700field names and its values, e.g. C<< {group=E<gt>"titin", pass=E<gt>"x", gid=E<gt>500, ...} >>.
2701With C<< with_field_names=E<gt>0 >>, an arrayref is returned instead: C<["titin", "x",
2702500, ...]>.
2703
2704
2705=back
2706
2707Returns an enveloped result (an array).
2708
2709First element (status) is an integer containing HTTP status code
2710(200 means OK, 4xx caller error, 5xx function error). Second element
2711(msg) is a string containing error message, or 'OK' if status is
2712200. Third element (payload) is optional, the actual result. Fourth
2713element (meta) is called result metadata and is optional, a hash
2714that contains extra information.
2715
2716Return value:  (any)
2717
2718
2719
2720=head2 list_users
2721
2722Usage:
2723
2724 list_users(%args) -> [status, msg, payload, meta]
2725
2726List Unix users in passwd file.
2727
2728This function is not exported by default, but exportable.
2729
2730Arguments ('*' denotes required arguments):
2731
2732=over 4
2733
2734=item * B<detail> => I<bool> (default: 0)
2735
2736If true, return all fields instead of just usernames.
2737
2738=item * B<etc_dir> => I<str> (default: "/etc")
2739
2740Specify location of passwd files.
2741
2742=item * B<with_field_names> => I<bool> (default: 1)
2743
2744If false, don't return hash for each entry.
2745
2746By default, when C<< detail=E<gt>1 >>, a hashref is returned for each entry containing
2747field names and its values, e.g. C<< {user=E<gt>"titin", pass=E<gt>"x", uid=E<gt>500, ...} >>.
2748With C<< with_field_names=E<gt>0 >>, an arrayref is returned instead: C<["titin", "x",
2749500, ...]>.
2750
2751
2752=back
2753
2754Returns an enveloped result (an array).
2755
2756First element (status) is an integer containing HTTP status code
2757(200 means OK, 4xx caller error, 5xx function error). Second element
2758(msg) is a string containing error message, or 'OK' if status is
2759200. Third element (payload) is optional, the actual result. Fourth
2760element (meta) is called result metadata and is optional, a hash
2761that contains extra information.
2762
2763Return value:  (any)
2764
2765
2766
2767=head2 list_users_and_groups
2768
2769Usage:
2770
2771 list_users_and_groups(%args) -> [status, msg, payload, meta]
2772
2773List Unix users and groups in passwdE<sol>group files.
2774
2775This is basically C<list_users()> and C<list_groups()> combined, so you can get
2776both data in a single call. Data is returned in an array. Users list is in the
2777first element, groups list in the second.
2778
2779This function is not exported by default, but exportable.
2780
2781Arguments ('*' denotes required arguments):
2782
2783=over 4
2784
2785=item * B<detail> => I<bool> (default: 0)
2786
2787If true, return all fields instead of just names.
2788
2789=item * B<etc_dir> => I<str> (default: "/etc")
2790
2791Specify location of passwd files.
2792
2793=item * B<with_field_names> => I<bool> (default: 1)
2794
2795If false, don't return hash for each entry.
2796
2797
2798=back
2799
2800Returns an enveloped result (an array).
2801
2802First element (status) is an integer containing HTTP status code
2803(200 means OK, 4xx caller error, 5xx function error). Second element
2804(msg) is a string containing error message, or 'OK' if status is
2805200. Third element (payload) is optional, the actual result. Fourth
2806element (meta) is called result metadata and is optional, a hash
2807that contains extra information.
2808
2809Return value:  (any)
2810
2811
2812
2813=head2 modify_group
2814
2815Usage:
2816
2817 modify_group(%args) -> [status, msg, payload, meta]
2818
2819Modify an existing group.
2820
2821Specify arguments to modify corresponding fields. Unspecified fields will not be
2822modified.
2823
2824This function is not exported by default, but exportable.
2825
2826Arguments ('*' denotes required arguments):
2827
2828=over 4
2829
2830=item * B<admins> => I<str>
2831
2832It must be a comma-separated list of user names, or empty.
2833
2834=item * B<backup> => I<bool> (default: 0)
2835
2836Whether to backup when modifying files.
2837
2838Backup is written with C<.bak> extension in the same directory. Unmodified file
2839will not be backed up. Previous backup will be overwritten.
2840
2841=item * B<encpass> => I<str>
2842
2843Encrypted password.
2844
2845=item * B<etc_dir> => I<str> (default: "/etc")
2846
2847Specify location of passwd files.
2848
2849=item * B<gid> => I<unix::gid>
2850
2851Numeric group ID.
2852
2853=item * B<group>* => I<unix::groupname>
2854
2855Group name.
2856
2857=item * B<members> => I<str>
2858
2859List of usernames that are members of this group, separated by commas.
2860
2861=item * B<pass> => I<str>
2862
2863Password, generally should be "x" which means password is encrypted in gshadow.
2864
2865
2866=back
2867
2868Returns an enveloped result (an array).
2869
2870First element (status) is an integer containing HTTP status code
2871(200 means OK, 4xx caller error, 5xx function error). Second element
2872(msg) is a string containing error message, or 'OK' if status is
2873200. Third element (payload) is optional, the actual result. Fourth
2874element (meta) is called result metadata and is optional, a hash
2875that contains extra information.
2876
2877Return value:  (any)
2878
2879
2880
2881=head2 modify_user
2882
2883Usage:
2884
2885 modify_user(%args) -> [status, msg, payload, meta]
2886
2887Modify an existing user.
2888
2889Specify arguments to modify corresponding fields. Unspecified fields will not be
2890modified.
2891
2892This function is not exported by default, but exportable.
2893
2894Arguments ('*' denotes required arguments):
2895
2896=over 4
2897
2898=item * B<backup> => I<bool> (default: 0)
2899
2900Whether to backup when modifying files.
2901
2902Backup is written with C<.bak> extension in the same directory. Unmodified file
2903will not be backed up. Previous backup will be overwritten.
2904
2905=item * B<encpass> => I<str>
2906
2907Encrypted password.
2908
2909=item * B<etc_dir> => I<str> (default: "/etc")
2910
2911Specify location of passwd files.
2912
2913=item * B<expire_date> => I<int>
2914
2915The date of expiration of the account, expressed as the number of days since Jan 1, 1970.
2916
2917=item * B<gecos> => I<str>
2918
2919Usually, it contains the full username.
2920
2921=item * B<gid> => I<unix::gid>
2922
2923Numeric primary group ID for this user.
2924
2925=item * B<home> => I<dirname>
2926
2927User's home directory.
2928
2929=item * B<last_pwchange> => I<int>
2930
2931The date of the last password change, expressed as the number of days since Jan 1, 1970.
2932
2933=item * B<max_pass_age> => I<int>
2934
2935The number of days after which the user will have to change her password.
2936
2937=item * B<min_pass_age> => I<int>
2938
2939The number of days the user will have to wait before she will be allowed to change her password again.
2940
2941=item * B<pass_inactive_period> => I<int>
2942
2943The number of days after a password has expired (see max_pass_age) during which the password should still be accepted (and user should update her password during the next login).
2944
2945=item * B<pass_warn_period> => I<int>
2946
2947The number of days before a password is going to expire (see max_pass_age) during which the user should be warned.
2948
2949=item * B<shell> => I<filename>
2950
2951User's shell.
2952
2953=item * B<uid> => I<unix::uid>
2954
2955Numeric user ID.
2956
2957=item * B<user>* => I<unix::username>
2958
2959User (login) name.
2960
2961
2962=back
2963
2964Returns an enveloped result (an array).
2965
2966First element (status) is an integer containing HTTP status code
2967(200 means OK, 4xx caller error, 5xx function error). Second element
2968(msg) is a string containing error message, or 'OK' if status is
2969200. Third element (payload) is optional, the actual result. Fourth
2970element (meta) is called result metadata and is optional, a hash
2971that contains extra information.
2972
2973Return value:  (any)
2974
2975
2976
2977=head2 set_user_groups
2978
2979Usage:
2980
2981 set_user_groups(%args) -> [status, msg, payload, meta]
2982
2983Set the groups that a user is member of.
2984
2985This function is not exported by default, but exportable.
2986
2987Arguments ('*' denotes required arguments):
2988
2989=over 4
2990
2991=item * B<etc_dir> => I<str> (default: "/etc")
2992
2993Specify location of passwd files.
2994
2995=item * B<groups>* => I<array[unix::groupname]> (default: [])
2996
2997List of group names that user is member of.
2998
2999Aside from this list, user will not belong to any other group.
3000
3001=item * B<user>* => I<unix::username>
3002
3003
3004=back
3005
3006Returns an enveloped result (an array).
3007
3008First element (status) is an integer containing HTTP status code
3009(200 means OK, 4xx caller error, 5xx function error). Second element
3010(msg) is a string containing error message, or 'OK' if status is
3011200. Third element (payload) is optional, the actual result. Fourth
3012element (meta) is called result metadata and is optional, a hash
3013that contains extra information.
3014
3015Return value:  (any)
3016
3017
3018
3019=head2 set_user_password
3020
3021Usage:
3022
3023 set_user_password(%args) -> [status, msg, payload, meta]
3024
3025Set user's password.
3026
3027This function is not exported by default, but exportable.
3028
3029Arguments ('*' denotes required arguments):
3030
3031=over 4
3032
3033=item * B<backup> => I<bool> (default: 0)
3034
3035Whether to backup when modifying files.
3036
3037Backup is written with C<.bak> extension in the same directory. Unmodified file
3038will not be backed up. Previous backup will be overwritten.
3039
3040=item * B<etc_dir> => I<str> (default: "/etc")
3041
3042Specify location of passwd files.
3043
3044=item * B<pass>* => I<str>
3045
3046=item * B<user>* => I<unix::username>
3047
3048
3049=back
3050
3051Returns an enveloped result (an array).
3052
3053First element (status) is an integer containing HTTP status code
3054(200 means OK, 4xx caller error, 5xx function error). Second element
3055(msg) is a string containing error message, or 'OK' if status is
3056200. Third element (payload) is optional, the actual result. Fourth
3057element (meta) is called result metadata and is optional, a hash
3058that contains extra information.
3059
3060Return value:  (any)
3061
3062
3063
3064=head2 user_exists
3065
3066Usage:
3067
3068 user_exists(%args) -> bool
3069
3070Check whether user exists.
3071
3072This function is not exported by default, but exportable.
3073
3074Arguments ('*' denotes required arguments):
3075
3076=over 4
3077
3078=item * B<etc_dir> => I<str> (default: "/etc")
3079
3080Specify location of passwd files.
3081
3082=item * B<uid> => I<unix::uid>
3083
3084=item * B<user> => I<unix::username>
3085
3086
3087=back
3088
3089Return value:  (bool)
3090
3091=head1 HOMEPAGE
3092
3093Please visit the project's homepage at L<https://metacpan.org/release/Unix-Passwd-File>.
3094
3095=head1 SOURCE
3096
3097Source repository is at L<https://github.com/perlancar/perl-Unix-Passwd-File>.
3098
3099=head1 BUGS
3100
3101Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Unix-Passwd-File>
3102
3103When submitting a bug or request, please include a test-file or a
3104patch to an existing test-file that illustrates the bug or desired
3105feature.
3106
3107=head1 SEE ALSO
3108
3109Old modules on CPAN which do not support shadow files are pretty useless to me
3110(e.g. L<Unix::ConfigFile>). Shadow passwords have been around since 1988 (and in
3111Linux since 1992), FFS!
3112
3113L<Passwd::Unix>. I created a fork of Passwd::Unix v0.52 called
3114L<Passwd::Unix::Alt> in 2011 to fix some of the deficiencies/quirks in
3115Passwd::Unix, including: lack of tests, insistence of running as root (despite
3116allowing custom passwd files), use of not-so-ubiquitous bzip2, etc. Then in 2012
3117I decided to create Unix::Passwd::File. Here are how Unix::Passwd::File differs
3118compared to Passwd::Unix (and Passwd::Unix::Alt):
3119
3120=over 4
3121
3122=item * tests in distribution
3123
3124=item * no need to run as root
3125
3126=item * no need to be able to read the shadow file for some operations
3127
3128For example, C<list_users()> will simply not return the C<encpass> field if the
3129shadow file is unreadable. Of course, access to shadow file is required when
3130getting or setting password.
3131
3132=item * strictly procedural (non-OO) interface
3133
3134I consider this a feature :-)
3135
3136=item * detailed error message for each operation
3137
3138=item * removal of global error variable
3139
3140=item * working locking
3141
3142Locking is done by locking C<passwd> file.
3143
3144=back
3145
3146L<Setup::Unix::User> and L<Setup::Unix::Group>, which use this module.
3147
3148L<Rinci>
3149
3150=head1 AUTHOR
3151
3152perlancar <perlancar@cpan.org>
3153
3154=head1 COPYRIGHT AND LICENSE
3155
3156This software is copyright (c) 2020, 2017, 2016, 2015, 2014, 2012 by perlancar@cpan.org.
3157
3158This is free software; you can redistribute it and/or modify it under
3159the same terms as the Perl 5 programming language system itself.
3160
3161=cut
3162