Mail::Ezmlm added
small updates to TODO and INSTALL
This commit is contained in:
commit
bf6c5d0c1f
14 changed files with 2292 additions and 0 deletions
33
Ezmlm/tags/Ezmlm-0.0.5.1/Changes
Normal file
33
Ezmlm/tags/Ezmlm-0.0.5.1/Changes
Normal file
|
|
@ -0,0 +1,33 @@
|
||||||
|
$Id: Changes,v 1.5 2005/03/05 14:14:27 guy Exp $
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
815
Ezmlm/tags/Ezmlm-0.0.5.1/Ezmlm.pm
Normal file
815
Ezmlm/tags/Ezmlm-0.0.5.1/Ezmlm.pm
Normal file
|
|
@ -0,0 +1,815 @@
|
||||||
|
# ===========================================================================
|
||||||
|
# Ezmlm.pm - version 0.04 - 26/05/2003
|
||||||
|
# $Id: Ezmlm.pm,v 1.10 2005/03/05 14:11:11 guy Exp $
|
||||||
|
#
|
||||||
|
# Object methods for ezmlm mailing lists
|
||||||
|
#
|
||||||
|
# Copyright (C) 1999-2005, Guy Antony Halse, All Rights Reserved.
|
||||||
|
# Please send bug reports and comments to guy@rucus.ru.ac.za
|
||||||
|
#
|
||||||
|
# Redistribution and use in source and binary forms, with or without
|
||||||
|
# modification, are permitted provided that the following conditions are
|
||||||
|
# met:
|
||||||
|
#
|
||||||
|
# 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 Antony Halse 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;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use vars qw($QMAIL_BASE $EZMLM_BASE $MYSQL_BASE $VERSION @ISA @EXPORT @EXPORT_OK);
|
||||||
|
use Carp;
|
||||||
|
|
||||||
|
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.05';
|
||||||
|
|
||||||
|
require 5.005;
|
||||||
|
|
||||||
|
# == Begin site dependant variables ==
|
||||||
|
$EZMLM_BASE = '/usr/local/bin'; #Autoinserted by Makefile.PL
|
||||||
|
$QMAIL_BASE = '/var/qmail'; #Autoinserted by Makefile.PL
|
||||||
|
$MYSQL_BASE = ''; #Autoinserted by Makefile.PL
|
||||||
|
# == End site dependant variables ==
|
||||||
|
|
||||||
|
use Carp;
|
||||||
|
|
||||||
|
# == clean up the path for taint checking ==
|
||||||
|
local $ENV{'PATH'} = $EZMLM_BASE;
|
||||||
|
|
||||||
|
# == Initialiser - Returns a reference to the object ==
|
||||||
|
sub new {
|
||||||
|
my($class, $list) = @_;
|
||||||
|
my $self = {};
|
||||||
|
bless $self, ref $class || $class || 'Mail::Ezmlm';
|
||||||
|
$self->setlist($list) if(defined($list) && $list);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Make a new mailing list and set it to current ==
|
||||||
|
sub make {
|
||||||
|
my($self, %list) = @_;
|
||||||
|
my($VHOST, $comandline, $hostname);
|
||||||
|
|
||||||
|
# Do we want to use command line switches
|
||||||
|
my $commandline = '';
|
||||||
|
$commandline = '-' . $list{'-switches'} if(defined($list{'-switches'}));
|
||||||
|
my @commandline;
|
||||||
|
# UGLY!
|
||||||
|
foreach (split(/["'](.+?)["']|(\s-\w+)/, $commandline)) {
|
||||||
|
next if (!defined($_) or !$_ or $_ eq ' ');
|
||||||
|
push @commandline, $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
# These three variables are essential
|
||||||
|
($self->_seterror(-1, 'must define -dir in a make()') && return 0) unless(defined($list{'-dir'}));
|
||||||
|
($self->_seterror(-1, 'must define -qmail in a make()') && return 0) unless(defined($list{'-qmail'}));
|
||||||
|
($self->_seterror(-1, 'must define -name in a make()') && return 0) unless(defined($list{'-name'}));
|
||||||
|
|
||||||
|
# Determine hostname if it is not supplied
|
||||||
|
$hostname = $self->_getdefaultdomain;
|
||||||
|
if(defined($list{'-host'})) {
|
||||||
|
$VHOST = 1 unless ($list{'-host'} eq $hostname);
|
||||||
|
} else {
|
||||||
|
$list{'-host'} = $hostname;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Attempt to make the list if we can.
|
||||||
|
unless(-e $list{'-dir'}) {
|
||||||
|
system("$EZMLM_BASE/ezmlm-make", @commandline, $list{'-dir'}, $list{'-qmail'}, $list{'-name'}, $list{'-host'}) == 0
|
||||||
|
|| ($self->_seterror($?) && return undef);
|
||||||
|
} else {
|
||||||
|
($self->_seterror(-1, '-dir must be defined in make()') && return 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Sort out the DIR/inlocal problem if necessary
|
||||||
|
if(defined($VHOST)) {
|
||||||
|
unless(defined($list{'-user'})) {
|
||||||
|
($self->_seterror(-1, '-user must match virtual host user in make()') && return 0) unless($list{'-user'} = $self->_getvhostuser($list{'-host'}));
|
||||||
|
}
|
||||||
|
|
||||||
|
open(INLOCAL, ">$list{'-dir'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in make()') && return 0);
|
||||||
|
print INLOCAL $list{'-user'} . '-' . $list{'-name'} . "\n";
|
||||||
|
close INLOCAL;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return $self->setlist($list{'-dir'});
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Update the current list ==
|
||||||
|
sub update {
|
||||||
|
my($self, $switches) = @_;
|
||||||
|
my($outhost, $inlocal);
|
||||||
|
|
||||||
|
# Do we have the command line switches
|
||||||
|
($self->_seterror(-1, 'nothing to update()') && return 0) unless(defined($switches));
|
||||||
|
$switches = '-e' . $switches;
|
||||||
|
my @switches;
|
||||||
|
|
||||||
|
# UGLY!
|
||||||
|
foreach (split(/["'](.+?)["']|(-\w+)/, $switches)) {
|
||||||
|
next if (!defined($_) or !$_ or $_ eq ' ');
|
||||||
|
push @switches, $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
# can we actually alter this list;
|
||||||
|
($self->_seterror(-1, 'must setlist() before you update()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
($self->_seterror(-1, "$self->{'LIST_NAME'} does not appear to be a valid list in update()") && return 0) unless(-e "$self->{'LIST_NAME'}/config");
|
||||||
|
|
||||||
|
# Work out if this is a vhost.
|
||||||
|
open(OUTHOST, "<$self->{'LIST_NAME'}/outhost") || ($self->_seterror(-1, 'unable to read outhost in update()') && return 0);
|
||||||
|
chomp($outhost = <OUTHOST>);
|
||||||
|
close(OUTHOST);
|
||||||
|
|
||||||
|
# Save the contents of inlocal if it is a vhost
|
||||||
|
unless($outhost eq $self->_getdefaultdomain) {
|
||||||
|
open(INLOCAL, "<$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in update()') && return 0);
|
||||||
|
chomp($inlocal = <INLOCAL>);
|
||||||
|
close(INLOCAL);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Attempt to update the list if we can.
|
||||||
|
system("$EZMLM_BASE/ezmlm-make", @switches, $self->{'LIST_NAME'}) == 0
|
||||||
|
|| ($self->_seterror($?) && return undef);
|
||||||
|
|
||||||
|
# Sort out the DIR/inlocal problem if necessary
|
||||||
|
if(defined($inlocal)) {
|
||||||
|
open(INLOCAL, ">$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to write inlocal in update()') && return 0);
|
||||||
|
print INLOCAL "$inlocal\n";
|
||||||
|
close INLOCAL;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return $self->{'LIST_NAME'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Get a list of options for the current list ==
|
||||||
|
sub getconfig {
|
||||||
|
my($self) = @_;
|
||||||
|
my($options, $i);
|
||||||
|
|
||||||
|
# Read the config file
|
||||||
|
if(open(CONFIG, "<$self->{'LIST_NAME'}/config")) {
|
||||||
|
while(<CONFIG>) {
|
||||||
|
if (/^F:-(\w+)/) {
|
||||||
|
$options = $1;
|
||||||
|
} elsif (/^(\d):(.+)$/) {
|
||||||
|
$options .= " -$1 '$2'";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
close CONFIG;
|
||||||
|
} else {
|
||||||
|
# Try manually
|
||||||
|
$options = $self->_getconfigmanual();
|
||||||
|
}
|
||||||
|
|
||||||
|
($self->_seterror(-1, 'unable to read configuration in getconfig()') && return undef) unless (defined($options));
|
||||||
|
|
||||||
|
# Add the unselected options too
|
||||||
|
foreach $i ('a' .. 'z') {
|
||||||
|
$options .= uc($i) unless ($options =~ /$i/i)
|
||||||
|
}
|
||||||
|
|
||||||
|
$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;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Output the subscribers to $stream ==
|
||||||
|
sub list {
|
||||||
|
my($self, $stream, $part) = @_;
|
||||||
|
$stream = *STDOUT unless (defined($stream));
|
||||||
|
if(defined($part)) {
|
||||||
|
print $stream $self->subscribers($part);
|
||||||
|
} else {
|
||||||
|
print $stream $self->subscribers;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Return an array of subscribers ==
|
||||||
|
sub subscribers {
|
||||||
|
my($self, $part) = @_;
|
||||||
|
my(@subscribers);
|
||||||
|
($self->_seterror(-1, 'must setlist() before returning subscribers()') && return undef) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
if(defined($part) && $part) {
|
||||||
|
($self->_seterror(-1, "$part part of $self->{'LIST_NAME'} does not appear to exist in subscribers()") && return undef) unless(-e "$self->{'LIST_NAME'}/$part");
|
||||||
|
@subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}/$part`;
|
||||||
|
} else {
|
||||||
|
@subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}`;
|
||||||
|
}
|
||||||
|
|
||||||
|
if($?) {
|
||||||
|
$self->_seterror($?, 'error during ezmlm-list in subscribers()');
|
||||||
|
return (scalar @subscribers ? @subscribers : undef);
|
||||||
|
} else {
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return @subscribers;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Subscribe users to the current list ==
|
||||||
|
sub sub {
|
||||||
|
my($self, @addresses) = @_;
|
||||||
|
($self->_seterror(-1, 'sub() must be called with at least one address') && return 0) unless @addresses;
|
||||||
|
my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
|
||||||
|
my($address);
|
||||||
|
($self->_seterror(-1, 'must setlist() before sub()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
|
||||||
|
if(defined($part) && $part) {
|
||||||
|
($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in sub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
next unless $self->_checkaddress($address);
|
||||||
|
system("$EZMLM_BASE/ezmlm-sub", "$self->{'LIST_NAME'}/$part", $address) == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
next unless $self->_checkaddress($address);
|
||||||
|
system("$EZMLM_BASE/ezmlm-sub", $self->{'LIST_NAME'}, $address) == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Unsubscribe users from a list ==
|
||||||
|
sub unsub {
|
||||||
|
my($self, @addresses) = @_;
|
||||||
|
($self->_seterror(-1, 'unsub() must be called with at least one address') && return 0) unless @addresses;
|
||||||
|
my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
|
||||||
|
my($address);
|
||||||
|
($self->_seterror(-1, 'must setlist() before unsub()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
|
||||||
|
if(defined($part) && $part) {
|
||||||
|
($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in unsub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
next unless $self->_checkaddress($address);
|
||||||
|
system("$EZMLM_BASE/ezmlm-unsub", "$self->{'LIST_NAME'}/$part", $address) == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
next unless $self->_checkaddress($address);
|
||||||
|
system("$EZMLM_BASE/ezmlm-unsub", $self->{'LIST_NAME'}, $address) == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Test whether people are subscribed to the list ==
|
||||||
|
sub issub {
|
||||||
|
my($self, @addresses) = @_;
|
||||||
|
my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
|
||||||
|
my($address, $issub); $issub = 1;
|
||||||
|
($self->_seterror(-1, 'must setlist() before issub()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
|
||||||
|
local $ENV{'SENDER'};
|
||||||
|
|
||||||
|
if(defined($part) && $part) {
|
||||||
|
($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in issub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
$ENV{'SENDER'} = $address;
|
||||||
|
undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", "$self->{'LIST_NAME'}/$part") / 256) != 0)
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
$ENV{'SENDER'} = $address;
|
||||||
|
undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", $self->{'LIST_NAME'}) / 256) != 0)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return $issub;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Is the list posting moderated ==
|
||||||
|
sub ismodpost {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before ismodpost()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/modpost";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Is the list subscriber moderated ==
|
||||||
|
sub ismodsub {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before ismodsub()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/modsub";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Is the list remote adminable ==
|
||||||
|
sub isremote {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before isremote()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/remote";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Does the list have a kill list ==
|
||||||
|
sub isdeny {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before isdeny()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/deny";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Does the list have an allow list ==
|
||||||
|
sub isallow {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before isallow()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/allow";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Is this a digested list ==
|
||||||
|
sub isdigest {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/digest";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == retrieve file contents ==
|
||||||
|
sub getpart {
|
||||||
|
my($self, $part) = @_;
|
||||||
|
my(@contents, $content);
|
||||||
|
if(open(PART, "<$self->{'LIST_NAME'}/$part")) {
|
||||||
|
while(<PART>) {
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
|
||||||
|
# == return an error message if appropriate ==
|
||||||
|
sub errmsg {
|
||||||
|
my($self) = @_;
|
||||||
|
return $self->{'ERRMSG'};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub errno {
|
||||||
|
my($self) = @_;
|
||||||
|
return $self->{'ERRNO'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Test the compatiblity of the module ==
|
||||||
|
sub check_version {
|
||||||
|
my($self) = @_;
|
||||||
|
my $version = `$EZMLM_BASE/ezmlm-make -V 2>&1`;
|
||||||
|
$self->_seterror(undef);
|
||||||
|
|
||||||
|
my ($ezmlm, $idx) = $version =~ m/^ezmlm-make\s+version:\s+ezmlm-([\d.]+)(?:\+ezmlm-idx-([\d.]+))?/;
|
||||||
|
if($ezmlm >= 0.53) {
|
||||||
|
if (defined($idx)) {
|
||||||
|
if ($idx >= 0.40) {
|
||||||
|
return 0;
|
||||||
|
} else {
|
||||||
|
return $version;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
return $version;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Create SQL Database tables if defined for a list ==
|
||||||
|
sub createsql {
|
||||||
|
my($self) = @_;
|
||||||
|
|
||||||
|
($self->_seterror(-1, 'MySQL must be compiled into Ezmlm for createsql() to work') && return 0) unless(defined($MYSQL_BASE) && $MYSQL_BASE);
|
||||||
|
($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
my($config) = $self->getconfig();
|
||||||
|
|
||||||
|
if($config =~ m/-6\s+'(.+?)'\s*/){
|
||||||
|
my($sqlsettings) = $1;
|
||||||
|
my($host, $port, $user, $password, $database, $table) = split(':', $sqlsettings, 6);
|
||||||
|
|
||||||
|
($self->_seterror(-1, 'error in list configuration while trying createsql()') && return 0)
|
||||||
|
unless (defined($host) && defined($port) && defined($user)
|
||||||
|
&& defined($password) && defined($database) && defined($table));
|
||||||
|
|
||||||
|
system("$EZMLM_BASE/ezmlm-mktab -d $table | $MYSQL_BASE/mysql -h$host -P$port -u$user -p$password -f $database") == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
|
||||||
|
} else {
|
||||||
|
$self->_seterror(-1, 'config for thislist() must include SQL options');
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
($self->_seterror(undef) && return 1);
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# == 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;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Internal function to work out a list configuration ==
|
||||||
|
sub _getconfigmanual {
|
||||||
|
my($self) = @_;
|
||||||
|
my ($savedollarslash, $options, $manager, $editor);
|
||||||
|
|
||||||
|
# Read the whole of DIR/editor and DIR/manager in
|
||||||
|
$savedollarslash = $/;
|
||||||
|
undef $/;
|
||||||
|
# $/ = \0777;
|
||||||
|
|
||||||
|
open (EDITOR, "<$self->{'LIST_NAME'}/editor") || ($self->_seterror($?) && return undef);
|
||||||
|
open (MANAGER, "<$self->{'LIST_NAME'}/manager") || ($self->_seterror($?) && return undef);
|
||||||
|
$editor = <EDITOR>; $manager = <MANAGER>;
|
||||||
|
close(EDITOR), close(MANAGER);
|
||||||
|
|
||||||
|
$/ = $savedollarslash;
|
||||||
|
|
||||||
|
$options = '';
|
||||||
|
$options .= 'a' if (-e "$self->{'LIST_NAME'}/archived");
|
||||||
|
$options .= 'd' if (-e "$self->{'LIST_NAME'}/digest");
|
||||||
|
$options .= 'f' if (-e "$self->{'LIST_NAME'}/prefix");
|
||||||
|
$options .= 'g' if ($manager =~ /ezmlm-get -\w*s/ );
|
||||||
|
$options .= 'i' if (-e "$self->{'LIST_NAME'}/indexed");
|
||||||
|
$options .= 'k' if (-e "$self->{'LIST_NAME'}/blacklist" || -e "$self->{'LIST_NAME'}/deny");
|
||||||
|
$options .= 'l' if ($manager =~ /ezmlm-manage -\w*l/ );
|
||||||
|
$options .= 'm' if (-e "$self->{'LIST_NAME'}/modpost");
|
||||||
|
$options .= 'n' if ($manager =~ /ezmlm-manage -\w*e/ );
|
||||||
|
$options .= 'p' if (-e "$self->{'LIST_NAME'}/public");
|
||||||
|
$options .= 'q' if ($manager =~ /ezmlm-request/ );
|
||||||
|
$options .= 'r' if (-e "$self->{'LIST_NAME'}/remote");
|
||||||
|
$options .= 's' if (-e "$self->{'LIST_NAME'}/modsub");
|
||||||
|
$options .= 't' if (-e "$self->{'LIST_NAME'}/text/trailer");
|
||||||
|
$options .= 'u' if (($options !~ /m/ && $editor =~ /ezmlm-issubn \'/ )
|
||||||
|
|| $editor =~ /ezmlm-gate/ );
|
||||||
|
$options .= 'x' if (-e "$self->{'LIST_NAME'}/extra" || -e "$self->{'LIST_NAME'}/allow");
|
||||||
|
|
||||||
|
return $options;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Internal Function to try to determine the vhost user ==
|
||||||
|
sub _getvhostuser {
|
||||||
|
my($self, $hostname) = @_;
|
||||||
|
my($username);
|
||||||
|
|
||||||
|
open(VD, "<$QMAIL_BASE/control/virtualdomains") || ($self->_seterror($?) && return undef);
|
||||||
|
while(<VD>) {
|
||||||
|
last if(($username) = /^\s*$hostname:(\w+)$/);
|
||||||
|
}
|
||||||
|
close VD;
|
||||||
|
|
||||||
|
return $username;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Internal function to work out default host name ==
|
||||||
|
sub _getdefaultdomain {
|
||||||
|
my($self) = @_;
|
||||||
|
my($hostname);
|
||||||
|
|
||||||
|
open (GETHOST, "<$QMAIL_BASE/control/defaultdomain")
|
||||||
|
|| open (GETHOST, "<$QMAIL_BASE/control/me")
|
||||||
|
|| ($self->_seterror($?) && return undef);
|
||||||
|
chomp($hostname = <GETHOST>);
|
||||||
|
close GETHOST;
|
||||||
|
|
||||||
|
return $hostname;
|
||||||
|
}
|
||||||
|
|
||||||
|
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.40). 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 if it exists. If it can't find this file 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.
|
||||||
|
|
||||||
|
=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 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>
|
||||||
|
|
||||||
|
=head1 BUGS
|
||||||
|
|
||||||
|
May have problems with newer versions of Perl.
|
||||||
|
|
||||||
|
Please report bugs to the author.
|
||||||
|
|
||||||
|
=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/
|
||||||
|
http://www.ezmlm.org/
|
||||||
|
http://www.qmail.org/
|
||||||
|
|
||||||
|
=cut
|
||||||
7
Ezmlm/tags/Ezmlm-0.0.5.1/MANIFEST
Normal file
7
Ezmlm/tags/Ezmlm-0.0.5.1/MANIFEST
Normal file
|
|
@ -0,0 +1,7 @@
|
||||||
|
Changes
|
||||||
|
Ezmlm.pm
|
||||||
|
MANIFEST
|
||||||
|
README
|
||||||
|
Makefile.PL
|
||||||
|
test.pl
|
||||||
|
META.yml
|
||||||
10
Ezmlm/tags/Ezmlm-0.0.5.1/META.yml
Normal file
10
Ezmlm/tags/Ezmlm-0.0.5.1/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.05
|
||||||
|
version_from: Ezmlm.pm
|
||||||
|
installdirs: site
|
||||||
|
requires:
|
||||||
|
|
||||||
|
distribution_type: module
|
||||||
|
generated_by: ExtUtils::MakeMaker version 6.17
|
||||||
119
Ezmlm/tags/Ezmlm-0.0.5.1/Makefile.PL
Normal file
119
Ezmlm/tags/Ezmlm-0.0.5.1/Makefile.PL
Normal file
|
|
@ -0,0 +1,119 @@
|
||||||
|
# $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
|
||||||
|
'DISTNAME' => 'Ezmlm',
|
||||||
|
'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' },
|
||||||
|
'clean' => { FILES => '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;
|
||||||
|
|
||||||
|
foreach (1..10) {
|
||||||
|
$ezmlm_path = prompt('Ezmlm binary directory?', '/usr/local/bin');
|
||||||
|
last if (-e "$ezmlm_path/ezmlm-make");
|
||||||
|
print "I can't find $ezmlm_path/ezmlm-make. Please try again\n";
|
||||||
|
if ($_ >= 10) {
|
||||||
|
print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n";
|
||||||
|
exit (2);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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 (-d "$qmail_path/control");
|
||||||
|
print "I can't find $qmail_path/control. Please try again\n";
|
||||||
|
if ($_ >= 10) {
|
||||||
|
print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n";
|
||||||
|
exit (2);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
foreach (1..10) {
|
||||||
|
$mysql_path = prompt('MySQL binary directory?', '');
|
||||||
|
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";
|
||||||
|
if ($_ >= 10) {
|
||||||
|
print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n";
|
||||||
|
exit (2);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
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*;}{\$EZMLM_BASE = '$ezmlm_path'; #Autoinserted by Makefile.PL};
|
||||||
|
s{^\$QMAIL_BASE\s*=\s*['"].+?['"]\s*;}{\$QMAIL_BASE = '$qmail_path'; #Autoinserted by Makefile.PL};
|
||||||
|
s{^\$MYSQL_BASE\s*=\s*['"].*?['"]\s*;}{\$MYSQL_BASE = '$mysql_path'; #Autoinserted by Makefile.PL};
|
||||||
|
print EZMLM;
|
||||||
|
}
|
||||||
|
close TMP; close EZMLM;
|
||||||
|
|
||||||
|
unlink "Ezmlm.pm.tmp.$$";
|
||||||
|
|
||||||
|
return {};
|
||||||
|
|
||||||
|
}
|
||||||
22
Ezmlm/tags/Ezmlm-0.0.5.1/README
Normal file
22
Ezmlm/tags/Ezmlm-0.0.5.1/README
Normal file
|
|
@ -0,0 +1,22 @@
|
||||||
|
$Id: README,v 1.3 2005/03/05 14:14:06 guy Exp $
|
||||||
|
|
||||||
|
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 cantonical path for the qmail and ezmlm binaries.
|
||||||
|
|
||||||
|
Documentation is in pod format. Please run perldoc Mail::Ezmlm after you have
|
||||||
|
installed it.
|
||||||
|
|
||||||
|
Much as I'd like to, I don't have the time to regularly maintain this. New
|
||||||
|
releases are infrequent at best. Check http://guy.rucus.net/ezmlm/contrib/
|
||||||
|
for patches, etc that may be useful.
|
||||||
|
|
||||||
|
- Guy Antony Halse <guy-ezmlm@rucus.ru.ac.za>
|
||||||
140
Ezmlm/tags/Ezmlm-0.0.5.1/test.pl
Normal file
140
Ezmlm/tags/Ezmlm-0.0.5.1/test.pl
Normal file
|
|
@ -0,0 +1,140 @@
|
||||||
|
# ===========================================================================
|
||||||
|
# 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 [Ezmlm.pm is designed to work with ezmlm-idx > 0.40. Your version reports as: ', $version, "]\n";
|
||||||
|
} else {
|
||||||
|
print "ok 9\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;
|
||||||
|
}
|
||||||
33
Ezmlm/trunk/Changes
Normal file
33
Ezmlm/trunk/Changes
Normal file
|
|
@ -0,0 +1,33 @@
|
||||||
|
$Id: Changes,v 1.5 2005/03/05 14:14:27 guy Exp $
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
815
Ezmlm/trunk/Ezmlm.pm
Normal file
815
Ezmlm/trunk/Ezmlm.pm
Normal file
|
|
@ -0,0 +1,815 @@
|
||||||
|
# ===========================================================================
|
||||||
|
# Ezmlm.pm - version 0.04 - 26/05/2003
|
||||||
|
# $Id: Ezmlm.pm,v 1.10 2005/03/05 14:11:11 guy Exp $
|
||||||
|
#
|
||||||
|
# Object methods for ezmlm mailing lists
|
||||||
|
#
|
||||||
|
# Copyright (C) 1999-2005, Guy Antony Halse, All Rights Reserved.
|
||||||
|
# Please send bug reports and comments to guy@rucus.ru.ac.za
|
||||||
|
#
|
||||||
|
# Redistribution and use in source and binary forms, with or without
|
||||||
|
# modification, are permitted provided that the following conditions are
|
||||||
|
# met:
|
||||||
|
#
|
||||||
|
# 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 Antony Halse 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;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use vars qw($QMAIL_BASE $EZMLM_BASE $MYSQL_BASE $VERSION @ISA @EXPORT @EXPORT_OK);
|
||||||
|
use Carp;
|
||||||
|
|
||||||
|
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.05';
|
||||||
|
|
||||||
|
require 5.005;
|
||||||
|
|
||||||
|
# == Begin site dependant variables ==
|
||||||
|
$EZMLM_BASE = '/usr/local/bin'; #Autoinserted by Makefile.PL
|
||||||
|
$QMAIL_BASE = '/var/qmail'; #Autoinserted by Makefile.PL
|
||||||
|
$MYSQL_BASE = ''; #Autoinserted by Makefile.PL
|
||||||
|
# == End site dependant variables ==
|
||||||
|
|
||||||
|
use Carp;
|
||||||
|
|
||||||
|
# == clean up the path for taint checking ==
|
||||||
|
local $ENV{'PATH'} = $EZMLM_BASE;
|
||||||
|
|
||||||
|
# == Initialiser - Returns a reference to the object ==
|
||||||
|
sub new {
|
||||||
|
my($class, $list) = @_;
|
||||||
|
my $self = {};
|
||||||
|
bless $self, ref $class || $class || 'Mail::Ezmlm';
|
||||||
|
$self->setlist($list) if(defined($list) && $list);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Make a new mailing list and set it to current ==
|
||||||
|
sub make {
|
||||||
|
my($self, %list) = @_;
|
||||||
|
my($VHOST, $comandline, $hostname);
|
||||||
|
|
||||||
|
# Do we want to use command line switches
|
||||||
|
my $commandline = '';
|
||||||
|
$commandline = '-' . $list{'-switches'} if(defined($list{'-switches'}));
|
||||||
|
my @commandline;
|
||||||
|
# UGLY!
|
||||||
|
foreach (split(/["'](.+?)["']|(\s-\w+)/, $commandline)) {
|
||||||
|
next if (!defined($_) or !$_ or $_ eq ' ');
|
||||||
|
push @commandline, $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
# These three variables are essential
|
||||||
|
($self->_seterror(-1, 'must define -dir in a make()') && return 0) unless(defined($list{'-dir'}));
|
||||||
|
($self->_seterror(-1, 'must define -qmail in a make()') && return 0) unless(defined($list{'-qmail'}));
|
||||||
|
($self->_seterror(-1, 'must define -name in a make()') && return 0) unless(defined($list{'-name'}));
|
||||||
|
|
||||||
|
# Determine hostname if it is not supplied
|
||||||
|
$hostname = $self->_getdefaultdomain;
|
||||||
|
if(defined($list{'-host'})) {
|
||||||
|
$VHOST = 1 unless ($list{'-host'} eq $hostname);
|
||||||
|
} else {
|
||||||
|
$list{'-host'} = $hostname;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Attempt to make the list if we can.
|
||||||
|
unless(-e $list{'-dir'}) {
|
||||||
|
system("$EZMLM_BASE/ezmlm-make", @commandline, $list{'-dir'}, $list{'-qmail'}, $list{'-name'}, $list{'-host'}) == 0
|
||||||
|
|| ($self->_seterror($?) && return undef);
|
||||||
|
} else {
|
||||||
|
($self->_seterror(-1, '-dir must be defined in make()') && return 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Sort out the DIR/inlocal problem if necessary
|
||||||
|
if(defined($VHOST)) {
|
||||||
|
unless(defined($list{'-user'})) {
|
||||||
|
($self->_seterror(-1, '-user must match virtual host user in make()') && return 0) unless($list{'-user'} = $self->_getvhostuser($list{'-host'}));
|
||||||
|
}
|
||||||
|
|
||||||
|
open(INLOCAL, ">$list{'-dir'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in make()') && return 0);
|
||||||
|
print INLOCAL $list{'-user'} . '-' . $list{'-name'} . "\n";
|
||||||
|
close INLOCAL;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return $self->setlist($list{'-dir'});
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Update the current list ==
|
||||||
|
sub update {
|
||||||
|
my($self, $switches) = @_;
|
||||||
|
my($outhost, $inlocal);
|
||||||
|
|
||||||
|
# Do we have the command line switches
|
||||||
|
($self->_seterror(-1, 'nothing to update()') && return 0) unless(defined($switches));
|
||||||
|
$switches = '-e' . $switches;
|
||||||
|
my @switches;
|
||||||
|
|
||||||
|
# UGLY!
|
||||||
|
foreach (split(/["'](.+?)["']|(-\w+)/, $switches)) {
|
||||||
|
next if (!defined($_) or !$_ or $_ eq ' ');
|
||||||
|
push @switches, $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
# can we actually alter this list;
|
||||||
|
($self->_seterror(-1, 'must setlist() before you update()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
($self->_seterror(-1, "$self->{'LIST_NAME'} does not appear to be a valid list in update()") && return 0) unless(-e "$self->{'LIST_NAME'}/config");
|
||||||
|
|
||||||
|
# Work out if this is a vhost.
|
||||||
|
open(OUTHOST, "<$self->{'LIST_NAME'}/outhost") || ($self->_seterror(-1, 'unable to read outhost in update()') && return 0);
|
||||||
|
chomp($outhost = <OUTHOST>);
|
||||||
|
close(OUTHOST);
|
||||||
|
|
||||||
|
# Save the contents of inlocal if it is a vhost
|
||||||
|
unless($outhost eq $self->_getdefaultdomain) {
|
||||||
|
open(INLOCAL, "<$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in update()') && return 0);
|
||||||
|
chomp($inlocal = <INLOCAL>);
|
||||||
|
close(INLOCAL);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Attempt to update the list if we can.
|
||||||
|
system("$EZMLM_BASE/ezmlm-make", @switches, $self->{'LIST_NAME'}) == 0
|
||||||
|
|| ($self->_seterror($?) && return undef);
|
||||||
|
|
||||||
|
# Sort out the DIR/inlocal problem if necessary
|
||||||
|
if(defined($inlocal)) {
|
||||||
|
open(INLOCAL, ">$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to write inlocal in update()') && return 0);
|
||||||
|
print INLOCAL "$inlocal\n";
|
||||||
|
close INLOCAL;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return $self->{'LIST_NAME'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Get a list of options for the current list ==
|
||||||
|
sub getconfig {
|
||||||
|
my($self) = @_;
|
||||||
|
my($options, $i);
|
||||||
|
|
||||||
|
# Read the config file
|
||||||
|
if(open(CONFIG, "<$self->{'LIST_NAME'}/config")) {
|
||||||
|
while(<CONFIG>) {
|
||||||
|
if (/^F:-(\w+)/) {
|
||||||
|
$options = $1;
|
||||||
|
} elsif (/^(\d):(.+)$/) {
|
||||||
|
$options .= " -$1 '$2'";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
close CONFIG;
|
||||||
|
} else {
|
||||||
|
# Try manually
|
||||||
|
$options = $self->_getconfigmanual();
|
||||||
|
}
|
||||||
|
|
||||||
|
($self->_seterror(-1, 'unable to read configuration in getconfig()') && return undef) unless (defined($options));
|
||||||
|
|
||||||
|
# Add the unselected options too
|
||||||
|
foreach $i ('a' .. 'z') {
|
||||||
|
$options .= uc($i) unless ($options =~ /$i/i)
|
||||||
|
}
|
||||||
|
|
||||||
|
$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;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Output the subscribers to $stream ==
|
||||||
|
sub list {
|
||||||
|
my($self, $stream, $part) = @_;
|
||||||
|
$stream = *STDOUT unless (defined($stream));
|
||||||
|
if(defined($part)) {
|
||||||
|
print $stream $self->subscribers($part);
|
||||||
|
} else {
|
||||||
|
print $stream $self->subscribers;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Return an array of subscribers ==
|
||||||
|
sub subscribers {
|
||||||
|
my($self, $part) = @_;
|
||||||
|
my(@subscribers);
|
||||||
|
($self->_seterror(-1, 'must setlist() before returning subscribers()') && return undef) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
if(defined($part) && $part) {
|
||||||
|
($self->_seterror(-1, "$part part of $self->{'LIST_NAME'} does not appear to exist in subscribers()") && return undef) unless(-e "$self->{'LIST_NAME'}/$part");
|
||||||
|
@subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}/$part`;
|
||||||
|
} else {
|
||||||
|
@subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}`;
|
||||||
|
}
|
||||||
|
|
||||||
|
if($?) {
|
||||||
|
$self->_seterror($?, 'error during ezmlm-list in subscribers()');
|
||||||
|
return (scalar @subscribers ? @subscribers : undef);
|
||||||
|
} else {
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return @subscribers;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Subscribe users to the current list ==
|
||||||
|
sub sub {
|
||||||
|
my($self, @addresses) = @_;
|
||||||
|
($self->_seterror(-1, 'sub() must be called with at least one address') && return 0) unless @addresses;
|
||||||
|
my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
|
||||||
|
my($address);
|
||||||
|
($self->_seterror(-1, 'must setlist() before sub()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
|
||||||
|
if(defined($part) && $part) {
|
||||||
|
($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in sub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
next unless $self->_checkaddress($address);
|
||||||
|
system("$EZMLM_BASE/ezmlm-sub", "$self->{'LIST_NAME'}/$part", $address) == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
next unless $self->_checkaddress($address);
|
||||||
|
system("$EZMLM_BASE/ezmlm-sub", $self->{'LIST_NAME'}, $address) == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Unsubscribe users from a list ==
|
||||||
|
sub unsub {
|
||||||
|
my($self, @addresses) = @_;
|
||||||
|
($self->_seterror(-1, 'unsub() must be called with at least one address') && return 0) unless @addresses;
|
||||||
|
my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
|
||||||
|
my($address);
|
||||||
|
($self->_seterror(-1, 'must setlist() before unsub()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
|
||||||
|
if(defined($part) && $part) {
|
||||||
|
($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in unsub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
next unless $self->_checkaddress($address);
|
||||||
|
system("$EZMLM_BASE/ezmlm-unsub", "$self->{'LIST_NAME'}/$part", $address) == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
next unless $self->_checkaddress($address);
|
||||||
|
system("$EZMLM_BASE/ezmlm-unsub", $self->{'LIST_NAME'}, $address) == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Test whether people are subscribed to the list ==
|
||||||
|
sub issub {
|
||||||
|
my($self, @addresses) = @_;
|
||||||
|
my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
|
||||||
|
my($address, $issub); $issub = 1;
|
||||||
|
($self->_seterror(-1, 'must setlist() before issub()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
|
||||||
|
local $ENV{'SENDER'};
|
||||||
|
|
||||||
|
if(defined($part) && $part) {
|
||||||
|
($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in issub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
$ENV{'SENDER'} = $address;
|
||||||
|
undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", "$self->{'LIST_NAME'}/$part") / 256) != 0)
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
foreach $address (@addresses) {
|
||||||
|
$ENV{'SENDER'} = $address;
|
||||||
|
undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", $self->{'LIST_NAME'}) / 256) != 0)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return $issub;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Is the list posting moderated ==
|
||||||
|
sub ismodpost {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before ismodpost()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/modpost";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Is the list subscriber moderated ==
|
||||||
|
sub ismodsub {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before ismodsub()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/modsub";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Is the list remote adminable ==
|
||||||
|
sub isremote {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before isremote()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/remote";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Does the list have a kill list ==
|
||||||
|
sub isdeny {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before isdeny()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/deny";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Does the list have an allow list ==
|
||||||
|
sub isallow {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before isallow()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/allow";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Is this a digested list ==
|
||||||
|
sub isdigest {
|
||||||
|
my($self) = @_;
|
||||||
|
($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
$self->_seterror(undef);
|
||||||
|
return -e "$self->{'LIST_NAME'}/digest";
|
||||||
|
}
|
||||||
|
|
||||||
|
# == retrieve file contents ==
|
||||||
|
sub getpart {
|
||||||
|
my($self, $part) = @_;
|
||||||
|
my(@contents, $content);
|
||||||
|
if(open(PART, "<$self->{'LIST_NAME'}/$part")) {
|
||||||
|
while(<PART>) {
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
|
||||||
|
# == return an error message if appropriate ==
|
||||||
|
sub errmsg {
|
||||||
|
my($self) = @_;
|
||||||
|
return $self->{'ERRMSG'};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub errno {
|
||||||
|
my($self) = @_;
|
||||||
|
return $self->{'ERRNO'};
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Test the compatiblity of the module ==
|
||||||
|
sub check_version {
|
||||||
|
my($self) = @_;
|
||||||
|
my $version = `$EZMLM_BASE/ezmlm-make -V 2>&1`;
|
||||||
|
$self->_seterror(undef);
|
||||||
|
|
||||||
|
my ($ezmlm, $idx) = $version =~ m/^ezmlm-make\s+version:\s+ezmlm-([\d.]+)(?:\+ezmlm-idx-([\d.]+))?/;
|
||||||
|
if($ezmlm >= 0.53) {
|
||||||
|
if (defined($idx)) {
|
||||||
|
if ($idx >= 0.40) {
|
||||||
|
return 0;
|
||||||
|
} else {
|
||||||
|
return $version;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
return $version;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Create SQL Database tables if defined for a list ==
|
||||||
|
sub createsql {
|
||||||
|
my($self) = @_;
|
||||||
|
|
||||||
|
($self->_seterror(-1, 'MySQL must be compiled into Ezmlm for createsql() to work') && return 0) unless(defined($MYSQL_BASE) && $MYSQL_BASE);
|
||||||
|
($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'}));
|
||||||
|
my($config) = $self->getconfig();
|
||||||
|
|
||||||
|
if($config =~ m/-6\s+'(.+?)'\s*/){
|
||||||
|
my($sqlsettings) = $1;
|
||||||
|
my($host, $port, $user, $password, $database, $table) = split(':', $sqlsettings, 6);
|
||||||
|
|
||||||
|
($self->_seterror(-1, 'error in list configuration while trying createsql()') && return 0)
|
||||||
|
unless (defined($host) && defined($port) && defined($user)
|
||||||
|
&& defined($password) && defined($database) && defined($table));
|
||||||
|
|
||||||
|
system("$EZMLM_BASE/ezmlm-mktab -d $table | $MYSQL_BASE/mysql -h$host -P$port -u$user -p$password -f $database") == 0 ||
|
||||||
|
($self->_seterror($?) && return undef);
|
||||||
|
|
||||||
|
} else {
|
||||||
|
$self->_seterror(-1, 'config for thislist() must include SQL options');
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
($self->_seterror(undef) && return 1);
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# == 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;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Internal function to work out a list configuration ==
|
||||||
|
sub _getconfigmanual {
|
||||||
|
my($self) = @_;
|
||||||
|
my ($savedollarslash, $options, $manager, $editor);
|
||||||
|
|
||||||
|
# Read the whole of DIR/editor and DIR/manager in
|
||||||
|
$savedollarslash = $/;
|
||||||
|
undef $/;
|
||||||
|
# $/ = \0777;
|
||||||
|
|
||||||
|
open (EDITOR, "<$self->{'LIST_NAME'}/editor") || ($self->_seterror($?) && return undef);
|
||||||
|
open (MANAGER, "<$self->{'LIST_NAME'}/manager") || ($self->_seterror($?) && return undef);
|
||||||
|
$editor = <EDITOR>; $manager = <MANAGER>;
|
||||||
|
close(EDITOR), close(MANAGER);
|
||||||
|
|
||||||
|
$/ = $savedollarslash;
|
||||||
|
|
||||||
|
$options = '';
|
||||||
|
$options .= 'a' if (-e "$self->{'LIST_NAME'}/archived");
|
||||||
|
$options .= 'd' if (-e "$self->{'LIST_NAME'}/digest");
|
||||||
|
$options .= 'f' if (-e "$self->{'LIST_NAME'}/prefix");
|
||||||
|
$options .= 'g' if ($manager =~ /ezmlm-get -\w*s/ );
|
||||||
|
$options .= 'i' if (-e "$self->{'LIST_NAME'}/indexed");
|
||||||
|
$options .= 'k' if (-e "$self->{'LIST_NAME'}/blacklist" || -e "$self->{'LIST_NAME'}/deny");
|
||||||
|
$options .= 'l' if ($manager =~ /ezmlm-manage -\w*l/ );
|
||||||
|
$options .= 'm' if (-e "$self->{'LIST_NAME'}/modpost");
|
||||||
|
$options .= 'n' if ($manager =~ /ezmlm-manage -\w*e/ );
|
||||||
|
$options .= 'p' if (-e "$self->{'LIST_NAME'}/public");
|
||||||
|
$options .= 'q' if ($manager =~ /ezmlm-request/ );
|
||||||
|
$options .= 'r' if (-e "$self->{'LIST_NAME'}/remote");
|
||||||
|
$options .= 's' if (-e "$self->{'LIST_NAME'}/modsub");
|
||||||
|
$options .= 't' if (-e "$self->{'LIST_NAME'}/text/trailer");
|
||||||
|
$options .= 'u' if (($options !~ /m/ && $editor =~ /ezmlm-issubn \'/ )
|
||||||
|
|| $editor =~ /ezmlm-gate/ );
|
||||||
|
$options .= 'x' if (-e "$self->{'LIST_NAME'}/extra" || -e "$self->{'LIST_NAME'}/allow");
|
||||||
|
|
||||||
|
return $options;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Internal Function to try to determine the vhost user ==
|
||||||
|
sub _getvhostuser {
|
||||||
|
my($self, $hostname) = @_;
|
||||||
|
my($username);
|
||||||
|
|
||||||
|
open(VD, "<$QMAIL_BASE/control/virtualdomains") || ($self->_seterror($?) && return undef);
|
||||||
|
while(<VD>) {
|
||||||
|
last if(($username) = /^\s*$hostname:(\w+)$/);
|
||||||
|
}
|
||||||
|
close VD;
|
||||||
|
|
||||||
|
return $username;
|
||||||
|
}
|
||||||
|
|
||||||
|
# == Internal function to work out default host name ==
|
||||||
|
sub _getdefaultdomain {
|
||||||
|
my($self) = @_;
|
||||||
|
my($hostname);
|
||||||
|
|
||||||
|
open (GETHOST, "<$QMAIL_BASE/control/defaultdomain")
|
||||||
|
|| open (GETHOST, "<$QMAIL_BASE/control/me")
|
||||||
|
|| ($self->_seterror($?) && return undef);
|
||||||
|
chomp($hostname = <GETHOST>);
|
||||||
|
close GETHOST;
|
||||||
|
|
||||||
|
return $hostname;
|
||||||
|
}
|
||||||
|
|
||||||
|
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.40). 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 if it exists. If it can't find this file 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.
|
||||||
|
|
||||||
|
=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 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>
|
||||||
|
|
||||||
|
=head1 BUGS
|
||||||
|
|
||||||
|
May have problems with newer versions of Perl.
|
||||||
|
|
||||||
|
Please report bugs to the author.
|
||||||
|
|
||||||
|
=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/
|
||||||
|
http://www.ezmlm.org/
|
||||||
|
http://www.qmail.org/
|
||||||
|
|
||||||
|
=cut
|
||||||
7
Ezmlm/trunk/MANIFEST
Normal file
7
Ezmlm/trunk/MANIFEST
Normal file
|
|
@ -0,0 +1,7 @@
|
||||||
|
Changes
|
||||||
|
Ezmlm.pm
|
||||||
|
MANIFEST
|
||||||
|
README
|
||||||
|
Makefile.PL
|
||||||
|
test.pl
|
||||||
|
META.yml
|
||||||
10
Ezmlm/trunk/META.yml
Normal file
10
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.05
|
||||||
|
version_from: Ezmlm.pm
|
||||||
|
installdirs: site
|
||||||
|
requires:
|
||||||
|
|
||||||
|
distribution_type: module
|
||||||
|
generated_by: ExtUtils::MakeMaker version 6.17
|
||||||
119
Ezmlm/trunk/Makefile.PL
Normal file
119
Ezmlm/trunk/Makefile.PL
Normal file
|
|
@ -0,0 +1,119 @@
|
||||||
|
# $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
|
||||||
|
'DISTNAME' => 'Ezmlm',
|
||||||
|
'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' },
|
||||||
|
'clean' => { FILES => '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;
|
||||||
|
|
||||||
|
foreach (1..10) {
|
||||||
|
$ezmlm_path = prompt('Ezmlm binary directory?', '/usr/local/bin');
|
||||||
|
last if (-e "$ezmlm_path/ezmlm-make");
|
||||||
|
print "I can't find $ezmlm_path/ezmlm-make. Please try again\n";
|
||||||
|
if ($_ >= 10) {
|
||||||
|
print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n";
|
||||||
|
exit (2);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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 (-d "$qmail_path/control");
|
||||||
|
print "I can't find $qmail_path/control. Please try again\n";
|
||||||
|
if ($_ >= 10) {
|
||||||
|
print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n";
|
||||||
|
exit (2);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
foreach (1..10) {
|
||||||
|
$mysql_path = prompt('MySQL binary directory?', '');
|
||||||
|
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";
|
||||||
|
if ($_ >= 10) {
|
||||||
|
print STDERR "No correct input after $_ attempts. Exiting Makefile.PL.\n";
|
||||||
|
exit (2);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
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*;}{\$EZMLM_BASE = '$ezmlm_path'; #Autoinserted by Makefile.PL};
|
||||||
|
s{^\$QMAIL_BASE\s*=\s*['"].+?['"]\s*;}{\$QMAIL_BASE = '$qmail_path'; #Autoinserted by Makefile.PL};
|
||||||
|
s{^\$MYSQL_BASE\s*=\s*['"].*?['"]\s*;}{\$MYSQL_BASE = '$mysql_path'; #Autoinserted by Makefile.PL};
|
||||||
|
print EZMLM;
|
||||||
|
}
|
||||||
|
close TMP; close EZMLM;
|
||||||
|
|
||||||
|
unlink "Ezmlm.pm.tmp.$$";
|
||||||
|
|
||||||
|
return {};
|
||||||
|
|
||||||
|
}
|
||||||
22
Ezmlm/trunk/README
Normal file
22
Ezmlm/trunk/README
Normal file
|
|
@ -0,0 +1,22 @@
|
||||||
|
$Id: README,v 1.3 2005/03/05 14:14:06 guy Exp $
|
||||||
|
|
||||||
|
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 cantonical path for the qmail and ezmlm binaries.
|
||||||
|
|
||||||
|
Documentation is in pod format. Please run perldoc Mail::Ezmlm after you have
|
||||||
|
installed it.
|
||||||
|
|
||||||
|
Much as I'd like to, I don't have the time to regularly maintain this. New
|
||||||
|
releases are infrequent at best. Check http://guy.rucus.net/ezmlm/contrib/
|
||||||
|
for patches, etc that may be useful.
|
||||||
|
|
||||||
|
- Guy Antony Halse <guy-ezmlm@rucus.ru.ac.za>
|
||||||
140
Ezmlm/trunk/test.pl
Normal file
140
Ezmlm/trunk/test.pl
Normal file
|
|
@ -0,0 +1,140 @@
|
||||||
|
# ===========================================================================
|
||||||
|
# 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 [Ezmlm.pm is designed to work with ezmlm-idx > 0.40. Your version reports as: ', $version, "]\n";
|
||||||
|
} else {
|
||||||
|
print "ok 9\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