ezmlm-web/ezmlm-web-modules
3
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

r424@erker: lars | 2008-09-28 23:38:45 +0200

Browse source 
module Mail::Ezmlm::GpgEzmlm:
 * simplified code for config file handling
 * added "cleanup" of dotqmail files
 * added wrapper around ezmlm-make (update)
This commit is contained in:
lars 2008-09-29 20:45:06 +00:00
parent 71edc021ff
commit 5bcdb2799c
1 changed files with 279 additions and 159 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

438
Ezmlm/trunk/GpgEzmlm.pm
View file

@ -30,7 +30,6 @@ 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 File::Copy; use File::Copy;
use File::Path;
use Carp; use Carp;
use Mail::Ezmlm; use Mail::Ezmlm;
@ -136,66 +135,40 @@ Otherwise it returns undef.
sub convert_to_encrypted { sub convert_to_encrypted {
my $class = shift; my $class = shift;
my $list_dir = shift; my $list_dir = shift;
my ($dot_loc, $backup_dir, $dot_prefix); my ($backup_dir);
# untaint "list_dir" # untaint "list_dir"
$list_dir =~ m/^([\w\d\_\-\.\@ \/]+)$/; $list_dir =~ m/^([\w\d\_\-\.\@ \/]+)$/;
if (defined($1)) { if (defined($1)) {
$list_dir = $1; $list_dir = $1;
} else { } else {
warn "List directory contains invalid characters!"; warn "[GpgEzmlm] list directory contains invalid characters!";
return undef;
}
# retrieve location of dotqmail-files
$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; return undef;
} }
# the backup directory will contain the old config file and the dotqmails # the backup directory will contain the old config file and the dotqmails
$backup_dir = $list_dir . '/.gpg-ezmlm.backup'; $backup_dir = _get_config_backup_dir($list_dir);
if ((! -e $backup_dir) && (!mkdir($backup_dir))) { if ((! -e $backup_dir) && (!mkdir($backup_dir))) {
warn "failed to create gpg-ezmlm conversion backup dir: $backup_dir"; warn "[GpgEzmlm] failed to create gpg-ezmlm conversion backup dir ("
return undef; . "$backup_dir): $!";
}
# 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; return undef;
} }
# check the input # check the input
unless (defined($list_dir)) { unless (defined($list_dir)) {
warn 'must define directory in convert_to_encrypted()'; warn '[GpgEzmlm] must define directory in convert_to_encrypted()';
return undef; return undef;
} }
# does the list directory exist? # does the list directory exist?
unless (-d $list_dir) { unless (-d $list_dir) {
warn 'directory does not exist: ' . $list_dir; warn '[GpgEzmlm] directory does not exist: ' . $list_dir;
return undef; return undef;
} }
# try to access the list as an encryted one (this should fail) # the list should currently _not_ be encrypted
if (Mail::Ezmlm::GpgEzmlm->new($list_dir)) { if (_is_encrypted($list_dir)) {
warn 'list is already encrypted: ' . $list_dir; warn '[GpgEzmlm] list is already encrypted: ' . $list_dir;
return undef;
}
unless (defined($dot_loc) && ($dot_loc ne '') && (-e $dot_loc)) {
warn 'dotqmail files not found: ' . $dot_loc;
return undef; return undef;
} }
@ -203,90 +176,32 @@ sub convert_to_encrypted {
# here starts the real conversion - the code is based on # here starts the real conversion - the code is based on
# "gpg-ezmlm-convert.pl" - see http://www.synacklabs.net/projects/crypt-ml/ # "gpg-ezmlm-convert.pl" - see http://www.synacklabs.net/projects/crypt-ml/
# move the base dotqmail file # update the dotqmail files
if (open(DOT_NEW, ">$backup_dir/$dot_prefix.new")) { return undef unless (_cleanup_dotqmail_files($list_dir, $backup_dir));
if (open(DOT_ORIG, "<$dot_loc")) {
while (<DOT_ORIG>) { # create the new config file, if it did not exist before
my $line = $_; unless (-e "$backup_dir/config.gpg-ezmlm") {
print DOT_NEW ($line =~ /ezmlm-send\s+(\S+)/) if (open(CONFIG_NEW, ">$backup_dir/config.gpg-ezmlm")) {
? "\|$GPG_EZMLM_BASE/gpg-ezmlm-send.pl $1\n" # just create the empty file (default)
: $line; close CONFIG_NEW;
}
close DOT_ORIG;
} else { } else {
warn "failed to open base dotqmail file: $dot_loc"; warn "[GpgEzmlm] failed to create new config file ("
. "$backup_dir/config.gpg-ezmlm): $!";
return undef; return undef;
} }
close DOT_NEW;
} else {
warn "failed to create new base dotqmail file: "
. "$backup_dir/$dot_prefix.new";
return undef;
} }
# move the "-default" dotqmail file return undef unless (&_enable_encryption_config_file($list_dir));
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 # create the (empty) gnupg keyring directory - this enables the keyring
# management interface. Don't create it, if it already exists. # management interface. Don't create it, if it already exists.
if ((!-e "$list_dir/.gnupg") && (!mkdir("$list_dir/.gnupg", 0700))) { if ((!-e "$list_dir/.gnupg") && (!mkdir("$list_dir/.gnupg", 0700))) {
warn "failed to create the gnupg keyring directory: $!"; warn "[GpgEzmlm] failed to create the gnupg keyring directory: $!";
return undef; return undef;
} }
my $result = $class->new($list_dir);
# move the original config file (if it exists) to the backup directory return $result;
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 ==
@ -348,7 +263,7 @@ sub convert_to_plaintext {
# the backup directory should contain the old config file (if it existed) # the backup directory should contain the old config file (if it existed)
# and the original dotqmail files # and the original dotqmail files
$backup_dir = $list_dir . '/.gpg-ezmlm.backup'; $backup_dir = _get_config_backup_dir($self->thislist());
unless (-r $backup_dir) { unless (-r $backup_dir) {
warn "[GpgEzmlm] failed to revert conversion - the backup directory " warn "[GpgEzmlm] failed to revert conversion - the backup directory "
. "is missing: $backup_dir"; . "is missing: $backup_dir";
@ -361,7 +276,7 @@ sub convert_to_plaintext {
if (defined($1)) { if (defined($1)) {
$dot_prefix = $1; $dot_prefix = $1;
} else { } else {
warn 'invalid location of dotqmail file: ' . $dot_loc; warn '[GpgEzmlm] invalid location of dotqmail file: ' . $dot_loc;
return undef; return undef;
} }
@ -374,22 +289,9 @@ sub convert_to_plaintext {
# start reverting the gpg-ezmlm conversion: # start reverting the gpg-ezmlm conversion:
# - restore old dotqmail files # - restore old dotqmail files
# - restore old config file (if it existed before) # - restore old config file (if it existed before)
# replace the config file with the original one (if it exists) # restore original config file (if it exists)
if (-e "$backup_dir/config") { &_enable_plaintext_config_file($list_dir);
unless (File::Copy::copy("$backup_dir/config", "$list_dir/config")) {
warn "[GpgEzmlm] failed to restore the original config file '"
. "$backup_dir/config' to '$list_dir/config': $!";
return undef;
}
} else {
unless (unlink("$list_dir/config")) {
warn "[GpgEzmlm] failed to remove the gpg-ezmlm config file ('"
. "$list_dir/config'): $!";
return undef;
}
}
# replace the dotqmail files with the ones from the backup # replace the dotqmail files with the ones from the backup
unless ((File::Copy::copy("$backup_dir/$dot_prefix", "$dot_loc")) unless ((File::Copy::copy("$backup_dir/$dot_prefix", "$dot_loc"))
@ -399,40 +301,50 @@ sub convert_to_plaintext {
return undef; return undef;
} }
# remove the original directory
unless (File::Path::rmtree($backup_dir)) {
warn "[GpgEzmlm] failed to remove configuration backup directory ('"
. $backup_dir . "'): $!";
# just warn - don't fail
}
$self = Mail::Ezmlm->new($list_dir); $self = Mail::Ezmlm->new($list_dir);
return $self; return $self;
} }
# == Update the current list == # == Update the "normal" settings of the current list ==
=head2 Updating the configuration of the current list: =head2 Updating the common configuration settings of the current list:
$list->update({ 'allowKeySubmission' => 1 }); $list->update("moUx");
=cut =cut
# update the "normal" (=not related to encryption) settings of the list
sub update { sub update {
my @params = @_; my $self = shift;
my $self = shift(@params); my $options = shift;
my (%switches, %ok_switches, $one_key, @delete_switches);
if (scalar @params > 1) { my ($result);
%switches = @params;
} else {
my $plaintext_switches = shift(@params); &_enable_plaintext_config_file($self->thislist());
# only do the "default" configuration of an ezmlm list $result = $self->SUPER::update($options);
return $self->SUPER::update($plaintext_switches); &_enable_encryption_config_file($self->thislist());
} # "repair" the dotqmail files
&_cleanup_dotqmail_files($self->thislist());
# the normal configuration via "ezmlm-make" may not happen, since
# this would overwrite the dotqmail files. Thus we just do nothing.
return $result;
}
# == Update the encryption settings of the current list ==
=head2 Updating the configuration of the current list:
$list->update_special({ 'allowKeySubmission' => 1 });
=cut
# update the encryption specific settings
sub update_special {
my ($self, %switches) = @_;
my (%ok_switches, $one_key, @delete_switches);
# we continue with the encryption settings
# check for important files: 'config' # check for important files: 'config'
unless (_is_encrypted($self->thislist())) { unless (_is_encrypted($self->thislist())) {
$self->_seterror(-1, "Update failed: '" . $self->thislist() $self->_seterror(-1, "Update failed: '" . $self->thislist()
@ -463,7 +375,7 @@ sub update {
# %switches should be empty now # %switches should be empty now
if (%switches) { if (%switches) {
foreach $one_key (keys %switches) { foreach $one_key (keys %switches) {
warn "unsupported setting: $one_key"; warn "[GpgEzmlm] unsupported setting: $one_key";
} }
} }
@ -502,7 +414,7 @@ sub update {
} else { } else {
$errorstring = "failed to write to temporary config file: $config_file_new"; $errorstring = "failed to write to temporary config file: $config_file_new";
$self->_seterror(-1, $errorstring); $self->_seterror(-1, $errorstring);
warn $errorstring; warn "[GpgEzmlm] $errorstring";
close CONFIG_OLD; close CONFIG_OLD;
return (1==0); return (1==0);
} }
@ -510,7 +422,7 @@ sub update {
} else { } else {
$errorstring = "failed to read the config file: $config_file_old"; $errorstring = "failed to read the config file: $config_file_old";
$self->_seterror(-1, $errorstring); $self->_seterror(-1, $errorstring);
warn $errorstring; warn "[GpgEzmlm] $errorstring";
return (1==0); return (1==0);
} }
close CONFIG_OLD; close CONFIG_OLD;
@ -518,7 +430,7 @@ sub update {
$errorstring = "failed to move new config file ($config_file_new) " $errorstring = "failed to move new config file ($config_file_new) "
. "to original config file ($config_file_old)"; . "to original config file ($config_file_old)";
$self->_seterror(-1, $errorstring); $self->_seterror(-1, $errorstring);
warn $errorstring; warn "[GpgEzmlm] $errorstring";
return (1==0); return (1==0);
} }
$self->_seterror(undef); $self->_seterror(undef);
@ -537,13 +449,11 @@ getconfig() returns a hash including all available settings
=cut =cut
sub getconfig { # retrieve the specific configuration of the list
sub getconfig_special {
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 # continue with retrieving the encryption configuration
# define defaults # define defaults
@ -604,7 +514,7 @@ sub _get_dotqmail_location {
# the "config" file was used before ezmlm-idx v5 # the "config" file was used before ezmlm-idx v5
$dot_loc = $1 if ($plain_list->getpart("config") =~ m/^T:(.*)$/); $dot_loc = $1 if ($plain_list->getpart("config") =~ m/^T:(.*)$/);
} else { } else {
warn 'list configuration file not found: ' . $list_dir; warn '[GpgEzmlm] list configuration file not found: ' . $list_dir;
$dot_loc = undef; $dot_loc = undef;
} }
} else { } else {
@ -644,16 +554,226 @@ sub _is_encrypted {
} }
} else { } else {
# failed to create a plaintext mailing list object # failed to create a plaintext mailing list object
warn "failed to create Mail::Ezmlm object for: " . $list_dir; warn "[GpgEzmlm] failed to create Mail::Ezmlm object for: "
. $list_dir;
} }
} else { } else {
warn "Directory does not appear to contain a valid list: " . $list_dir; warn "[GpgEzmlm] Directory does not appear to contain a valid list: "
. $list_dir;
} }
return $result; return $result;
} }
# what is done:
# - copy current dotqmail files to the backup directory
# - replace "ezmlm-send" and "ezmlm-manage" with the gpg-ezmlm replacements
# (in the real dotqmail files)
# This function should be called:
# 1) as part of the plaintext->encryption conversion of a list
# 2) after calling ezmlm-make for an encrypted list (since the dotqmail files
# are overwritten by ezmlm-make)
sub _cleanup_dotqmail_files {
my $list_dir = shift;
my ($backup_dir, $dot_loc, $dot_prefix);
# where should we store the current dotqmail files?
$backup_dir = _get_config_backup_dir($list_dir);
# retrieve location of dotqmail-files
$dot_loc = _get_dotqmail_location($list_dir);
# untaint "dot_loc"
$dot_loc =~ m/^([\w\d\_\-\.\@ \/]+)$/;
if (defined($1)) {
$dot_loc = $1;
} else {
$dot_loc =~ s/\W/_/g;
warn "[GpgEzmlm] directory name of dotqmail files contains invalid "
. "characters: $dot_loc (escaped special characters)";
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 '[GpgEzmlm] invalid location of dotqmail file: ' . $dot_loc;
return undef;
}
# check if the base dotqmail file exists
unless (defined($dot_loc) && ($dot_loc ne '') && (-e $dot_loc)) {
warn '[GpgEzmlm] dotqmail files not found: ' . $dot_loc;
return undef;
}
# move the base dotqmail file
if (open(DOT_NEW, ">$backup_dir/$dot_prefix.new")) {
if (open(DOT_ORIG, "<$dot_loc")) {
my $line_found = (0==1);
while (<DOT_ORIG>) {
my $line = $_;
if ($line =~ /ezmlm-send\s+(\S+)/) {
print DOT_NEW "\|$GPG_EZMLM_BASE/gpg-ezmlm-send.pl $1\n";
$line_found = (0==0);
} else {
print DOT_NEW $line;
}
}
close DOT_ORIG;
# move the original file to the backup and the new file back
if ($line_found) {
unless ((rename($dot_loc, "$backup_dir/$dot_prefix"))
&& (rename("$backup_dir/$dot_prefix.new", $dot_loc))) {
warn "[GpgEzmlm] failed to move base dotqmail file: $!";
return undef;
}
} else {
warn "[GpgEzmlm] Warning: I expected a pristine base "
. "dotqmail file: $dot_loc";
}
} else {
warn "[GpgEzmlm] failed to open base dotqmail file: $dot_loc";
return undef;
}
close DOT_NEW;
} else {
warn "[GpgEzmlm] failed to create new base dotqmail file: "
. "$backup_dir/$dot_prefix.new";
return undef;
}
# move the "-default" dotqmail file
if (open(DEFAULT_NEW, ">$backup_dir/$dot_prefix-default.new")) {
if (open(DEFAULT_ORIG, "<$dot_loc-default")) {
my $line_found = (0==1);
while (<DEFAULT_ORIG>) {
my $line = $_;
if ($line =~ /ezmlm-manage\s+(\S+)/) {
print DEFAULT_NEW "\|$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl $1\n";
$line_found = (0==0);
} else {
print DEFAULT_NEW $line;
}
}
close DEFAULT_ORIG;
# move the original file to the backup and the new file back
if ($line_found) {
unless ((rename("$dot_loc-default",
"$backup_dir/$dot_prefix-default"))
&& (rename("$backup_dir/$dot_prefix-default.new",
"$dot_loc-default"))) {
warn "[GpgEzmlm] failed to move default dotqmail file: $!";
return undef;
}
} else {
warn "[GpgEzmlm] Warning: I expected a pristine default "
. "dotqmail file: $dot_loc-default";
}
} else {
warn "[GpgEzmlm] failed to open default dotqmail file: "
. "$dot_loc-default";
return undef;
}
close DEFAULT_NEW;
} else {
warn "[GpgEzmlm] failed to create new default dotqmail file: "
. "$backup_dir/$dot_prefix-default.new";
return undef;
}
return (0==0);
}
# activate the config file for encryption (gpg-ezmlm)
sub _enable_encryption_config_file {
my $list_dir = shift;
my ($backup_dir);
$backup_dir = _get_config_backup_dir($list_dir);
# check, if the current config file is for gpg-ezmlm or for ezmlm-idx
if (_is_encrypted($list_dir)) {
warn "[GpgEzmlm] I expected a pristine ezmlm-idx config file: "
. "$list_dir/config";
return undef;
}
# store the current original config file
if ((-e "$list_dir/config") && (!File::Copy::copy("$list_dir/config",
"$backup_dir/config.original"))) {
warn "[GpgEzmlm] failed to save the current ezmlm-idx config file ('"
. "$list_dir/config') to '$backup_dir/config.original': $!";
return undef;
}
# copy the encryption config file to the list directory
unless (File::Copy::copy("$backup_dir/config.gpg-ezmlm",
"$list_dir/config")) {
warn "[GpgEzmlm] failed to enable the gpg-ezmlm config file (from '"
. "$backup_dir/config.gpg-ezmlm' to '$list_dir/config'): $!";
return undef;
}
return (0==0);
}
# activate the config file for plain ezmlm-idx lists
sub _enable_plaintext_config_file {
my $list_dir = shift;
my ($backup_dir);
$backup_dir = _get_config_backup_dir($list_dir);
# check, if the current config file is for gpg-ezmlm or for ezmlm-idx
unless (_is_encrypted($list_dir)) {
warn "[GpgEzmlm] I expected a config file for gpg-ezmlm: "
. "$list_dir/config";
return undef;
}
# store the current gpg-ezmlm config file
unless (File::Copy::copy("$list_dir/config",
"$backup_dir/config.gpg-ezmlm")) {
warn "[GpgEzmlm] failed to save the current gpg-ezmlm config file ('"
. "$list_dir/config') to '$backup_dir/config.gpg-ezmlm': $!";
return undef;
}
# copy the ezmlm-idx config file to the list directory - or remove the
# currently active gpg-ezmlm config file
if (-e "$backup_dir/config.original") {
unless (File::Copy::copy("$backup_dir/config.original",
"$list_dir/config")) {
warn "[GpgEzmlm] failed to enable the originnal config file (from '"
. "$backup_dir/config.original' to '$list_dir/config': $!";
return undef;
}
} else {
unless (unlink("$list_dir/config")) {
warn "[GpgEzmlm] failed to remove the gpg-ezmlm config file ("
. "$list_dir/config): $!";
return undef;
}
}
return (0==0);
}
# where should the dotqmail files and the config file be stored?
sub _get_config_backup_dir {
my $list_dir = shift;
return $list_dir . '/.gpg-ezmlm.backup';
}
# == check version of gpg-ezmlm == # == check version of gpg-ezmlm ==
sub check_gpg_ezmlm_version { sub check_gpg_ezmlm_version {
my $ret_value = system("'$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl' --version &>/dev/null"); my $ret_value = system("'$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl' --version &>/dev/null");