aboutsummaryrefslogtreecommitdiffstats
path: root/misc
diff options
context:
space:
mode:
Diffstat (limited to 'misc')
-rw-r--r--misc/mklist/config20
-rwxr-xr-xmisc/mklist/mklist.pl232
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