1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
# Copyrights 1995-2024 by [Mark Overmeer <markov@cpan.org>].
# For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# 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;{
our $VERSION = '2.22';
}
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(<FH>)
{ 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(<CF>)
{ 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(<CF>)
{ 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;
|
