diff options
Diffstat (limited to 'misc/mklist')
| -rw-r--r-- | misc/mklist/config | 20 | ||||
| -rwxr-xr-x | misc/mklist/mklist.pl | 232 |
2 files changed, 252 insertions, 0 deletions
diff --git a/misc/mklist/config b/misc/mklist/config new file mode 100644 index 0000000..e913ecd --- /dev/null +++ b/misc/mklist/config @@ -0,0 +1,20 @@ +# A comma-separated list of public keys that are allowed to ask for +# a list creation. (Note: the key have to be in the user's public +# keyring.) +authorized_pubkeys = AF910D26 + +# Postfix configuration directory. +postfix_config_dir = /etc/postfix/ + +# Where to put the lookup transport tables. +#postfix_data_dir = /etc/postfix/ +postfix_data_dir = /tmp + +# The domain to be appended to *local* aliases. +mydestination = lists.fripost.org + +# LDAP configuration +ldap_uri = ldap://127.0.0.1:389 +ldap_suffix = ou=virtual,o=mailHosting,dc=fripost,dc=dev +ldap_bind_dn = cn=ListCreator,ou=services,o=mailHosting,dc=fripost,dc=dev +ldap_bind_pw = listcreator diff --git a/misc/mklist/mklist.pl b/misc/mklist/mklist.pl new file mode 100755 index 0000000..105178a --- /dev/null +++ b/misc/mklist/mklist.pl @@ -0,0 +1,232 @@ +#!/usr/bin/perl + +use 5.010_000; +use strict; +use warnings; +use utf8; + +our $VERSION = '0.01'; + +=head1 NAME + +mklist.pl - Create a new list + +=head1 SYNOPSIS + +B<mklist.pl> {B<mailman>|B<schleuder>} < email + +=cut + + +####################################################################### +# + +use Mail::GnuPG; +use MIME::Parser; +use File::Spec::Functions; +use Fcntl qw/:flock SEEK_END/; +use POSIX qw/setuid setgid/; +use Pod::Usage; +use Config::Auto; +use lib '../../../panel/lib'; +use Fripost::Schema; + +my $transport = shift; +pod2usage(2) unless defined $transport and + grep { $transport eq $_} + qw/mailman schleuder/; + use Cwd; + +my $config = Config::Auto::parse( './config', format => "equal" ); + +# Drop root privileges +unless ($<) { + chdir File::Spec::Functions::tmpdir or die "Cannot chdir: $!"; + my $user = $transport eq 'mailman' ? 'list' : + $transport eq 'schleuder' ? 'schleuder' : + die "I will not let root run this script.\n"; + my @record = getpwnam $user; + setgid($record[3]) or die "Cannot setgid: $!\n"; + setuid($record[2]) or die "Cannot setuid: $!\n"; +} +my ($list, $owner, $password); + + +####################################################################### +# +# Read the (signed) email from STDIN, and ensure that the signing key +# is authorized to create new lists. +{ + my $parser = MIME::Parser::->new; + $parser->output_to_core(1); + my $msg = $parser->parse( \*STDIN ); + + die "Error: Not a multipart/signed message.\n" + unless $msg->is_multipart and + $msg->mime_type eq 'multipart/signed' and + $msg->parts; + + my $gpg = Mail::GnuPG::->new; + die "Error: The message is not GPG/MIME signed.\n" + unless $gpg->is_signed( $msg ); + + my ($ret, $key, $addr) = $gpg->verify( $msg ); + if ($ret) { + map { print STDERR $_ } @{$gpg->{last_message}}; + exit $ret; + } + + die "Error: 0x$key ($addr) is not authorized to create lists.\n" + unless grep { $key eq $_ } + (ref $config->{authorized_pubkeys} eq 'ARRAY' ? + @{$config->{authorized_pubkeys}} : + $config->{authorized_pubkeys} + ); + + + # The first non-blank line in the email body is the list's email + # address. + my @body = grep { !/^\s*$/ } + (split /\s*\n\s*/, $msg->parts(0)->stringify_body); + $list = shift @body; + $owner = shift @body; + $password = shift @body; + # TODO: idealy the email would be encrypted (at least for schleuder), + # since it contains a password. +} +my ($l,$d) = split /\@/, $list, 2; + + +####################################################################### +# +# Ensure that the root DN has been created, otherwise doing the below is +# useless. + +{ + # It's pointless to have a global variable here, since after the list + # creation the connection may not be still alive. + my $fp = &auth(); + $fp->list->is_pending($list) + or die "Error: $list is not pending for creation.\n"; + $fp->done; +} + + +####################################################################### +# +# Create the list + +#if ($transport eq 'mailman') { +# system ( '/var/lib/mailman/bin/newlist', '-q' +# , '-u', 'smtp.fripost.org' # TODO: that should be $mydestination +# , $list +# , $owner +# , $password +# ); +# die "newlist exited with status $?\n" if $?; +#} +# +#elsif ($transport eq 'schleuder') { +# system ( '/usr/bin/schleuder-newlist' +# , $list +# , '-email', $list +# , '-realname', $l +# , '-nointeractive' +# , '-adminaddress', $owner +# , '-initmember', $owner +# , '-initmemberkey', # TODO: that needs to be a file +# ); +# die "schleuder-newlist exited with status $?\n" if $?; +# system ( '/usr/bin/ruby', '/opt/webschleuder/contrib/enable_webschleuder.rb' +# , $list +# , $password +# ); +# # TODO: try not to use the password in the command argument +# die "enable_webschleuder exited with status $?\n" if $?; +#} + +# List the commands that are to be added to the LDAP directory and the lookup table. +my @cmds = $transport eq 'mailman' ? qw/admin bounces confirm join leave owner request subscribe unsubscribe/ : + $transport eq 'schleuder' ? qw/bounce sendkey/ : + die 'Unknown transport'; + + +####################################################################### +# +# Add the LDAP commands under the list's root DN, and remove the +# 'pending' status. +{ + my $fp = &auth(); + $fp->list->add_commands($list, \@cmds); + $fp->done; +} + + +####################################################################### +# +# Create/update the Postfix lookup table. + +{ + + my $db = File::Spec::Functions::catfile( $config->{postfix_data_dir}, + 'transport_'.$transport ); + my $new = not (-e $db); + open my $fh, '>>', $db or die "Cannot open $db: $!"; + flock $fh, LOCK_EX or die "Cannot lock $db: $!"; + seek $fh, 0, SEEK_END or die "Cannot seek $db: $!"; + if ($new) { + print $fh "# Do not modify this file! Use $0 to create lists instead.\n" + or die "Cannot print: $!"; + } + + + print $fh "\n# ".$list." - ".localtime."\n"; + &print_transport($fh, undef); + foreach (@cmds) { &print_transport($fh, $_); } + + close $fh or die "Cannot close $db: $!"; + + # Compile the lookup table (Postfix takes care of the race condition here). + system ('/usr/sbin/postmap', '-c', $config->{postfix_config_dir}, $db); + die "postmap exited with status $?\n" if $?; +} + + +# Append a list command to the lookup table. +sub print_transport { + my $fh = shift; + my $cmd = shift; + my $l = $l; + $l .= '-'.$cmd if defined $cmd and $cmd ne ''; + $l .= '#'.$d if defined $d; + printf $fh "%-63s %s:\n", $l.'@'.$config->{mydestination}, $transport + or die "Cannot printf: $!"; +} + +# Authenticate +sub auth { + Fripost::Schema::->auth( undef, $config->{ldap_bind_pw} + , ldap_bind_dn => join(',',@{$config->{ldap_bind_dn}}) + , ldap_uri => $config->{ldap_uri} + , ldap_suffix => $config->{ldap_suffix} + ); +} + + +####################################################################### +# + +=head1 AUTHOR + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut |