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

initialization of the Mail::Ezmlm::Gpg module

Browse source
This commit is contained in:
lars 2006-03-27 00:57:24 +00:00
parent 68740ac6f4
commit 5796ae787e
8 changed files with 985 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gpg-Ezmlm/trunk/Changes Normal file
View file

@ -0,0 +1,5 @@
Revision history for Perl extension Mail::Ezmlm::Gpg
0.01 Mon Mar 27 02:13:19 2006
- original version

579
gpg-Ezmlm/trunk/Gpg.pm Normal file
View file

@ -0,0 +1,579 @@
# ===========================================================================
# 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
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# TODO: change to GPL
#
# Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
#
# Redistributions in binary form must reproduce the above copyright notice,
# this list of conditions and the following disclaimer in the documentation
# and/or other materials provided with the distribution.
#
# Neither name Guy Lars Kruse nor the names of any contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
# IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# ==========================================================================
# POD is at the end of this file. Search for '=head' to find it
package Mail::Ezmlm::Gpg;
use strict;
use vars qw($GPG_EZMLM_BASE $VERSION @ISA @EXPORT @EXPORT_OK);
use Carp;
use Text::ParseWords;
require Exporter;
@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
);
$VERSION = '0.01';
require 5.005;
# == Begin site dependant variables ==
$GPG_EZMLM_BASE = '/usr/local/bin'; #Autoinserted by Makefile.PL
# == End site dependant variables ==
# == check the ezmlm-make path ==
$GPG_EZMLM_BASE = '/usr/local/bin/ezmlm' unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/local/bin/ezmlm-idx' unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/local/bin' unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/bin/ezmlm' unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/bin/ezmlm-idx' unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
$GPG_EZMLM_BASE = '/usr/bin' unless (-e "$GPG_EZMLM_BASE/gpg-ezmlm-manage.pl");
# == clean up the path for taint checking ==
local $ENV{'PATH'} = $GPG_EZMLM_BASE;
# == Initialiser - Returns a reference to the object ==
sub new {
my($class, $list) = @_;
my $self = {};
bless $self, ref $class || $class || 'Mail::Ezmlm::Gpg';
$self->setlist($list) if(defined($list) && $list);
return $self;
}
# == Make a new mailing list and set it to current ==
sub convert {
my($self, %list) = @_;
# Do we want to use command line switches
# These three variables are essential
($self->_seterror(-1, 'must define -dir in a make()') && return 0) unless(defined($list{'-dir'}));
# Attempt to make the list if we can.
unless(-e $list{'-dir'}) {
system("$GPG_EZMLM_BASE/gpg-ezmlm-convert.pm", $list{'-dir'}) == 0
|| ($self->_seterror($?) && return undef);
} else {
($self->_seterror(-1, '-dir must be defined in make()') && return 0);
}
$self->_seterror(undef);
return $self->setlist($list{'-dir'});
}
# == Update the current list ==
sub update {
my($self, %switches) = @_;
# check for important files: 'config'
($self->_seterror(-1, "$self->{'LIST_NAME'} does not appear to be a valid list in update()") && return 0) unless((-e "$self->{'LIST_NAME'}/config") || (-e "$self->{'LIST_NAME'}/flags"));
# Attempt to update the list if we can.
# TODO: put the changer code here
$self->_seterror(undef);
return $self->{'LIST_NAME'};
}
# == Get a list of options for the current list ==
sub getconfig {
my($self) = @_;
my(%options);
# Read the config file
if(open(CONFIG, "<$self->{'LIST_NAME'}/config")) {
# 'config' contains the authorative information
while(<CONFIG>) {
$options{$1} = $2 if (/^(\w+)\s(.*)$/);
}
close CONFIG;
} else {
$self->_seterror(-1, 'unable to read configuration file in getconfig()' && return undef);
}
$self->_seterror(undef);
return %options;
}
# == Return the name of the current list ==
sub thislist {
my($self) = shift;
$self->_seterror(undef);
return $self->{'LIST_NAME'};
}
# == Set the current mailing list ==
sub setlist {
my($self, $list) = @_;
if ($list =~ m/^([\w\d\_\-\.\/]+)$/) {
$list = $1;
if (-e "$list/lock") {
$self->_seterror(undef);
return $self->{'LIST_NAME'} = $list;
} else {
$self->_seterror(-1, "$list does not appear to be a valid list in setlist()");
return undef;
}
} else {
$self->_seterror(-1, "$list contains tainted data in setlist()");
return undef;
}
}
# == is the list encrypted? ==
sub is_gpg {
my($self) = @_;
($self->_seterror(-1, 'must setlist() before is_gpg()') && return 0) unless(defined($self->{'LIST_NAME'}));
$self->_seterror(undef);
return (0==1) unless (-e "$self->{'LIST_NAME'}/config");
my $content = getpart("config");
return (0==1) if ($content =~ /^F:/m);
return (0==0);
}
# == retrieve file contents ==
sub getpart {
my($self, $part) = @_;
my(@contents, $content);
# check for the file in the list directory first
my $filename = $self->{'LIST_NAME'} . "/$part";
# check for default file in config directory, if necessary
if (open(PART, "<$filename")) {
while(<PART>) {
unless ( /^#/ ) {
chomp($contents[$#contents++] = $_);
$content .= $_;
}
}
close PART;
if(wantarray) {
return @contents;
} else {
return $content;
}
} ($self->_seterror($?) && return undef);
}
# == set files contents ==
sub setpart {
my($self, $part, @content) = @_;
my($line);
if(open(PART, ">$self->{'LIST_NAME'}/$part")) {
foreach $line (@content) {
$line =~ s/[\r]//g; $line =~ s/\n$//;
print PART "$line\n";
}
close PART;
return 1;
} ($self->_seterror($?) && return undef);
}
# == import a new public key for a subscriber ==
sub import_public_key {
}
# == sign a public key ==
sub sign_public_key {
}
# == delete a public key ==
sub delete_public_key {
}
# == list_public_keys ==
sub list_public_keys {
}
# == generate new private key ==
sub generate_private_key {
}
# == list_private_keys ==
sub list_private_keys {
}
# == 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;
}
# == Internal function to test for valid email addresses ==
sub _checkaddress {
my($self, $address) = @_;
return 1 unless defined($address);
return 0 unless ($address =~ m/^(\S+\@\S+\.\S+)$/);
$_[1] = $1;
return 1;
}
1;
__END__
=head1 NAME
Ezmlm - Object Methods for Ezmlm Mailing Lists
=head1 SYNOPSIS
use Mail::Ezmlm;
$list = new Mail::Ezmlm;
The rest is a bit complicated for a Synopsis, see the description.
=head1 ABSTRACT
Ezmlm is a Perl module that is designed to provide an object interface to
the ezmlm mailing list manager software. See the ezmlm web page
(http://www.ezmlm.org/) for a complete description of the software.
This version of the module is designed to work with ezmlm version 0.53.
It is fully compatible with ezmlm's IDX extensions (version 0.4xx and 5.0 ). Both
of these can be obtained via anon ftp from ftp://ftp.ezmlm.org/pub/patches/
=head1 DESCRIPTION
=head2 Setting up a new Ezmlm object:
use Mail::Ezmlm;
$list = new Mail::Ezmlm;
$list = new Mail::Ezmlm('/home/user/lists/moolist');
=head2 Changing which list the Ezmlm object points at:
$list->setlist('/home/user/lists/moolist');
=head2 Getting a list of current subscribers:
=item Two methods of listing subscribers is provided. The first prints a list
of subscribers, one per line, to the supplied FILEHANDLE. If no filehandle is
given, this defaults to STDOUT. An optional second argument specifies the
part of the list to display (mod, digest, allow, deny). If the part is
specified, then the FILEHANDLE must be specified.
$list->list;
$list->list(\*STDERR);
$list->list(\*STDERR, 'deny');
=item The second method returns an array containing the subscribers. The
optional argument specifies which part of the list to display (mod, digest,
allow, deny).
@subscribers = $list->subscribers;
@subscribers = $list->subscribers('allow');
=head2 Testing for subscription:
$list->issub('nobody@on.web.za');
$list->issub(@addresses);
$list->issub(@addresses, 'mod');
issub() returns 1 if all the addresses supplied are found as subscribers
of the current mailing list, otherwise it returns undefined. The optional
argument specifies which part of the list to check (mod, digest, allow,
deny).
=head2 Subscribing to a list:
$list->sub('nobody@on.web.za');
$list->sub(@addresses);
$list->sub(@addresses, 'digest');
sub() takes a LIST of addresses and subscribes them to the current mailing list.
The optional argument specifies which part of the list to subscribe to (mod,
digest, allow, deny).
=head2 Unsubscribing from a list:
$list->unsub('nobody@on.web.za');
$list->unsub(@addresses);
$list->unsub(@addresses, 'mod');
unsub() takes a LIST of addresses and unsubscribes them (if they exist) from the
current mailing list. The optional argument specifies which part of the list
to unsubscribe from (mod, digest, allow, deny).
=head2 Creating a new list:
$list->make(-dir=>'/home/user/list/moo',
-qmail=>'/home/user/.qmail-moo',
-name=>'user-moo',
-host=>'on.web.za',
-user=>'onwebza',
-switches=>'mPz');
make() creates the list as defined and sets it to the current list. There are
three variables which must be defined in order for this to occur; -dir, -qmail and -name.
=over 6
=item -dir is the full path of the directory in which the mailing list is to
be created.
=item -qmail is the full path and name of the .qmail file to create.
=item -name is the local part of the mailing list address (eg if your list
was user-moo@on.web.za, -name is 'user-moo').
=item -host is the name of the host that this list is being created on. If
this item is omitted, make() will try to determine your hostname. If -host is
not the same as your hostname, then make() will attempt to fix DIR/inlocal for
a virtual host.
=item -user is the name of the user who owns this list. This item only needs to
be defined for virtual domains. If it exists, it is prepended to -name in DIR/inlocal.
If it is not defined, the make() will attempt to work out what it should be from
the qmail control files.
=item -switches is a list of command line switches to pass to ezmlm-make(1).
Note that the leading dash ('-') should be ommitted from the string.
=back
make() returns the value of thislist() for success, undefined if there was a
problem with the ezmlm-make system call and 0 if there was some other problem.
See the ezmlm-make(1) man page for more details
=head2 Determining which list we are currently altering:
$whichlist = $list->thislist;
print $list->thislist;
=head2 Getting the current configuration of the current list:
$list->getconfig;
getconfig() returns a string that contains the command line switches that
would be necessary to re-create the current list. It does this by reading the
DIR/config file (idx < v5.0) or DIR/flags (idx >= v5.0) if one of them exists.
If it can't find these files it attempts to work things out for itself (with
varying degrees of success). If both these methods fail, then getconfig()
returns undefined.
$list->ismodpost;
$list->ismodsub;
$list->isremote;
$list->isdeny;
$list->isallow;
The above five functions test various features of the list, and return a 1
if the list has that feature, or a 0 if it doesn't. These functions are
considered DEPRECATED as their result is not reliable. Use "getconfig" instead.
=head2 Updating the configuration of the current list:
$list->update('msPd');
update() can be used to rebuild the current mailing list with new command line
options. These options can be supplied as a string argument to the procedure.
Note that you do not need to supply the '-' or the 'e' command line switch.
@part = $list->getpart('headeradd');
$part = $list->getpart('headeradd');
$list->setpart('headerremove', @part);
getpart() and setpart() can be used to retrieve and set the contents of
various text files such as headeradd, headerremove, mimeremove, etc.
=head2 Manage language dependent text files
$list->get_available_text_files;
$list->get_text_content('sub-ok');
$list->set_text_content('sub-ok', @content);
These functions allow you to manipulate the text files, that are used for
automatic replies by ezmlm.
$list->is_text_default('sub-ok');
$list->reset_text('sub-ok');
These two functions are available if you are using ezmlm-idx v5.0 or higher.
is_text_default() checks, if there is a customized text file defined for this list.
reset_text() removes the customized text file from this list. Ezmlm-idx will use
system-wide default text file, if there is no customized text file for this list.
=head2 Change the list's settings (for ezmlm-idx >= 5.0)
Mail::Ezmlm->get_config_dir;
$list->get_config_dir;
$list->set_config_dir('/etc/ezmlm-local');
These function access the file 'conf-etc' in the mailing list's directory. The
static function always returns the default configuration directory of ezmlm-idx
(/etc/ezmlm).
$list->get_available_languages;
$list->get_lang;
$list->set_lang('de');
$list->get_charset;
$list->set_charset('iso-8859-1:Q');
These functions allow you to change the language of the text files, that are used
for automatic replies of ezmlm-idx (since v5.0 the configured language is stored
in 'conf-lang' within the mailing list's directory). Customized files (in the 'text'
directory of a mailing list directory) override the default language files.
Empty strings for set_lang() and set_charset() reset the setting to its default value.
=head2 Get the installed version of ezmlm
Mail::Ezmlm->get_version;
The result is one of the following:
0 - unknown
3 - ezmlm 0.53
4 - ezmlm-idx 0.4xx
5 - ezmlm-idx 5.x
=head2 Creating MySQL tables:
$list->createsql();
Currently only works for MySQL.
createsql() will attempt to create the table specified in the SQL connect
options of the current mailing list. It will return an error if the current
mailing list was not configured to use SQL, or is Ezmlm was not compiled
with MySQL support. See the MySQL info pages for more information.
=head2 Checking the Mail::Ezmlm and ezmlm version numbers
The version number of the Mail::Ezmlm module is stored in the variable
$Mail::Ezmlm::VERSION. The compatibility of this version of Mail::Ezmlm
with your system installed version of ezmlm can be checked with
$list->check_version();
This returns 0 for compatible, or the version string of ezmlm-make(2) if
the module is incompatible with your set up.
=head1 RETURN VALUES
All of the routines described above have return values. 0 or undefined are
used to indicate that an error of some form has occoured, while anything
>0 (including strings, etc) are used to indicate success.
If an error is encountered, the functions
$list->errno();
$list->errmsg();
can be used to determine what the error was.
errno() returns; 0 or undef if there was no error.
-1 for an error relating to this module.
>0 exit value of the last system() call.
errmsg() returns a string containing a description of the error ($! if it
was from a system() call). If there is no error, it returns undef.
For those who are interested, in those sub routines that have to make system
calls to perform their function, an undefined value indicates that the
system call failed, while 0 indicates some other error. Things that you would
expect to return a string (such as thislist()) return undefined to indicate
that they haven't a clue ... as opposed to the empty string which would mean
that they know about nothing :)
=head1 AUTHOR
Guy Antony Halse <guy-ezmlm@rucus.net>
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)
http://rucus.ru.ac.za/~guy/ezmlm/
https://systemausfall.org/toolforge/ezmlm-web
http://www.ezmlm.org/
http://www.qmail.org/
=cut

