source: trunk/debathena/debathena/libmail-expandaliases-perl/ExpandAliases.pm @ 24013

Revision 24013, 13.8 KB checked in by broder, 14 years ago (diff)
Create a package for the Mail::ExpandAliases Perl module. This will be used for an updated version of the debathena-msmtp-mta which can understand /etc/aliases files.
RevLine 
[24013]1package Mail::ExpandAliases;
2
3# -------------------------------------------------------------------
4# Mail::ExpandAliases - Expand aliases from /etc/aliases files
5# Copyright (C) 2002 darren chamberlain <darren@cpan.org>
6#
7# This program is free software; you can redistribute it and/or
8# modify it under the terms of the GNU General Public License as
9# published by the Free Software Foundation; version 2.
10#
11# This program is distributed in the hope that it will be useful, but
12# WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14# General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program; if not, write to the Free Software
18# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19# 02111-1307  USA
20# -------------------------------------------------------------------
21# Design of this class:
22#
23#   - Read aliases file
24#
25#   - Parse aliases file
26#
27#       o Read file, normalize
28#
29#           + Skip malformed lines
30#
31#           + Join multi-line entries
32#
33#           + Discard comments
34#
35#       o Create internal structure
36#
37#   - On call to expand
38#
39#       o Start with first alias, and expand
40#
41#       o Expand each alias, unless:
42#
43#           + It is non-local
44#
45#           + It has already been seen
46#
47#   - Return list of responses
48# -------------------------------------------------------------------
49
50use strict;
51use vars qw($VERSION $DEBUG @POSSIBLE_ALIAS_FILES);
52
53$VERSION = 0.46;
54$DEBUG = 0 unless defined $DEBUG;
55@POSSIBLE_ALIAS_FILES = qw(/etc/aliases
56                           /etc/mail/aliases
57                           /etc/postfix/aliases
58                           /etc/exim/aliases);
59
60use constant PARSED  => 0;  # Parsed aliases
61use constant CACHED  => 1;  # Caches lookups
62use constant FILE    => 2;  # "Main" aliases file
63
64# ----------------------------------------------------------------------
65# import(@files)
66#
67# Allow for compile-time additions to @POSSIBLE_ALIAS_FILES
68# ----------------------------------------------------------------------
69sub import {
70    my $class = shift;
71    unshift @POSSIBLE_ALIAS_FILES, $_ for @_;
72}
73
74sub new {
75    my ($class, $file) = @_;
76    my $self = bless [ { }, { }, "" ] => $class;
77
78    $self->[ FILE ] = (grep { -e $_ && -r _ }
79                       ($file, @POSSIBLE_ALIAS_FILES))[0];
80    $self->debug("Using alias file " . $self->[ FILE ]);
81    $self->init();
82
83    return $self;
84}
85
86sub debug {
87    my $class = shift;
88    $class = ref $class || $class;
89    if ($DEBUG) {
90        warn "[ $class ] $_\n"
91            for (@_);
92    }
93}
94
95# ----------------------------------------------------------------------
96# init($file)
97#
98# Parse file, extracting aliases.  Note that this is a (more or less)
99# literal representation of the file; expansion of aliases happens at
100# run time, as aliases are requested.
101# # ----------------------------------------------------------------------
102sub init {
103    my $self = shift;
104    my $file = shift || $self->[ FILE ];
105    return $self unless defined $file;
106
107    # Chapter 24 of the sendmail book
108    # (www.oreilly.com/catalog/sendmail/) describes the process of
109    # looking for aliases thusly:
110    #
111    # "The aliases(5) file is composed of lines of text.  Any line that
112    # begins with a # is a comment and is ignored.  Empty lines (those
113    # that contain only a newline character) are also ignored.  Any
114    # lines that begins with a space or tab is joined (appended) to the
115    # line above it.  All other lines are text are viewed as alias
116    # lines.  The format for an alias line is:
117    #
118    #   local: alias
119    #
120    # "The local must begin a line. It is an address in the form of a
121    # local recipient address...  The colon follows the local on
122    # the same line and may be preceded with spaces or tabs.  If the
123    # colon is missing, sendmail prints and syslog(3)'s the following
124    # error message and skips that alias line:
125    #
126    #   missing colon
127    #
128    # "The alias (to the right of the colon) is one or more addresses on
129    # the same line.  Indented continuation lines are permitted.  Each
130    # address should be separated from the next by a comma and optional
131    # space characters. A typical alias looks like this:
132    #
133    #   root: jim, sysadmin@server, gunther ^ | indenting whitespace
134    #
135    # "Here, root is hte local address to be aliases.  When mail is to
136    # be locally delivered to root, it is looked up in the aliases(5)
137    # file.  If found, root is replaced with the three addresses show
138    # earlier, and mail is instead delivered to those other three
139    # addresses.
140    #
141    # "This process of looking up and possibly aliases local recipients
142    # is repeated for each recipient until no more aliases are found in
143    # the aliases(5) file.  That is, for example, if one of the aliases
144    # for root is jim, and if jim also exists to the left of a colon in
145    # the aliases file, he too is replaced with his alias:
146    #
147    #   jim: jim@otherhost
148    #
149    # "The list of addresses to the right of the colon may be mail
150    # addresses (such as gunther or jim@otherhost), the name of a
151    # program to run (such as /etc/relocated), the name of a file onto
152    # which to append (such as /usr/share/archive), or the name of a
153    # file to read for additional addresses (using :include:)."
154
155    $self->debug("Opening alias file '$file'");
156    my $fh = File::Aliases->new($file)
157        or die "Can't open $file: $!";
158
159    while (my $line = $fh->next) {
160        chomp($line);
161        next if $line =~ /^#/;
162        next if $line =~ /^\s*$/;
163
164        $line =~ s/\s+/ /g;
165        my ($orig, $alias, @expandos);
166
167        $orig = $line;
168        if ($line =~ s/^([^:\s]+)\s*:\s*//) {
169            $alias = lc $1;
170            $self->debug("$. => '$alias'");
171        }
172        else {
173            local $DEBUG = 1;
174            $self->debug("$file line $.: missing colon");
175            next;
176        }
177
178        @expandos =
179            #grep !/^$alias$/,
180            map { s/^\s*//; s/\s*$//; $_ }
181            split /,/, $line;
182
183        $self->debug($alias, map "\t$_", @expandos);
184        $self->[ PARSED ]->{ $alias } = \@expandos;
185    }
186
187    return $self;
188}
189
190# ----------------------------------------------------------------------
191# expand($name)
192#
193# Expands $name to @addresses.  If @addresses is empty, return $name.
194# In list context, returns a list of the matching expansions; in
195# scalar context, returns a reference to an array of expansions.
196# ----------------------------------------------------------------------
197sub expand {
198    my ($self, $name, $original, $lcname, %answers, @answers, @names, $n);
199    $self = shift;
200    $name = shift || return $name;
201    $original = shift;
202    $lcname = lc $name;
203
204    return $name if (defined $original && $name eq $original);
205
206    return @{ $self->[ CACHED ]->{ $lcname } }
207        if (defined $self->[ CACHED ]->{ $lcname });
208
209    if (@names = @{ $self->[ PARSED ]->{ $lcname } || [ ] }) {
210        my $c = $self->[ CACHED ]->{ $lcname } = [ ];
211
212        for $n (@names) {
213            $n =~ s/^[\s'"]*//g;
214            $n =~ s/['"\s]*$//g;
215            my $type = substr $n, 0, 1;
216
217            if ($type eq '|' or $type eq '/') {
218                # |/path/to/program
219                # /path/to/mbox
220                $answers{ $n }++;
221                push @$c, $n;
222            }
223
224            elsif ($type eq ':') {
225                # :include:
226                #$n =~ s/:include:\s*//ig;
227                #$self->parse($n);
228                warn "Skipping include file $n\n";
229            }
230
231            elsif ($type eq '\\') {
232                # \foo
233                # literal, non-escaped value, useful for
234                # aliases like:
235                #   foo: \foo, bar
236                # where mail to foo, a local user, should also
237                # go to bar.
238                $n =~ s/^\\//;
239                $answers{ $n }++;
240                push @$c, $n;
241            }
242
243            else {
244                for ($self->expand($n, $original || $name)) {
245                    $answers{ $_ }++
246                }
247            }
248        }
249
250        # Add to the cache
251        @answers = sort keys %answers;
252        $self->[ CACHED ]->{ $lcname } = \@answers;
253        return wantarray ? @answers : \@answers;
254    }
255
256    return $name;
257}
258
259# ----------------------------------------------------------------------
260# reload()
261#
262# Reset the instance.  Clears out parsed aliases and empties the cache.
263# ----------------------------------------------------------------------
264sub reload {
265    my ($self, $file) = @_;
266
267    %{ $self->[ PARSED ] } = ();
268    %{ $self->[ CACHED ] } = ();
269    $self->[ FILE ] = $file if defined $file;
270
271    $self->parse;
272
273    return $self;
274}
275
276# ----------------------------------------------------------------------
277# aliases()
278#
279# Lists the aliases.
280# In list context, returns an array;
281# in scalar context, returns a reference to an array.
282#
283# From a patch submitted by Thomas Kishel <tom@kishel.net>
284# ----------------------------------------------------------------------
285sub aliases {
286    my ($self, @answers);
287    $self = shift;
288    @answers = sort keys %{ $self->[ PARSED ] };
289    return wantarray ? @answers : \@answers;
290}
291
292package File::Aliases;
293use constant FH     => 0;
294use constant BUFFER => 1;
295
296use IO::File;
297
298# This package ensures that each read (i.e., calls to next() --
299# I'm too lazy to implement this as a tied file handle so it can
300# be used in <>) returns a single alias entry, which may span
301# multiple lines.
302#
303# XXX I suppose I could simply subclass IO::File, and rename next
304# to readline.
305
306sub new {
307    my $class = shift;
308    my $file = shift;
309    my $fh = IO::File->new($file);
310
311    my $self = bless [ $fh, '' ] => $class;
312    $self->[ BUFFER ] = <$fh>
313        if $fh;
314
315    return $self;
316}
317
318sub next {
319    my $self = shift;
320    my $buffer = $self->[ BUFFER ];
321    my $fh = $self->[ FH ];
322
323    return ""
324        unless defined $fh;
325
326    $self->[ BUFFER ] = "";
327    while (<$fh>) {
328        if (/^\S/) {
329            $self->[ BUFFER ] = $_;
330            last;
331        } else {
332            $buffer .= $_;
333        }
334    }
335
336    return $buffer;
337}
338
3391;
340
341__END__
342
343=head1 NAME
344
345Mail::ExpandAliases - Expand aliases from /etc/aliases files
346
347=head1 SYNOPSIS
348
349  use Mail::ExpandAliases;
350
351  my $ma = Mail::ExpandAliases->new("/etc/aliases");
352  my @list = $ma->expand("listname");
353
354=head1 DESCRIPTION
355
356I've looked for software to expand aliases from an alias file for a
357while, but have never found anything adequate.  In this day and age,
358few public SMTP servers support EXPN, which makes alias expansion
359problematic.  This module, and the accompanying C<expand-alias>
360script, attempts to address that deficiency.
361
362=head1 USAGE
363
364Mail::ExpandAliases is an object oriented module, with a constructor
365named C<new>:
366
367  my $ma = Mail::ExpandAliases->new("/etc/mail/aliases");
368
369C<new> takes the filename of an aliases file; if not supplied, or if
370the file specified does not exist or is not readable,
371Mail::ExpandAliases will look in a predetermined set of default
372locations and use the first one found.  See L<"ALIAS FILE LOCATIONS">,
373below, for details on this search path and how to modify it.
374
375Lookups are made using the C<expand> method:
376
377  @aliases = $ma->expand("listname");
378
379C<expand> returns a list of expanded addresses, sorted alphabetically.
380These expanded addresses are also expanded, whenever possible.
381
382A non-expandible alias (no entry in the aliases file) expands to
383itself, i.e., does not expand.
384
385In scalar context, C<expand> returns a reference to a list.
386
387Note that Mail::ExpandAliases provides read-only access to the alias
388file.  If you are looking for read access, see Mail::Alias, which is a
389more general interface to alias files.
390
391Mail::ExpandAliases make a resonable attempt to handle aliases the way
392C<sendmail> does, including loop detection and support for escaped
393named.  See chapter 24, "Aliases", in I<Sendmail>
394(E<lt>http://www.oreilly.com/catalog/sendmail/E<gt>) for full details
395about this process.
396
397=head1 ALIAS FILE LOCATIONS
398
399Paths to the aliases file can be added globally at compile time:
400
401  use Mail::ExpandAliases qw(/etc/exim/aliases);
402
403Alias file locations can also be specified to instances when they
404are constructed:
405
406  my $ma = Mail::ExpandAliases->new("/etc/exim/aliases");
407
408Alias file locations are stored in the package global @POSSIBLE_ALIAS_FILES,
409which can be assigned to directly if you're not impressed with encapsulation:
410
411  @Mail::ExpandAliases::POSSIBLE_ALIAS_FILES = ("/etc/aliases");
412
413By default, @POSSIBLE_ALIAS_FILES contains F</etc/aliases>,
414F</etc/mail/aliases>, F</etc/postfix/aliases>, and
415F</etc/exim/aliases>.  If your alias file is ones of these, the
416filename can be omitted from the constructor; Mail::ExpandAliases will
417look in @POSSIBLE_ALIAS_FILES until it finds a file that exists.
418
419Note that it is not (necessarily) an error if none of these files
420exists.  An alias file can be added by passing a filename to the
421init() method:
422
423  my $ma = Mail::ExpandAliases->new();
424
425  # Write a temporary aliases file in /tmp/aliases-$<
426  $ma->init("/tmp/aliases-$<");
427
428Calling expand before setting an alias file will, of course, produce
429no useful expansions.
430
431If the constructor is called with the name of a file that exists but
432cannot be opened, Mail::ExpandAliases will die with an error detailing
433the problem.
434
435=head1 BUGS / SHORTCOMINGS
436
437If you were telnet mailhost 25, and the server had EXPN turned on,
438then sendmail would read a user's .forward file.  This software cannot
439do that, and makes no attempt to.  Only the invoking user's .forward
440file should be readable (if any other user's .forward file was
441readable, sendmail would not read it, making this feature useless),
442and the invoking user should not need this module to read their own
443.forward file.
444
445Any other shortcomings, bugs, errors, or generally related complaints
446and requests should be reported via the appropriate queue at
447<http://rt.cpan.org/>.
448
449=head1 AUTHOR
450
451darren chamberlain E<lt>darren@cpan.orgE<gt>
Note: See TracBrowser for help on using the repository browser.