#!/usr/bin/perl

# Copyright (C) 2008  Nick Urbanik <nicku@nicku.org>

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use warnings;
use strict;

use Getopt::Long;
use Crypt::PasswdMD5;
use POSIX;
use Carp;
use Net::FTP;

# Set configuration defaults here:
my $list = 'camwest-discuss';
my $list_dir='/var/lib/mailman/lists';
# Can also override them with command line options.

my $force;
my $ftp_dest;
my $ftp_dir;
my $ftp_user;
my $ftp_pw;

( my $prog = $0 ) =~ s{.*/}{};
my $logfile = "/tmp/$prog-" . POSIX::strftime( '%Y%m%d', localtime ) . '.log';
open my $log, '>>', $logfile or die "cannot open $logfile: $!";

sub note {
    my @msg = @_;
    $msg[ -1 ] =~ s{[\n\r ]*$}{};
    #my $timestamp = localtime;
    my $timestamp_pid = POSIX::strftime "%y/%m/%d %X \[$$]: ", localtime;
    $msg[ 0 ] = "$timestamp_pid$msg[ 0 ]";
    s{[\n\r]}{\n$timestamp_pid}msg foreach @msg;
    print $log @msg, "\n" or die "Cannot write @msg to log: $!";
    print @msg, "\n" or die "Cannot write @msg to stdout: $!";
}

$SIG{__WARN__} = sub {
    note "WARNING:\n", Carp::longmess, @_;
    warn @_;
};

$SIG{__DIE__} = sub {
    note "TERMINATING:\n", Carp::longmess, @_;
    die @_;
};

sub usage {
    print <<END_USAGE;
$prog [--list=LIST] [--list-dir=DIR] [--help] [--force] [--debug]
   [--ftp-dest=SERVER --ftp-dir=FTPDIR --ftp-user=USER --ftp-pw=PASSWD]

Reads the usernames (email addresses) and passwords from the mailman
configuration for LIST, create an MD5 hashed salted password for
use with Apache.  The aim is to use the same usernames and passwords
maintained by Mailman to provide access to a web site.

Defaults:
LIST: $list
DIR:  $list_dir
Provide --ftp-dest=SERVER and --ftp-dir=FTPDIR ftp parameters if provide any.

If these ftp parameters are provided, will attempt to send the htpasswd
file to that server and directory.

Uses Net::FTP, which can use Net::Netrc to read ~/.netrc if it exists.

Logs to file /tmp/$prog-yyyymmdd.log
END_USAGE
    exit 1;
}

my $debug;
GetOptions (
    'list=s'     => \$list,
    'list-dir=s' => \$list_dir,
    force        => \$force,
    'debug+'     => \$debug,
    'ftp-dest=s' => \$ftp_dest,
    'ftp-dir=s'  => \$ftp_dir,
    'ftp-user=s' => \$ftp_user,
    'ftp-pw=s'   => \$ftp_pw,
    help         => sub { usage },
) or usage;

warn "Need all ftp server and directory  parameters if provide any" and usage
    if ( $ftp_dir or $ftp_dest ) and not ( $ftp_dir and $ftp_dest );

opendir my $listdir_dh, $list_dir or die "Cannot Open $list_dir: $!";
my @lists = grep {
    $_ ne q{.} and $_ ne q{..} and $_ ne 'mailman'
} readdir $listdir_dh;
closedir $listdir_dh or die "Cannot close $list_dir: $!";

die "Cannot find list '$list' here\n" unless grep { $_ eq $list } @lists;

my $config = "$list_dir/$list/config.pck";

my $htpasswdfile = "/etc/mailman/htpasswd.$list";

if ( -f $htpasswdfile and -M _ < -M $config ) {
    note "'$htpasswdfile' exists and is newer than '$config'; nothing to do\n";
    exit 0;
}

my $mm_home = ( getpwnam( q{mailman} ) )[7]
    or die "Cannot identify mailman home\n";

# First read the email addresses of members of $list:
open my $config_fh, '-|', "$mm_home/bin/list_members $list"
    or die "Cannot fork $mm_home/bin/list_members $list: $!";
chomp( my @members = <$config_fh> );
my %member = map { $_ => 1 } @members;
close $config_fh or die "Cannot wait for $mm_home/bin/list_members $list: $!";

note "@lists\n" if $debug;

note "@members\n" if $debug;

open my $dumpcfg_fh, '-|', "$mm_home/bin/dumpdb $config"
    or die "Cannot fork $mm_home/bin/dumpdb $config: $!";
open my $htpw_fh, '>', $htpasswdfile or die "Cannot open '$htpasswdfile': $!";

my $found_pw;
my $done;
CFG_LINE:
while ( <$dumpcfg_fh> ) {
    next CFG_LINE if $done;
    if ( s{'passwords': \s+ \{ }{}xms ) {
	$found_pw = 1;
    }
    next CFG_LINE unless $found_pw;
    if ( m{^ \s* '([^']+)': \s '([^']+)' \s* (\}?,) \s* $}xms ) {
	my ( $user, $pass, $end ) = ( $1, $2, $3 );
	if ( ! exists $member{$user} ) {
	    warn "Have USER='$user' PASS='$pass' END='$end' matching no user\n";
	    next CFG_LINE;
	}
	if ( ++$member{$user} != 2 ) {
	    warn "Found '$user' a second time!\n";
	    last CFG_LINE;
	}

	my $passwd = apache_md5_crypt( $pass );
	print $htpw_fh "$user:$passwd\n";
	$done = 1 if $end =~ /\}/;
    }
}
close $dumpcfg_fh or die "Cannot wait for $mm_home/bin/dumpdb $config: $!";
close $htpw_fh or die "Cannot close '$htpasswdfile': $!";

note "Found @{[scalar keys %member]} users in $list\n";

my @anyleft = grep { $member{$_} != 2 } keys %member;
if ( @anyleft ) {
    warn "Found user without a password: '",
	join( q{', '}, @anyleft ), "'\n";
}

if ( $ftp_dest ) {
    my $ftp = Net::FTP->new( $ftp_dest )
	or die "Cannot connect to '$ftp_dest': $@";
    $ftp->login( $ftp_user, $ftp_pw ) or die "Cannot login ", $ftp->message;
    $ftp->cwd( $ftp_dir )
	or die "Cannot chdir to '$ftp_dir' ", $ftp->message;
    $ftp->put( $htpasswdfile )
	or die "Cannot put $htpasswdfile ", $ftp->message;
    note "Successfully sent $htpasswdfile to ftp://$ftp_dest/$ftp_dir/";
    $ftp->quit;
}

note "Finished this run of $prog";
close $log or die "Cannot close $logfile: $!";
exit 0;