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

Mail::Ezmlm release v0.08.2:

Browse source 
* updated debian files
* tagged release
* uploaded packages
This commit is contained in:
lars 2008-10-16 01:34:44 +00:00
parent ec43298706
commit 01865d2ba4
13 changed files with 3118 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
Ezmlm/debian/changelog
View file

@ -1,3 +1,9 @@
libemail-ezmlm-perl (0.08.2-1) unstable; urgency=low
* New upstream release
-- Lars Kruse <devel@sumpfralle.de> Thu, 16 Oct 2008 03:17:42 +0200
libemail-ezmlm-perl (0.08.1-1) unstable; urgency=low libemail-ezmlm-perl (0.08.1-1) unstable; urgency=low
* New upstream release * New upstream release

2
Ezmlm/debian/control
View file

@ -9,7 +9,7 @@ Homepage: https://systemausfall.org/toolforge/ezmlm-web
Package: libemail-ezmlm-perl Package: libemail-ezmlm-perl
Section: perl Section: perl
Architecture: all Architecture: all
Depends: ${perl:Depends}, libcrypt-gpg-perl Depends: ${perl:Depends}, libcrypt-gpg-perl, gnupg
Description: access ezmlm-idx mailig lists with perl's object methods Description: access ezmlm-idx mailig lists with perl's object methods
The support for ezmlm-idx 6.0 is complete. The support for ezmlm-idx 6.0 is complete.
The module still works fine with ezmlm-idx 0.4xx, too. The module still works fine with ezmlm-idx 0.4xx, too.

64
Ezmlm/tags/Ezmlm-0.08.2/Changes Normal file
View file

@ -0,0 +1,64 @@
Revision history for Perl extension Mail::Ezmlm.
0.01 Sun Oct 31 12:58:16 1999
- original version; created by h2xs 1.1.1.1.2.1
0.02 Wed Jan 26 07:59:10 SAST 2000
- Added functions to check various options
(ismodsub, ismodpost, isremote, isdeny, isallow, isdigest)
- Allowed sub, unsub, list, subscribers, issub to work with list subparts
(ie, the allow, deny, mod, digest sub directories)
- Changed system() calls to safer ones (ie command, switches)
- Made error handling better (errmsg() and errno())
- Added support for creating MySQL tables via ezmlm-mktab
0.03 Mon Sep 25 11:49:26 SAST 2000
- fixed the issub() function
- fixed the problem with dashes in hostnames.
- hopefully got rid of some of the warnings from sub() and unsub()
0.04 Mon May 26 18:15:38 SAST 2003
- fixed return value of Makefile.PL (Andrew Pam <xanni@glasswings.com.au>)
- fixed issub() (again) to handle parts properly (bug 602; moguo@servism.com)
- converted module global variables to instance variables
0.05 Sat Mar 5 12:47:10 SAST 2005
- fixed forced scalar return in subscribers() (Jon Coulter <ledjon@ledjon.com>)
- fixed handling of dashes in hostnames (bug 5571; Lars Braeuer <lbraeuer@mpex.net>)
- fixed some tainting problems (Scott Beck <sbeck@gossamer-threads.com> and Matt Simerson <matt@tnpi.biz>)
- fixed order of control/defaulthost and control/me (bug 1515)
- fixed a bug in Makefile.PL (bug 11771). does not affect most users, so released as 0.05.1
0.06 Mon Dec 26 18:55:12 CET 2005
- support for ezmlm-idx-5.0.0 added
- fixed version check
0.07 Mon Jan 2 22:12:32 CET 2006
- new functions for text management (idx >= 5.0)
- new functions for language setting (idx >= 5.0)
- new functions for charset setting (idx >= 5.0)
- new functions for config directory setting (idx >= 5.0)
- look for ezmlm-make at run-time
- requires Text::ParseWords
0.07.1 Mon Jan 23 22:30:14 CET 2006
- fix misinterpretation of empty settings
0.07.2 Sun May 6 06:20:13 CEST 2006
- fix parsing of ezmlm-make options
0.07.2 Tue Jun 20 01:05:56 UTC 2006
- fixed 'get_charset' and 'set_charset' for idx < 5.0
0.08 Thu Oct 2 03:23:06 CEST 2008
- fixed handling of the 'owner' setting for ezmlm-idx > v5
- updated ezmlm-idx version detection
- allow "@" in the path of a mailing list
- add modules Mail::Ezmlm::GpgKeyRing and Mail::Ezmlm::GpgEzmlm
0.08.1 Thu Oct 12 04:37:06 CEST 2008
- fixed issues of Mail::Ezmlm::GpgEzmlm with ezmlm-idx v0.4x lists
0.08.2 Wed Oct 15 23:00:12 CEST 2008
- added check for external dependency to the test script

