--- /dev/null
+#
+# MdwOpt.pm
+#
+# Options parsing
+#
+# (c) 1996 Mark Wooding
+#
+
+#----- Notices --------------------------------------------------------------
+#
+# This program comes with no warranty, not even of any kind, unless
+# someone other than the author offers to provide one. It may be used
+# and distributed under the terms of the GNU General Public Licence, in
+# the interests of promoting freely available software for Linux.
+
+package MdwOpt;
+require 5.00;
+require Exporter;
+
+@ISA=qw(Exporter);
+@EXPORT=qw( );
+
+#----- The code -------------------------------------------------------------
+
+# --- MdwOpt::new ---
+#
+# Arguments: (scalar) shortopts == short options description
+# (see below) longopts == long options description
+# (array ref) arguments == pointer to argument list
+# (array ref) flags == a number of flags you can set
+#
+# Returns: A `MdwOpt' object, which can be used to extract options from
+# an array of argument strings.
+#
+# Use: Creates a `MdwOpt' object which contains all the information
+# needed to parse a command line. The arguments are a bit
+# complicated, so I'll explain them below. This implementation
+# provides a similar level of flexibility to the C `mdwopt'
+# routine, although the interface is rather different, since it
+# takes advantage of some of Perl's object-oriented features.
+#
+#
+# How options parsing appears to users
+#
+# A command line consists of a number of `words' (which may
+# contain spaces, according to various shell quoting
+# conventions). A word may be an option, an argument to an
+# option, or a non-option. An option begins with a special
+# character, usually `-', although `+' is also used sometimes.
+# As special exceptions, the word containing only a `-' is
+# considered to be a non-option, since it usually represents
+# standard input or output as a filename, and the word
+# containing a double-dash `--' is used to mark all following
+# words as being non-options regardless of their initial
+# character.
+#
+# Traditionally, all words after the first non-option have been
+# considered to be non-options automatically, so that options
+# must be specified before filenames. However, this
+# implementation can extract all the options from the command
+# line regardless of their position. This can usually be
+# disabled by setting one of the environment variables
+# `POSIXLY_CORRECT' or `_POSIX_OPTION_ORDER'.
+#
+# There are two different styles of options: `short' and
+# `long'.
+#
+# Short options are the sort which Unix has known for ages: an
+# option is a single letter, preceded by a `-'. Short options
+# can be joined together to save space (and possibly to make
+# silly words): e.g., instead of giving options `-x -y', a user
+# could write `-xy'. Some short options can have arguments,
+# which appear after the option letter, either immediately
+# following, or in the next `word' (so an option with an
+# argument could be written as `-o foo' or as `-ofoo'). Note
+# that options with optional arguments must be written in the
+# second style.
+#
+# When a short option controls a flag setting, it is sometimes
+# possible to explicitly turn the flag off, as well as turning
+# it on, (usually to override default options). This is
+# usually done by using a `+' instead of a `-' to introduce the
+# option.
+#
+# Long options, as popularised by the GNU utilities, are given
+# long-ish memorable names, preceded by a double-dash `--'.
+# Since their names are more than a single character, long
+# options can't be combined in the same way as short options.
+# Arguments to long options may be given either in the same
+# `word', separated from the option name by an equals sign,
+# or in the following `word'.
+#
+# Long option names can be abbreviated if necessary, as long
+# as the abbreviation is unique. This means that options can
+# have sensible and memorable names but still not require much
+# typing from an experienced user.
+#
+# Like short options, long options can control flag settings.
+# The options to manipulate these settings come in pairs: an
+# option of the form `--set-flag' might set the flag, while an
+# option of the form `--no-set-flag' might clear it.
+#
+# It is usual for applications to provide both short and long
+# options with identical behaviour. Some applications with
+# lots of options may only provide long options (although they
+# will often be only two or three characters long). In this
+# case, long options can be preceded with a single `-'
+# character, and negated by a `+' character.
+#
+# Finally, some (older) programs accept arguments of the form
+# `-<number>', to set some numerical parameter, typically a
+# line count of some kind.
+#
+#
+# How programs parse options
+#
+# The difficult bit is all in the setting up at the beginning.
+# I've used some funny data structures to try and pack all the
+# important information away.
+#
+# The first `shortopts' argument specifies the allowable short
+# options, followed by various switch characters which control
+# option-specific features. Allowable characters are as
+# follows:
+#
+# : option takes a required argument
+# :: option takes an optional argument
+# + option may be negated
+#
+# Note that the `+' must appear /before/ the `:' characters.
+#
+# The `longopts' argument is a reference to a hash, containing
+# various pieces of information. (Using a reference here means
+# that we can pass other aggregate values around. It also
+# might save a little memory.) The hash contains an item for
+# each long option string you want to support: the option's
+# name is the key; the value is another hash reference
+# containing information about the option. This sub-hash
+# should contain a number of the following items:
+#
+# Key Use
+# ~~~ ~~~
+#
+# return Value to return when this option is found.
+# May be any sort of non-false scalar value.
+#
+# arg Information about the argument for this
+# option. May be one of the strings `none',
+# `opt' and `req'. (Actually `none' is the
+# same as a false value, and `req' is the same
+# as any other true value.)
+#
+# negate If true, allow the option to be negated.
+#
+# The `flags' argument is a reference to a array containing
+# items from the following table.
+#
+# Flag Use
+# ~~~~ ~~~
+#
+# nolong Don't support any long options
+# noshort Don't support any short options
+# numeric Support numeric options
+# negate Support negated options
+# env Read options from environment variable
+# permute Force permuting of the argument list
+# inorder Read options in order
+# posix Force use of POSIX option semantics
+# quiet Don't report errors when they happen
+
+sub new
+{
+ my $class=shift;
+ my $self=bless {}; # Make an empty reference for me
+ my ($short,$long,$argv,$flags)=@_; # Read the caller's arguments
+ my ($x); # Temporaries for copying
+ my ($prog); # Program name read from argv[0]
+
+ # --- Set up the simple parts of the structure ---
+
+ @{$self->{argv}}=@$argv; # Copy the arguments list
+
+ $self->{flags}={}; # Clear the flags hash out
+ foreach $x (@$flags) { $self->{flags}{$x}=1; }
+
+ $self->{short}=$short; # Copy the short options string
+ $self->{long}=$long; # Take a reference to the long opts
+
+ # --- Get the arguments list sorted out ---
+
+ $prog=$0; # Read the program name
+ $prog =~ s|^.*/||; # Strip leading gubbins from it
+ $self->{prog}=$prog; # This as the program name
+
+ # --- Play with the ordering settings ---
+
+ unless ($self->{flags}{permute} ||
+ $self->{flags}{inorder} ||
+ $self->{flags}{posix})
+ {
+ if (defined($ENV{'POSIXLY_CORRECT'}) ||
+ defined($ENV{'_POSIX_OPTION_ORDER'}))
+ { $self->{flags}{posix}=1; }
+ else
+ { $self->{flags}{permute}=1; }
+ }
+
+ # --- Set up the environment variable, if we're reading that ---
+ #
+ # List concatenation is so easy ;-) This is actually better than the C
+ # version, although much less efficient, since it works `properly' with
+ # non-options in the options string.
+
+ @{$self->{argv}}=(split(' ',$ENV{uc($self->{prog})}),@{$self->{argv}})
+ if ($self->{flags}{env});
+
+ # --- Initialise persistent state bits ---
+
+ $self->{rest}=[]; # No non-options found yet
+ $self->{this}=''; # We're not in a shortopt group
+
+ # --- That's it, so we're done now ---
+
+ return ($self);
+}
+
+# --- mo->err ---
+#
+# Arguments: (scalar) error == a string to return
+#
+# Returns: A suitable error message from mo->read.
+#
+# Use: Contructs an error return and maybe displays the message to
+# the user.
+
+sub err
+{
+ my ($self,$msg)=@_;
+
+ print STDERR "$self->{prog}: $msg\n"
+ unless $self->{flags}{quiet};
+ return ($msg);
+}
+
+# --- mo->read ---
+#
+# Arguments: --
+#
+# Returns: A list containing interesting things about the option
+#
+# Use: Returns information about the next option read. The list
+# contains, in order:
+#
+# * The `value' of the option, with a suffix `+' if negated
+# * The argument passed to the option
+#
+# Non-options are reported by passing a `value' of an empty
+# string. The end of the options is reported by returning
+# `undef' as the value. An error is returned my setting
+# `value' to `?' and putting the error message in the argument
+# field.
+
+sub read
+{
+ my ($self)=@_; # Read the arguments list
+ my ($opt,$arg,$prefix);
+
+ if ($self->{this} eq '') # Have we any shortopts left?
+ {
+ $self->{flags}{_neg}=0; # This option isn't negated yet
+
+ # --- Find the next option to handle ---
+
+ arg: for (;;)
+ {
+ $opt=shift(@{$self->{argv}}); # Shift out the next option
+ return (undef,undef)
+ unless (defined($opt));
+
+ if ($opt =~ /^-/ || ($opt =~ /^\+/ && $self->{flags}{negate}))
+ {
+ if ($opt eq '--') # If no more options at all
+ {
+ push(@{$self->{rest}},@{$self->{argv}});
+ return (undef,undef); # Return two undefined values
+ }
+ elsif (length($opt)!=1)
+ { last arg; } # Otherwise we've found an option
+ }
+
+ switch: {
+ push(@{$self->{rest}},$opt,@{$self->{argv}}),
+ return (undef,undef) # And return two undefined values
+ if $self->{flags}{posix};
+
+ return ('',$opt) # Return this non-option
+ if $self->{flags}{inorder};
+
+ push(@{$self->{rest}},$opt) # Add to the `rest' list
+ ;
+ }
+ }
+
+ # --- Check for a numeric option ---
+
+ return ('#',substr($opt,1))
+ if $self->{flags}{numeric} && $opt =~ /^-[+-]?[0-9]/;
+
+ # --- Handle long options ---
+ #
+ # This is where things start getting hairy.
+
+ if (($opt =~ /^--/ || $self->{flags}{noshort}) &&
+ !$self->{flags}{nolong})
+ {
+ my ($match,$key,$real);
+
+ # --- Extract the prefix, option name and argument ---
+ #
+ # This is rather easier than the C version.
+
+ ($self->{flags}{negate}) ?
+ (($prefix,$opt) = $opt =~ /^(\+|--no-|--|-)(.*)/) :
+ (($prefix,$opt) = $opt =~ /^(\+|--)(.*)/);
+ $self->{flags}{_neg}=1 if ($prefix eq '+' || $prefix eq '--no-');
+
+ ($opt,$arg)=($`,$') if $opt =~ /=/;
+
+ # --- Now try and find an entry in the hash table ---
+
+ longopt: foreach $key (keys(%{$self->{long}}))
+ {
+ next longopt
+ if $self->{flags}{_neg} && !$self->{long}{$key}{negate};
+
+ ($match,$real)=($self->{long}{$key},$key),
+ last longopt
+ if $key eq $opt;
+
+ next longopt
+ if length($key)<length($opt) ||
+ $opt ne substr($key,0,length($opt));
+
+ $match=undef,
+ last longopt
+ if defined($match);
+
+ ($match,$real)=($self->{long}{$key},$key)
+ ;
+ }
+
+ return ('?',$self->err("unrecognised option `$prefix$opt'"))
+ unless defined($match);
+
+ if ($match->{arg} eq 'none' || !$match->{arg})
+ {
+ return ('?',
+ $self->err("option `$prefix$real' does not accept " .
+ "arguments"))
+ if $arg;
+ }
+ elsif ($match->{arg} ne 'opt')
+ {
+ $arg=shift(@{$self->{argv}})
+ unless $arg;
+ return ('?',$self->err("option `$prefix$real' requires an argument"))
+ unless defined($arg);
+ }
+
+ $opt=($match->{"return"} || $real);
+ $opt .= '+' if ($self->{flags}{_neg});
+ return ($opt,$arg);
+ }
+
+ # --- Right, it must be a short option ---
+
+ $self->{flags}{_neg}=1 if ($opt =~ /^\+/);
+ $self->{this}=substr($opt,1);
+ }
+
+ # --- Handle the next short option ---
+
+ ($opt,$self->{this})=(substr($self->{this},0,1),substr($self->{this},1));
+ $prefix=($self->{flags}{_neg} ? '+' : '-');
+
+ if ($self->{short} =~ /\Q$opt/ &&
+ (!$self->{flags}{_neg} || substr($',0,1) eq '+'))
+ {
+ my ($rest,$arg)=($',undef);
+
+ # --- Found an option, so handle the argument ---
+
+ $rest =~ /^\+?(:{0,2})/;
+ if ($1)
+ {
+ $arg=$self->{this};
+ $self->{this}='';
+ if ($1 eq ':' && !$arg)
+ {
+ $arg=shift(@{$self->{argv}});
+ return ('?',$self->err("option `$prefix$opt' requires an argument"))
+ unless defined($arg);
+ }
+ }
+
+ $opt.='+' if $self->{flags}{_neg};
+ return ($opt,$arg);
+ }
+ return ('?',$self->err("unrecognised option `$prefix$opt'"));
+}
+
+# --- mo->rest ---
+#
+# Arguments: --
+#
+# Returns: A list containing the remaining command line items in order.
+#
+# Use: Returns all the unprocessed command line arguments.
+
+sub rest
+{
+ my ($self)=@_;
+ return (@{$self->{rest}});
+}
+
+# --- prog ---
+#
+# Arguments: --
+#
+# Returns: The program name, read from $0.
+#
+# Use: Returns the name of the program, with leading path elements
+# snipped off. You can call this either as a class method or
+# by passing a MdwOpt object.
+
+sub prog { $0 =~ m|^.*/| ? $' : $0 }
+
+1;
--- /dev/null
+#! /usr/bin/perl
+#
+# Sanitise Linux password and group databases
+#
+# (c) 1998 Mark Wooding
+#
+
+use MdwOpt;
+use FileHandle;
+use POSIX;
+
+#----- Documentation --------------------------------------------------------
+
+=head1 NAME
+
+shadowfix - fix password and group files
+
+=head1 SYNOPSIS
+
+B<shadowfix> I<options>...
+
+=head1 DESCRIPTION
+
+Shadowfix trundles through your various password files and makes sure
+that they're consistent with themselves.
+
+Currently, the checks Shadowfix makes, and their resolutions, are:
+
+=over 4
+
+=item *
+
+Every user named in the password file should have a shadow password entry;
+create a shadow password entry if necessary.
+
+=item *
+
+Every password field in the password file indicates only presence or absence
+of a password; move a realistic-looking password to the shadow password file,
+and ensure that the password entry in the password file is either empty
+(signifying no password) or an `x' character (signifying a password).
+
+=item *
+
+The primary group of each user exists; warn about nonexistent primary groups.
+
+=item *
+
+Every user is a member of his primary group; add the user to the membership
+list of the group where necessary.
+
+=item *
+
+There are no entries in the shadow password file which don't match entries in
+the main password file; delete orphaned shadow password entries.
+
+=item *
+
+Check group and shadow group files for consistency, as for password and
+shadow password files: every group entry has a shadow entry, no passwords in
+the group file, no orphaned shadow group entries.
+
+=item *
+
+The lists of group members are consistent between group and shadow group
+files; edit the shadow group list to match the main group list where
+necessary.
+
+=item *
+
+Group administrators, listed in the shadow group file, are real users; warn
+about nonexistent group administrators.
+
+=back
+
+A lot of the checks above only make sense when shadow password and group
+files are used. When instructed not to create shadow files, Shadowfix will
+perform the password/group consistency checks as described above. Also, if
+given shadow files as input, and told not to create shadow files on output,
+Shadowfix will merge the password information back into the main files.
+Obviously, translating shadowed to non-shadowed files involved information
+loss: in particular, information about password expiry and group
+administration is lost.
+
+It's time to examine the command line options.
+
+=over 4
+
+=item B<--passwd=>I<file>
+
+Use I<file> as the main password file.
+
+=item B<--group=>I<file>
+
+Use I<file> as the main group file.
+
+=item B<--shadow=>I<file>
+
+Use I<file> as the shadow password file.
+
+=item B<--gshadow=>I<file>
+
+Use I<file> as the shadow group file.
+
+=item B<--in-passwd=>I<file>
+
+Read main password file entries from I<file>.
+
+=item B<--in-group=>I<file>
+
+Read main group file entries from I<file>.
+
+=item B<--in-shadow=>I<file>
+
+Read shadow password file entries from I<file>.
+
+=item B<--in-gshadow=>I<file>
+
+Read shadow group file entries from I<file>.
+
+=item B<--quiet>
+
+Suppresses Shadowfix's informative messages about what it's doing to your
+passwored files. Enabling this option is not recommended.
+
+=back
+
+If the input files aren't specified explitly, Shadowfix defaults to trying to
+read the output files. These default sensibly to the system password and
+shadow files in F</etc>.
+
+Shadowfix knows about locking password files, so C<passwd> and C<vipw> will
+interact with it properly.
+
+=head1 FILES
+
+=over 4
+
+=item F</etc/passwd>, F</etc/shadow>, F</etc/group>, F</etc/gshadow>
+
+System default password and group files.
+
+=back
+
+=head1 BUGS
+
+Shadowfix doesn't understand how to cope with YP password files. Yellow
+Pages is a security hole; don't use it.
+
+=head1 AUTHOR
+
+Mark Wooding, <mdw@nsict.org>
+
+=cut
+
+#----- Configuration section ------------------------------------------------
+
+$passwd = "/etc/passwd";
+$group = "/etc/group";
+$shadow = "/etc/shadow";
+$gshadow = "/etc/gshadow";
+$passwd_in = $shadow_in = undef;
+$group_in = $gshadow_in = undef;
+
+$suyb = 0;
+
+#----- Subroutines ----------------------------------------------------------
+
+sub hashify {
+ map { $_, 1 } @_;
+}
+
+sub moan {
+ print STDERR "shadowfix: @_\n";
+}
+
+sub uidsort {
+ if ($a eq $b) {
+ return 0;
+ } elsif ($a eq "+") {
+ return +1;
+ } elsif ($b eq "+") {
+ return -1;
+ } elsif (!exists($ubynam{$a})) {
+ return +1;
+ } elsif (!exists($ubynam{$b})) {
+ return -1;
+ } else {
+ return $ubynam{$a}{uid} <=> $ubynam{$b}{uid} || $a cmp $b;
+ }
+}
+
+sub gidsort {
+ if ($a eq $b) {
+ return 0;
+ } elsif ($a eq "+") {
+ return +1;
+ } elsif ($b eq "+") {
+ return -1;
+ } else {
+ return $gbynam{$a}{gid} <=> $gbynam{$b}{gid} || $a cmp $b;
+ }
+}
+
+sub lockfile {
+ my $file = shift;
+ my $mode = shift or 0644;
+ my $fh = new FileHandle;
+
+ $fh->open("${file}.lock", O_WRONLY | O_EXCL | O_CREAT, 0600) or
+ die "couldn't obtain lock file ${file}.lock";
+ $fh->print($$);
+ $fh->close;
+ $fh->open("${file}.edit", O_WRONLY | O_TRUNC | O_CREAT, $mode) or do {
+ unlink "${file}.lock";
+ die "open(${file}.edit): $!";
+ };
+ return $fh;
+}
+
+sub unlockfile {
+ my $file = shift;
+ my $fh = shift;
+ $fh->close;
+
+ # --- See whether the file changed ---
+
+ CHECK: {
+ my ($ofh, $nfh);
+ my ($obuf, $nbuf);
+ my ($osz, $nsz);
+
+ # --- Open the old and new versions for reading ---
+
+ $ofh = new FileHandle $file, O_RDONLY;
+ $nfh = new FileHandle "${file}.edit", O_RDONLY;
+ last CHECK if !$ofh || !$nfh;
+
+ # --- Read blocks from each and compare ---
+
+ BLOCK: for (;;) {
+ $osz = sysread($ofh, $obuf, 4096);
+ $nsz = sysread($nfh, $nbuf, 4096);
+ last CHECK if !defined($osz) || !defined($nsz);
+ last CHECK if $obuf ne $nbuf;
+ last BLOCK if $sz == 0;
+ }
+
+ # --- The files are identical ---
+
+ # moan "file $file is unchanged";
+ unlink("${file}.edit");
+ unlink("${file}.lock");
+ return;
+ }
+
+ # --- Find the current owner ---
+
+ # system("diff -u $file $file.edit");
+
+ if (-e $file) {
+ my ($mode, $uid, $gid);
+ (undef, undef, $mode, undef, $uid, $gid) = stat $file;
+ chmod $mode, "${file}.edit";
+ chown $uid, $gid, "${file}.edit";
+ }
+
+ # --- Move the old file out of the way ---
+
+ !-e $file or rename("${file}", "${file}-") or do {
+ unlink "${file}.lock";
+ unlink "${file}.edit";
+ die "couldn't save backup copy of $file: $!";
+ };
+
+ # --- Move the new one into place ---
+
+ rename ("${file}.edit", "${file}") or do {
+ rename("${file}-", "${file}"); # This shouldn't happen!
+ unlink "${file}.lock";
+ unlink "${file}.edit";
+ die "HELP!!! couldn't save backup copy of $file: $!";
+ };
+
+ # --- Release the lock ---
+
+ moan "updated $file"
+ unless $suyb;
+ unlink("${file}.lock");
+}
+
+#----- Main code ------------------------------------------------------------
+
+# --- Options parsing ---
+
+$longopts = { 'passwd' => { return => 'p', arg => 'opt' },
+ 'in-passwd' => { return => 'ip', arg => 'opt' },
+ 'shadow' => { return => 'ps', arg => 'opt' },
+ 'in-shadow' => { return => 'ips', arg => 'opt' },
+ 'group' => { return => 'g', arg => 'opt' },
+ 'in-group' => { return => 'ig', arg => 'opt' },
+ 'gshadow' => { return => 'gs', arg => 'opt' },
+ 'in-gshadow' => { return => 'igs', arg => 'opt' },
+ 'quiet' => { return => 'q', negate => 1 } };
+
+$opts = MdwOpt->new("", $longopts, \@ARGV, ['negate', 'noshort']);
+
+OPT: while (($opt, $arg) = $opts->read, $opt) {
+ $passwd = $arg, next OPT if $opt eq 'p';
+ $passwd_in = $arg, next OPT if $opt eq 'ip';
+ $shadow = $arg, next OPT if $opt eq 'ps';
+ $shadow_in = $arg, next OPT if $opt eq 'ips';
+ $group = $arg, next OPT if $opt eq 'g';
+ $group_in = $arg, next OPT if $opt eq 'ig';
+ $gshadow = $arg, next OPT if $opt eq 'gs';
+ $gshadow_in = $arg, next OPT if $opt eq 'igs';
+ $suyb = 1, next OPT if $opt eq 'q';
+ $suyb = 0, next OPT if $opt eq 'q+';
+ die "bad option";
+}
+
+$passwd_in = $passwd unless $passwd_in;
+$shadow_in = $shadow unless $shadow_in;
+$group_in = $group unless $group_in;
+$gshadow_in = $gshadow unless $gshadow_in;
+
+# --- Initialise the user tables ---
+
+%ubynam = %ubyuid = %subynam = ();
+%gbynam = %gbygid = %sgbynam = ();
+
+# --- Slurp the user tables into memory ---
+
+$pw = new FileHandle $passwd_in, O_RDONLY or die "open($passwd_in): $!";
+while ($line = $pw->getline) {
+ chomp $line;
+ @f = split /:/, $line;
+ $#f = 6;
+ $a = { data => [ @f ], name => $f[0], uid => $f[2], gid => $f[3] };
+ $ubynam{$a->{name}} = $ubyuid{$a->{uid}} = $a;
+}
+$pw->close;
+
+$gr = new FileHandle $group_in, O_RDONLY or die "open($group_in): $!";
+while ($line = $gr->getline) {
+ chomp $line;
+ @f = split /:/, $line;
+ $#f = 3;
+ $a = { data => [ @f ],
+ members => { hashify(split /,/, $f[3]) },
+ name => $f[0], gid => $f[2] };
+ $gbynam{$a->{name}} = $gbygid{$a->{gid}} = $a;
+}
+$gr->close;
+
+undef $have_shadow;
+if ($shadow_in) {
+ if ($spw = new FileHandle $shadow_in, O_RDONLY) {
+ while ($line = $spw->getline) {
+ chomp $line;
+ @f = split /:/, $line;
+ $#f = 8;
+ $a = { data => [ @f ], name => $f[0] };
+ $subynam{$a->{name}} = $a;
+ }
+ $spw->close;
+ $have_shadow = 1;
+ } else {
+ die "open($shadow_in): $!" unless $! == ENOENT;
+ }
+}
+
+undef $have_gshadow;
+if ($gshadow_in) {
+ if ($sgr = new FileHandle $gshadow_in, O_RDONLY) {
+ while ($line = $sgr->getline) {
+ chomp $line;
+ @f = split /:/, $line;
+ $#f = 3;
+ $a = { data => [ @f ],
+ members => { hashify (split /,/, $f[3]) },
+ name => $f[0] };
+ $sgbynam{$a->{name}} = $a;
+ }
+ $sgr->close;
+ $have_gshadow = 1;
+ } else {
+ die "open($gshadow_in): $!" unless $! == ENOENT;
+ }
+}
+
+# --- Check primary group memberships ---
+
+for $u (values %ubynam) {
+ $unam = $u->{name};
+ if (exists $gbygid{$u->{gid}}) {
+ $g = $gbygid{$u->{gid}};
+ unless ($unam eq "+" || exists($g->{members}{$unam})) {
+ moan "user $unam is not a member of his/her primary group"
+ unless $suyb;
+ $g->{members}{$unam} = 1;
+ }
+ } else {
+ moan "user $unam seems to belong to a nonexistant group"
+ unless $suyb;
+ }
+}
+
+# --- Shadow password checks ---
+
+if ($shadow) {
+
+ # --- Full shadowing checks ---
+
+ for $u (values %ubynam) {
+ $unam = $u->{name};
+
+ # --- Ensure there's a shadow password entry ---
+
+ unless ($unam eq "+" || exists($subynam{$unam})) {
+ moan "user $unam not in shadow password file: adding"
+ unless $suyb;
+ $subynam{$unam} = { name => $unam,
+ data => [$unam,
+ $u->{data}[1],
+ 10205, 0, 99999, 7, "", "", ""] };
+ }
+
+ # --- Mark unloginable shadow password entries ---
+
+ $su = $subynam{$unam};
+ $p = $su->{data}[1];
+ if ($p ne "*" && length($p) > 0 && length($p) < 5) {
+ moan "blanked user ${unam}'s password"
+ unless $suyb;
+ $su->{data}[1] = "*";
+ }
+
+ # --- Blank out normal password entries ---
+
+ if ($unam eq "+") {
+ # Nothing doing
+ } elsif ($p eq "") {
+ $u->{data}[1] = "";
+ } else {
+ $u->{data}[1] = "x";
+ }
+ }
+
+ # --- Remove shadow entries which don't make sense any more ---
+
+ for $su (values %subynam) {
+ $unam = $su->{name};
+ unless (exists($ubynam{$unam})) {
+ moan "user $unam only in shadow password file: deleting"
+ unless $suyb;
+ delete $subynam{$su->{name}};
+ }
+ }
+
+} elsif ($have_shadow) {
+
+ # --- We have shadowing, but aren't writing out entries ---
+
+ for $u (values %ubynam) {
+ $unam = $u->{name};
+ $u->{data}[1] = $subynam{$unam}{data}[1]
+ if exists($subynam{$unam});
+ }
+}
+
+# --- Shadow group checks ---
+
+for $g (values %gbynam) {
+ $gnam = $g->{name};
+
+ # --- Ensure there's a shadow group entry ---
+
+ unless (!$gshadow || $gnam eq "+" || exists($sgbynam{$gnam})) {
+ moan "group $gnam not in shadow group file: adding"
+ unless $suyb;
+ $sgbynam{$gnam} = { name => $gnam,
+ data => [$gnam,
+ $g->{data}[1],
+ "",
+ $g->{data}[3]],
+ members => { %{$g->{members}} } };
+ }
+
+ # --- Play games with passwords ---
+
+ if ($gshadow) {
+
+ # --- Mark unloginable shadow group entries ---
+
+ $sg = $sgbynam{$gnam};
+ $p = $sg->{data}[1];
+ if ($p ne "*" && length($p) > 0 && length($p) < 5) {
+ moan "blanked group ${gnam}'s password"
+ unless $suyb;
+ $sg->{data}[1] = "*";
+ }
+
+ # --- Blank out normal passwords ---
+
+ $g->{data}[1] = "x" unless $gnam eq "+";
+
+ # --- Check that the group's administrators exist ---
+
+ if ($sg->{data}[2] ne "" && !$suyb) {
+ my @admins =
+ my $admin;
+ foreach $admin (split(/,/, $sg->{data}[2])) {
+ exists $ubynam{$admin} or
+ moan "user $admin owns group $gnam but doesn't seem to exist";
+ }
+ }
+
+ } elsif ($have_gshadow) {
+ $g->{data}[1] = $sgbynam{$gnam}{data}[1]
+ if exists($sgbynam{$gnam});
+ $sg = undef;
+ }
+
+ # --- The group members should be consistent across both files ---
+
+ for $i (keys %{$g->{members}}) {
+ exists $ubynam{$i} or $suyb or
+ moan "user $i is a member of group $gnam but doesn't seem to exist";
+ unless (!$sg || exists($sg->{members}{$i})) {
+ moan "group $gnam does not include $i in shadow group file: adding"
+ unless $suyb;
+ $sg->{members}{$i} = 1;
+ }
+ }
+ if ($sg) {
+ for $i (keys %{$sg->{members}}) {
+ unless (exists($g->{members}{$i})) {
+ moan "group $gnam does not include $i in main group file: deleting"
+ unless $suyb;
+ delete $sg->{members}{$i};
+ }
+ }
+ }
+}
+
+# --- Remove entries which are only in the shadow file ---
+
+if ($gshadow) {
+ for $sg (values %sgbynam) {
+ $gnam = $sg->{name};
+ unless (exists($gbynam{$gnam})) {
+ moan "group $gnam only in shadow group file: deleting"
+ unless $suyb;
+ delete $sgbynam{$gnam};
+ }
+ }
+}
+
+# --- Fix up the data blocks ---
+
+for $g (values %gbynam) {
+ $g->{data}[3] = join(",", sort uidsort keys %{$g->{members}});
+}
+
+if ($gshadow) {
+ for $sg (values %sgbynam) {
+ $sg->{data}[3] = join(",", sort uidsort keys %{$sg->{members}});
+ }
+}
+
+# --- Output the finished work of art ---
+
+$pw = lockfile($passwd, 0644);
+for $unam (sort uidsort keys %ubynam) {
+ $pw->print(join(":", @{$ubynam{$unam}{data}}), "\n");
+}
+unlockfile($passwd, $pw);
+
+if ($shadow) {
+ $spw = lockfile($shadow, 0640);
+ for $unam (sort uidsort keys %subynam) {
+ $spw->print(join(":", @{$subynam{$unam}{data}}), "\n");
+ }
+ unlockfile($shadow, $spw);
+}
+
+$gr = lockfile($group, 0644);
+for $gnam (sort gidsort keys %gbynam) {
+ $gr->print(join(":", @{$gbynam{$gnam}{data}}), "\n");
+}
+unlockfile($group, $gr);
+
+if ($gshadow) {
+ $sgr = lockfile($gshadow, 0640);
+ for $gnam (sort gidsort keys %sgbynam) {
+ $sgr->print(join(":", @{$sgbynam{$gnam}{data}}), "\n");
+ }
+ unlockfile($gshadow, $sgr);
+}
+
+#----- More subroutines -----------------------------------------------------
+
+sub udump {
+ my $u = shift;
+ printf "name = %s\n", $u->{name};
+ printf "uid = %d, gid = %d\n", $u->{uid}, $u->{gid};
+ printf "data = %s\n", join(":", @{$u->{data}});
+ print "\n";
+}
+
+sub sudump {
+ my $u = shift;
+ printf "name = %s\n", $u->{name};
+ printf "data = %s\n", join(":", @{$u->{data}});
+ print "\n";
+}
+
+sub gdump {
+ my $g = shift;
+ printf "name = %s\n", $g->{name};
+ printf "gid = %d\n", $g->{gid};
+ printf "members = %s\n", join(",", sort uidsort keys %{$g->{members}});
+ printf "data = %s\n", join(":", @{$g->{data}});
+ print "\n";
+}
+
+sub sgdump {
+ my $g = shift;
+ printf "name = %s\n", $g->{name};
+ printf "members = %s\n", join(",", sort uidsort keys %{$g->{members}});
+ printf "data = %s\n", join(":", @{$g->{data}});
+ print "\n";
+}
+
+#----- That's all, folks ----------------------------------------------------