#!/usr/bin/perl -w
#
# $Id: groupmembers.redhat,v 1.2 2006/06/01 04:26:12 jmates Exp $
#
# The author disclaims all copyrights and releases this script into the
# public domain.
#
# Manages /etc/groups file. Written for RedHat Linux, though should be
# portable to other operating systems that share the same standard Unix
# groups file format.

use strict;

# group members must match the following
my $group_re = qr/[A-Za-z0-9]+/;

# RedHat uses 'x' where others use '*' for group password field...
my $group_pass = 'x';

use File::Basename qw(basename);
my $basename = basename $0;

my $groupname = shift;
print_help() unless @ARGV;

unless ( $groupname =~ m/$group_re/ ) {
  remark( 'error', 'group fails regex check', { name => $groupname } );
  exit 101;
}

# parse out valid groups from command line
my ( %seen_members, @new_members );
for my $entry (@ARGV) {
  for my $member ( $entry =~ m/($group_re)/g ) {
    next if exists $seen_members{$member};
    $seen_members{$member}++;
    push @new_members, $member;
  }
}

my $groups = parse_group("/etc/group");

# only modify existing groups
unless ( exists $groups->{$groupname} ) {
  remark( 'notice', 'no such group', { name => $groupname } );
  exit;
}

$groups->{$groupname}->{members} = \@new_members;

# TODO memory costly, probably could write out to temp file on fly then
# do the rename
my @newgroup;
for my $group (
  sort { $groups->{$a}->{id} <=> $groups->{$b}->{id} }
  keys %$groups
 ) {
  my $groupref = $groups->{$group};

  push @newgroup,
   join( ':',
    $groupref->{name}, $group_pass, $groupref->{id},
    join( ',', sort @{ $groupref->{members} } ) );
}
write_file( "/etc/group", \@newgroup );
chmod 0444, "/etc/group";

exit;

sub parse_group {
  my $file = shift;
  unless ( open FILE, "< $file" ) {
    remark( 'error', 'could not open file', { file => $file, errno => $! } );
    exit 102;
  }
  my %groups;
  while (<FILE>) {
    next if m/^#/;  # OS X has leading comments in groups file...
    chomp;

    my %group;
    ( @group{qw(name passwd id)}, my $users ) = split /:/, $_, 4;
    $users ||= '';
    $group{members} = [ split ',', $users ];

    unless ( exists $group{name}
      and defined $group{name}
      and exists $group{id}
      and defined $group{id} ) {
      remark(
        'warning',
        'skipping invalid group entry',
        { file => $file, line => $. }
      );
      next;
    }

    if ( exists $groups{ $group{name} } ) {
      remark( 'warning', 'skipping duplicate group', { name => $group{name} } );
      next;
    }
    $groups{ $group{name} } = \%group;
  }
  return \%groups;
}

sub write_file {
  my $file = shift;
  my $ref  = shift;

  # write to temporary file, then rename onto requested file
  unless ( open FILE, "> $file.$basename" ) {
    remark(
      'error',
      'could not open for writing',
      { file => "$file.$basename", errno => $! }
    );
  } else {
    if ( ref $ref eq 'ARRAY' ) {
      print FILE "$_\n" for @$ref;
    } elsif ( ref $ref eq 'HASH' ) {
      print FILE "$_\n" for sort keys %$ref
    }
    close FILE
     or
     remark( 'error', 'problem writing file', { file => $file, errno => $! } );

    rename "$file.$basename", $file
     or remark(
      'warning',
      'problem renaming file',
      { file => $file, errno => $! }
     );
  }
}

sub remark {
  my $priority   = shift;
  my $message    = shift;
  my $attributes = shift;

  # KLUGE skip info logs
  #return 1 if $priority eq 'info';

  chomp $message;

  my $attr_str;
  if ($attributes) {
    $attr_str = join ', ',
     map { $attributes->{$_} ||= ''; "$_=$attributes->{$_}" }
     sort keys %$attributes;
  }

  print STDERR "$priority: $message"
   . ( $attr_str ? ": $attr_str" : '' ) . "\n";
  return 1;
}