view release on metacpan or  search on metacpan

ExpandAliases.pm  view on Meta::CPAN

#
#   - Parse aliases file
#
#       o Read file, normalize
#
#           + Skip malformed lines
#
#           + Join multi-line entries
#
#           + Discard comments
#
#       o Create internal structure
#
#   - On call to expand
#
#       o Start with first alias, and expand
#
#       o Expand each alias, unless:
#
#           + It is non-local
#
#           + It has already been seen
#
#   - Return list of responses
# -------------------------------------------------------------------

use strict;
use vars qw($VERSION $DEBUG @POSSIBLE_ALIAS_FILES);

$VERSION = 0.49;
$DEBUG = 0 unless defined $DEBUG;
@POSSIBLE_ALIAS_FILES = qw(/etc/aliases
                           /etc/mail/aliases
                           /etc/postfix/aliases
                           /etc/exim/aliases);

use constant PARSED  => 0;  # Parsed aliases
use constant CACHED  => 1;  # Caches lookups
use constant FILE    => 2;  # "Main" aliases file

# ----------------------------------------------------------------------
# import(@files)
#
# Allow for compile-time additions to @POSSIBLE_ALIAS_FILES
# ----------------------------------------------------------------------
sub import {
    my $class = shift;

    for my $x (@_) {
        if ($x =~ /^debug$/i) {
            $DEBUG = 1;
        }
        elsif (-f "$x") {
            unshift @POSSIBLE_ALIAS_FILES, $x;
        }
    }
}

sub new {
    my ($class, $file) = @_;
    my $self = bless [ { }, { }, "" ] => $class;

    $self->[ FILE ] = (grep { -e $_ && -r _ }
                       ($file, @POSSIBLE_ALIAS_FILES))[0];
    $self->debug("Using alias file " . $self->[ FILE ]);
    $self->init();

    return $self;
}

sub debug {
    my $class = shift;
    $class = ref $class || $class;
    if ($DEBUG) {
        warn "[ $class ] $_\n"
            for (@_);
    }
}

# ----------------------------------------------------------------------
# init($file)
#
# Parse file, extracting aliases.  Note that this is a (more or less)
# literal representation of the file; expansion of aliases happens at
# run time, as aliases are requested.
# # ----------------------------------------------------------------------
sub init {
    my $self = shift;
    my $file = shift || $self->[ FILE ];
    return $self unless defined $file;

    # Chapter 24 of the sendmail book
    # (www.oreilly.com/catalog/sendmail/) describes the process of
    # looking for aliases thusly:
    #
    # "The aliases(5) file is composed of lines of text.  Any line that
    # begins with a # is a comment and is ignored.  Empty lines (those
    # that contain only a newline character) are also ignored.  Any
    # lines that begins with a space or tab is joined (appended) to the
    # line above it.  All other lines are text are viewed as alias
    # lines.  The format for an alias line is:
    #
    #   local: alias
    #
    # "The local must begin a line. It is an address in the form of a
    # local recipient address...  The colon follows the local on
    # the same line and may be preceded with spaces or tabs.  If the
    # colon is missing, sendmail prints and syslog(3)'s the following
    # error message and skips that alias line:
    #
    #   missing colon
    #
    # "The alias (to the right of the colon) is one or more addresses on
    # the same line.  Indented continuation lines are permitted.  Each
    # address should be separated from the next by a comma and optional
    # space characters. A typical alias looks like this:
    #
    #   root: jim, sysadmin@server, gunther ^ | indenting whitespace
    #
    # "Here, root is hte local address to be aliases.  When mail is to
    # be locally delivered to root, it is looked up in the aliases(5)

ExpandAliases.pm  view on Meta::CPAN

    $self = shift;
    @answers = sort keys %{ $self->[ PARSED ] };
    return wantarray ? @answers : \@answers;
}

# ----------------------------------------------------------------------
# exists($alias)
#
# Determine if an alias exists not not
# ----------------------------------------------------------------------
sub exists {
    my ($self, $alias) = @_;
    return CORE::exists($self->[ PARSED ]->{ $alias });
}

# ----------------------------------------------------------------------
# check($alias)
#
# Returns the unexpanded form an an alias.  I.e., exactly what is in the
# file, without expansion.
#
# Unlike expand, if $alias does not exist in the file, check() returns
# the empty array.  Otherwise, $alias returns an array (in list context)
# or a reference to an array (in scalar context) to the items in the
# aliases file.
#
# You can emulate expand() by calling check recusrively.
# ----------------------------------------------------------------------
sub check {
    my $self = shift;
    my $ret;

    if (my $name = shift) {
        $ret = $self->[ PARSED ]->{ $name }
    }

    $ret ||= [];

    return wantarray ? @$ret : [ @$ret ];
}

package File::Aliases;
use constant FH     => 0;
use constant BUFFER => 1;

use IO::File;

# This package ensures that each read (i.e., calls to next() --
# I'm too lazy to implement this as a tied file handle so it can
# be used in <>) returns a single alias entry, which may span
# multiple lines.
#
# XXX I suppose I could simply subclass IO::File, and rename next
# to readline.

sub new {
    my $class = shift;
    my $file = shift;
    my $fh = IO::File->new($file);

    my $self = bless [ $fh, '' ] => $class;
    $self->[ BUFFER ] = <$fh>
        if $fh;

    return $self;
}

sub next {
    my $self = shift;
    my $buffer = $self->[ BUFFER ];
    my $fh = $self->[ FH ];

    return ""
        unless defined $fh;

    $self->[ BUFFER ] = "";
    while (<$fh>) {
        if (/^\S/) {
            $self->[ BUFFER ] = $_;
            last;
        } else {
            $buffer .= $_;
        }
    }

    return $buffer;
}

1;

__END__

=head1 NAME

Mail::ExpandAliases - Expand aliases from /etc/aliases files

=head1 SYNOPSIS

  use Mail::ExpandAliases;

  my $ma = Mail::ExpandAliases->new("/etc/aliases");
  my @list = $ma->expand("listname");

=head1 DESCRIPTION

I've looked for software to expand aliases from an alias file for a
while, but have never found anything adequate.  In this day and age,
few public SMTP servers support EXPN, which makes alias expansion
problematic.  This module, and the accompanying C<expand-alias>
script, attempts to address that deficiency.

=head1 USAGE

Mail::ExpandAliases is an object oriented module, with a constructor
named C<new>:

  my $ma = Mail::ExpandAliases->new("/etc/mail/aliases");

C<new> takes the filename of an aliases file; if not supplied, or if
the file specified does not exist or is not readable,
Mail::ExpandAliases will look in a predetermined set of default