Mail::Ezmlm release v0.08.2:

* updated debian files
* tagged release
* uploaded packages

Ezmlm/debian/changelog

@@ -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
 
   * New upstream release

Ezmlm/debian/control

@@ -9,7 +9,7 @@ Homepage: https://systemausfall.org/toolforge/ezmlm-web
 Package: libemail-ezmlm-perl
 Section: perl
 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
  The support for ezmlm-idx 6.0 is complete.
  The module still works fine with ezmlm-idx 0.4xx, too.

Ezmlm/tags/Ezmlm-0.08.2/Changes

@@ -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
+

Ezmlm/tags/Ezmlm-0.08.2/Ezmlm/GpgEzmlm.pm

@@ -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

Ezmlm/tags/Ezmlm-0.08.2/Ezmlm/GpgKeyRing.pm

@@ -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
+

Ezmlm/tags/Ezmlm-0.08.2/MANIFEST

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

Ezmlm/tags/Ezmlm-0.08.2/META.yml

@@ -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

Ezmlm/tags/Ezmlm-0.08.2/Makefile.PL

@@ -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 {};
+
+}
+

Ezmlm/tags/Ezmlm-0.08.2/README

@@ -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>

Ezmlm/tags/Ezmlm-0.08.2/test.pl

@@ -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;
+}