initialization of the Mail::Ezmlm::Gpg module
This commit is contained in:
parent
68740ac6f4
commit
5796ae787e
8 changed files with 985 additions and 0 deletions
5
gpg-Ezmlm/trunk/Changes
Normal file
5
gpg-Ezmlm/trunk/Changes
Normal 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
579
gpg-Ezmlm/trunk/Gpg.pm
Normal 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
7
gpg-Ezmlm/trunk/MANIFEST
Normal file
|
|
@ -0,0 +1,7 @@
|
||||||
|
Changes
|
||||||
|
Gpg.pm
|
||||||
|
MANIFEST
|
||||||
|
README
|
||||||
|
Makefile.PL
|
||||||
|
test.pl
|
||||||
|
META.yml
|
||||||
10
gpg-Ezmlm/trunk/META.yml
Normal file
10
gpg-Ezmlm/trunk/META.yml
Normal 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
131
gpg-Ezmlm/trunk/Makefile.PL
Normal 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
17
gpg-Ezmlm/trunk/README
Normal 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
2
gpg-Ezmlm/trunk/TODO
Normal file
|
|
@ -0,0 +1,2 @@
|
||||||
|
all
|
||||||
|
|
||||||
234
gpg-Ezmlm/trunk/test.pl
Normal file
234
gpg-Ezmlm/trunk/test.pl
Normal 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;
|
||||||
|
}
|
||||||
Loading…
Reference in a new issue