Ezmlm
view release on metacpan or search on metacpan
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
# ===========================================================================
# GpgEzmlm.pm
# $Id$
#
# Object methods for gpg-ezmlm mailing lists
#
# Copyright (C) 2006, Lars Kruse, All Rights Reserved.
# Please send bug reports and comments to devel@sumpfralle.de
#
# 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,
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
=head1 SYNOPSIS
use Mail::Ezmlm::GpgEzmlm;
$list = new Mail::Ezmlm::GpgEzmlm(DIRNAME);
The rest is a bit complicated for a Synopsis, see the description.
=head1 DESCRIPTION
Mail::Ezmlm::GpgEzmlm is a Perl module that is designed to provide an object
interface to encrypted mailing lists based upon gpg-ezmlm.
See the gpg-ezmlm web page (http://www.synacklabs.net/projects/crypt-ml/) for
details about this software.
The Mail::Ezmlm::GpgEzmlm class is inherited from the Mail::Ezmlm class.
=cut
# == Begin site dependant variables ==
$GPG_EZMLM_BASE = '/usr/bin'; # Autoinserted by Makefile.PL
$GPG_BIN = '/usr/bin/gpg'; # Autoinserted by Makefile.PL
# == clean up the path for taint checking ==
local $ENV{PATH};
# the following lines were taken from "man perlrun"
$ENV{PATH} = $GPG_EZMLM_BASE;
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
# check, if gpg-ezmlm is installed
unless (-x "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl") {
die("Warning: gpg-ezmlm does not seem to be installed - "
. "executable '$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl' not found!");
}
# == Initialiser - Returns a reference to the object ==
=head2 Setting up a new Mail::Ezmlm::GpgEzmlm object:
use Mail::Ezmlm::GpgEzmlm;
$list = new Mail::Ezmlm::GpgEzmlm('/home/user/lists/moolist');
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
Use this function to access an existing encrypted mailing list.
=cut
sub new {
my ($class, $list_dir) = @_;
# call the previous initialization function
my $self = $class->SUPER::new($list_dir);
bless $self, ref $class || $class || 'Mail::Ezmlm::GpgEzmlm';
# define the available (supported) options for gpg-ezmlm ==
@{$self->{SUPPORTED_OPTIONS}} = (
"GnuPG",
"KeyDir",
"RequireSub",
"RequireSigs",
"NoKeyNoCrypt",
"SignMessages",
"EncryptToAll",
"VerifiedKeyReq",
"AllowKeySubmission");
# check if the mailing is encrypted
if (_is_encrypted($list_dir)) {
return $self;
} else {
return undef;
}
}
# == convert an existing list to gpg-ezmlm ==
=head2 Converting a plaintext mailing list to an encrypted list:
You need to have a normal list before you can convert it into an encrypted list.
You can create plaintext mailing list with Mail::Ezmlm.
$encrypted_list->Mail::Ezmlm::GpgEzmlm->convert_to_encrypted('/lists/foo');
Use this function to convert a plaintext list into an encrypted mailing list.
The function returns a Mail::Ezmlm::GpgEzmlm object if it was successful.
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
if (defined($1)) {
$list_dir = $1;
} else {
warn "[GpgEzmlm] list directory contains invalid characters!";
return undef;
}
# the backup directory will contain the old config file and the dotqmails
$backup_dir = _get_config_backup_dir($list_dir);
if ((! -e $backup_dir) && (!mkdir($backup_dir))) {
warn "[GpgEzmlm] failed to create gpg-ezmlm conversion backup dir ("
. "$backup_dir): $!";
return undef;
}
# check the input
unless (defined($list_dir)) {
warn '[GpgEzmlm] must define directory in convert_to_encrypted()';
return undef;
}
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
}
# the list should currently _not_ be encrypted
if (_is_encrypted($list_dir)) {
warn '[GpgEzmlm] list is already encrypted: ' . $list_dir;
return undef;
}
# here starts the real conversion - the code is based on
# "gpg-ezmlm-convert.pl" - see http://www.synacklabs.net/projects/crypt-ml/
# update the dotqmail files
return undef unless (_cleanup_dotqmail_files($list_dir, $backup_dir));
# create the new config file, if it did not exist before
unless (-e "$backup_dir/config.gpg-ezmlm") {
if (open(CONFIG_NEW, ">$backup_dir/config.gpg-ezmlm")) {
# just create the empty file (default)
close CONFIG_NEW;
} else {
warn "[GpgEzmlm] failed to create new config file ("
. "$backup_dir/config.gpg-ezmlm): $!";
return undef;
}
}
return undef unless (&_enable_encryption_config_file($list_dir));
# create the (empty) gnupg keyring directory - this enables the keyring
# management interface. Don't create it, if it already exists.
if ((!-e "$list_dir/.gnupg") && (!mkdir("$list_dir/.gnupg", 0700))) {
warn "[GpgEzmlm] failed to create the gnupg keyring directory: $!";
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
warn '[GpgEzmlm] invalid location of dotqmail file: ' . $dot_loc;
return undef;
}
# the "dotqmail" location must be valid
unless (defined($dot_loc) && ($dot_loc ne '') && (-e $dot_loc)) {
$self->_seterror(-1, 'dotqmail files not found: ' . $dot_loc);
return undef;
}
# start reverting the gpg-ezmlm conversion:
# - restore old dotqmail files
# - restore old config file (if it existed before)
# restore original config file (if it exists)
&_enable_plaintext_config_file($list_dir);
# replace the dotqmail files with the ones from the backup
unless ((File::Copy::copy("$backup_dir/$dot_prefix", "$dot_loc"))
&& (File::Copy::copy("$backup_dir/$dot_prefix-default",
"$dot_loc-default",))) {
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
my $self = shift;
my $options = shift;
my ($result);
# restore the ususal ezmlm-idx config file (for v0.4xx)
&_enable_plaintext_config_file($self->thislist());
# let ezmlm-make do the setup
$result = $self->SUPER::update($options);
# restore the gpg-ezmlm config file
&_enable_encryption_config_file($self->thislist());
# "repair" the dotqmail files (use "gpg-ezmlm-send" instead of "ezmlm-send")
&_cleanup_dotqmail_files($self->thislist());
# return the result of the ezmlm-make run
return $result;
}
# == Update the encryption settings of the current list ==
=head2 Updating the configuration of the current list:
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
print CONFIG_NEW $in_line if ($found == 0);
} else {
# just print the remaining config file if no other settings are left
print CONFIG_NEW $in_line;
}
}
# write the remaining settings to the end of the file
while (($one_opt, $one_val) = each(%ok_switches)) {
print CONFIG_NEW _get_config_line($one_opt, $one_val);
}
# always set the default value for the "gpg" setting explicitely,
# if it was not overriden - otherwise gpg-ezmlm breaks on most
# systems (its default location is /usr/local/bin/gpg)
unless ($gnupg_setting_found) {
print CONFIG_NEW _get_config_line("GnuPG", $GPG_BIN);
}
} else {
$errorstring = "failed to write to temporary config file: $config_file_new";
$self->_seterror(-1, $errorstring);
warn "[GpgEzmlm] $errorstring";
close CONFIG_OLD;
return (1==0);
}
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
$dot_loc = undef;
}
} else {
# return undef for invalid list directories
$dot_loc = undef;
}
return $dot_loc;
}
# return true if the given directory contains a gpg-ezmlm mailing list
sub _is_encrypted {
my $list_dir = shift;
my ($result, $plain_list);
# by default we assume, that the list is not encrypted
$result = 0;
if (-e "$list_dir/lock") {
# it is a valid ezmlm-idx mailing list
$plain_list = Mail::Ezmlm->new($list_dir);
if ($plain_list) {
if (-e "$list_dir/config") {
my $content = $plain_list->getpart("config");
$content = '' unless defined($content);
# return false if we encounter the usual ezmlm-idx-v0.4-header
if ($content =~ /^F:/m) {
# this is a plaintext ezmlm-idx v0.4 mailing list
# this is a valid case - no warning necessary
} else {
# this is a gpg-ezmlm mailing list
$result = 1;
}
} else {
# gpg-ezmlm needs a "config" file - thus the list seems to be plain
# this is a valid case - no warning necessary
}
} else {
# failed to create a plaintext mailing list object
warn "[GpgEzmlm] failed to create Mail::Ezmlm object for: "
. $list_dir;
}
} else {
warn "[GpgEzmlm] Directory does not appear to contain a valid list: "
. $list_dir;
}
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?
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
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))) {
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
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"))
Ezmlm/GpgEzmlm.pm view on Meta::CPAN
} 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 ==
sub check_gpg_ezmlm_version {
my $ret_value = system("'$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl' --version &>/dev/null");
# for now we do not need a specific version of gpg-ezmlm - it just has to
# know the "--version" argument (available since gpg-ezmlm 0.3.4)
return ($ret_value == 0);
}
# == check if gpg-ezmlm is installed ==
sub is_available {
# the existence of the gpg-ezmlm script is sufficient for now
return -e "$GPG_EZMLM_BASE/gpg-ezmlm-convert.pl";
}
############ some internal functions ##############
# == return an error message if appropriate ==
sub errmsg {
my ($self) = @_;
return $self->{'ERRMSG'};
}
Ezmlm/GpgKeyRing.pm view on Meta::CPAN
# ===========================================================================
# Gpg.pm
# $Id$
#
# Object methods for gpg-ezmlm mailing lists
#
# Copyright (C) 2006, Lars Kruse, All Rights Reserved.
# Please send bug reports and comments to devel@sumpfralle.de
#
# 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,
Ezmlm/GpgKeyRing.pm view on Meta::CPAN
The rest is a bit complicated for a Synopsis, see the description.
=head1 DESCRIPTION
Mail::Ezmlm::GpgKeyRing is a Perl module that is designed to provide an object
interface to GnuPG keyrings for encrypted mailing lists.
=cut
# == Begin site dependant variables ==
$GPG_BIN = '/usr/bin/gpg'; # Autoinserted by Makefile.PL
# == check the gpg path ==
$GPG_BIN = '/usr/local/bin/gpg'
unless (-x "$GPG_BIN");
$GPG_BIN = '/usr/bin/gpg'
unless (-x "$GPG_BIN");
$GPG_BIN = '/bin/gpg'
unless (-x "$GPG_BIN");
$GPG_BIN = '/usr/local/bin/gpg2'
unless (-x "$GPG_BIN");
$GPG_BIN = '/usr/bin/gpg2'
unless (-x "$GPG_BIN");
$GPG_BIN = '/bin/gpg2'
unless (-x "$GPG_BIN");
# == clean up the path ==
local $ENV{'PATH'} = "/bin";
# check, if gpg is installed
unless (-x "$GPG_BIN") {
die("Warning: gnupg does not seem to be installed - none of the "
. "executables 'gpg' or 'gpg2' were found at the usual locations!");
}
# == Initialiser - Returns a reference to the object ==
=head2 Setting up a new Mail::Ezmlm::GpgKeyRing object:
use Mail::Ezmlm::GpgKeyRing;
$keyring = new Mail::Ezmlm::GpgKeyRing('/home/user/lists/foolist/.gnupg');
Ezmlm/GpgKeyRing.pm view on Meta::CPAN
$keyring->export_key($key_id);
$keyring->export_key($email_address);
The return value is a string containing the ascii armored key data.
=cut
sub export_key {
my ($self, $keyid) = @_;
my ($gpg, $gpgoption, $gpgcommand, $output);
# return immediately - this avoids creating an empty keyring unintentionally
return () unless (-e $self->{'KEYRING_DIR'});
$gpg = $self->_get_gpg_object();
$gpgoption = "--armor --export $keyid";
$gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " $gpgoption";
$output = `$gpgcommand 2>/dev/null`;
if ($output) {
return $output;
} else {
return undef;
}
}
# == import a new key ==
Ezmlm/GpgKeyRing.pm view on Meta::CPAN
You can import public or secret keys into the keyring.
The key should be ascii armored.
$keyring->import_key($ascii_armored_key_data);
=cut
sub import_key {
my ($self, $key) = @_;
my $gpg = $self->_get_gpg_object();
if ($gpg->addkey($key)) {
return (0==0);
} else {
return (1==0);
}
}
# == delete a key ==
=head2 Delete a key:
Ezmlm/GpgKeyRing.pm view on Meta::CPAN
Remove a public key (and the matching secret key if it exists) from the keyring.
The argument is the id of the key or any other unique pattern.
$keyring->delete_key($keyid);
=cut
sub delete_key {
my ($self, $keyid) = @_;
my $gpg = $self->_get_gpg_object();
my $fprint = $self->_get_fingerprint($keyid);
return (1==0) unless (defined($fprint));
my $gpgoption = "--delete-secret-and-public-key $fprint";
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " $gpgoption";
if (system($gpgcommand)) {
return (1==0);
} else {
return (0==0);
}
}
# == generate new private key ==
=head2 Generate a new key:
$keyring->generate_key($name, $comment, $email_address, $keysize, $expire);
Refer to the documentation of gnupg for the format of the arguments.
=cut
sub generate_private_key {
my ($self, $name, $comment, $email, $keysize, $expire) = @_;
my $gpg = $self->_get_gpg_object();
my $gpgoption = "--gen-key";
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " $gpgoption";
my $pid = open(INPUT, "| $gpgcommand");
print INPUT "Key-Type: DSA\n";
print INPUT "Key-Length: 1024\n";
print INPUT "Subkey-Type: ELG-E\n";
print INPUT "Subkey-Length: $keysize\n";
print INPUT "Name-Real: $name\n";
print INPUT "Name-Comment: $comment\n" if ($comment);
print INPUT "Name-Email: $email\n";
print INPUT "Expire-Date: $expire\n";
return close INPUT;
}
Ezmlm/GpgKeyRing.pm view on Meta::CPAN
# see above for POD (get_public_keys)
sub get_secret_keys {
my ($self) = @_;
my @keys = $self->_get_keys("sec");
return @keys;
}
############ some internal functions ##############
# == internal function for creating a gpg object ==
sub _get_gpg_object() {
my ($self) = @_;
my $gpg = new Crypt::GPG();
my $dirname = $self->get_location();
# replace whitespace characters in the keyring directory name
$dirname =~ s/(\s)/\\$1/g;
$gpg->gpgbin($GPG_BIN);
$gpg->gpgopts("--lock-multiple --no-tty --no-secmem-warning --batch --quiet --homedir $dirname");
return $gpg;
}
# == internal function to list keys ==
sub _get_keys() {
# type can be "pub" or "sec"
my ($self, $keyType) = @_;
my ($gpg, $flag, $gpgoption, @keys, $key);
# return immediately - this avoids creating an empty keyring unintentionally
return () unless (-r $self->{'KEYRING_DIR'});
$gpg = $self->_get_gpg_object();
if ($keyType eq "pub") {
$flag = "pub";
$gpgoption = "--list-keys";
} elsif ($keyType eq "sec") {
$flag = "sec";
$gpgoption = "--list-secret-keys";
} else {
warn "wrong keyType: $keyType";
return undef;
}
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " --with-colons $gpgoption";
my @read_keys = grep /^$flag/, `$gpgcommand`;
foreach $key (@read_keys) {
my ($type, $trust, $size, $algorithm, $id, $created,
$expires, $u2, $ownertrust, $uid) = split ":", $key;
# stupid way of "decoding" utf8 (at least it works for ":")
$uid =~ s/\\x3a/:/g;
$uid =~ /^(.*) <([^<]*)>/;
my $name = $1;
my $email = $2;
push @keys, {name => $name, email => $email, id => $id, expires => $expires};
}
return @keys;
}
# == internal function to retrieve the fingerprint of a key ==
sub _get_fingerprint()
{
my ($self, $key_id) = @_;
my $gpg = $self->_get_gpg_object();
$key_id =~ /^([0-9A-Z]*)$/;
$key_id = $1;
return undef unless ($key_id);
my $gpgoption = "--fingerprint $key_id";
my $gpgcommand = $gpg->gpgbin() . " " . $gpg->gpgopts() . " --with-colons $gpgoption";
my @fingerprints = grep /^fpr:/, `$gpgcommand`;
if (@fingerprints > 1) {
warn "[Mail::Ezmlm::GpgKeyRing] more than one key matched ($key_id)!";
return undef;
}
return undef if (@fingerprints < 1);
my $fpr = $fingerprints[0];
$fpr =~ /^fpr:*([0-9A-Z]*):*$/;
$fpr = $1;
return undef unless $1;
return $1;
Ezmlm/GpgKeyRing.pm view on Meta::CPAN
=head1 BUGS
There are no known bugs.
Please report bugs to the author or use the bug tracking system at
https://systemausfall.org/trac/ezmlm-web.
=head1 SEE ALSO
gnupg(7), gpg(1), gpg2(1), Crypt::GPG(3pm)
https://systemausfall.org/toolforge/ezmlm-web/
http://www.ezmlm.org/
=cut
Makefile.PL view on Meta::CPAN
'CONFIGURE' => \&set_paths,
'NAME' => 'Mail::Ezmlm',
'VERSION_FROM' => 'Ezmlm.pm', # finds $VERSION
'PREREQ_PM' => { 'File::Copy' => 0, 'Crypt::GPG' => 0 },
'DISTNAME' => 'Ezmlm',
'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' },
'clean' => { FILES => 'ezmlmtmp' }
);
sub set_paths {
my ($qmail_path, $ezmlm_path, $gpg_ezmlm_path, $gpg_ezmlm_requested);
my ($gpg_bin, $gpg_bin_requested);
# special case to handle the FreeBSD ports system
if ($ENV{BSD_BATCH_INSTALL}) {
print STDERR "\$BSD_BATCH_INSTALL is set in your environment, assuming port defaults\n";
return {};
}
print << 'EOM';
We now need to know where some things live on your system. I'll try and make
Makefile.PL view on Meta::CPAN
foreach (1..10) {
$qmail_path = prompt('Qmail base directory?', '/var/qmail');
last if (-e "$qmail_path/control");
print "I can't find $qmail_path/control. Please try again\n";
}
if (! -e "$qmail_path/control") {
print STDERR "Warning: No correct input after $_ attempts. Continuing with warnings ...\n";
}
# check if gpg-ezmlm is installed (for Mail::Ezmlm::GpgEzmlm)
$gpg_ezmlm_requested = prompt('Is gpg-ezmlm installed for encrypted mailing list support? (y/N)', "n");
$gpg_ezmlm_requested = ($gpg_ezmlm_requested =~ /^y/i);
if ($gpg_ezmlm_requested) {
undef $gpg_ezmlm_path;
foreach ('/usr/local/bin', '/usr/bin', '/usr/local/bin/gpg-ezmlm',
'/usr/bin/gpg-ezmlm') {
if (-e "$_/gpg-ezmlm-manage.pl") {
$gpg_ezmlm_path = $_;
last;
}
}
$gpg_ezmlm_path = '/usr/bin' unless (defined($gpg_ezmlm_path));
# ask the user to confirm our guessing
foreach (1..10) {
$gpg_ezmlm_path = prompt('gpg-ezmlm installation directory?',
"$gpg_ezmlm_path");
last if (-e "$gpg_ezmlm_path/gpg-ezmlm-manage.pl");
print "I can't find $gpg_ezmlm_path/gpg-ezmlm-manage.pl. "
. "Please try again\n";
}
unless (-e "$gpg_ezmlm_path/gpg-ezmlm-manage.pl") {
print STDERR "Warning: No correct input after $_ attempts. "
. "Continuing with warnings ...\n";
}
}
# check if gpg is installed (for Mail::Ezmlm::GpgKeyRing)
$gpg_bin_requested = prompt('Is gnupg installed (for keyring support in encrypted mailing lists)? (y/N)', "n");
$gpg_bin_requested = ($gpg_bin_requested =~ /^y/i);
if ($gpg_bin_requested) {
undef $gpg_bin;
foreach ('/usr/local/bin/gpg', '/usr/bin/gpg', '/bin/gpg',
'/usr/local/bin/gpg2', '/usr/bin/gpg2', '/bin/gpg2') {
if (-x "$_") {
$gpg_bin = $_;
last;
}
}
$gpg_bin = '/usr/bin' unless (defined($gpg_bin));
# ask the user to confirm our guessing
foreach (1..10) {
$gpg_bin = prompt('Path to the gpg or gpg2 binary?', "$gpg_bin");
last if (-x "$gpg_bin");
print "I can't find $gpg_bin. Please try again\n";
}
unless (-x "$gpg_bin") {
print STDERR "Warning: No correct input after $_ attempts. "
. "Continuing with warnings ...\n";
}
}
# check if mysql support is necessary
if(`strings $ezmlm_path/ezmlm-sub | grep -i 'MySQL'`) {
print << 'EOM';
Makefile.PL view on Meta::CPAN
open(TMP, "<Ezmlm.pm.tmp.$$") or die "Unable to read temp file: $!";
while(<TMP>) {
s{^\$EZMLM_BASE\s*=\s*['"].+?['"]\s*;\s*(#.*|)$}{\$EZMLM_BASE = '$ezmlm_path'; #Autoinserted by Makefile.PL};
s{^\$QMAIL_BASE\s*=\s*['"].+?['"]\s*;\s*(#.*|)$}{\$QMAIL_BASE = '$qmail_path'; #Autoinserted by Makefile.PL};
s{^\$MYSQL_BASE\s*=\s*['"].*?['"]\s*;\s*(#.*|)$}{\$MYSQL_BASE = '$mysql_path'; #Autoinserted by Makefile.PL};
print EZMLM;
}
close TMP; close EZMLM;
unlink "Ezmlm.pm.tmp.$$";
if ($gpg_ezmlm_requested) {
# set the variables in GpgEzmlm.pm
# Back up file
open(GPGEZMLM, '<Ezmlm/GpgEzmlm.pm')
or die "Unable to open Ezmlm/GpgEzmlm.pm for read: $!";
open(TMP, ">Ezmlm/GpgEzmlm.pm.tmp.$$") or die "Unable to create temp file: $!";
while(<GPGEZMLM>) { print TMP; }
close TMP; close GPGEZMLM;
# Do variable substitution
open(GPGEZMLM, '>Ezmlm/GpgEzmlm.pm')
or die "Unable to open Ezmlm/GpgEzmlm.pm for write: $!";
open(TMP, "<Ezmlm/GpgEzmlm.pm.tmp.$$")
or die "Unable to read temp file: $!";
while(<TMP>) {
s{^\$GPG_EZMLM_BASE\s*=\s*['"].+?['"]\s*;\s*(#.*|)$}{\$GPG_EZMLM_BASE = '$gpg_ezmlm_path'; # Autoinserted by Makefile.PL};
s{^\$GPG_BIN\s*=\s*['"].+?['"]\s*;\s*(#.*|)$}{\$GPG_BIN = '$gpg_bin'; # Autoinserted by Makefile.PL} if ($gpg_bin_requested);
print GPGEZMLM;
}
close TMP; close GPGEZMLM;
unlink "Ezmlm/GpgEzmlm.pm.tmp.$$";
}
# set the variables in GpgKeyRing.pm
if ($gpg_bin_requested) {
# Back up file
open(GPGKEYRING, '<Ezmlm/GpgKeyRing.pm')
or die "Unable to open Ezmlm/GpgKeyRing.pm for read: $!";
open(TMP, ">Ezmlm/GpgKeyRing.pm.tmp.$$") or die "Unable to create temp file: $!";
while(<GPGKEYRING>) { print TMP; }
close TMP; close GPGKEYRING;
# Do variable substitution
open(GPGKEYRING, '>Ezmlm/GpgKeyRing.pm') or die "Unable to open Ezmlm/GpgKeyRing.pm for write: $!";
open(TMP, "<Ezmlm/GpgKeyRing.pm.tmp.$$") or die "Unable to read temp file: $!";
while(<TMP>) {
s{^\$GPG_BIN\s*=\s*['"].+?['"]\s*;\s*(#.*|)$}{\$GPG_BIN = '$gpg_bin'; # Autoinserted by Makefile.PL};
print GPGKEYRING;
}
close TMP; close GPGKEYRING;
unlink "Ezmlm/GpgKeyRing.pm.tmp.$$";
}
return {};
}
( run in 1.040 second using v1.01-cache-2.11-cpan-df04353d9ac )