#!/usr/bin/perl -w
#
# htpasswd_import_users:
# Import /etc/passwd users into an htpasswd file.
#
# Sadly this has to run as root (shadow passwords).
#
# Copyright (c) 2004 UK Citizens Online Democracy. All rights reserved.
# Email: chris@mysociety.org; WWW: http://www.mysociety.org/
#

my $rcsid = ''; $rcsid .= '$Id: htpasswd_import_users,v 1.10 2013-12-19 08:38:20 ian Exp $';

use strict;

use Errno;
use File::Spec;
use File::stat;
use IO::File;
use Data::Dumper;
use Getopt::Std;

sub usage () {
    print STDERR "usage: $0 [ -n <htgroup file prefix> ] <htpasswd file> <htgroup file>\n";
    print STDERR "          [ <htpasswd extras> <htgroup extras> ]\n\n";
    print STDERR "  -n creates an htpasswd file per group with the given prefix.\n";
    print STDERR "     prefix must have a trailing slash if it's a directory.\n\n";

    exit 1;
}

our ($opt_n);
getopts('n:');

usage unless (@ARGV == 4 || @ARGV == 2);

my $passwd_file = $ARGV[0];
my $group_file = $ARGV[1];
my $existing_passwd_file = $ARGV[2] || '';
my $existing_group_file = $ARGV[3] || '';

my ($wwwdata_login, $wwwdata_pass, $wwwdata_uid, $wwwdata_gid) = getpwnam('www-data');

=item create_file_to_replace FILE

Create a file to replace the named FILE. Returns in list context a handle open
on the new file, and its name.

=cut
sub create_file_to_replace ($) {
    my ($name) = @_;

    my $st = stat($name);
    my ($v, $path, $file) = File::Spec->splitpath($name);

    for (my $i = 0; $i < 10; ++$i) {
        my $n = File::Spec->catpath($v, $path, sprintf('.%s.%08x.%08x', $file, int(rand(0xffffffff)), time()));
        my $h = new IO::File($n, O_CREAT | O_EXCL | O_WRONLY, defined($st) ? $st->mode() : 0600);
        last if (!$h and !$!{EEXIST});
        chown($wwwdata_uid, $wwwdata_gid, $n);
        return ($n, $h);
    }
    die $!;
}

my ($users, $groups);

# Create new password file
my ($h, $passwd_newfile);
eval {
    ($passwd_newfile, $h) = create_file_to_replace($passwd_file);

    # Find all users who are in admin- groups
    while (@_ = getgrent()) {
        if ($_[0] =~ m/^admin-/) {
            foreach my $user (split(/,?\s+/, $_[3])) {
                @{$users->{$user}} = getpwnam($user);
                die "getpwnam('$user') failed" if (!$users->{$user});
                push @{$groups->{$_[0]}}, $user;
            }
        }
    }
    endgrent();

    # And now the additional ones
    if ($existing_passwd_file) {
        open(EXISTING_PASSWD, $existing_passwd_file) or die "$!";
        while (<EXISTING_PASSWD>) {
            chomp;
            next if /^\s?$/;
            my ($name, $passwd) = split /:/;
            die "malformed line in $existing_passwd_file" if (!$name || !$passwd);
            @{$users->{$name}} = ($name, $passwd);
        }
        close(EXISTING_PASSWD);

        open(EXISTING_GROUP, $existing_group_file) or die "$!";
        while (<EXISTING_GROUP>) {
            chomp;
            next if /^\s?$/;
            my ($group, $members) = split /: /;
            die "malformed line in $existing_group_file" if (!$group || !$members);
            foreach my $member (split /,?\s+/, $members) {
                push @{$groups->{$group}}, $member if (!grep /^$member$/, @{$groups->{$group}});
            }
        }
        close(EXISTING_GROUP);
    }

    # Write out password lines for those users
    foreach my $user (keys %$users) {
        my $name = $users->{$user}[0];
        my $passwd = $users->{$user}[1];
        next if $passwd eq '!';
        $h->printf("%s:%s\n", $name, $passwd) or die "$!";
    }

    $h->close() or die "$!";
};

if ($@) {
    unlink($passwd_newfile) if ($passwd_newfile);
    die $@;
} elsif (!rename($passwd_newfile, $passwd_file)) {
    die $!;
};

# Create new group file
my ($group_newfile);
eval {
    ($group_newfile, $h) = create_file_to_replace($group_file);

    # Write out all admin- groups in Apache's group file format
    foreach my $group (keys %$groups) {
        $h->print("$group: ");
        $h->print(join(" ", @{$groups->{$group}}));
        $h->print("\n");
    }

    $h->close() or die "$!";
};

if ($@) {
    unlink($group_newfile) if ($group_newfile);
    die $@;
} elsif (!rename($group_newfile, $group_file)) {
    die $!;
};

# Create per-group htpasswd files if -n was specified
if ($opt_n) {
    my $filename;
    my @group_files_created;
    foreach my $group (keys %$groups) {
        eval {
            $filename = $opt_n.$group;
            ($group_newfile, $h) = create_file_to_replace($filename);
            foreach my $user (@{$groups->{$group}}) {
                if (defined $users->{$user}) {
                    $h->printf("%s:%s\n", $user, $users->{$user}[1]);
                } else {
                    warn "$group: $user doesn't exist";
                }
            }
            $h->close() or die "$!";
        };

        if ($@) {
            unlink($group_newfile) if ($group_newfile);
            die $@;
        } elsif (!rename($group_newfile, $filename)) {
            die $!;
        }
    }

    # Delete obsolete per-group files
    foreach my $existing_file (glob $opt_n.'*') {
        my $group_part = $existing_file;
        $group_part =~ s/^$opt_n//;
        unlink $existing_file if (!grep /^$group_part$/, keys %$groups);
    }
}

exit(0);