1236
Ezmlm/tags/Ezmlm-0.08.2/Ezmlm.pm Normal file
View file

File diff suppressed because it is too large Load diff

887
Ezmlm/tags/Ezmlm-0.08.2/Ezmlm/GpgEzmlm.pm Normal file
View file

@ -0,0 +1,887 @@
# ===========================================================================
# 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,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#
# ==========================================================================
package Mail::Ezmlm::GpgEzmlm;
use strict;
use warnings;
use diagnostics;
use vars qw($GPG_EZMLM_BASE $GPG_BIN $VERSION @ISA @EXPORT @EXPORT_OK);
use File::Copy;
use Carp;
use Mail::Ezmlm;
# this package inherits object methods from Mail::Ezmlm
@ISA = qw(Mail::Ezmlm);
$VERSION = '0.1';
require 5.005;
=head1 NAME
Mail::Ezmlm::GpgEzmlm - Object Methods for encrypted Ezmlm Mailing Lists
=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');
new() returns undefined if an error occoured.
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.
Otherwise it returns undef.
=cut
sub convert_to_encrypted {
my $class = shift;
my $list_dir = shift;
my ($backup_dir);
# untaint "list_dir"
$list_dir =~ m/^([\w\d\_\-\.\@ \/]+)$/;
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;
}
# does the list directory exist?
unless (-d $list_dir) {
warn '[GpgEzmlm] directory does not exist: ' . $list_dir;
return undef;
}
# 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: $!";
return undef;
}
my $result = $class->new($list_dir);
return $result;
}
# == convert an encrypted list back to plaintext ==
=head2 Converting an encryted mailing list to a plaintext list:
$list->convert_to_plaintext();
This function returns undef in case of errors. Otherwise the Mail::Ezmlm
object of the plaintext mailing list is returned.
=cut
sub convert_to_plaintext {
my $self = shift;
my ($dot_loc, $list_dir, $dot_prefix, $backup_dir);
$list_dir = $self->thislist();
# untaint the input
$list_dir =~ m/^([\w\d\_\-\.\/\@]+)$/;
unless (defined($1)) {
# sanitize directory name (it must be safe to put the warn message)
$list_dir =~ s/\W/_/g;
warn "[GpgEzmlm] the list directory contains invalid characters: '"
. $list_dir . "' (special characters are escaped)";
return undef;
}
$list_dir = $1;
# check if a directory was given
unless (defined($list_dir)) {
$self->_seterror(-1, 'must define directory in convert_to_plaintext()');
return undef;
}
# the list directory must exist
unless (-d $list_dir) {
$self->_seterror(-1, 'directory does not exist: ' . $list_dir);
return undef;
}
# check if the current object is still encrypted
unless (_is_encrypted($list_dir)) {
$self->_seterror(-1, 'list is not encrypted: ' . $list_dir);
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 {
$dot_loc =~ s/\W/_/g;
warn "[GpgEzmlm] directory name of dotqmail files contains invalid "
. "characters: $dot_loc (special characters are escaped)";
return undef;
}
# the backup directory should contain the old config file (if it existed)
# and the original dotqmail files
$backup_dir = _get_config_backup_dir($self->thislist());
unless (-r $backup_dir) {
warn "[GpgEzmlm] failed to revert conversion - the backup directory "
. "is missing: $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 '[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",))) {
warn "[GpgEzmlm] failed to restore dotqmail files: $!";
return undef;
}
$self = Mail::Ezmlm->new($list_dir);
return $self;
}
# == Update the "normal" settings of the current list ==
=head2 Updating the common configuration settings of the current list:
$list->update("moUx");
=cut
# update the "normal" (=not related to encryption) settings of the list
sub update {
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:
$list->update_special({ 'allowKeySubmission' => 1 });
=cut
# update the encryption specific settings
sub update_special {
my ($self, %switches) = @_;
my (%ok_switches, $one_key, @delete_switches);
# check for important files: 'config'
unless (_is_encrypted($self->thislist())) {
$self->_seterror(-1, "Update failed: '" . $self->thislist()
. "' does not appear to be a valid list");
return undef;
}
@delete_switches = ();
# check if all supplied settings are supported
# btw we change the case (upper/lower) of the setting to the default one
foreach $one_key (keys %switches) {
my $ok_key;
foreach $ok_key (@{$self->{SUPPORTED_OPTIONS}}) {
# check the key case-insensitively
if ($ok_key =~ /^$one_key$/i) {
$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};
}
# %switches should be empty now
if (%switches) {
foreach $one_key (keys %switches) {
warn "[GpgEzmlm] unsupported setting: $one_key";
}
}
my $errorstring;
my $config_file_old = $self->thislist() . "/config";
my $config_file_new = $self->thislist() . "/config.new";
my $gnupg_setting_found = (0==1);
if (open(CONFIG_OLD, "<$config_file_old")) {
if (open(CONFIG_NEW, ">$config_file_new")) {
my ($in_line, $one_opt, $one_val, $new_setting);
while (<CONFIG_OLD>) {
$in_line = $_;
$gnupg_setting_found = (0==0) if ($in_line =~ m/^\s*GnuPG\s+/i);
if (%ok_switches) {
my $found = 0;
while (($one_opt, $one_val) = each(%ok_switches)) {
# is this the right line (maybe commented out)?
if ($in_line =~ m/^#?\s*$one_opt\s+/i) {
print CONFIG_NEW _get_config_line($one_opt, $one_val);
delete $ok_switches{$one_opt};
$found = 1;
}
}
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);
}
close CONFIG_NEW;
} else {
$errorstring = "failed to read the config file: $config_file_old";
$self->_seterror(-1, $errorstring);
warn "[GpgEzmlm] $errorstring";
return (1==0);
}
close CONFIG_OLD;
unless (rename($config_file_new, $config_file_old)) {
$errorstring = "failed to move new config file ($config_file_new) "
. "to original config file ($config_file_old)";
$self->_seterror(-1, $errorstring);
warn "[GpgEzmlm] $errorstring";
return (1==0);
}
$self->_seterror(undef);
return (0==0);
}
# return the configuration file string for a key/value combination
sub _get_config_line {
my $key = shift;
my $value = shift;
my $result = "$key ";
if (($key eq "GnuPG") || ($key eq "keyDir")) {
# these are the only settings with string values
# escape special characters
$value =~ s/[^\w\.\/\-]/_/g;
$result .= $value;
} else {
$result .= ($value)? "yes" : "no";
}
$result .= "\n";
return $result;
}
# == Get a list of options for the current list ==
=head2 Getting the current configuration of the current list:
$list->getconfig;
getconfig() returns a hash including all available settings
(undefined settings are returned with their default value).
=cut
# call the original 'getconfig' function after restoring the "normal" config
# file (necessary only for ezmlm-idx < 0.4x)
sub getconfig {
my $self = shift;
my ($result);
&_enable_plaintext_config_file($self->thislist());
$result = $self->SUPER::getconfig();
&_enable_encryption_config_file($self->thislist());
return $result;
}
# retrieve the specific configuration of the list
sub getconfig_special {
my ($self) = @_;
my (%options, $list_dir);
# continue with retrieving the encryption configuration
# define defaults
$options{KeyDir} = '';
$options{SignMessages} = 1;
$options{NoKeyNoCrypt} = 0;
$options{AllowKeySubmission} = 1;
$options{EncryptToAll} = 0;
$options{VerifiedKeyReq} = 0;
$options{RequireSub} = 0;
$options{RequireSigs} = 0;
# Read the config file
$list_dir = $self->thislist();
if (open(CONFIG, "<$list_dir/config")) {
# 'config' contains the authorative information
while(<CONFIG>) {
if (/^(\w+)\s(.*)$/) {
my $optname = $1;
my $optvalue = $2;
my $one_opt;
foreach $one_opt (@{$self->{SUPPORTED_OPTIONS}}) {
if ($one_opt =~ m/^$optname$/i) {
if ($optvalue =~ /^yes$/i) {
$options{$one_opt} = 1;
} else {
$options{$one_opt} = 0;
}
}
}
}
}
close CONFIG;
} else {
$self->_seterror(-1, 'unable to read configuration file in getconfig()');
return undef;
}
$self->_seterror(undef);
return %options;
}
# ********** internal functions ****************
# return the location of the dotqmail files
sub _get_dotqmail_location {
my $list_dir = shift;
my ($plain_list, $dot_loc);
$plain_list = Mail::Ezmlm->new($list_dir);
if ($plain_list) {
if (-r "$list_dir/dot") {
$dot_loc = $plain_list->getpart("dot");
chomp($dot_loc);
} elsif (-r "$list_dir/config") {
# the "config" file was used before ezmlm-idx v5
$dot_loc = $1 if ($plain_list->getpart("config") =~ /^T:(.*)$/m);
} else {
warn '[GpgEzmlm] list configuration file not found: ' . $list_dir;
$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?
$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 ==
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'};
}
sub errno {
my ($self) = @_;
return $self->{'ERRNO'};
}
# == Internal function to set the error to return ==
sub _seterror {
my ($self, $no, $mesg) = @_;
if (defined($no) && $no) {
if ($no < 0) {
$self->{'ERRNO'} = -1;
$self->{'ERRMSG'} = $mesg || 'An undefined error occoured';
} else {
$self->{'ERRNO'} = $no / 256;
$self->{'ERRMSG'} = $! || $mesg || 'An undefined error occoured in a system() call';
}
} else {
$self->{'ERRNO'} = 0;
$self->{'ERRMSG'} = undef;
}
return 1;
}
1;
=head1 AUTHOR
Lars Kruse <devel@sumpfralle.de>
=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
ezmlm(5), ezmlm-make(2), ezmlm-sub(1),
ezmlm-unsub(1), ezmlm-list(1), ezmlm-issub(1)
https://systemausfall.org/toolforge/ezmlm-web/
http://www.synacklabs.net/projects/crypt-ml/
http://www.ezmlm.org/
http://www.qmail.org/
=cut

399
Ezmlm/tags/Ezmlm-0.08.2/Ezmlm/GpgKeyRing.pm Normal file
View file

@ -0,0 +1,399 @@
# ===========================================================================
# 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,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
#
# ==========================================================================
package Mail::Ezmlm::GpgKeyRing;
use strict;
use vars qw($GPG_BIN $VERSION @ISA @EXPORT @EXPORT_OK);
use Carp;
use Crypt::GPG;
$VERSION = '0.1';
require 5.005;
=head1 NAME
Mail::Ezmlm::GpgKeyRing - Object Methods for gnupg keyring management
=head1 SYNOPSIS
use Mail::Ezmlm::GpgKeyRing;
$keyring = new Mail::Ezmlm::GpgKeyRing(DIRNAME);
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');
new() returns the new instance for success, undefined if there was a problem.
=cut
sub new {
my($class, $keyring_dir) = @_;
my $self = {};
bless $self, ref $class || $class || 'Mail::Ezmlm::GpgKeyRing';
if ($self->set_location($keyring_dir)) {
return $self;
} else {
return undef;
}
}
# == Return the directory of the gnupg keyring ==
=head2 Determining the location of the configured keyring.
$whichkeyring = $keyring->get_location();
print $keyring->get_location();
=cut
sub get_location {
my($self) = shift;
return $self->{'KEYRING_DIR'};
}
# == Set the current keyring directory ==
=head2 Changing which keyring the Mail::Ezmlm::GpgKeyRing object points at:
$keyring->set_location('/home/user/lists/foolist/.gnupg');
=cut
sub set_location {
my($self, $keyring_dir) = @_;
if (-e "$keyring_dir") {
if (-x "$keyring_dir") {
# at least it is a directory - so it looks ok
$self->{'KEYRING_DIR'} = $keyring_dir;
} else {
# it seems to be a file or something else - we complain
warn "GPG keyring location must be a directory: $keyring_dir";
$self->{'KEYRING_DIR'} = undef;
}
} else {
# probably the keyring directory does not exist, yet
# a warning should not be necessary
$self->{'KEYRING_DIR'} = $keyring_dir;
}
return $self->{'KEYRING_DIR'}
}
# == export a key ==
=head2 Export a key:
You may export public keys of the keyring.
The key can be identified by its id or other (unique) patterns (like the
gnupg program).
$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 ==
=head2 Import a key:
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:
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;
}
# == get_public_keys ==
=head2 Getting public keys:
Return an array of key hashes each containing the following elements:
=over
=item *
name
=item *
email
=item *
id
=item *
expires
=back
$keyring->get_public_keys();
$keyring->get_secret_keys();
=cut
sub get_public_keys {
my ($self) = @_;
my @keys = $self->_get_keys("pub");
return @keys;
}
# == get_private_keys ==
# 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;
}
=head1 AUTHOR
Lars Kruse <devel@sumpfralle.de>
=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

9
Ezmlm/tags/Ezmlm-0.08.2/MANIFEST Normal file
View file

@ -0,0 +1,9 @@
Changes
Ezmlm.pm
MANIFEST
README
Makefile.PL
test.pl
META.yml
Ezmlm/GpgKeyRing.pm
Ezmlm/GpgEzmlm.pm

10
Ezmlm/tags/Ezmlm-0.08.2/META.yml Normal file
View file

@ -0,0 +1,10 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Ezmlm
version: 0.08
version_from: Ezmlm.pm
installdirs: site
requires:
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17

232
Ezmlm/tags/Ezmlm-0.08.2/Makefile.PL Normal file
View file

@ -0,0 +1,232 @@
# $Id: Makefile.PL,v 1.3 2005/03/05 14:15:20 guy Exp $
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'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
some intelligent guesses - if I get it right, please just press enter at the
prompt. If I get them wrong, please type in the correct path for me and then
press enter.
First I need to know where the Ezmlm binaries live (ie where I can find
ezmlm-make, ezmlm-sub, etc).
EOM
*prompt = \&ExtUtils::MakeMaker::prompt;
# guess default
$ezmlm_path = '/usr/local/bin/ezmlm';
$ezmlm_path = '/usr/local/bin/ezmlm-idx' unless (-e "$ezmlm_path/ezmlm-make");
$ezmlm_path = '/usr/local/bin' unless (-e "$ezmlm_path/ezmlm-make");
$ezmlm_path = '/usr/bin/ezmlm' unless (-e "$ezmlm_path/ezmlm-make");
$ezmlm_path = '/usr/bin/ezmlm-idx' unless (-e "$ezmlm_path/ezmlm-make");
$ezmlm_path = '/usr/bin' unless (-e "$ezmlm_path/ezmlm-make");
# return to default, if nothing can be found
$ezmlm_path = '/usr/local/bin/ezmlm' unless (-e "$ezmlm_path/ezmlm-make");
foreach (1..10) {
$ezmlm_path = prompt('Ezmlm binary directory?', "$ezmlm_path");
last if (-e "$ezmlm_path/ezmlm-make");
print "I can't find $ezmlm_path/ezmlm-make. Please try again\n";
}
unless (-e "$ezmlm_path/ezmlm-make") {
print STDERR "Warning: No correct input after $_ attempts. Continuing with warnings ...\n";
}
unless (system(("$ezmlm_path/ezmlm-make", "-V")) == 0) {
print STDERR "Warning: your version of ezmlm-make does not support the '-V' argument. Please upgrade to ezmlm-idx v0.400 or above.\n";
}
print << 'EOM';
Now I need to know where Qmail resides on your system. The Qmail base
directory is the one in which the Qmail bin, control, etc directories
live in.
EOM
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';
It appears you have compiled MySQL support into your version of Ezmlm. If
this is correct, I now need to know where the MySQL client (mysql) lives on
your machine.
Please leave this blank if you do not want to enable MySQL support in the
Mail::Ezmlm module.
EOM
$mysql_path = '/usr/bin';
$mysql_path = '/usr/local/bin' unless (-e "$mysql_path/mysql");
# return to default - if nothing works
$mysql_path = '/usr/bin' unless (-e "$mysql_path/mysql");
foreach (1..10) {
$mysql_path = prompt('MySQL binary directory?', "$mysql_path");
last if (-e "$mysql_path/mysql" || $mysql_path eq '');
print "I can't find $mysql_path/mysql. Please enter the full path\n";
print "or leave this option blank if you don't want to use MySQL\n";
}
unless ((-e "$mysql_path/mysql") || ($mysql_path eq '')) {
print STDERR "Warning: No correct input after $_ attempts. Continuing with warnings ...\n";
}
}
print << 'EOM';
Thank you. I will use this information to configure Mail::Ezmlm for you
EOM
# set the variables in Ezmlm.pm
# Back up file
open(EZMLM, '<Ezmlm.pm') or die "Unable to open Ezmlm.pm for read: $!";
open(TMP, ">Ezmlm.pm.tmp.$$") or die "Unable to create temp file: $!";
while(<EZMLM>) { print TMP; }
close TMP; close EZMLM;
# Do variable substitution
open(EZMLM, '>Ezmlm.pm') or die "Unable to open Ezmlm.pm for write: $!";
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 {};
}

19
Ezmlm/tags/Ezmlm-0.08.2/README Normal file
View file

@ -0,0 +1,19 @@
$Id$
Ezmlm.pm
Object methods for ezmlm mailing lists.
Install by doing the following ...
# perl Makefile.PL
# make test
# make install
One thing. For some reason MakeMaker doesn't like symlinks. Please make sure
you use the full canonical path for the qmail and ezmlm binaries.
Documentation is in pod format. Please run perldoc Mail::Ezmlm after you have
installed it.
- Guy Antony Halse <guy-ezmlm@rucus.ru.ac.za>
- Lars Kruse <devel@sumpfralle.de>

255
Ezmlm/tags/Ezmlm-0.08.2/test.pl Normal file
View file

@ -0,0 +1,255 @@
# ===========================================================================
# test.pl - version 0.02 - 25/09/2000
# $Id: test.pl,v 1.5 2005/03/05 14:08:30 guy Exp $
# Test suite for Mail::Ezmlm
#
# Copyright (C) 1999, Guy Antony Halse, All Rights Reserved.
# Please send bug reports and comments to guy-ezmlm@rucus.ru.ac.za
#
# This program is subject to the restrictions set out in the copyright
# agreement that can be found in the Ezmlm.pm file in this distribution
#
# ==========================================================================
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
$failed = 0;
BEGIN { $| = 1; print "1..9\n"; }
END {($failed++ && print "not ok 1\n") unless $loaded;}
use Mail::Ezmlm;
$loaded = 1;
print "Loading: ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
use Cwd;
use File::Find;
# we need to check, if ezmlm-idx is installed
sub check_external_dependency {
my $ezmlm_bin = $Mail::Ezmlm::EZMLM_BASE . "/ezmlm-make";
if (-x $ezmlm_bin) {
return (0==0);
} else {
return (0==1);
}
}
if (!check_external_dependency()) {
# For humans:
warn "You don't have ezmlm-idx installed. Please fetch it from "
. "http://ezmlm.org/ and install it.";
# For the tester scripts:
exit 0;
}
$list = new Mail::Ezmlm;
# create a temp directory if necessary
$TMP = cwd() . '/ezmlmtmp';
mkdir $TMP, 0755 unless (-d $TMP);
print 'Checking list creation: ';
$test1 = $list->make(-name=>"ezmlm-test1-$$",
-qmail=>"$TMP/.qmail-ezmlm-test1-$$",
-dir=>"$TMP/ezmlm-test1-$$");
if($test1 eq "$TMP/ezmlm-test1-$$") {
print "ok 2\n";
} else {
print 'not ok 2 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Checking vhost list creation: ';
$test2 = $list->make(-name=>"ezmlm-test2-$$",
-qmail=>"$TMP/.qmail-ezmlm-test2-$$",
-dir=>"$TMP/ezmlm-test2-$$",
-host=>'on.web.za',
-user=>'onwebza');
if($test2 eq "$TMP/ezmlm-test2-$$") {
open(INLOCAL, "<$TMP/ezmlm-test2-$$/inlocal");
chomp($test2 = <INLOCAL>);
close INLOCAL;
if($test2 eq "onwebza-ezmlm-test2-$$") {
print "ok 3\n";
} else {
print 'not ok 3 [', $list->errmsg(), "]\n";
$failed++;
}
} else {
print 'not ok 3 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Testing list update: ';
if($list->update('ms')) {
print "ok 4\n";
} else {
print 'not ok 4 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Testing setlist() and thislist(): ';
$list->setlist("$TMP/ezmlm-test1-$$");
if($list->thislist eq "$TMP/ezmlm-test1-$$") {
print "ok 5\n";
} else {
print 'not ok 5 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Testing list subscription and subscription listing: ';
$list->sub('nobody@on.web.za');
$list->sub('anonymous@on.web.za', 'test@on.web.za');
@subscribers = $list->subscribers;
if($subscribers[1] =~ /nobody\@on.web.za/) {
print "ok 6\n";
} else {
print 'not ok 6 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Testing issub(): ';
if(defined($list->issub('nobody@on.web.za'))) {
if(defined($list->issub('some@non.existant.address'))) {
print 'not ok 7 [', $list->errmsg(), "]\n";
$failed++;
} else {
print "ok 7\n";
}
} else {
print 'not ok 7 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Testing list unsubscription: ';
$list->unsub('nobody@on.web.za');
$list->unsub('anonymous@on.web.za', 'test@on.web.za');
@subscribers = $list->subscribers;
unless(@subscribers) {
print "ok 8\n";
} else {
print 'not ok 8 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Testing installed version of ezmlm: ';
my $version = $list->check_version();
# "check_version" returns zero for a valid version and the version string for an
# invalid version of ezmlm
if ($version != 0) {
$version =~ s/\n//;
print 'not ok 9 [Warning: Ezmlm.pm is designed to work with ezmlm-idx > 0.40. Your version reports as: ', $version, "]\n";
} else {
print "ok 9\n";
}
print 'Testing retrieving of text files: ';
if ($list->get_text_content('sub-ok') ne '') {
print "ok 10\n";
} else {
print 'not ok 10 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Testing changing of text files: ';
$list->set_text_content('sub-ok', "testing message\n");
if ($list->get_text_content('sub-ok') eq "testing message\n") {
print "ok 11\n";
} else {
print 'not ok 11 [', $list->errmsg(), "]\n";
$failed++;
}
print 'Testing if text file is marked as customized (only idx >= 5.0): ';
if ($list->get_version() >= 5) {
if ($list->is_text_default('sub-ok')) {
print 'not ok 12 [', $list->errmsg(), "]\n";
$failed++;
} else {
print "ok 12\n";
}
} else {
print "ok 12 [skipped]\n";
}
print 'Testing resetting text files (only idx >= 5.0): ';
if ($list->get_version() >= 5) {
$list->reset_text('sub-ok');
if ($list->is_text_default('sub-ok')) {
print "ok 13\n";
} else {
print 'not ok 13 [', $list->errmsg(), "]\n";
$failed++;
}
} else {
print "ok 13 [skipped]\n";
}
print 'Testing retrieving available languages (only idx >= 5.0): ';
if ($list->get_version() >= 5) {
my @avail_langs = $list->get_available_languages();
if ($#avail_langs > 0) {
print "ok 14\n";
} else {
print 'not ok 14 [', $list->errmsg(), "]\n";
$failed++;
}
} else {
print "ok 14 [skipped]\n";
}
print 'Testing changing the configured language (only idx >= 5.0): ';
if ($list->get_version() >= 5) {
my @avail_langs = $list->get_available_languages();
$list->set_lang($avail_langs[$#avail_langs-1]);
if ($list->get_lang() eq $avail_langs[$#avail_langs-1]) {
print "ok 15\n";
} else {
print 'not ok 15 [', $list->errmsg(), "]\n";
$failed++;
}
} else {
print "ok 15 [skipped]\n";
}
print 'Testing getting the configuration directory (only idx >= 5.0): ';
if ($list->get_version() >= 5) {
if ($list->get_config_dir() ne '') {
print "ok 16\n";
} else {
print 'not ok 16 [', $list->errmsg(), "]\n";
$failed++;
}
} else {
print "ok 16 [skipped]\n";
}
print 'Testing changing the configuration directory (only idx >= 5.0): ';
if ($list->get_version() >= 5) {
$list->set_config_dir('/etc/ezmlm-local');
if ($list->get_config_dir() eq '/etc/ezmlm-local') {
print "ok 17\n";
} else {
print 'not ok 17 [', $list->errmsg(), "]\n";
$failed++;
}
} else {
print "ok 17 [skipped]\n";
}
if($failed > 0) {
print "\n$failed tests were failed\n";
exit $failed;
} else {
print "\nSuccessful :-)\n";
finddepth(sub { (-d $File::Find::name) ? rmdir ($File::Find::name) : unlink ($File::Find::name) }, cwd() . "/ezmlmtmp");
exit;
}

BIN
Ezmlm/tags/packages/Ezmlm-0.08.2.tar.gz Normal file
View file

Binary file not shown.

BIN
Ezmlm/tags/packages/libemail-ezmlm-perl_0.08.2-1_all.deb Normal file
View file

Binary file not shown.