module Mail::Ezmlm::GpgEzmlm:

* added custom conversion script to remove dependency on a patch gpg-ezmlm
* fix various minor problems
This commit is contained in:
lars 2008-09-27 23:33:22 +00:00
parent 7479782d18
commit 28cbeae46b

View file

@ -29,13 +29,12 @@ use strict;
use warnings; use warnings;
use diagnostics; use diagnostics;
use vars qw($GPG_EZMLM_BASE $VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($GPG_EZMLM_BASE $VERSION @ISA @EXPORT @EXPORT_OK);
use vars qw(@GPG_LIST_OPTIONS);
use Carp; use Carp;
use Mail::Ezmlm; use Mail::Ezmlm;
# this package inherits object methods from Mail::Ezmlm # this package inherits object methods from Mail::Ezmlm
@ISA = qw("Mail::Ezmlm"); @ISA = qw(Mail::Ezmlm);
$VERSION = '0.1'; $VERSION = '0.1';
@ -64,7 +63,7 @@ The Mail::Ezmlm::GpgEzmlm class is inherited from the Mail::Ezmlm class.
=cut =cut
# == Begin site dependant variables == # == Begin site dependant variables ==
$GPG_EZMLM_BASE = '/usr/local/bin/gpg-ezmlm'; # Autoinserted by Makefile.PL $GPG_EZMLM_BASE = '/usr/bin'; # Autoinserted by Makefile.PL
# == clean up the path for taint checking == # == clean up the path for taint checking ==
local $ENV{PATH}; local $ENV{PATH};
@ -75,16 +74,6 @@ delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
# == define the available (supported) GPG_LIST_OPTIONS ==
@GPG_LIST_OPTIONS = (
"RequireSub",
"requireSigs",
"NokeyNocrypt",
"signMessages",
"encryptToAll",
"VerifiedKeyReq",
"allowKeySubmission");
# == Initialiser - Returns a reference to the object == # == Initialiser - Returns a reference to the object ==
@ -104,6 +93,16 @@ sub new {
# call the previous initialization function # call the previous initialization function
my $self = $class->SUPER::new($list_dir); my $self = $class->SUPER::new($list_dir);
bless $self, ref $class || $class || 'Mail::Ezmlm::GpgEzmlm'; bless $self, ref $class || $class || 'Mail::Ezmlm::GpgEzmlm';
# define the available (supported) options for gpg-ezmlm ==
@{$self->{SUPPORTED_OPTIONS}} = (
"KeyDir",
"RequireSub",
"RequireSigs",
"NoKeyNoCrypt",
"SignMessages",
"EncryptToAll",
"VerifiedKeyReq",
"AllowKeySubmission");
# check if the mailing is encrypted # check if the mailing is encrypted
if (_is_encrypted($list_dir)) { if (_is_encrypted($list_dir)) {
return $self; return $self;
@ -128,38 +127,159 @@ Otherwise it returns undef.
=cut =cut
sub convert_to_encrypted { sub convert_to_encrypted {
my $class = shift;
my $list_dir = shift; my $list_dir = shift;
my $dot_loc; my ($dot_loc, $backup_dir, $dot_prefix);
unless (defined($list_dir)) { # untaint "list_dir"
warn 'must define directory in convert_to_encrypted()'; $list_dir =~ m/^([\w\d\_\-\.\@ \/]+)$/;
return undef; if (defined($1)) {
} $list_dir = $1;
# does the list directory exist? } else {
unless (-d $list_dir) { warn "List directory contains invalid characters!";
warn 'directory does not exist: ' . $list_dir;
return undef;
}
# try to access the list as an encryted one (this should fail)
if (Mail::Ezmlm::GpgEzmlm->new($list_dir)) {
warn 'list is already encrypted: ' . $list_dir;
return undef; return undef;
} }
# retrieve location of dotqmail-files # retrieve location of dotqmail-files
$dot_loc = _get_dotqmail_location($list_dir); $dot_loc = _get_dotqmail_location($list_dir);
# untaint "dot_loc"
$dot_loc =~ m/^([\w\d\_\-\.\@ \/]+)$/;
if (defined($1)) {
$dot_loc = $1;
} else {
warn "Directory name of dotqmail files contains invalid characters!";
return undef;
}
# the backup directory will contain the old config file and the dotqmails
$backup_dir = $list_dir . '/gpg-ezmlm.bak';
if ((! -e $backup_dir) && (!mkdir($backup_dir))) {
warn "failed to create gpg-ezmlm conversion backup dir: $backup_dir";
return undef;
}
# the "dot_prefix" is the basename of the main dotqmail file
# (e.g. '.qmail-list-foo')
$dot_loc =~ m/\/([^\/]+)$/;
if (defined($1)) {
$dot_prefix = $1;
} else {
warn 'invalid location of dotqmail file: ' . $dot_loc;
return undef;
}
# check the input
unless (defined($list_dir)) {
warn 'must define directory in convert_to_encrypted()';
return undef;
}
# does the list directory exist?
unless (-d $list_dir) {
warn 'directory does not exist: ' . $list_dir;
return undef;
}
# try to access the list as an encryted one (this should fail)
if (Mail::Ezmlm::GpgEzmlm->new($list_dir)) {
warn 'list is already encrypted: ' . $list_dir;
return undef;
}
unless (defined($dot_loc) && ($dot_loc ne '') && (-e $dot_loc)) { unless (defined($dot_loc) && ($dot_loc ne '') && (-e $dot_loc)) {
warn 'dotqmail files not found: ' . $dot_loc; warn 'dotqmail files not found: ' . $dot_loc;
return undef; return undef;
} }
# TODO: use a custom conversion script
unless (system("$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl", "--quiet", "--skip-keygen", $list_dir, $dot_loc) == 0) { # here starts the real conversion - the code is based on
# "gpg-ezmlm-convert.pl" - see http://www.synacklabs.net/projects/crypt-ml/
# move the base dotqmail file
if (open(DOT_NEW, ">$backup_dir/$dot_prefix.new")) {
if (open(DOT_ORIG, "<$dot_loc")) {
while (<DOT_ORIG>) {
my $line = $_;
print DOT_NEW ($line =~ /ezmlm-send\s+(\S+)/)
? "\|$GPG_EZMLM_BASE/gpg-ezmlm-send.pl $1\n"
: $line;
}
close DOT_ORIG;
} else {
warn "failed to open base dotqmail file: $dot_loc";
return undef;
}
close DOT_NEW;
} else {
warn "failed to create new base dotqmail file: "
. "$backup_dir/$dot_prefix.new";
return undef; return undef;
} }
return Mail::Ezmlm::GpgEzmlm->new($list_dir); # move the "-default" dotqmail file
if (open(DEFAULT_NEW, ">$backup_dir/$dot_prefix-default.new")) {
if (open(DEFAULT_ORIG, "<$dot_loc-default")) {
while (<DEFAULT_ORIG>) {
my $line = $_;
print DEFAULT_NEW ($line =~ /ezmlm-manage\s+(\S+)/)
? "\|$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl $1\n"
: $line;
}
close DEFAULT_ORIG;
} else {
warn "failed to open default dotqmail file: $dot_loc-default";
return undef;
}
close DEFAULT_NEW;
} else {
warn "failed to create new default dotqmail file: "
. "$backup_dir/$dot_prefix-default.new";
return undef;
}
# create the new config file
if (open(CONFIG_NEW, ">$backup_dir/config.new")) {
# just create the empty file (default)
close CONFIG_NEW;
} else {
warn "failed to create new config file: $backup_dir/config.new";
return undef;
}
# create the (empty) gnupg keyring directory - this enables the keyring
# management interface
unless (mkdir("$list_dir/.gnupg", 0700)) {
warn "failed to create the gnupg keyring directory: $!";
return undef;
}
# move the original config file (if it exists) to the backup directory
if ((-e "$list_dir/config")
&& (!rename("$list_dir/config", "$backup_dir/config"))) {
warn "failed to backup the original config file "
. "'$list_dir/config' to '$backup_dir/config': $!";
return undef;
}
# replace the config file with the new empty one
unless (rename("$backup_dir/config.new", "$list_dir/config")) {
warn "failed to move the new config file '$backup_dir/config.new'"
. " to '$list_dir/config': $!";
return undef;
}
# move the original files to the backup and the new files back
unless ((rename($dot_loc, "$backup_dir/$dot_prefix"))
&& (rename("$backup_dir/$dot_prefix.new", $dot_loc))
&& (rename("$dot_loc-default", "$backup_dir/$dot_prefix-default"))
&& (rename("$backup_dir/$dot_prefix-default.new",
"$dot_loc-default"))) {
warn "failed to move dotqmail files for gpg-ezmlm: $!";
return undef;
}
return $class->new($list_dir);
} }
# == convert an encrypted list back to plaintext == # == convert an encrypted list back to plaintext ==
@ -177,7 +297,7 @@ sub convert_to_plaintext {
my $self = shift; my $self = shift;
my ($dot_loc, $list_dir); my ($dot_loc, $list_dir);
$list_dir = $self->{'LIST_DIR'}; $list_dir = $self->thislist();
# check if a directory was given # check if a directory was given
unless (defined($list_dir)) { unless (defined($list_dir)) {
$self->_seterror(-1, 'must define directory in convert_to_plaintext()'); $self->_seterror(-1, 'must define directory in convert_to_plaintext()');
@ -203,6 +323,7 @@ sub convert_to_plaintext {
return undef; return undef;
} }
# TODO: implement the custom backward conversion
if (system("$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl", "--quiet", "--revert", $list_dir, $dot_loc) != 0) { if (system("$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl", "--quiet", "--revert", $list_dir, $dot_loc) != 0) {
$self->_seterror($?, "failed to undo list encryption: " . $list_dir); $self->_seterror($?, "failed to undo list encryption: " . $list_dir);
return undef; return undef;
@ -222,27 +343,47 @@ sub convert_to_plaintext {
=cut =cut
sub update { sub update {
my ($self, %switches) = @_; my @params = @_;
my (%ok_switches, $one_key); my $self = shift(@params);
my (%switches, %ok_switches, $one_key, @delete_switches);
if (scalar @params > 1) {
%switches = @params;
} else {
my $plaintext_switches = shift(@params);
# only do the "default" configuration of an ezmlm list
return $self->SUPER::update($plaintext_switches);
}
# we continue with the encryption settings
# check for important files: 'config' # check for important files: 'config'
unless (_is_encrypted($self->{'LIST_DIR'})) { unless (_is_encrypted($self->thislist())) {
$self->_seterror(-1, "Update failed: '" . $self->{'LIST_DIR'} $self->_seterror(-1, "Update failed: '" . $self->thislist()
. "' does not appear to be a valid list"); . "' does not appear to be a valid list");
return undef; return undef;
} }
@delete_switches = ();
# check if all supplied settings are supported # check if all supplied settings are supported
# btw we change the case (upper/lower) of the setting to the default one # btw we change the case (upper/lower) of the setting to the default one
foreach $one_key (keys %switches) { foreach $one_key (keys %switches) {
my $ok_key; my $ok_key;
foreach $ok_key (@GPG_LIST_OPTIONS) { foreach $ok_key (@{$self->{SUPPORTED_OPTIONS}}) {
# check the key case-insensitively
if ($ok_key =~ /^$one_key$/i) { if ($ok_key =~ /^$one_key$/i) {
$ok_switches{$ok_key} = $switches{$one_key}; $ok_switches{$ok_key} = $switches{$one_key};
push @delete_switches, $one_key;
}
}
}
# remove all keys, that were accepted above
# we could not do it before, since this could cause issues with the current
# "foreach" looping through the hash
foreach $one_key (@delete_switches) {
delete $switches{$one_key}; delete $switches{$one_key};
} }
}
}
# %switches should be empty now # %switches should be empty now
if (%switches) { if (%switches) {
foreach $one_key (keys %switches) { foreach $one_key (keys %switches) {
@ -251,8 +392,8 @@ sub update {
} }
my $errorstring; my $errorstring;
my $config_file_old = "$self->{'LIST_DIR'}/config"; my $config_file_old = $self->thislist() . "/config";
my $config_file_new = "$self->{'LIST_DIR'}/config.new"; my $config_file_new = $self->thislist() . "/config.new";
if (open(CONFIG_OLD, "<$config_file_old")) { if (open(CONFIG_OLD, "<$config_file_old")) {
if (open(CONFIG_NEW, ">$config_file_new")) { if (open(CONFIG_NEW, ">$config_file_new")) {
my ($in_line, $one_opt, $one_val, $new_setting); my ($in_line, $one_opt, $one_val, $new_setting);
@ -324,14 +465,20 @@ sub getconfig {
my ($self) = @_; my ($self) = @_;
my (%options, $list_dir); my (%options, $list_dir);
# return the "normal" list configuration when asked for a string
return $self->SUPER::getconfig() unless (wantarray);
# continue with retrieving the encryption configuration
# define defaults # define defaults
$options{signMessages} = 1; $options{KeyDir} = '';
$options{NokeyNocrypt} = 0; $options{SignMessages} = 1;
$options{allowKeySubmission} = 1; $options{NoKeyNoCrypt} = 0;
$options{encryptToAll} = 0; $options{AllowKeySubmission} = 1;
$options{EncryptToAll} = 0;
$options{VerifiedKeyReq} = 0; $options{VerifiedKeyReq} = 0;
$options{RequireSub} = 0; $options{RequireSub} = 0;
$options{requireSigs} = 0; $options{RequireSigs} = 0;
# Read the config file # Read the config file
@ -343,7 +490,7 @@ sub getconfig {
my $optname = $1; my $optname = $1;
my $optvalue = $2; my $optvalue = $2;
my $one_opt; my $one_opt;
foreach $one_opt (@GPG_LIST_OPTIONS) { foreach $one_opt (@{$self->{SUPPORTED_OPTIONS}}) {
if ($one_opt =~ m/^$optname$/i) { if ($one_opt =~ m/^$optname$/i) {
if ($optvalue =~ /^yes$/i) { if ($optvalue =~ /^yes$/i) {
$options{$one_opt} = 1; $options{$one_opt} = 1;
@ -406,6 +553,7 @@ sub _is_encrypted {
if ($plain_list) { if ($plain_list) {
if (-e "$list_dir/config") { if (-e "$list_dir/config") {
my $content = $plain_list->getpart("config"); my $content = $plain_list->getpart("config");
$content = '' unless defined($content);
# return false if we encounter the usual ezmlm-idx-v0.4-header # return false if we encounter the usual ezmlm-idx-v0.4-header
if ($content =~ /^F:/m) { if ($content =~ /^F:/m) {
# this is a plaintext ezmlm-idx v0.4 mailing list # this is a plaintext ezmlm-idx v0.4 mailing list