indentation changed to tabs

This commit is contained in:
lars 2005-12-26 15:39:19 +00:00
parent 255cbdb494
commit eaca96a963

View file

@ -68,109 +68,109 @@ local $ENV{'PATH'} = $EZMLM_BASE;
# == Initialiser - Returns a reference to the object == # == Initialiser - Returns a reference to the object ==
sub new { sub new {
my($class, $list) = @_; my($class, $list) = @_;
my $self = {}; my $self = {};
bless $self, ref $class || $class || 'Mail::Ezmlm'; bless $self, ref $class || $class || 'Mail::Ezmlm';
$self->setlist($list) if(defined($list) && $list); $self->setlist($list) if(defined($list) && $list);
return $self; return $self;
} }
# == Make a new mailing list and set it to current == # == Make a new mailing list and set it to current ==
sub make { sub make {
my($self, %list) = @_; my($self, %list) = @_;
my($VHOST, $comandline, $hostname); my($VHOST, $comandline, $hostname);
# Do we want to use command line switches # Do we want to use command line switches
my $commandline = ''; my $commandline = '';
$commandline = '-' . $list{'-switches'} if(defined($list{'-switches'})); $commandline = '-' . $list{'-switches'} if(defined($list{'-switches'}));
my @commandline; my @commandline;
# UGLY! # UGLY!
foreach (split(/["'](.+?)["']|(\s-\w+)/, $commandline)) { foreach (split(/["'](.+?)["']|(\s-\w+)/, $commandline)) {
next if (!defined($_) or !$_ or $_ eq ' '); next if (!defined($_) or !$_ or $_ eq ' ');
push @commandline, $_; push @commandline, $_;
} }
# These three variables are essential # 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 -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 -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'})); ($self->_seterror(-1, 'must define -name in a make()') && return 0) unless(defined($list{'-name'}));
# Determine hostname if it is not supplied # Determine hostname if it is not supplied
$hostname = $self->_getdefaultdomain; $hostname = $self->_getdefaultdomain;
if(defined($list{'-host'})) { if(defined($list{'-host'})) {
$VHOST = 1 unless ($list{'-host'} eq $hostname); $VHOST = 1 unless ($list{'-host'} eq $hostname);
} else { } else {
$list{'-host'} = $hostname; $list{'-host'} = $hostname;
} }
# Attempt to make the list if we can. # Attempt to make the list if we can.
unless(-e $list{'-dir'}) { unless(-e $list{'-dir'}) {
system("$EZMLM_BASE/ezmlm-make", @commandline, $list{'-dir'}, $list{'-qmail'}, $list{'-name'}, $list{'-host'}) == 0 system("$EZMLM_BASE/ezmlm-make", @commandline, $list{'-dir'}, $list{'-qmail'}, $list{'-name'}, $list{'-host'}) == 0
|| ($self->_seterror($?) && return undef); || ($self->_seterror($?) && return undef);
} else { } else {
($self->_seterror(-1, '-dir must be defined in make()') && return 0); ($self->_seterror(-1, '-dir must be defined in make()') && return 0);
} }
# Sort out the DIR/inlocal problem if necessary # Sort out the DIR/inlocal problem if necessary
if(defined($VHOST)) { if(defined($VHOST)) {
unless(defined($list{'-user'})) { unless(defined($list{'-user'})) {
($self->_seterror(-1, '-user must match virtual host user in make()') && return 0) unless($list{'-user'} = $self->_getvhostuser($list{'-host'})); ($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); open(INLOCAL, ">$list{'-dir'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in make()') && return 0);
print INLOCAL $list{'-user'} . '-' . $list{'-name'} . "\n"; print INLOCAL $list{'-user'} . '-' . $list{'-name'} . "\n";
close INLOCAL; close INLOCAL;
} }
$self->_seterror(undef); $self->_seterror(undef);
return $self->setlist($list{'-dir'}); return $self->setlist($list{'-dir'});
} }
# == Update the current list == # == Update the current list ==
sub update { sub update {
my($self, $switches) = @_; my($self, $switches) = @_;
my($outhost, $inlocal); my($outhost, $inlocal);
# Do we have the command line switches # Do we have the command line switches
($self->_seterror(-1, 'nothing to update()') && return 0) unless(defined($switches)); ($self->_seterror(-1, 'nothing to update()') && return 0) unless(defined($switches));
$switches = '-e' . $switches; $switches = '-e' . $switches;
my @switches; my @switches;
# UGLY! # UGLY!
foreach (split(/["'](.+?)["']|(-\w+)/, $switches)) { foreach (split(/["'](.+?)["']|(-\w+)/, $switches)) {
next if (!defined($_) or !$_ or $_ eq ' '); next if (!defined($_) or !$_ or $_ eq ' ');
push @switches, $_; push @switches, $_;
} }
# can we actually alter this list; # can we actually alter this list;
($self->_seterror(-1, 'must setlist() before you update()') && return 0) unless(defined($self->{'LIST_NAME'})); ($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"); ($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. # Work out if this is a vhost.
open(OUTHOST, "<$self->{'LIST_NAME'}/outhost") || ($self->_seterror(-1, 'unable to read outhost in update()') && return 0); open(OUTHOST, "<$self->{'LIST_NAME'}/outhost") || ($self->_seterror(-1, 'unable to read outhost in update()') && return 0);
chomp($outhost = <OUTHOST>); chomp($outhost = <OUTHOST>);
close(OUTHOST); close(OUTHOST);
# Save the contents of inlocal if it is a vhost # Save the contents of inlocal if it is a vhost
unless($outhost eq $self->_getdefaultdomain) { unless($outhost eq $self->_getdefaultdomain) {
open(INLOCAL, "<$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in update()') && return 0); open(INLOCAL, "<$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in update()') && return 0);
chomp($inlocal = <INLOCAL>); chomp($inlocal = <INLOCAL>);
close(INLOCAL); close(INLOCAL);
} }
# Attempt to update the list if we can. # Attempt to update the list if we can.
system("$EZMLM_BASE/ezmlm-make", @switches, $self->{'LIST_NAME'}) == 0 system("$EZMLM_BASE/ezmlm-make", @switches, $self->{'LIST_NAME'}) == 0
|| ($self->_seterror($?) && return undef); || ($self->_seterror($?) && return undef);
# Sort out the DIR/inlocal problem if necessary # Sort out the DIR/inlocal problem if necessary
if(defined($inlocal)) { if(defined($inlocal)) {
open(INLOCAL, ">$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to write inlocal in update()') && return 0); open(INLOCAL, ">$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to write inlocal in update()') && return 0);
print INLOCAL "$inlocal\n"; print INLOCAL "$inlocal\n";
close INLOCAL; close INLOCAL;
} }
$self->_seterror(undef); $self->_seterror(undef);
return $self->{'LIST_NAME'}; return $self->{'LIST_NAME'};
} }
# == Get a list of options for the current list == # == Get a list of options for the current list ==
@ -184,7 +184,7 @@ sub getconfig {
# 'config' is not authorative anymore since this version # 'config' is not authorative anymore since this version
$option = $self->_getconfigmanual_idx5(); $option = $self->_getconfigmanual_idx5();
} elsif(open(CONFIG, "<$self->{'LIST_NAME'}/config")) { } elsif(open(CONFIG, "<$self->{'LIST_NAME'}/config")) {
# 'config' contains the authorative information # 'config' contains the authorative information
while(<CONFIG>) { while(<CONFIG>) {
if (/^F:-(\w+)/) { if (/^F:-(\w+)/) {
$options = $1; $options = $1;
@ -198,387 +198,387 @@ sub getconfig {
$options = $self->_getconfigmanual_idx4(); $options = $self->_getconfigmanual_idx4();
} }
($self->_seterror(-1, 'unable to read configuration in getconfig()') && return undef) unless (defined($options)); ($self->_seterror(-1, 'unable to read configuration in getconfig()') && return undef) unless (defined($options));
# Add the unselected options too # Add the unselected options too
# TODO: this is not especially great, as some options are undefined and cause an # TODO: this is not especially great, as some options are undefined and cause an
# error, if you use it for update # error, if you use it for update
foreach $i ('a' .. 'z') { foreach $i ('a' .. 'z') {
$options .= uc($i) unless ($options =~ /$i/i) $options .= uc($i) unless ($options =~ /$i/i)
} }
$self->_seterror(undef); $self->_seterror(undef);
return $options; return $options;
} }
# == Return the name of the current list == # == Return the name of the current list ==
sub thislist { sub thislist {
my($self) = shift; my($self) = shift;
$self->_seterror(undef); $self->_seterror(undef);
return $self->{'LIST_NAME'}; return $self->{'LIST_NAME'};
} }
# == Set the current mailing list == # == Set the current mailing list ==
sub setlist { sub setlist {
my($self, $list) = @_; my($self, $list) = @_;
if ($list =~ m/^([\w\d\_\-\.\/]+)$/) { if ($list =~ m/^([\w\d\_\-\.\/]+)$/) {
$list = $1; $list = $1;
if (-e "$list/lock") { if (-e "$list/lock") {
$self->_seterror(undef); $self->_seterror(undef);
return $self->{'LIST_NAME'} = $list; return $self->{'LIST_NAME'} = $list;
} else { } else {
$self->_seterror(-1, "$list does not appear to be a valid list in setlist()"); $self->_seterror(-1, "$list does not appear to be a valid list in setlist()");
return undef; return undef;
} }
} else { } else {
$self->_seterror(-1, "$list contains tainted data in setlist()"); $self->_seterror(-1, "$list contains tainted data in setlist()");
return undef; return undef;
} }
} }
# == Output the subscribers to $stream == # == Output the subscribers to $stream ==
sub list { sub list {
my($self, $stream, $part) = @_; my($self, $stream, $part) = @_;
$stream = *STDOUT unless (defined($stream)); $stream = *STDOUT unless (defined($stream));
if(defined($part)) { if(defined($part)) {
print $stream $self->subscribers($part); print $stream $self->subscribers($part);
} else { } else {
print $stream $self->subscribers; print $stream $self->subscribers;
} }
} }
# == Return an array of subscribers == # == Return an array of subscribers ==
sub subscribers { sub subscribers {
my($self, $part) = @_; my($self, $part) = @_;
my(@subscribers); my(@subscribers);
($self->_seterror(-1, 'must setlist() before returning subscribers()') && return undef) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before returning subscribers()') && return undef) unless(defined($self->{'LIST_NAME'}));
if(defined($part) && $part) { 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"); ($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`; @subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}/$part`;
} else { } else {
@subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}`; @subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}`;
} }
if($?) { if($?) {
$self->_seterror($?, 'error during ezmlm-list in subscribers()'); $self->_seterror($?, 'error during ezmlm-list in subscribers()');
return (scalar @subscribers ? @subscribers : undef); return (scalar @subscribers ? @subscribers : undef);
} else { } else {
$self->_seterror(undef); $self->_seterror(undef);
return @subscribers; return @subscribers;
} }
} }
# == Subscribe users to the current list == # == Subscribe users to the current list ==
sub sub { sub sub {
my($self, @addresses) = @_; my($self, @addresses) = @_;
($self->_seterror(-1, 'sub() must be called with at least one address') && return 0) unless @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($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
my($address); my($address);
($self->_seterror(-1, 'must setlist() before sub()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before sub()') && return 0) unless(defined($self->{'LIST_NAME'}));
if(defined($part) && $part) { 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"); ($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) { foreach $address (@addresses) {
next unless $self->_checkaddress($address); next unless $self->_checkaddress($address);
system("$EZMLM_BASE/ezmlm-sub", "$self->{'LIST_NAME'}/$part", $address) == 0 || system("$EZMLM_BASE/ezmlm-sub", "$self->{'LIST_NAME'}/$part", $address) == 0 ||
($self->_seterror($?) && return undef); ($self->_seterror($?) && return undef);
} }
} else { } else {
foreach $address (@addresses) { foreach $address (@addresses) {
next unless $self->_checkaddress($address); next unless $self->_checkaddress($address);
system("$EZMLM_BASE/ezmlm-sub", $self->{'LIST_NAME'}, $address) == 0 || system("$EZMLM_BASE/ezmlm-sub", $self->{'LIST_NAME'}, $address) == 0 ||
($self->_seterror($?) && return undef); ($self->_seterror($?) && return undef);
} }
} }
$self->_seterror(undef); $self->_seterror(undef);
return 1; return 1;
} }
# == Unsubscribe users from a list == # == Unsubscribe users from a list ==
sub unsub { sub unsub {
my($self, @addresses) = @_; my($self, @addresses) = @_;
($self->_seterror(-1, 'unsub() must be called with at least one address') && return 0) unless @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($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
my($address); my($address);
($self->_seterror(-1, 'must setlist() before unsub()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before unsub()') && return 0) unless(defined($self->{'LIST_NAME'}));
if(defined($part) && $part) { 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"); ($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) { foreach $address (@addresses) {
next unless $self->_checkaddress($address); next unless $self->_checkaddress($address);
system("$EZMLM_BASE/ezmlm-unsub", "$self->{'LIST_NAME'}/$part", $address) == 0 || system("$EZMLM_BASE/ezmlm-unsub", "$self->{'LIST_NAME'}/$part", $address) == 0 ||
($self->_seterror($?) && return undef); ($self->_seterror($?) && return undef);
} }
} else { } else {
foreach $address (@addresses) { foreach $address (@addresses) {
next unless $self->_checkaddress($address); next unless $self->_checkaddress($address);
system("$EZMLM_BASE/ezmlm-unsub", $self->{'LIST_NAME'}, $address) == 0 || system("$EZMLM_BASE/ezmlm-unsub", $self->{'LIST_NAME'}, $address) == 0 ||
($self->_seterror($?) && return undef); ($self->_seterror($?) && return undef);
} }
} }
$self->_seterror(undef); $self->_seterror(undef);
return 1; return 1;
} }
# == Test whether people are subscribed to the list == # == Test whether people are subscribed to the list ==
sub issub { sub issub {
my($self, @addresses) = @_; my($self, @addresses) = @_;
my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/); my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
my($address, $issub); $issub = 1; my($address, $issub); $issub = 1;
($self->_seterror(-1, 'must setlist() before issub()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before issub()') && return 0) unless(defined($self->{'LIST_NAME'}));
local $ENV{'SENDER'}; local $ENV{'SENDER'};
if(defined($part) && $part) { 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"); ($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) { foreach $address (@addresses) {
$ENV{'SENDER'} = $address; $ENV{'SENDER'} = $address;
undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", "$self->{'LIST_NAME'}/$part") / 256) != 0) undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", "$self->{'LIST_NAME'}/$part") / 256) != 0)
} }
} else { } else {
foreach $address (@addresses) { foreach $address (@addresses) {
$ENV{'SENDER'} = $address; $ENV{'SENDER'} = $address;
undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", $self->{'LIST_NAME'}) / 256) != 0) undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", $self->{'LIST_NAME'}) / 256) != 0)
} }
} }
$self->_seterror(undef); $self->_seterror(undef);
return $issub; return $issub;
} }
# == Is the list posting moderated == # == Is the list posting moderated ==
sub ismodpost { sub ismodpost {
my($self) = @_; my($self) = @_;
($self->_seterror(-1, 'must setlist() before ismodpost()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before ismodpost()') && return 0) unless(defined($self->{'LIST_NAME'}));
$self->_seterror(undef); $self->_seterror(undef);
return -e "$self->{'LIST_NAME'}/modpost"; return -e "$self->{'LIST_NAME'}/modpost";
} }
# == Is the list subscriber moderated == # == Is the list subscriber moderated ==
sub ismodsub { sub ismodsub {
my($self) = @_; my($self) = @_;
($self->_seterror(-1, 'must setlist() before ismodsub()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before ismodsub()') && return 0) unless(defined($self->{'LIST_NAME'}));
$self->_seterror(undef); $self->_seterror(undef);
return -e "$self->{'LIST_NAME'}/modsub"; return -e "$self->{'LIST_NAME'}/modsub";
} }
# == Is the list remote adminable == # == Is the list remote adminable ==
sub isremote { sub isremote {
my($self) = @_; my($self) = @_;
($self->_seterror(-1, 'must setlist() before isremote()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before isremote()') && return 0) unless(defined($self->{'LIST_NAME'}));
$self->_seterror(undef); $self->_seterror(undef);
return -e "$self->{'LIST_NAME'}/remote"; return -e "$self->{'LIST_NAME'}/remote";
} }
# == Does the list have a kill list == # == Does the list have a kill list ==
sub isdeny { sub isdeny {
my($self) = @_; my($self) = @_;
($self->_seterror(-1, 'must setlist() before isdeny()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before isdeny()') && return 0) unless(defined($self->{'LIST_NAME'}));
$self->_seterror(undef); $self->_seterror(undef);
return -e "$self->{'LIST_NAME'}/deny"; return -e "$self->{'LIST_NAME'}/deny";
} }
# == Does the list have an allow list == # == Does the list have an allow list ==
sub isallow { sub isallow {
my($self) = @_; my($self) = @_;
($self->_seterror(-1, 'must setlist() before isallow()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before isallow()') && return 0) unless(defined($self->{'LIST_NAME'}));
$self->_seterror(undef); $self->_seterror(undef);
return -e "$self->{'LIST_NAME'}/allow"; return -e "$self->{'LIST_NAME'}/allow";
} }
# == Is this a digested list == # == Is this a digested list ==
sub isdigest { sub isdigest {
my($self) = @_; my($self) = @_;
($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'})); ($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'}));
$self->_seterror(undef); $self->_seterror(undef);
return -e "$self->{'LIST_NAME'}/digest"; return -e "$self->{'LIST_NAME'}/digest";
} }
# == retrieve file contents == # == retrieve file contents ==
sub getpart { sub getpart {
my($self, $part) = @_; my($self, $part) = @_;
my(@contents, $content); my(@contents, $content);
if(open(PART, "<$self->{'LIST_NAME'}/$part")) { if(open(PART, "<$self->{'LIST_NAME'}/$part")) {
while(<PART>) { while(<PART>) {
chomp($contents[$#contents++] = $_); chomp($contents[$#contents++] = $_);
$content .= $_; $content .= $_;
} }
close PART; close PART;
if(wantarray) { if(wantarray) {
return @contents; return @contents;
} else { } else {
return $content; return $content;
} }
} ($self->_seterror($?) && return undef); } ($self->_seterror($?) && return undef);
} }
# == set files contents == # == set files contents ==
sub setpart { sub setpart {
my($self, $part, @content) = @_; my($self, $part, @content) = @_;
my($line); my($line);
if(open(PART, ">$self->{'LIST_NAME'}/$part")) { if(open(PART, ">$self->{'LIST_NAME'}/$part")) {
foreach $line (@content) { foreach $line (@content) {
$line =~ s/[\r]//g; $line =~ s/\n$//; $line =~ s/[\r]//g; $line =~ s/\n$//;
print PART "$line\n"; print PART "$line\n";
} }
close PART; close PART;
return 1; return 1;
} ($self->_seterror($?) && return undef); } ($self->_seterror($?) && return undef);
} }
# == return an error message if appropriate == # == return an error message if appropriate ==
sub errmsg { sub errmsg {
my($self) = @_; my($self) = @_;
return $self->{'ERRMSG'}; return $self->{'ERRMSG'};
} }
sub errno { sub errno {
my($self) = @_; my($self) = @_;
return $self->{'ERRNO'}; return $self->{'ERRNO'};
} }
# == Test the compatiblity of the module == # == Test the compatiblity of the module ==
sub check_version { sub check_version {
my($self) = @_; my($self) = @_;
my $version = `$EZMLM_BASE/ezmlm-make -V 2>&1`; my $version = `$EZMLM_BASE/ezmlm-make -V 2>&1`;
$self->_seterror(undef); $self->_seterror(undef);
my ($ezmlm, $idx) = $version =~ m/^ezmlm-make\s+version:\s+ezmlm-([\d.]+)(?:\+ezmlm-idx-([\d.]+))?/; my ($ezmlm, $idx) = $version =~ m/^ezmlm-make\s+version:\s+ezmlm-([\d.]+)(?:\+ezmlm-idx-([\d.]+))?/;
if($ezmlm >= 0.53) { if($ezmlm >= 0.53) {
if (defined($idx)) { if (defined($idx)) {
if ($idx >= 0.40) { if ($idx >= 0.40) {
return 0; return 0;
} else { } else {
return $version; return $version;
} }
} }
return 0; return 0;
} }
return $version; return $version;
} }
# == Create SQL Database tables if defined for a list == # == Create SQL Database tables if defined for a list ==
sub createsql { sub createsql {
my($self) = @_; 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, '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'})); ($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'}));
my($config) = $self->getconfig(); my($config) = $self->getconfig();
if($config =~ m/-6\s+'(.+?)'\s*/){ if($config =~ m/-6\s+'(.+?)'\s*/){
my($sqlsettings) = $1; my($sqlsettings) = $1;
my($host, $port, $user, $password, $database, $table) = split(':', $sqlsettings, 6); my($host, $port, $user, $password, $database, $table) = split(':', $sqlsettings, 6);
($self->_seterror(-1, 'error in list configuration while trying createsql()') && return 0) ($self->_seterror(-1, 'error in list configuration while trying createsql()') && return 0)
unless (defined($host) && defined($port) && defined($user) unless (defined($host) && defined($port) && defined($user)
&& defined($password) && defined($database) && defined($table)); && 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 || 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); ($self->_seterror($?) && return undef);
} else { } else {
$self->_seterror(-1, 'config for thislist() must include SQL options'); $self->_seterror(-1, 'config for thislist() must include SQL options');
return 0; return 0;
} }
($self->_seterror(undef) && return 1); ($self->_seterror(undef) && return 1);
} }
# == Internal function to set the error to return == # == Internal function to set the error to return ==
sub _seterror { sub _seterror {
my($self, $no, $mesg) = @_; my($self, $no, $mesg) = @_;
if(defined($no) && $no) { if(defined($no) && $no) {
if($no < 0) { if($no < 0) {
$self->{'ERRNO'} = -1; $self->{'ERRNO'} = -1;
$self->{'ERRMSG'} = $mesg || 'An undefined error occoured'; $self->{'ERRMSG'} = $mesg || 'An undefined error occoured';
} else { } else {
$self->{'ERRNO'} = $no / 256; $self->{'ERRNO'} = $no / 256;
$self->{'ERRMSG'} = $! || $mesg || 'An undefined error occoured in a system() call'; $self->{'ERRMSG'} = $! || $mesg || 'An undefined error occoured in a system() call';
} }
} else { } else {
$self->{'ERRNO'} = 0; $self->{'ERRNO'} = 0;
$self->{'ERRMSG'} = undef; $self->{'ERRMSG'} = undef;
} }
return 1; return 1;
} }
# == Internal function to test for valid email addresses == # == Internal function to test for valid email addresses ==
sub _checkaddress { sub _checkaddress {
my($self, $address) = @_; my($self, $address) = @_;
return 1 unless defined($address); return 1 unless defined($address);
return 0 unless ($address =~ m/^(\S+\@\S+\.\S+)$/); return 0 unless ($address =~ m/^(\S+\@\S+\.\S+)$/);
$_[1] = $1; $_[1] = $1;
return 1; return 1;
} }
# == Internal function to work out a list configuration == # == Internal function to work out a list configuration ==
sub _getconfigmanual_idx4 { sub _getconfigmanual_idx4 {
my($self) = @_; my($self) = @_;
my ($savedollarslash, $options, $manager, $editor); my ($savedollarslash, $options, $manager, $editor);
# Read the whole of DIR/editor and DIR/manager in # Read the whole of DIR/editor and DIR/manager in
$savedollarslash = $/; $savedollarslash = $/;
undef $/; undef $/;
# $/ = \0777; # $/ = \0777;
open (EDITOR, "<$self->{'LIST_NAME'}/editor") || ($self->_seterror($?) && return undef); open (EDITOR, "<$self->{'LIST_NAME'}/editor") || ($self->_seterror($?) && return undef);
open (MANAGER, "<$self->{'LIST_NAME'}/manager") || ($self->_seterror($?) && return undef); open (MANAGER, "<$self->{'LIST_NAME'}/manager") || ($self->_seterror($?) && return undef);
$editor = <EDITOR>; $manager = <MANAGER>; $editor = <EDITOR>; $manager = <MANAGER>;
close(EDITOR), close(MANAGER); close(EDITOR), close(MANAGER);
$/ = $savedollarslash; $/ = $savedollarslash;
$options = ''; $options = '';
$options .= 'a' if (-e "$self->{'LIST_NAME'}/archived"); $options .= 'a' if (-e "$self->{'LIST_NAME'}/archived");
$options .= 'd' if (-e "$self->{'LIST_NAME'}/digest"); $options .= 'd' if (-e "$self->{'LIST_NAME'}/digest");
$options .= 'f' if (-e "$self->{'LIST_NAME'}/prefix"); $options .= 'f' if (-e "$self->{'LIST_NAME'}/prefix");
$options .= 'g' if ($manager =~ /ezmlm-get -\w*s/ ); $options .= 'g' if ($manager =~ /ezmlm-get -\w*s/ );
$options .= 'i' if (-e "$self->{'LIST_NAME'}/indexed"); $options .= 'i' if (-e "$self->{'LIST_NAME'}/indexed");
$options .= 'k' if (-e "$self->{'LIST_NAME'}/blacklist" || -e "$self->{'LIST_NAME'}/deny"); $options .= 'k' if (-e "$self->{'LIST_NAME'}/blacklist" || -e "$self->{'LIST_NAME'}/deny");
$options .= 'l' if ($manager =~ /ezmlm-manage -\w*l/ ); $options .= 'l' if ($manager =~ /ezmlm-manage -\w*l/ );
$options .= 'm' if (-e "$self->{'LIST_NAME'}/modpost"); $options .= 'm' if (-e "$self->{'LIST_NAME'}/modpost");
$options .= 'n' if ($manager =~ /ezmlm-manage -\w*e/ ); $options .= 'n' if ($manager =~ /ezmlm-manage -\w*e/ );
$options .= 'p' if (-e "$self->{'LIST_NAME'}/public"); $options .= 'p' if (-e "$self->{'LIST_NAME'}/public");
$options .= 'q' if ($manager =~ /ezmlm-request/ ); $options .= 'q' if ($manager =~ /ezmlm-request/ );
$options .= 'r' if (-e "$self->{'LIST_NAME'}/remote"); $options .= 'r' if (-e "$self->{'LIST_NAME'}/remote");
$options .= 's' if (-e "$self->{'LIST_NAME'}/modsub"); $options .= 's' if (-e "$self->{'LIST_NAME'}/modsub");
$options .= 't' if (-e "$self->{'LIST_NAME'}/text/trailer"); $options .= 't' if (-e "$self->{'LIST_NAME'}/text/trailer");
$options .= 'u' if (($options !~ /m/ && $editor =~ /ezmlm-issubn \'/ ) $options .= 'u' if (($options !~ /m/ && $editor =~ /ezmlm-issubn \'/ )
|| $editor =~ /ezmlm-gate/ ); || $editor =~ /ezmlm-gate/ );
$options .= 'x' if (-e "$self->{'LIST_NAME'}/extra" || -e "$self->{'LIST_NAME'}/allow"); $options .= 'x' if (-e "$self->{'LIST_NAME'}/extra" || -e "$self->{'LIST_NAME'}/allow");
return $options; return $options;
} }
# == Internal Function to try to determine the vhost user == # == Internal Function to try to determine the vhost user ==
sub _getvhostuser { sub _getvhostuser {
my($self, $hostname) = @_; my($self, $hostname) = @_;
my($username); my($username);
open(VD, "<$QMAIL_BASE/control/virtualdomains") || ($self->_seterror($?) && return undef); open(VD, "<$QMAIL_BASE/control/virtualdomains") || ($self->_seterror($?) && return undef);
while(<VD>) { while(<VD>) {
last if(($username) = /^\s*$hostname:(\w+)$/); last if(($username) = /^\s*$hostname:(\w+)$/);
} }
close VD; close VD;
return $username; return $username;
} }
# == Internal function to work out default host name == # == Internal function to work out default host name ==
sub _getdefaultdomain { sub _getdefaultdomain {
my($self) = @_; my($self) = @_;
my($hostname); my($hostname);
open (GETHOST, "<$QMAIL_BASE/control/defaultdomain") open (GETHOST, "<$QMAIL_BASE/control/defaultdomain")
|| open (GETHOST, "<$QMAIL_BASE/control/me") || open (GETHOST, "<$QMAIL_BASE/control/me")
|| ($self->_seterror($?) && return undef); || ($self->_seterror($?) && return undef);
chomp($hostname = <GETHOST>); chomp($hostname = <GETHOST>);
close GETHOST; close GETHOST;
return $hostname; return $hostname;
} }
1; 1;