File Coverage

blib/lib/Mail/Util.pm

Criterion	Covered	Total	%
statement	15	81	18.5
branch	0	50	0.0
condition	0	25	0.0
subroutine	5	9	55.5
pod	4	4	100.0
total	24	169	14.2

# Copyrights 1995-2019 by [Mark Overmeer ].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of the bundle MailTools.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md for Copyright.
# Licensed under the same terms as Perl itself.

package Mail::Util;
use vars '$VERSION';
$VERSION = '2.21';

use base 'Exporter';

use strict;
use Carp;

our @EXPORT_OK = qw(read_mbox maildomain mailaddress);

sub Version { our $VERSION }

my ($domain, $mailaddress);
my @sendmailcf = qw(/etc /etc/sendmail /etc/ucblib
    /etc/mail /usr/lib /var/adm/sendmail);


sub read_mbox($)
{   my $file  = shift;

    local *FH;
    open FH,'<', $file
	or croak "cannot open '$file': $!\n";

    local $_;
    my @mbox;
    my $mail  = [];
    my $blank = 1;

    while()
    {   if($blank && /^From .*\d{4}/)
        {   push @mbox, $mail if @$mail;
            $mail  = [ $_ ];
            $blank = 0;
        }
        else
        {   $blank = m/^$/ ? 1 : 0;
            push @$mail, $_;
        }
    }

    push @mbox, $mail if @$mail;
    close FH;

    wantarray ? @mbox : \@mbox;
}


sub maildomain()
{   return $domain
	if defined $domain;

    $domain = $ENV{MAILDOMAIN}
        and return $domain;

    # Try sendmail configuration file

    my $config = (grep -r, map {"$_/sendmail.cf"} @sendmailcf)[0];

    local *CF;
    local $_;
    if(defined $config && open CF, '<', $config)
    {   my %var;
	while()
        {   if(my ($v, $arg) = /^D([a-zA-Z])([\w.\$\-]+)/)
            {   $arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$'.$1/eg;
		$var{$v} = $arg;
	    }
	}
	close CF;
	$domain = $var{j} if defined $var{j};
	$domain = $var{M} if defined $var{M};

        $domain = $1
            if $domain && $domain =~ m/([A-Za-z0-9](?:[\.\-A-Za-z0-9]+))/;

	return $domain
	    if defined $domain && $domain !~ /\$/;
    }

    # Try smail config file if exists

    if(open CF, '<', "/usr/lib/smail/config")
    {   while()
        {   if( /\A\s*hostnames?\s*=\s*(\S+)/ )
            {   $domain = (split /\:/,$1)[0];
		last;
	    }
	}
	close CF;

	return $domain
	    if defined $domain;
    }

    # Try a SMTP connection to 'mailhost'

    if(eval {require Net::SMTP})
    {   foreach my $host (qw(mailhost localhost))
        {   # hosts are local, so short timeout
            my $smtp = eval { Net::SMTP->new($host, Timeout => 5) };
	    if(defined $smtp)
            {   $domain = $smtp->domain;
		$smtp->quit;
		last;
	    }
	}
    }

    # Use internet(DNS) domain name, if it can be found
    $domain = Net::Domain::domainname()
        if !defined $domain && eval {require Net::Domain};

    $domain ||= "localhost";
}


sub mailaddress(;$)
{   $mailaddress = shift if @_;

    return $mailaddress
        if defined $mailaddress;

    # Get user name from environment
    $mailaddress = $ENV{MAILADDRESS};

    unless($mailaddress || $^O ne 'MacOS')
    {   require Mac::InternetConfig;

        no strict;
	Mac::InternetConfig->import;
	$mailaddress = $InternetConfig{kICEmail()};
    }

    $mailaddress ||= $ENV{USER} || $ENV{LOGNAME} || eval {getpwuid $>}
                 ||  "postmaster";

    # Add domain if it does not exist
    $mailaddress .= '@' . maildomain
	if $mailaddress !~ /\@/;

    $mailaddress =~ s/(^.*<|>.*$)//g;
    $mailaddress;
}

1;