7
gpg-Ezmlm/trunk/MANIFEST Normal file
View file

@ -0,0 +1,7 @@
Changes
Gpg.pm
MANIFEST
README
Makefile.PL
test.pl
META.yml

10
gpg-Ezmlm/trunk/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.07.1
version_from: Ezmlm.pm
installdirs: site
requires:
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17

131
gpg-Ezmlm/trunk/Makefile.PL Normal file
View file

@ -0,0 +1,131 @@
# $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::Gpg',
'VERSION_FROM' => 'Gpg.pm', # finds $VERSION
'DISTNAME' => 'Ezmlm-Gpg',
'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' },
'clean' => { FILES => 'gpg-ezmlmtmp' }
);
sub set_paths {
my($qmail_path, $ezmlm_path);
# 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";
}
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";
}
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
# 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.$$";
return {};
}

17
gpg-Ezmlm/trunk/README Normal file
View file

@ -0,0 +1,17 @@
Ezmlm.pm
Object methods for gpg-ezmlm mailing lists
(see http://www.synacklabs.net/projects/crypt-ml)
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 cantonical path for the qmail and ezmlm binaries.
Documentation is in pod format. Please run perldoc Mail::Ezmlm::Gpg after you have
installed it.
- Lars Kruse <devel@sumpfralle.de>

2
gpg-Ezmlm/trunk/TODO Normal file
View file

@ -0,0 +1,2 @@
all

234
gpg-Ezmlm/trunk/test.pl Normal file
View file

@ -0,0 +1,234 @@
# ===========================================================================
# 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;
$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();
if ($version) {
$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;
}