| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
2
|
|
|
|
|
|
|
## MIME Email Builder - ~/lib/Mail/Make.pm |
|
3
|
|
|
|
|
|
|
## Version v0.22.0 |
|
4
|
|
|
|
|
|
|
## Copyright(c) 2026 DEGUEST Pte. Ltd. |
|
5
|
|
|
|
|
|
|
## Author: Jacques Deguest <jack@deguest.jp> |
|
6
|
|
|
|
|
|
|
## Created 2026/03/02 |
|
7
|
|
|
|
|
|
|
## Modified 2026/03/18 |
|
8
|
|
|
|
|
|
|
## All rights reserved |
|
9
|
|
|
|
|
|
|
## |
|
10
|
|
|
|
|
|
|
## |
|
11
|
|
|
|
|
|
|
## This program is free software; you can redistribute it and/or modify it |
|
12
|
|
|
|
|
|
|
## under the same terms as Perl itself. |
|
13
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
14
|
|
|
|
|
|
|
package Mail::Make; |
|
15
|
|
|
|
|
|
|
BEGIN |
|
16
|
|
|
|
|
|
|
{ |
|
17
|
6
|
|
|
6
|
|
1121248
|
use strict; |
|
|
6
|
|
|
|
|
13
|
|
|
|
6
|
|
|
|
|
288
|
|
|
18
|
6
|
|
|
6
|
|
29
|
use warnings; |
|
|
6
|
|
|
|
|
14
|
|
|
|
6
|
|
|
|
|
452
|
|
|
19
|
6
|
|
|
6
|
|
52
|
warnings::register_categories( 'Mail::Make' ); |
|
20
|
6
|
|
|
6
|
|
917
|
use parent qw( Module::Generic ); |
|
|
6
|
|
|
|
|
575
|
|
|
|
6
|
|
|
|
|
38
|
|
|
21
|
6
|
|
|
6
|
|
715920
|
use vars qw( $VERSION $EXCEPTION_CLASS $CRLF $MAX_BODY_IN_MEMORY_SIZE ); |
|
|
6
|
|
|
|
|
18
|
|
|
|
6
|
|
|
|
|
550
|
|
|
22
|
6
|
|
|
6
|
|
4010
|
use Mail::Make::Entity; |
|
|
6
|
|
|
|
|
27
|
|
|
|
6
|
|
|
|
|
80
|
|
|
23
|
6
|
|
|
6
|
|
1968
|
use Mail::Make::Exception; |
|
|
6
|
|
|
|
|
11
|
|
|
|
6
|
|
|
|
|
27
|
|
|
24
|
6
|
|
|
6
|
|
1310
|
use Mail::Make::Headers; |
|
|
6
|
|
|
|
|
11
|
|
|
|
6
|
|
|
|
|
38
|
|
|
25
|
6
|
|
|
6
|
|
1209
|
use Mail::Make::Headers::Subject; |
|
|
6
|
|
|
|
|
12
|
|
|
|
6
|
|
|
|
|
45
|
|
|
26
|
6
|
|
|
6
|
|
1191
|
use Scalar::Util (); |
|
|
6
|
|
|
|
|
13
|
|
|
|
6
|
|
|
|
|
468
|
|
|
27
|
6
|
|
|
|
|
12
|
our $CRLF = "\015\012"; |
|
28
|
6
|
|
|
|
|
11
|
our $MAX_BODY_IN_MEMORY_SIZE = 1_048_576; # 1 MiB default |
|
29
|
6
|
|
|
|
|
11
|
our $EXCEPTION_CLASS = 'Mail::Make::Exception'; |
|
30
|
6
|
|
|
|
|
117
|
our $VERSION = 'v0.22.0'; |
|
31
|
|
|
|
|
|
|
} |
|
32
|
|
|
|
|
|
|
|
|
33
|
6
|
|
|
6
|
|
28
|
use strict; |
|
|
6
|
|
|
|
|
9
|
|
|
|
6
|
|
|
|
|
153
|
|
|
34
|
6
|
|
|
6
|
|
23
|
use warnings; |
|
|
6
|
|
|
|
|
11
|
|
|
|
6
|
|
|
|
|
41856
|
|
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub init |
|
37
|
|
|
|
|
|
|
{ |
|
38
|
49
|
|
|
49
|
1
|
2950961
|
my $self = shift( @_ ); |
|
39
|
|
|
|
|
|
|
# Top-level envelope headers live in a Mail::Make::Headers instance. |
|
40
|
|
|
|
|
|
|
# All RFC 2822 envelope fields (From, To, Cc, Bcc, Subject, Date, Message-ID, |
|
41
|
|
|
|
|
|
|
# In-Reply-To, References, Reply-To, Sender) are stored there directly, avoiding any |
|
42
|
|
|
|
|
|
|
# duplication between Mail::Make and the final Mail::Make::Entity's headers object. |
|
43
|
49
|
|
|
|
|
1120
|
$self->{_headers} = Mail::Make::Headers->new; |
|
44
|
|
|
|
|
|
|
# Accumulated body parts (Mail::Make::Entity objects, in order of addition) |
|
45
|
49
|
|
|
|
|
844
|
$self->{_parts} = []; |
|
46
|
|
|
|
|
|
|
# When the serialised message exceeds this byte threshold (or when use_temp_file is true), |
|
47
|
|
|
|
|
|
|
# as_string_ref() spools to a temporary file rather than keeping the entire message in RAM. |
|
48
|
|
|
|
|
|
|
# Set to 0 or undef to disable file spooling entirely. |
|
49
|
49
|
|
|
|
|
261
|
$self->{max_body_in_memory_size} = $MAX_BODY_IN_MEMORY_SIZE; |
|
50
|
49
|
|
|
|
|
290
|
$self->{use_temp_file} = 0; |
|
51
|
49
|
|
|
|
|
314
|
$self->{_exception_class} = $EXCEPTION_CLASS; |
|
52
|
49
|
|
|
|
|
160
|
$self->{_init_strict_use_sub} = 1; |
|
53
|
49
|
50
|
|
|
|
231
|
$self->SUPER::init( @_ ) || return( $self->pass_error ); |
|
54
|
49
|
|
|
|
|
4333
|
return( $self ); |
|
55
|
|
|
|
|
|
|
} |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# as_entity() |
|
58
|
|
|
|
|
|
|
# Returns the fully assembled top-level Mail::Make::Entity object. |
|
59
|
|
|
|
|
|
|
# The MIME structure is chosen based on the accumulated parts: |
|
60
|
|
|
|
|
|
|
# |
|
61
|
|
|
|
|
|
|
# Only plain text -> text/plain |
|
62
|
|
|
|
|
|
|
# Only HTML -> text/html |
|
63
|
|
|
|
|
|
|
# Plain + HTML -> multipart/alternative |
|
64
|
|
|
|
|
|
|
# Any of the above + inlines -> multipart/related |
|
65
|
|
|
|
|
|
|
# Any of the above + attachments -> multipart/mixed |
|
66
|
|
|
|
|
|
|
sub as_entity |
|
67
|
|
|
|
|
|
|
{ |
|
68
|
54
|
|
|
54
|
1
|
221
|
my $self = shift( @_ ); |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# When gpg_sign() / gpg_encrypt() / gpg_sign_encrypt() have already assembled the |
|
71
|
|
|
|
|
|
|
# top-level entity (stored in _gpg_entity), return it directly. Envelope headers have |
|
72
|
|
|
|
|
|
|
# already been merged by _wrap_in_mail(). |
|
73
|
54
|
50
|
|
|
|
332
|
return( $self->{_gpg_entity} ) if( defined( $self->{_gpg_entity} ) ); |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# S/MIME: entity pre-assembled by Mail::Make::SMIME::_build_from_smime_output(). |
|
76
|
|
|
|
|
|
|
# Headers are already embedded in the parsed entity; return it directly. |
|
77
|
54
|
50
|
|
|
|
283
|
return( $self->{_smime_entity} ) if( defined( $self->{_smime_entity} ) ); |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Partition accumulated parts by role |
|
80
|
54
|
|
|
|
|
149
|
my( @plain, @html, @inline, @attachment ); |
|
81
|
54
|
|
|
|
|
155
|
for my $part ( @{$self->{_parts}} ) |
|
|
54
|
|
|
|
|
338
|
|
|
82
|
|
|
|
|
|
|
{ |
|
83
|
75
|
|
50
|
|
|
472
|
my $type = lc( $part->effective_type // '' ); |
|
84
|
|
|
|
|
|
|
# Use get() for the raw string value; content_disposition() returns a typed |
|
85
|
|
|
|
|
|
|
# object which stringifies to '' when uninitialised, making // unreliable. |
|
86
|
75
|
|
100
|
|
|
430
|
my $cd = lc( $part->headers->get( 'Content-Disposition' ) // '' ); |
|
87
|
75
|
100
|
66
|
|
|
864
|
if( $type eq 'text/plain' && $cd !~ /attachment/ ) |
|
|
|
100
|
66
|
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
88
|
|
|
|
|
|
|
{ |
|
89
|
50
|
|
|
|
|
289
|
push( @plain, $part ); |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
elsif( $type eq 'text/html' && $cd !~ /attachment/ ) |
|
92
|
|
|
|
|
|
|
{ |
|
93
|
9
|
|
|
|
|
29
|
push( @html, $part ); |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
elsif( $cd =~ /inline/ && $part->headers->get( 'Content-ID' ) ) |
|
96
|
|
|
|
|
|
|
{ |
|
97
|
6
|
|
|
|
|
28
|
push( @inline, $part ); |
|
98
|
|
|
|
|
|
|
} |
|
99
|
|
|
|
|
|
|
else |
|
100
|
|
|
|
|
|
|
{ |
|
101
|
10
|
|
|
|
|
38
|
push( @attachment, $part ); |
|
102
|
|
|
|
|
|
|
} |
|
103
|
|
|
|
|
|
|
} |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# NOTE: Step 1: build the text body (plain, html, or alternative) |
|
106
|
54
|
|
|
|
|
109
|
my $body_entity; |
|
107
|
54
|
100
|
100
|
|
|
1275
|
if( @plain && @html ) |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
{ |
|
109
|
6
|
|
50
|
|
|
58
|
$body_entity = Mail::Make::Entity->build( type => 'multipart/alternative' ) || |
|
110
|
|
|
|
|
|
|
return( $self->pass_error( Mail::Make::Entity->error ) ); |
|
111
|
6
|
|
|
|
|
48185
|
$body_entity->add_part( $_ ) for( @plain ); |
|
112
|
6
|
|
|
|
|
33
|
$body_entity->add_part( $_ ) for( @html ); |
|
113
|
|
|
|
|
|
|
} |
|
114
|
|
|
|
|
|
|
elsif( @html ) |
|
115
|
|
|
|
|
|
|
{ |
|
116
|
3
|
|
|
|
|
7
|
$body_entity = $html[0]; |
|
117
|
|
|
|
|
|
|
} |
|
118
|
|
|
|
|
|
|
elsif( @plain ) |
|
119
|
|
|
|
|
|
|
{ |
|
120
|
44
|
|
|
|
|
108
|
$body_entity = $plain[0]; |
|
121
|
|
|
|
|
|
|
} |
|
122
|
|
|
|
|
|
|
else |
|
123
|
|
|
|
|
|
|
{ |
|
124
|
1
|
|
|
|
|
8
|
return( $self->error( "No body parts have been added." ) ); |
|
125
|
|
|
|
|
|
|
} |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# NOTE: Step 2: wrap in multipart/related if there are inline parts |
|
128
|
53
|
|
|
|
|
110
|
my $related_entity = $body_entity; |
|
129
|
53
|
100
|
|
|
|
252
|
if( @inline ) |
|
130
|
|
|
|
|
|
|
{ |
|
131
|
6
|
|
50
|
|
|
52
|
$related_entity = Mail::Make::Entity->build( type => 'multipart/related' ) || |
|
132
|
|
|
|
|
|
|
return( $self->pass_error( Mail::Make::Entity->error ) ); |
|
133
|
6
|
|
|
|
|
46953
|
$related_entity->add_part( $body_entity ); |
|
134
|
6
|
|
|
|
|
31
|
$related_entity->add_part( $_ ) for( @inline ); |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# NOTE: Step 3: wrap in multipart/mixed if there are attachments |
|
138
|
53
|
|
|
|
|
199
|
my $top_entity = $related_entity; |
|
139
|
53
|
100
|
|
|
|
178
|
if( @attachment ) |
|
140
|
|
|
|
|
|
|
{ |
|
141
|
7
|
|
50
|
|
|
92
|
$top_entity = Mail::Make::Entity->build( type => 'multipart/mixed' ) || |
|
142
|
|
|
|
|
|
|
return( $self->pass_error( Mail::Make::Entity->error ) ); |
|
143
|
7
|
|
|
|
|
43951
|
$top_entity->add_part( $related_entity ); |
|
144
|
7
|
|
|
|
|
39
|
$top_entity->add_part( $_ ) for( @attachment ); |
|
145
|
|
|
|
|
|
|
} |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# NOTE: Step 4: transfer envelope headers to the top-level entity |
|
148
|
|
|
|
|
|
|
# We merge our own _headers into the entity's headers object so that MIME-specific |
|
149
|
|
|
|
|
|
|
# headers already set on the entity (Content-Type, CTE, etc.) take precedence, while |
|
150
|
|
|
|
|
|
|
# envelope headers come from _headers. |
|
151
|
|
|
|
|
|
|
# Any header already present in the entity headers is left untouched. |
|
152
|
53
|
|
|
|
|
247
|
my $ent_headers = $top_entity->headers; |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# Auto-generate Date if not set |
|
155
|
|
|
|
|
|
|
$self->{_headers}->init_header( |
|
156
|
53
|
|
|
|
|
462
|
'Date' => $self->_format_date() |
|
157
|
|
|
|
|
|
|
); |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# Auto-generate Message-ID if not set |
|
160
|
53
|
100
|
|
|
|
290
|
unless( $self->{_headers}->exists( 'Message-ID' ) ) |
|
161
|
|
|
|
|
|
|
{ |
|
162
|
|
|
|
|
|
|
$self->{_headers}->message_id( { generate => 1, domain => $self->_default_domain } ) || |
|
163
|
45
|
50
|
|
|
|
463
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
164
|
|
|
|
|
|
|
} |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# MIME-Version is always added to the entity's own headers (not the envelope), since |
|
167
|
|
|
|
|
|
|
# it belongs at the top of the MIME structure. |
|
168
|
53
|
|
|
|
|
271
|
$ent_headers->init_header( 'MIME-Version' => '1.0' ); |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# Merge envelope headers into the entity: each field from _headers that is not already |
|
171
|
|
|
|
|
|
|
# present in ent_headers is copied over. |
|
172
|
|
|
|
|
|
|
$self->{_headers}->scan( sub |
|
173
|
|
|
|
|
|
|
{ |
|
174
|
269
|
|
|
269
|
|
480
|
my( $name, $value ) = @_; |
|
175
|
269
|
|
|
|
|
816
|
$ent_headers->init_header( $name => $value ); |
|
176
|
269
|
|
|
|
|
548
|
return(1); |
|
177
|
53
|
|
|
|
|
920
|
}); |
|
178
|
|
|
|
|
|
|
|
|
179
|
53
|
|
|
|
|
400
|
return( $top_entity ); |
|
180
|
|
|
|
|
|
|
} |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# as_string() |
|
183
|
|
|
|
|
|
|
# Assembles the message and returns it as a plain string, consistent with |
|
184
|
|
|
|
|
|
|
# MIME::Entity::stringify. Use print($fh) to avoid loading the whole message into memory, |
|
185
|
|
|
|
|
|
|
# or as_string_ref() to avoid a string copy. |
|
186
|
|
|
|
|
|
|
sub as_string |
|
187
|
|
|
|
|
|
|
{ |
|
188
|
26
|
|
|
26
|
1
|
8581
|
my $self = shift( @_ ); |
|
189
|
26
|
|
100
|
|
|
149
|
my $entity = $self->as_entity || return( $self->pass_error ); |
|
190
|
25
|
|
|
|
|
154
|
return( $entity->as_string( @_ ) ); |
|
191
|
|
|
|
|
|
|
} |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# as_string_ref() |
|
194
|
|
|
|
|
|
|
# Returns the assembled message as a scalar reference (no string copy). |
|
195
|
|
|
|
|
|
|
# When use_temp_file is true, or the serialised entity size exceeds max_body_in_memory_size, |
|
196
|
|
|
|
|
|
|
# the message is written to a Module::Generic::Scalar buffer, thus keeping peak RAM use |
|
197
|
|
|
|
|
|
|
# to a single copy rather than two overlapping buffers (the serialisation buffer plus the |
|
198
|
|
|
|
|
|
|
# returned string). |
|
199
|
|
|
|
|
|
|
sub as_string_ref |
|
200
|
|
|
|
|
|
|
{ |
|
201
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
202
|
0
|
|
0
|
|
|
0
|
my $entity = $self->as_entity || return( $self->pass_error ); |
|
203
|
0
|
|
|
|
|
0
|
my $threshold = $self->{max_body_in_memory_size}; |
|
204
|
0
|
|
|
|
|
0
|
my $force_file = $self->{use_temp_file}; |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Fast path: build directly in memory when neither condition applies |
|
207
|
0
|
0
|
0
|
|
|
0
|
unless( $force_file || ( defined( $threshold ) && $threshold > 0 && $entity->length > $threshold ) ) |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
208
|
|
|
|
|
|
|
{ |
|
209
|
0
|
|
|
|
|
0
|
return( $entity->as_string_ref ); |
|
210
|
|
|
|
|
|
|
} |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# new_scalar() is inherited from Module::Generic, and returns a Module::Generic::Scalar object |
|
213
|
0
|
|
|
|
|
0
|
my $buf = $self->new_scalar; |
|
214
|
|
|
|
|
|
|
# In-memory fielhandle; returns a Module::Generic::Scalar::IO object |
|
215
|
0
|
|
0
|
|
|
0
|
my $fh = $buf->open( '>', { binmode => ':raw', autoflush => 1 } ) || return( $buf->error ); |
|
216
|
0
|
0
|
|
|
|
0
|
$entity->print( $fh ) || return( $self->pass_error( $entity->error ) ); |
|
217
|
|
|
|
|
|
|
# The scalar object stringifies as necessary. |
|
218
|
0
|
|
|
|
|
0
|
return( $buf ); |
|
219
|
|
|
|
|
|
|
} |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# attach( %opts ) |
|
222
|
|
|
|
|
|
|
# Adds a standard (downloadable) attachment. |
|
223
|
|
|
|
|
|
|
# Recognised keys: path, data, type, filename, charset, encoding, description |
|
224
|
|
|
|
|
|
|
sub attach |
|
225
|
|
|
|
|
|
|
{ |
|
226
|
11
|
|
|
11
|
1
|
64
|
my $self = shift( @_ ); |
|
227
|
|
|
|
|
|
|
# Detect positional shorthand: attach( '/path/to/file.pdf' ) or |
|
228
|
|
|
|
|
|
|
# attach( '/path/to/file.pdf', encoding => 'base64', ... ) |
|
229
|
|
|
|
|
|
|
# Triggered when argument count is odd and the first argument is a plain scalar |
|
230
|
|
|
|
|
|
|
# (not a reference), contains no newline, and resolves to an existing file. |
|
231
|
11
|
50
|
33
|
|
|
149
|
if( ( scalar( @_ ) % 2 ) && |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
232
|
|
|
|
|
|
|
( !ref( $_[0] ) || $self->_can_overload( $_[0] => '""' ) ) && |
|
233
|
|
|
|
|
|
|
index( "$_[0]", "\n" ) == -1 ) |
|
234
|
|
|
|
|
|
|
{ |
|
235
|
|
|
|
|
|
|
# shift() first to avoid $_[0] being altered by new_file() resolution |
|
236
|
4
|
|
|
|
|
40
|
my $f = $self->new_file( shift( @_ ) ); # Module::Generic::File will trigger stringification |
|
237
|
4
|
50
|
|
|
|
589272
|
if( $f->exists ) |
|
238
|
|
|
|
|
|
|
{ |
|
239
|
|
|
|
|
|
|
# then, we pass it back here: |
|
240
|
4
|
|
|
|
|
378
|
unshift( @_, path => $f ); |
|
241
|
|
|
|
|
|
|
} |
|
242
|
|
|
|
|
|
|
} |
|
243
|
11
|
|
|
|
|
90
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
244
|
11
|
100
|
66
|
|
|
13331
|
unless( defined( $opts->{data} ) || defined( $opts->{path} ) ) |
|
245
|
|
|
|
|
|
|
{ |
|
246
|
1
|
|
|
|
|
7
|
return( $self->error( "attach(): 'data' or 'path' is required." ) ); |
|
247
|
|
|
|
|
|
|
} |
|
248
|
10
|
|
50
|
|
|
164
|
$opts->{disposition} //= 'attachment'; |
|
249
|
10
|
|
50
|
|
|
177
|
my $entity = Mail::Make::Entity->build( %$opts ) || |
|
250
|
|
|
|
|
|
|
return( $self->pass_error( Mail::Make::Entity->error ) ); |
|
251
|
10
|
|
|
|
|
67667
|
push( @{$self->{_parts}}, $entity ); |
|
|
10
|
|
|
|
|
72
|
|
|
252
|
10
|
|
|
|
|
221
|
return( $self ); |
|
253
|
|
|
|
|
|
|
} |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# attach_inline( %opts ) |
|
256
|
|
|
|
|
|
|
# Adds an inline part (e.g. an image referenced via cid: in HTML). |
|
257
|
|
|
|
|
|
|
# 'id' or 'cid' is required. |
|
258
|
|
|
|
|
|
|
sub attach_inline |
|
259
|
|
|
|
|
|
|
{ |
|
260
|
7
|
|
|
7
|
1
|
58
|
my $self = shift( @_ ); |
|
261
|
7
|
|
|
|
|
54
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
262
|
7
|
50
|
33
|
|
|
9176
|
unless( defined( $opts->{data} ) || defined( $opts->{path} ) ) |
|
263
|
|
|
|
|
|
|
{ |
|
264
|
0
|
|
|
|
|
0
|
return( $self->error( "attach_inline(): 'data' or 'path' is required." ) ); |
|
265
|
|
|
|
|
|
|
} |
|
266
|
7
|
100
|
100
|
|
|
90
|
unless( defined( $opts->{id} ) || defined( $opts->{cid} ) ) |
|
267
|
|
|
|
|
|
|
{ |
|
268
|
1
|
|
|
|
|
23
|
return( $self->error( "attach_inline(): 'id' or 'cid' is required for inline parts." ) ); |
|
269
|
|
|
|
|
|
|
} |
|
270
|
|
|
|
|
|
|
# Normalise: Entity->build() expects 'cid' |
|
271
|
6
|
|
66
|
|
|
29
|
$opts->{cid} //= delete( $opts->{id} ); |
|
272
|
6
|
|
50
|
|
|
72
|
$opts->{disposition} //= 'inline'; |
|
273
|
6
|
|
50
|
|
|
52
|
my $entity = Mail::Make::Entity->build( %$opts ) || |
|
274
|
|
|
|
|
|
|
return( $self->pass_error( Mail::Make::Entity->error ) ); |
|
275
|
6
|
|
|
|
|
48043
|
push( @{$self->{_parts}}, $entity ); |
|
|
6
|
|
|
|
|
37
|
|
|
276
|
6
|
|
|
|
|
155
|
return( $self ); |
|
277
|
|
|
|
|
|
|
} |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# bcc( @addresses ) |
|
280
|
|
|
|
|
|
|
# Accumulates BCC recipients (may be called multiple times). |
|
281
|
|
|
|
|
|
|
sub bcc |
|
282
|
|
|
|
|
|
|
{ |
|
283
|
2
|
|
|
2
|
1
|
23
|
my $self = shift( @_ ); |
|
284
|
2
|
50
|
|
|
|
50
|
if( @_ ) |
|
285
|
|
|
|
|
|
|
{ |
|
286
|
2
|
50
|
|
|
|
48
|
my @encoded = map { $self->_encode_address( $_ ) } ( ref( $_[0] ) eq 'ARRAY' ? @{$_[0]} : @_ ); |
|
|
2
|
|
|
|
|
35
|
|
|
|
0
|
|
|
|
|
0
|
|
|
287
|
|
|
|
|
|
|
$self->{_headers}->push_header( 'Bcc' => join( ', ', @encoded ) ) || |
|
288
|
2
|
50
|
|
|
|
79
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
289
|
2
|
|
|
|
|
77
|
return( $self ); |
|
290
|
|
|
|
|
|
|
} |
|
291
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'Bcc' ) ); |
|
292
|
|
|
|
|
|
|
} |
|
293
|
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# build( %params ) - alternate hash-based constructor/factory |
|
295
|
|
|
|
|
|
|
# Returns a Mail::Make object with all parameters applied. |
|
296
|
|
|
|
|
|
|
sub build |
|
297
|
|
|
|
|
|
|
{ |
|
298
|
8
|
|
|
8
|
1
|
146821
|
my $class = shift( @_ ); |
|
299
|
8
|
|
|
|
|
63
|
my $params = $class->_get_args_as_hash( @_ ); |
|
300
|
8
|
|
50
|
|
|
30756
|
my $self = $class->new || return( $class->pass_error ); |
|
301
|
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
# Scalar envelope fields |
|
303
|
8
|
|
|
|
|
77
|
foreach my $field ( qw( date from in_reply_to message_id reply_to return_path sender subject ) ) |
|
304
|
|
|
|
|
|
|
{ |
|
305
|
|
|
|
|
|
|
$self->$field( $params->{ $field } ) || return( $self->pass_error ) |
|
306
|
64
|
100
|
50
|
|
|
243
|
if( exists( $params->{ $field } ) ); |
|
307
|
|
|
|
|
|
|
} |
|
308
|
|
|
|
|
|
|
# List fields |
|
309
|
8
|
|
|
|
|
34
|
foreach my $field ( qw( bcc cc references to ) ) |
|
310
|
|
|
|
|
|
|
{ |
|
311
|
32
|
100
|
|
|
|
59
|
if( exists( $params->{ $field } ) ) |
|
312
|
|
|
|
|
|
|
{ |
|
313
|
8
|
|
|
|
|
23
|
my $v = $params->{ $field }; |
|
314
|
8
|
100
|
|
|
|
42
|
$self->$field( ref( $v ) eq 'ARRAY' ? @$v : $v ) || return( $self->pass_error ); |
|
|
|
50
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
} |
|
316
|
|
|
|
|
|
|
} |
|
317
|
|
|
|
|
|
|
# Body convenience shorthands |
|
318
|
8
|
50
|
|
|
|
30
|
if( exists( $params->{plain} ) ) |
|
319
|
|
|
|
|
|
|
{ |
|
320
|
8
|
50
|
33
|
|
|
32
|
if( exists( $params->{plain_opts} ) && ref( $params->{plain_opts} ) ne 'HASH' ) |
|
321
|
|
|
|
|
|
|
{ |
|
322
|
0
|
|
0
|
|
|
0
|
return( $self->error( "The parameter 'plain_opts' must be a hash reference. You provided '", $self->_str_val( $params->{plain_opts} // 'undef' ), "'." ) ); |
|
323
|
|
|
|
|
|
|
} |
|
324
|
8
|
|
50
|
|
|
10
|
my %opts = %{$params->{plain_opts} // {}}; |
|
|
8
|
|
|
|
|
70
|
|
|
325
|
8
|
50
|
|
|
|
44
|
$self->plain( $params->{plain}, %opts ) || return( $self->pass_error ); |
|
326
|
|
|
|
|
|
|
} |
|
327
|
8
|
50
|
|
|
|
48
|
if( exists( $params->{html} ) ) |
|
328
|
|
|
|
|
|
|
{ |
|
329
|
0
|
0
|
0
|
|
|
0
|
if( exists( $params->{html_opts} ) && ref( $params->{html_opts} ) ne 'HASH' ) |
|
330
|
|
|
|
|
|
|
{ |
|
331
|
0
|
|
0
|
|
|
0
|
return( $self->error( "The parameter 'html_opts' must be a hash reference. You provided '", $self->_str_val( $params->{html_opts} // 'undef' ), "'." ) ); |
|
332
|
|
|
|
|
|
|
} |
|
333
|
0
|
|
0
|
|
|
0
|
my %opts = %{$params->{html_opts} // {}}; |
|
|
0
|
|
|
|
|
0
|
|
|
334
|
0
|
0
|
|
|
|
0
|
$self->html( $params->{html}, %opts ) || return( $self->pass_error ); |
|
335
|
|
|
|
|
|
|
} |
|
336
|
|
|
|
|
|
|
# Attachments: scalar, arrayref of scalars, or arrayref of hashrefs |
|
337
|
8
|
100
|
66
|
|
|
121
|
if( exists( $params->{attach} ) && defined( $params->{attach} ) ) |
|
338
|
|
|
|
|
|
|
{ |
|
339
|
4
|
|
|
|
|
13
|
my $attach = $params->{attach}; |
|
340
|
|
|
|
|
|
|
# Accepts vanilla array reference or array objects like Module::Generic::Array |
|
341
|
4
|
100
|
|
|
|
43
|
my @items = $self->_is_array( $attach ) ? @$attach : ( $attach ); |
|
342
|
4
|
|
|
|
|
92
|
foreach my $item ( @items ) |
|
343
|
|
|
|
|
|
|
{ |
|
344
|
7
|
50
|
|
|
|
20341
|
next unless( defined( $item ) ); |
|
345
|
|
|
|
|
|
|
# Such as: |
|
346
|
|
|
|
|
|
|
# { path => '/some/where/file.pdf', filename => '04 report.pdf', type => 'application/pdf' } |
|
347
|
|
|
|
|
|
|
# { data => $attachment_data, filename => '04 report.pdf', type => 'application/pdf' } |
|
348
|
7
|
100
|
|
|
|
53
|
if( ref( $item ) eq 'HASH' ) |
|
349
|
|
|
|
|
|
|
{ |
|
350
|
3
|
50
|
|
|
|
46
|
$self->attach( %$item ) || return( $self->pass_error ); |
|
351
|
|
|
|
|
|
|
} |
|
352
|
|
|
|
|
|
|
else |
|
353
|
|
|
|
|
|
|
{ |
|
354
|
|
|
|
|
|
|
# Plain scalar or stringifiable object - delegate to attach() which |
|
355
|
|
|
|
|
|
|
# already handles the positional shorthand |
|
356
|
|
|
|
|
|
|
# So, this can be an attachment data, or a file path, or a file object |
|
357
|
|
|
|
|
|
|
# like Module::Generic::File (as long as it stringifies) and does not |
|
358
|
|
|
|
|
|
|
# contain a "\n" |
|
359
|
4
|
50
|
|
|
|
33
|
$self->attach( $item ) || return( $self->pass_error ); |
|
360
|
|
|
|
|
|
|
} |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
} |
|
363
|
|
|
|
|
|
|
# Extra arbitrary headers |
|
364
|
8
|
100
|
66
|
|
|
22688
|
if( exists( $params->{headers} ) && ref( $params->{headers} ) eq 'HASH' ) |
|
365
|
|
|
|
|
|
|
{ |
|
366
|
1
|
|
|
|
|
2
|
while( my( $n, $v ) = each( %{$params->{headers}} ) ) |
|
|
2
|
|
|
|
|
8
|
|
|
367
|
|
|
|
|
|
|
{ |
|
368
|
1
|
50
|
|
|
|
6
|
$self->header( $n, $v ) || return( $self->pass_error ); |
|
369
|
|
|
|
|
|
|
} |
|
370
|
|
|
|
|
|
|
} |
|
371
|
8
|
|
|
|
|
142
|
return( $self ); |
|
372
|
|
|
|
|
|
|
} |
|
373
|
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# cc( @addresses ) |
|
375
|
|
|
|
|
|
|
# Accumulates CC recipients. |
|
376
|
|
|
|
|
|
|
sub cc |
|
377
|
|
|
|
|
|
|
{ |
|
378
|
3
|
|
|
3
|
1
|
40
|
my $self = shift( @_ ); |
|
379
|
3
|
50
|
|
|
|
57
|
if( @_ ) |
|
380
|
|
|
|
|
|
|
{ |
|
381
|
3
|
50
|
|
|
|
49
|
my @encoded = map { $self->_encode_address( $_ ) } ( ref( $_[0] ) eq 'ARRAY' ? @{$_[0]} : @_ ); |
|
|
3
|
|
|
|
|
37
|
|
|
|
0
|
|
|
|
|
0
|
|
|
382
|
|
|
|
|
|
|
$self->{_headers}->push_header( 'Cc' => join( ', ', @encoded ) ) || |
|
383
|
3
|
50
|
|
|
|
106
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
384
|
3
|
|
|
|
|
108
|
return( $self ); |
|
385
|
|
|
|
|
|
|
} |
|
386
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'Cc' ) ); |
|
387
|
|
|
|
|
|
|
} |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
# date( [$date_string_or_epoch] ) |
|
390
|
|
|
|
|
|
|
# Delegates to Mail::Make::Headers::date(), which handles epoch integers, string validation, |
|
391
|
|
|
|
|
|
|
# and RFC 5322 formatting. |
|
392
|
|
|
|
|
|
|
sub date |
|
393
|
|
|
|
|
|
|
{ |
|
394
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
395
|
0
|
0
|
|
|
|
0
|
if( @_ ) |
|
396
|
|
|
|
|
|
|
{ |
|
397
|
|
|
|
|
|
|
$self->{_headers}->date( @_ ) || |
|
398
|
0
|
0
|
|
|
|
0
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
399
|
0
|
|
|
|
|
0
|
return( $self ); |
|
400
|
|
|
|
|
|
|
} |
|
401
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->date ); |
|
402
|
|
|
|
|
|
|
} |
|
403
|
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
# from( [$address] ) |
|
405
|
|
|
|
|
|
|
sub from |
|
406
|
|
|
|
|
|
|
{ |
|
407
|
47
|
|
|
47
|
1
|
120
|
my $self = shift( @_ ); |
|
408
|
47
|
50
|
|
|
|
213
|
if( @_ ) |
|
409
|
|
|
|
|
|
|
{ |
|
410
|
47
|
|
|
|
|
296
|
my $addr = $self->_encode_address( shift( @_ ) ); |
|
411
|
|
|
|
|
|
|
$self->{_headers}->set( 'From' => $addr ) || |
|
412
|
47
|
50
|
|
|
|
691
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
413
|
47
|
|
|
|
|
838
|
return( $self ); |
|
414
|
|
|
|
|
|
|
} |
|
415
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'From' ) ); |
|
416
|
|
|
|
|
|
|
} |
|
417
|
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# header( $name, $value ) |
|
419
|
|
|
|
|
|
|
# Appends an arbitrary extra header to the envelope (push_header semantics: does not |
|
420
|
|
|
|
|
|
|
# replace, allows multiple values for the same field). |
|
421
|
|
|
|
|
|
|
sub header |
|
422
|
|
|
|
|
|
|
{ |
|
423
|
2
|
|
|
2
|
1
|
7
|
my $self = shift( @_ ); |
|
424
|
2
|
50
|
|
|
|
9
|
if( @_ == 1 ) |
|
425
|
|
|
|
|
|
|
{ |
|
426
|
|
|
|
|
|
|
# Getter shortcut |
|
427
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( $_[0] ) ); |
|
428
|
|
|
|
|
|
|
} |
|
429
|
2
|
|
|
|
|
6
|
my( $name, $value ) = @_; |
|
430
|
2
|
50
|
33
|
|
|
28
|
unless( defined( $name ) && length( $name ) && defined( $value ) ) |
|
|
|
|
33
|
|
|
|
|
|
431
|
|
|
|
|
|
|
{ |
|
432
|
0
|
|
|
|
|
0
|
return( $self->error( "header(): name and value are required." ) ); |
|
433
|
|
|
|
|
|
|
} |
|
434
|
|
|
|
|
|
|
$self->{_headers}->push_header( $name => $value ) || |
|
435
|
2
|
50
|
|
|
|
16
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
436
|
2
|
|
|
|
|
14
|
return( $self ); |
|
437
|
|
|
|
|
|
|
} |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# headers() |
|
440
|
|
|
|
|
|
|
# Returns the Mail::Make::Headers object that holds the envelope headers. |
|
441
|
|
|
|
|
|
|
# Read-only: the object is created in init() and is not replaceable from outside, to |
|
442
|
|
|
|
|
|
|
# prevent accidental aliasing. |
|
443
|
0
|
|
|
0
|
1
|
0
|
sub headers { return( $_[0]->{_headers} ); } |
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
# html( $content [, %opts] ) |
|
446
|
|
|
|
|
|
|
# Adds a text/html body part. |
|
447
|
|
|
|
|
|
|
sub html |
|
448
|
|
|
|
|
|
|
{ |
|
449
|
9
|
|
|
9
|
1
|
23
|
my $self = shift( @_ ); |
|
450
|
9
|
|
|
|
|
28
|
my $text = shift( @_ ); |
|
451
|
9
|
|
|
|
|
52
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
452
|
9
|
50
|
|
|
|
70
|
unless( defined( $text ) ) |
|
453
|
|
|
|
|
|
|
{ |
|
454
|
0
|
|
|
|
|
0
|
return( $self->error( "html(): text content is required." ) ); |
|
455
|
|
|
|
|
|
|
} |
|
456
|
|
|
|
|
|
|
my $part = Mail::Make::Entity->build( |
|
457
|
|
|
|
|
|
|
type => 'text/html', |
|
458
|
|
|
|
|
|
|
charset => ( $opts->{charset} // 'utf-8' ), |
|
459
|
9
|
|
50
|
|
|
176
|
encoding => ( $opts->{encoding} // 'quoted-printable' ), |
|
460
|
|
|
|
|
|
|
data => $text, |
|
461
|
|
|
|
|
|
|
) || return( $self->pass_error( Mail::Make::Entity->error ) ); |
|
462
|
9
|
|
|
|
|
61243
|
push( @{$self->{_parts}}, $part ); |
|
|
9
|
|
|
|
|
43
|
|
|
463
|
9
|
|
|
|
|
127
|
return( $self ); |
|
464
|
|
|
|
|
|
|
} |
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# in_reply_to( [$mid] ) |
|
467
|
|
|
|
|
|
|
sub in_reply_to |
|
468
|
|
|
|
|
|
|
{ |
|
469
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
470
|
0
|
0
|
|
|
|
0
|
if( @_ ) |
|
471
|
|
|
|
|
|
|
{ |
|
472
|
|
|
|
|
|
|
$self->{_headers}->set( 'In-Reply-To' => shift( @_ ) ) || |
|
473
|
0
|
0
|
|
|
|
0
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
474
|
0
|
|
|
|
|
0
|
return( $self ); |
|
475
|
|
|
|
|
|
|
} |
|
476
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'In-Reply-To' ) ); |
|
477
|
|
|
|
|
|
|
} |
|
478
|
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
# max_body_in_memory_size( [$bytes] ) |
|
480
|
|
|
|
|
|
|
# Gets or sets the byte threshold above which as_string_ref() spools to a temporary file. |
|
481
|
|
|
|
|
|
|
# Set to 0 to disable the threshold (always use memory). |
|
482
|
|
|
|
|
|
|
# Default: $Mail::Make::MAX_BODY_IN_MEMORY_SIZE (1 MiB). |
|
483
|
0
|
|
|
0
|
1
|
0
|
sub max_body_in_memory_size { return( shift->_set_get_number( 'max_body_in_memory_size', @_ ) ); } |
|
484
|
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
# message_id( [$mid | \%opts] ) |
|
486
|
|
|
|
|
|
|
# Delegates fully to Mail::Make::Headers::message_id(), which handles generation, |
|
487
|
|
|
|
|
|
|
# validation, and removal. |
|
488
|
|
|
|
|
|
|
sub message_id |
|
489
|
|
|
|
|
|
|
{ |
|
490
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
491
|
0
|
0
|
|
|
|
0
|
if( @_ ) |
|
492
|
|
|
|
|
|
|
{ |
|
493
|
|
|
|
|
|
|
$self->{_headers}->message_id( @_ ) || |
|
494
|
0
|
0
|
|
|
|
0
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
495
|
0
|
|
|
|
|
0
|
return( $self ); |
|
496
|
|
|
|
|
|
|
} |
|
497
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->message_id ); |
|
498
|
|
|
|
|
|
|
} |
|
499
|
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
# plain( $content [, %opts] ) |
|
501
|
|
|
|
|
|
|
# Adds a text/plain body part. |
|
502
|
|
|
|
|
|
|
sub plain |
|
503
|
|
|
|
|
|
|
{ |
|
504
|
43
|
|
|
43
|
1
|
1250
|
my $self = shift( @_ ); |
|
505
|
43
|
|
|
|
|
330
|
my $text = shift( @_ ); |
|
506
|
43
|
|
|
|
|
543
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
507
|
43
|
50
|
|
|
|
481
|
unless( defined( $text ) ) |
|
508
|
|
|
|
|
|
|
{ |
|
509
|
0
|
|
|
|
|
0
|
return( $self->error( "plain(): text content is required." ) ); |
|
510
|
|
|
|
|
|
|
} |
|
511
|
|
|
|
|
|
|
my $part = Mail::Make::Entity->build( |
|
512
|
|
|
|
|
|
|
type => 'text/plain', |
|
513
|
|
|
|
|
|
|
charset => ( $opts->{charset} // 'utf-8' ), |
|
514
|
43
|
|
50
|
|
|
1363
|
encoding => ( $opts->{encoding} // 'quoted-printable' ), |
|
515
|
|
|
|
|
|
|
data => $text, |
|
516
|
|
|
|
|
|
|
) || return( $self->pass_error( Mail::Make::Entity->error ) ); |
|
517
|
43
|
|
|
|
|
306414
|
push( @{$self->{_parts}}, $part ); |
|
|
43
|
|
|
|
|
208
|
|
|
518
|
43
|
|
|
|
|
353
|
return( $self ); |
|
519
|
|
|
|
|
|
|
} |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
# print( $fh ) |
|
522
|
|
|
|
|
|
|
# Serialises the assembled message to a filehandle. |
|
523
|
|
|
|
|
|
|
sub print |
|
524
|
|
|
|
|
|
|
{ |
|
525
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
526
|
0
|
|
0
|
|
|
0
|
my $fh = shift( @_ ) || |
|
527
|
|
|
|
|
|
|
return( $self->error( "No file handle was provided to print the mail entity." ) ); |
|
528
|
0
|
0
|
|
|
|
0
|
unless( $self->_is_glob( $fh ) ) |
|
529
|
|
|
|
|
|
|
{ |
|
530
|
0
|
|
0
|
|
|
0
|
return( $self->error( "Value provided (", $self->_str_val( $fh // 'undef' ), ") is not a file handle." ) ); |
|
531
|
|
|
|
|
|
|
} |
|
532
|
0
|
|
0
|
|
|
0
|
my $entity = $self->as_entity || return( $self->pass_error ); |
|
533
|
0
|
0
|
|
|
|
0
|
$entity->print( $fh ) || return( $self->pass_error( $entity->error ) ); |
|
534
|
0
|
|
|
|
|
0
|
return( $self ); |
|
535
|
|
|
|
|
|
|
} |
|
536
|
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# references( @mids ) |
|
538
|
|
|
|
|
|
|
# Accumulates Message-ID references. |
|
539
|
|
|
|
|
|
|
sub references |
|
540
|
|
|
|
|
|
|
{ |
|
541
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
542
|
0
|
0
|
|
|
|
0
|
if( @_ ) |
|
543
|
|
|
|
|
|
|
{ |
|
544
|
0
|
0
|
|
|
|
0
|
my @mids = ( ref( $_[0] ) eq 'ARRAY' ? @{$_[0]} : @_ ); |
|
|
0
|
|
|
|
|
0
|
|
|
545
|
|
|
|
|
|
|
# References is a single folded header: accumulate by appending. |
|
546
|
0
|
|
0
|
|
|
0
|
my $existing = $self->{_headers}->header( 'References' ) // ''; |
|
547
|
0
|
|
|
|
|
0
|
my $new = join( ' ', grep{ length( $_ ) } $existing, @mids ); |
|
|
0
|
|
|
|
|
0
|
|
|
548
|
|
|
|
|
|
|
$self->{_headers}->set( 'References' => $new ) || |
|
549
|
0
|
0
|
|
|
|
0
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
550
|
0
|
|
|
|
|
0
|
return( $self ); |
|
551
|
|
|
|
|
|
|
} |
|
552
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'References' ) ); |
|
553
|
|
|
|
|
|
|
} |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
# reply_to( [$address] ) |
|
556
|
|
|
|
|
|
|
sub reply_to |
|
557
|
|
|
|
|
|
|
{ |
|
558
|
1
|
|
|
1
|
1
|
5
|
my $self = shift( @_ ); |
|
559
|
1
|
50
|
|
|
|
4
|
if( @_ ) |
|
560
|
|
|
|
|
|
|
{ |
|
561
|
1
|
|
|
|
|
3
|
my $addr = $self->_encode_address( shift( @_ ) ); |
|
562
|
|
|
|
|
|
|
$self->{_headers}->set( 'Reply-To' => $addr ) || |
|
563
|
1
|
50
|
|
|
|
3
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
564
|
1
|
|
|
|
|
10
|
return( $self ); |
|
565
|
|
|
|
|
|
|
} |
|
566
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'Reply-To' ) ); |
|
567
|
|
|
|
|
|
|
} |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
# return_path( [$address] ) |
|
570
|
|
|
|
|
|
|
sub return_path |
|
571
|
|
|
|
|
|
|
{ |
|
572
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
573
|
0
|
0
|
|
|
|
0
|
if( @_ ) |
|
574
|
|
|
|
|
|
|
{ |
|
575
|
0
|
|
|
|
|
0
|
my $addr = $self->_encode_address( shift( @_ ) ); |
|
576
|
|
|
|
|
|
|
$self->{_headers}->set( 'Return-Path' => $addr ) || |
|
577
|
0
|
0
|
|
|
|
0
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
578
|
0
|
|
|
|
|
0
|
return( $self ); |
|
579
|
|
|
|
|
|
|
} |
|
580
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'Return-Path' ) ); |
|
581
|
|
|
|
|
|
|
} |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# sender( [$address] ) |
|
584
|
|
|
|
|
|
|
sub sender |
|
585
|
|
|
|
|
|
|
{ |
|
586
|
1
|
|
|
1
|
1
|
4
|
my $self = shift( @_ ); |
|
587
|
1
|
50
|
|
|
|
4
|
if( @_ ) |
|
588
|
|
|
|
|
|
|
{ |
|
589
|
1
|
|
|
|
|
8
|
my $addr = $self->_encode_address( shift( @_ ) ); |
|
590
|
|
|
|
|
|
|
$self->{_headers}->set( 'Sender' => $addr ) || |
|
591
|
1
|
50
|
|
|
|
7
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
592
|
1
|
|
|
|
|
4
|
return( $self ); |
|
593
|
|
|
|
|
|
|
} |
|
594
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'Sender' ) ); |
|
595
|
|
|
|
|
|
|
} |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
# smtpsend( %opts ) |
|
598
|
|
|
|
|
|
|
# Assembles the message and submits it via SMTP using Net::SMTP. |
|
599
|
|
|
|
|
|
|
# |
|
600
|
|
|
|
|
|
|
# Recognised options: |
|
601
|
|
|
|
|
|
|
# Host => $hostname_or_Net_SMTP_object |
|
602
|
|
|
|
|
|
|
# Defaults to trying $ENV{SMTPHOSTS} (colon-separated), |
|
603
|
|
|
|
|
|
|
# 'mailhost', then 'localhost'. |
|
604
|
|
|
|
|
|
|
# MailFrom => $envelope_sender (MAIL FROM) |
|
605
|
|
|
|
|
|
|
# Defaults to the From: header address-spec. |
|
606
|
|
|
|
|
|
|
# To => \@recipients Override the To header for RCPT TO. |
|
607
|
|
|
|
|
|
|
# Cc => \@recipients Additional CC addresses for RCPT TO. |
|
608
|
|
|
|
|
|
|
# Bcc => \@recipients Additional BCC addresses for RCPT TO. |
|
609
|
|
|
|
|
|
|
# Note: Bcc is stripped from the outgoing headers per RFC 2822 §3.6.3. |
|
610
|
|
|
|
|
|
|
# Hello => $fqdn EHLO/HELO hostname. |
|
611
|
|
|
|
|
|
|
# Port => $port SMTP port (default 25). |
|
612
|
|
|
|
|
|
|
# Debug => $bool Enable Net::SMTP debug output. |
|
613
|
|
|
|
|
|
|
# |
|
614
|
|
|
|
|
|
|
# Returns the list of recipients successfully handed to the MTA on success, or undef and |
|
615
|
|
|
|
|
|
|
# sets error() on failure. |
|
616
|
|
|
|
|
|
|
sub smtpsend |
|
617
|
|
|
|
|
|
|
{ |
|
618
|
12
|
|
|
12
|
1
|
498
|
my $self = shift( @_ ); |
|
619
|
12
|
|
|
|
|
74
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
620
|
|
|
|
|
|
|
|
|
621
|
12
|
50
|
|
|
|
15853
|
$self->_load_class( 'Net::SMTP' ) || return( $self->pass_error ); |
|
622
|
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
# Build the entity first so we can inspect its headers |
|
624
|
12
|
|
50
|
|
|
136666
|
my $entity = $self->as_entity || return( $self->pass_error ); |
|
625
|
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
# Determine envelope sender (MAIL FROM) |
|
627
|
12
|
|
|
|
|
33
|
my $mail_from = $opts->{MailFrom}; |
|
628
|
12
|
100
|
66
|
|
|
70
|
unless( defined( $mail_from ) && length( $mail_from ) ) |
|
629
|
|
|
|
|
|
|
{ |
|
630
|
11
|
|
50
|
|
|
40
|
my $from_hdr = $self->{_headers}->header( 'From' ) // ''; |
|
631
|
11
|
100
|
|
|
|
67
|
if( $from_hdr =~ /<([^>]+)>/ ) |
|
632
|
|
|
|
|
|
|
{ |
|
633
|
1
|
|
|
|
|
34
|
$mail_from = $1; |
|
634
|
|
|
|
|
|
|
} |
|
635
|
|
|
|
|
|
|
else |
|
636
|
|
|
|
|
|
|
{ |
|
637
|
10
|
|
|
|
|
37
|
( $mail_from = $from_hdr ) =~ s/\s+//g; |
|
638
|
|
|
|
|
|
|
} |
|
639
|
|
|
|
|
|
|
} |
|
640
|
|
|
|
|
|
|
|
|
641
|
12
|
50
|
33
|
|
|
181
|
unless( defined( $mail_from ) && length( $mail_from ) ) |
|
642
|
|
|
|
|
|
|
{ |
|
643
|
0
|
|
|
|
|
0
|
return( $self->error( "smtpsend(): cannot determine envelope sender (MAIL FROM). Set MailFrom or From header." ) ); |
|
644
|
|
|
|
|
|
|
} |
|
645
|
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
# Validate auth credentials before touching the network |
|
647
|
|
|
|
|
|
|
# Password may be a plain string or a CODE ref (resolved later). |
|
648
|
12
|
|
|
|
|
63
|
my $username = $opts->{Username}; |
|
649
|
12
|
|
|
|
|
25
|
my $password = $opts->{Password}; |
|
650
|
|
|
|
|
|
|
|
|
651
|
12
|
100
|
66
|
|
|
47
|
if( defined( $username ) && length( $username ) ) |
|
652
|
|
|
|
|
|
|
{ |
|
653
|
2
|
100
|
|
|
|
6
|
unless( defined( $password ) ) |
|
654
|
|
|
|
|
|
|
{ |
|
655
|
1
|
|
|
|
|
15
|
return( $self->error( "smtpsend(): Username supplied but Password is missing." ) ); |
|
656
|
|
|
|
|
|
|
} |
|
657
|
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
# Authen::SASL and MIME::Base64 are required for SMTP AUTH. |
|
659
|
|
|
|
|
|
|
# Check early so the error is clear rather than a cryptic auth failure. |
|
660
|
1
|
|
|
|
|
27
|
foreach my $mod ( qw( MIME::Base64 Authen::SASL ) ) |
|
661
|
|
|
|
|
|
|
{ |
|
662
|
2
|
50
|
|
|
|
483
|
$self->_load_class( $mod ) || |
|
663
|
|
|
|
|
|
|
return( $self->error( "smtpsend(): SMTP authentication requires $mod, which is not installed. Install it with: cpan $mod" ) ); |
|
664
|
|
|
|
|
|
|
} |
|
665
|
|
|
|
|
|
|
} |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
# Determine RCPT TO addresses before connecting, so we can bail early. |
|
668
|
|
|
|
|
|
|
# Honour explicit override lists first; fall back to message headers. |
|
669
|
11
|
|
|
|
|
4977
|
my @rcpt_raw; |
|
670
|
11
|
|
|
|
|
124
|
foreach my $field ( qw( To Cc Bcc ) ) |
|
671
|
|
|
|
|
|
|
{ |
|
672
|
33
|
|
|
|
|
79
|
my $v = $opts->{ $field }; |
|
673
|
33
|
100
|
|
|
|
70
|
if( defined( $v ) ) |
|
674
|
|
|
|
|
|
|
{ |
|
675
|
1
|
50
|
|
|
|
10
|
push( @rcpt_raw, ref( $v ) eq 'ARRAY' ? @$v : $v ); |
|
676
|
|
|
|
|
|
|
} |
|
677
|
|
|
|
|
|
|
else |
|
678
|
|
|
|
|
|
|
{ |
|
679
|
32
|
|
100
|
|
|
107
|
my $hv = $self->{_headers}->header( $field ) // ''; |
|
680
|
32
|
100
|
|
|
|
161
|
push( @rcpt_raw, $hv ) if( length( $hv ) ); |
|
681
|
|
|
|
|
|
|
} |
|
682
|
|
|
|
|
|
|
} |
|
683
|
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
# Parse each raw value into bare addr-specs |
|
685
|
11
|
|
|
|
|
20
|
my @addr; |
|
686
|
11
|
|
|
|
|
24
|
foreach my $raw ( @rcpt_raw ) |
|
687
|
|
|
|
|
|
|
{ |
|
688
|
14
|
|
|
|
|
20
|
my @found_angle; |
|
689
|
14
|
|
|
|
|
55
|
while( $raw =~ /<([^>]+)>/g ) |
|
690
|
|
|
|
|
|
|
{ |
|
691
|
0
|
|
|
|
|
0
|
push( @found_angle, $1 ); |
|
692
|
|
|
|
|
|
|
} |
|
693
|
14
|
50
|
|
|
|
31
|
if( @found_angle ) |
|
694
|
|
|
|
|
|
|
{ |
|
695
|
0
|
|
|
|
|
0
|
push( @addr, @found_angle ); |
|
696
|
|
|
|
|
|
|
} |
|
697
|
|
|
|
|
|
|
else |
|
698
|
|
|
|
|
|
|
{ |
|
699
|
|
|
|
|
|
|
# Bare comma-separated list (no angle brackets) |
|
700
|
14
|
|
|
|
|
66
|
push( @addr, grep{ /\@/ } map{ s/^\s+|\s+$//gr } split( /,/, $raw ) ); |
|
|
13
|
|
|
|
|
113
|
|
|
|
13
|
|
|
|
|
231
|
|
|
701
|
|
|
|
|
|
|
} |
|
702
|
|
|
|
|
|
|
} |
|
703
|
|
|
|
|
|
|
# Deduplicate while preserving order |
|
704
|
11
|
|
|
|
|
20
|
my %seen; |
|
705
|
11
|
|
|
|
|
24
|
@addr = grep{ !$seen{ $_ }++ } @addr; |
|
|
13
|
|
|
|
|
107
|
|
|
706
|
|
|
|
|
|
|
|
|
707
|
11
|
100
|
|
|
|
28
|
unless( @addr ) |
|
708
|
|
|
|
|
|
|
{ |
|
709
|
1
|
|
|
|
|
29
|
return( $self->error( "smtpsend(): no recipients found." ) ); |
|
710
|
|
|
|
|
|
|
} |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
# Build Net::SMTP connection options |
|
713
|
|
|
|
|
|
|
# SSL => 1 : direct SSL/TLS (e.g. port 465, aka SMTPS) |
|
714
|
10
|
|
|
|
|
15
|
my @smtp_opts; |
|
715
|
10
|
100
|
|
|
|
44
|
push( @smtp_opts, Hello => $opts->{Hello} ) if( defined( $opts->{Hello} ) ); |
|
716
|
10
|
100
|
|
|
|
39
|
push( @smtp_opts, Port => $opts->{Port} ) if( defined( $opts->{Port} ) ); |
|
717
|
10
|
50
|
|
|
|
29
|
push( @smtp_opts, Debug => $opts->{Debug} ) if( defined( $opts->{Debug} ) ); |
|
718
|
10
|
100
|
|
|
|
32
|
push( @smtp_opts, Timeout => $opts->{Timeout} ) if( defined( $opts->{Timeout} ) ); |
|
719
|
10
|
50
|
|
|
|
36
|
if( $opts->{SSL} ) |
|
720
|
|
|
|
|
|
|
{ |
|
721
|
0
|
|
|
|
|
0
|
push( @smtp_opts, SSL => 1 ); |
|
722
|
0
|
0
|
|
|
|
0
|
if( ref( $opts->{SSL_opts} ) eq 'HASH' ) |
|
723
|
|
|
|
|
|
|
{ |
|
724
|
0
|
|
|
|
|
0
|
push( @smtp_opts, %{$opts->{SSL_opts}} ); |
|
|
0
|
|
|
|
|
0
|
|
|
725
|
|
|
|
|
|
|
} |
|
726
|
|
|
|
|
|
|
} |
|
727
|
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
# NOTE: SMTP connect |
|
729
|
10
|
|
|
|
|
60
|
my $smtp; |
|
730
|
10
|
|
|
|
|
16
|
my $quit = 1; |
|
731
|
10
|
|
|
|
|
23
|
my $host = $opts->{Host}; |
|
732
|
|
|
|
|
|
|
|
|
733
|
10
|
50
|
|
|
|
75
|
if( !defined( $host ) ) |
|
|
|
100
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
{ |
|
735
|
0
|
|
|
|
|
0
|
my @hosts = qw( mailhost localhost ); |
|
736
|
0
|
0
|
0
|
|
|
0
|
if( defined( $ENV{SMTPHOSTS} ) && length( $ENV{SMTPHOSTS} ) ) |
|
737
|
|
|
|
|
|
|
{ |
|
738
|
0
|
|
|
|
|
0
|
unshift( @hosts, split( /:/, $ENV{SMTPHOSTS} ) ); |
|
739
|
|
|
|
|
|
|
} |
|
740
|
|
|
|
|
|
|
|
|
741
|
0
|
|
|
|
|
0
|
foreach my $h ( @hosts ) |
|
742
|
|
|
|
|
|
|
{ |
|
743
|
0
|
|
|
|
|
0
|
local $@; |
|
744
|
0
|
|
|
|
|
0
|
$smtp = eval{ Net::SMTP->new( $h, @smtp_opts ) }; |
|
|
0
|
|
|
|
|
0
|
|
|
745
|
0
|
0
|
|
|
|
0
|
last if( defined( $smtp ) ); |
|
746
|
|
|
|
|
|
|
} |
|
747
|
|
|
|
|
|
|
} |
|
748
|
|
|
|
|
|
|
elsif( $self->_is_a( $host => 'Net::SMTP' ) ) |
|
749
|
|
|
|
|
|
|
{ |
|
750
|
|
|
|
|
|
|
# Caller passes an already-connected object; we must not quit it. |
|
751
|
1
|
|
|
|
|
219
|
$smtp = $host; |
|
752
|
1
|
|
|
|
|
29
|
$quit = 0; |
|
753
|
|
|
|
|
|
|
} |
|
754
|
|
|
|
|
|
|
else |
|
755
|
|
|
|
|
|
|
{ |
|
756
|
9
|
|
|
|
|
270
|
local $@; |
|
757
|
9
|
|
|
|
|
20
|
$smtp = eval{ Net::SMTP->new( $host, @smtp_opts ) }; |
|
|
9
|
|
|
|
|
431
|
|
|
758
|
|
|
|
|
|
|
} |
|
759
|
|
|
|
|
|
|
|
|
760
|
10
|
100
|
|
|
|
34125
|
unless( defined( $smtp ) ) |
|
761
|
|
|
|
|
|
|
{ |
|
762
|
1
|
|
|
|
|
16
|
return( $self->error( "smtpsend(): could not connect to any SMTP server." ) ); |
|
763
|
|
|
|
|
|
|
} |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
# STARTTLS upgrade (ignored when caller supplied a pre-built object or SSL) |
|
766
|
9
|
50
|
33
|
|
|
52
|
if( $opts->{StartTLS} && $quit ) |
|
767
|
|
|
|
|
|
|
{ |
|
768
|
0
|
|
|
|
|
0
|
my %tls_opts; |
|
769
|
0
|
0
|
|
|
|
0
|
if( ref( $opts->{SSL_opts} ) eq 'HASH' ) |
|
770
|
|
|
|
|
|
|
{ |
|
771
|
0
|
|
|
|
|
0
|
%tls_opts = %{$opts->{SSL_opts}}; |
|
|
0
|
|
|
|
|
0
|
|
|
772
|
|
|
|
|
|
|
} |
|
773
|
0
|
0
|
|
|
|
0
|
unless( $smtp->starttls( %tls_opts ) ) |
|
774
|
|
|
|
|
|
|
{ |
|
775
|
0
|
|
|
|
|
0
|
my $smtp_msg = join( ' ', $smtp->message ); |
|
776
|
0
|
|
|
|
|
0
|
$smtp->quit; |
|
777
|
0
|
0
|
|
|
|
0
|
return( $self->error( "smtpsend(): STARTTLS negotiation failed" . ( length( $smtp_msg ) ? ": $smtp_msg" : '.' ) ) ); |
|
778
|
|
|
|
|
|
|
} |
|
779
|
|
|
|
|
|
|
} |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
|
782
|
|
|
|
|
|
|
# SMTP Authentication (SASL via Authen::SASL + Net::SMTP::auth) |
|
783
|
|
|
|
|
|
|
# Password is resolved here so the CODE ref is called as late as possible. |
|
784
|
|
|
|
|
|
|
# |
|
785
|
|
|
|
|
|
|
# We build an explicit Authen::SASL object rather than letting Net::SMTP |
|
786
|
|
|
|
|
|
|
# pick the mechanism freely. Left to itself, Authen::SASL prefers |
|
787
|
|
|
|
|
|
|
# DIGEST-MD5 and CRAM-MD5, which are both deprecated (RFC 6331, RFC 8314) and |
|
788
|
|
|
|
|
|
|
# routinely disabled on modern Postfix/Dovecot servers. Over an already |
|
789
|
|
|
|
|
|
|
# encrypted STARTTLS or SSL channel, PLAIN and LOGIN are both safe and |
|
790
|
|
|
|
|
|
|
# universally supported. |
|
791
|
|
|
|
|
|
|
# |
|
792
|
|
|
|
|
|
|
# Mechanism selection: |
|
793
|
|
|
|
|
|
|
# 1. Caller may supply an explicit list via AuthMechanisms option. |
|
794
|
|
|
|
|
|
|
# 2. Otherwise we use our preferred order: PLAIN LOGIN. |
|
795
|
|
|
|
|
|
|
# 3. We intersect with what the server actually advertises (supports AUTH). |
|
796
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
|
797
|
9
|
100
|
66
|
|
|
74
|
if( defined( $username ) && length( $username ) ) |
|
798
|
|
|
|
|
|
|
{ |
|
799
|
1
|
50
|
|
|
|
25
|
if( ref( $password ) eq 'CODE' ) |
|
800
|
|
|
|
|
|
|
{ |
|
801
|
1
|
|
|
|
|
10
|
local $@; |
|
802
|
1
|
|
|
|
|
9
|
$password = eval{ $password->() }; |
|
|
1
|
|
|
|
|
38
|
|
|
803
|
1
|
50
|
33
|
|
|
38
|
if( $@ || !defined( $password ) ) |
|
804
|
|
|
|
|
|
|
{ |
|
805
|
0
|
0
|
|
|
|
0
|
$smtp->quit if( $quit ); |
|
806
|
0
|
|
0
|
|
|
0
|
return( $self->error( "smtpsend(): password callback failed: " . ( $@ // 'returned undef' ) ) ); |
|
807
|
|
|
|
|
|
|
} |
|
808
|
|
|
|
|
|
|
} |
|
809
|
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
# Determine which mechanisms the server advertises |
|
811
|
1
|
|
50
|
|
|
12
|
my $server_mechs = $smtp->supports( 'AUTH' ) // ''; |
|
812
|
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
# Build the preferred mechanism list |
|
814
|
1
|
|
50
|
|
|
19
|
my $preferred = $opts->{AuthMechanisms} // 'PLAIN LOGIN'; |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
# Intersect: keep only those the server supports, preserving our order |
|
817
|
1
|
|
|
|
|
4
|
my %server_set = map{ uc( $_ ) => 1 } split( /\s+/, $server_mechs ); |
|
|
0
|
|
|
|
|
0
|
|
|
818
|
1
|
|
|
|
|
2
|
my @agreed = grep{ $server_set{ uc( $_ ) } } split( /\s+/, $preferred ); |
|
|
2
|
|
|
|
|
367
|
|
|
819
|
|
|
|
|
|
|
|
|
820
|
1
|
50
|
|
|
|
60
|
if( !@agreed ) |
|
821
|
|
|
|
|
|
|
{ |
|
822
|
|
|
|
|
|
|
# No intersection -- fall back to whatever the server offers, |
|
823
|
|
|
|
|
|
|
# excluding the deprecated challenge-response mechanisms. |
|
824
|
1
|
|
|
|
|
5
|
@agreed = grep{ !/^(?:DIGEST-MD5|CRAM-MD5|GSSAPI)$/i } |
|
|
0
|
|
|
|
|
0
|
|
|
825
|
|
|
|
|
|
|
split( /\s+/, $server_mechs ); |
|
826
|
|
|
|
|
|
|
} |
|
827
|
|
|
|
|
|
|
|
|
828
|
1
|
|
|
|
|
27
|
my $sasl = Authen::SASL->new( |
|
829
|
|
|
|
|
|
|
mechanism => join( ' ', @agreed ), |
|
830
|
|
|
|
|
|
|
callback => { |
|
831
|
|
|
|
|
|
|
user => $username, |
|
832
|
|
|
|
|
|
|
pass => $password, |
|
833
|
|
|
|
|
|
|
authname => $username, |
|
834
|
|
|
|
|
|
|
}, |
|
835
|
|
|
|
|
|
|
); |
|
836
|
|
|
|
|
|
|
|
|
837
|
1
|
50
|
|
|
|
45
|
unless( $smtp->auth( $sasl ) ) |
|
838
|
|
|
|
|
|
|
{ |
|
839
|
|
|
|
|
|
|
# Capture the server's error message for a more useful diagnostic |
|
840
|
1
|
|
|
|
|
44
|
my $smtp_msg = join( ' ', $smtp->message ); |
|
841
|
1
|
50
|
|
|
|
13
|
$smtp->quit if( $quit ); |
|
842
|
1
|
50
|
|
|
|
433
|
return( $self->error( "smtpsend(): SMTP authentication failed for user '$username'" . ( length( $smtp_msg ) ? ": $smtp_msg" : '.' ) ) ); |
|
843
|
|
|
|
|
|
|
} |
|
844
|
|
|
|
|
|
|
} |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
# Serialise message, stripping Bcc from transmitted copy |
|
847
|
|
|
|
|
|
|
my $send_entity = $self->as_entity || do |
|
848
|
8
|
|
33
|
|
|
52
|
{ |
|
849
|
|
|
|
|
|
|
$smtp->quit if( $quit ); |
|
850
|
|
|
|
|
|
|
return( $self->pass_error ); |
|
851
|
|
|
|
|
|
|
}; |
|
852
|
8
|
|
|
|
|
49
|
$send_entity->headers->remove( 'Bcc' ); |
|
853
|
|
|
|
|
|
|
my $msg = $send_entity->as_string || do |
|
854
|
8
|
|
33
|
|
|
169
|
{ |
|
855
|
|
|
|
|
|
|
$smtp->quit if( $quit ); |
|
856
|
|
|
|
|
|
|
return( $self->pass_error( $send_entity->error ) ); |
|
857
|
|
|
|
|
|
|
}; |
|
858
|
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
# Submit |
|
860
|
8
|
|
33
|
|
|
268
|
my $ok = $smtp->mail( $mail_from ) |
|
861
|
|
|
|
|
|
|
&& $smtp->to( @addr ) |
|
862
|
|
|
|
|
|
|
&& $smtp->data( $msg ); |
|
863
|
|
|
|
|
|
|
|
|
864
|
8
|
100
|
|
|
|
350990
|
$smtp->quit if( $quit ); |
|
865
|
|
|
|
|
|
|
|
|
866
|
8
|
50
|
|
|
|
13197
|
unless( $ok ) |
|
867
|
|
|
|
|
|
|
{ |
|
868
|
0
|
|
|
|
|
0
|
return( $self->error( "smtpsend(): SMTP transaction failed." ) ); |
|
869
|
|
|
|
|
|
|
} |
|
870
|
|
|
|
|
|
|
|
|
871
|
8
|
50
|
|
|
|
259
|
return( wantarray() ? @addr : \@addr ); |
|
872
|
|
|
|
|
|
|
} |
|
873
|
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
# subject( [$string] ) |
|
875
|
|
|
|
|
|
|
# RFC 2047-encodes non-ASCII subjects before storing. |
|
876
|
|
|
|
|
|
|
sub subject |
|
877
|
|
|
|
|
|
|
{ |
|
878
|
39
|
|
|
39
|
1
|
1237
|
my $self = shift( @_ ); |
|
879
|
39
|
50
|
|
|
|
120
|
if( @_ ) |
|
880
|
|
|
|
|
|
|
{ |
|
881
|
39
|
|
|
|
|
190
|
my $enc = $self->_encode_header( shift( @_ ) ); |
|
882
|
|
|
|
|
|
|
$self->{_headers}->set( 'Subject' => $enc ) || |
|
883
|
39
|
50
|
|
|
|
38620
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
884
|
39
|
|
|
|
|
526
|
return( $self ); |
|
885
|
|
|
|
|
|
|
} |
|
886
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'Subject' ) ); |
|
887
|
|
|
|
|
|
|
} |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
# to( @addresses ) |
|
890
|
|
|
|
|
|
|
# Accumulates To recipients. |
|
891
|
|
|
|
|
|
|
sub to |
|
892
|
|
|
|
|
|
|
{ |
|
893
|
48
|
|
|
48
|
1
|
1261
|
my $self = shift( @_ ); |
|
894
|
48
|
50
|
|
|
|
130
|
if( @_ ) |
|
895
|
|
|
|
|
|
|
{ |
|
896
|
48
|
50
|
|
|
|
266
|
my @encoded = map{ $self->_encode_address( $_ ) } ( ref( $_[0] ) eq 'ARRAY' ? @{$_[0]} : @_ ); |
|
|
49
|
|
|
|
|
145
|
|
|
|
0
|
|
|
|
|
0
|
|
|
897
|
|
|
|
|
|
|
# Merge into a single To: header (RFC 5322 §3.6.3 allows only one To field) |
|
898
|
48
|
|
|
|
|
498
|
my $existing = $self->{_headers}->header( 'To' ); |
|
899
|
48
|
100
|
|
|
|
128
|
my $new_val = join( ', ', grep{ defined( $_ ) && length( $_ ) } $existing, @encoded ); |
|
|
97
|
|
|
|
|
661
|
|
|
900
|
|
|
|
|
|
|
$self->{_headers}->set( 'To' => $new_val ) || |
|
901
|
48
|
50
|
|
|
|
221
|
return( $self->pass_error( $self->{_headers}->error ) ); |
|
902
|
48
|
|
|
|
|
568
|
return( $self ); |
|
903
|
|
|
|
|
|
|
} |
|
904
|
0
|
|
|
|
|
0
|
return( $self->{_headers}->header( 'To' ) ); |
|
905
|
|
|
|
|
|
|
} |
|
906
|
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
# use_temp_file( [$bool] ) |
|
908
|
|
|
|
|
|
|
# When true, as_string_ref() always spools to a temporary file regardless of message size. |
|
909
|
|
|
|
|
|
|
# This is used when we know the message will be large, or when we want to bound peak |
|
910
|
|
|
|
|
|
|
# memory use unconditionally. |
|
911
|
|
|
|
|
|
|
# Default: false. |
|
912
|
0
|
|
|
0
|
1
|
0
|
sub use_temp_file { return( shift->_set_get_boolean( 'use_temp_file', @_ ) ); } |
|
913
|
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
# gpg_encrypt( %opts ) |
|
915
|
|
|
|
|
|
|
# Encrypts this message for one or more recipients and returns a new Mail::Make object |
|
916
|
|
|
|
|
|
|
# whose body is a RFC 3156 multipart/encrypted structure. |
|
917
|
|
|
|
|
|
|
# |
|
918
|
|
|
|
|
|
|
# Required options: |
|
919
|
|
|
|
|
|
|
# Recipients => [ 'alice@example.com', ... ] |
|
920
|
|
|
|
|
|
|
# |
|
921
|
|
|
|
|
|
|
# Optional options: |
|
922
|
|
|
|
|
|
|
# GpgBin => '/usr/bin/gpg2' |
|
923
|
|
|
|
|
|
|
# KeyServer => 'keys.openpgp.org' |
|
924
|
|
|
|
|
|
|
# AutoFetch => 1 |
|
925
|
|
|
|
|
|
|
# Digest => 'SHA256' |
|
926
|
|
|
|
|
|
|
sub gpg_encrypt |
|
927
|
|
|
|
|
|
|
{ |
|
928
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
929
|
0
|
|
|
|
|
0
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
930
|
0
|
|
|
|
|
0
|
require Mail::Make::GPG; |
|
931
|
|
|
|
|
|
|
my $gpg = Mail::Make::GPG->new( |
|
932
|
|
|
|
|
|
|
( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ), |
|
933
|
|
|
|
|
|
|
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ), |
|
934
|
|
|
|
|
|
|
( defined( $opts->{KeyServer} ) ? ( keyserver => $opts->{KeyServer} ) : () ), |
|
935
|
0
|
|
0
|
|
|
0
|
( defined( $opts->{AutoFetch} ) ? ( auto_fetch => $opts->{AutoFetch} ) : () ), |
|
936
|
|
|
|
|
|
|
) || return( $self->pass_error( Mail::Make::GPG->error ) ); |
|
937
|
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
my $recipients = $opts->{Recipients} || |
|
939
|
0
|
|
0
|
|
|
0
|
return( $self->error( 'gpg_encrypt(): Recipients option is required.' ) ); |
|
940
|
0
|
0
|
|
|
|
0
|
$recipients = [ $recipients ] unless( ref( $recipients ) eq 'ARRAY' ); |
|
941
|
|
|
|
|
|
|
|
|
942
|
0
|
|
0
|
|
|
0
|
return( $gpg->encrypt( |
|
943
|
|
|
|
|
|
|
entity => $self, |
|
944
|
|
|
|
|
|
|
recipients => $recipients, |
|
945
|
|
|
|
|
|
|
) || $self->pass_error( $gpg->error ) ); |
|
946
|
|
|
|
|
|
|
} |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
# gpg_sign( %opts ) |
|
949
|
|
|
|
|
|
|
# Signs this message and returns a new Mail::Make object whose body is a |
|
950
|
|
|
|
|
|
|
# RFC 3156 multipart/signed structure with a detached ASCII-armoured signature. |
|
951
|
|
|
|
|
|
|
# |
|
952
|
|
|
|
|
|
|
# Required options: |
|
953
|
|
|
|
|
|
|
# KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752' |
|
954
|
|
|
|
|
|
|
# |
|
955
|
|
|
|
|
|
|
# Optional options: |
|
956
|
|
|
|
|
|
|
# Passphrase => 'secret' # or CODE ref; omit to use gpg-agent |
|
957
|
|
|
|
|
|
|
# Digest => 'SHA256' |
|
958
|
|
|
|
|
|
|
# GpgBin => '/usr/bin/gpg2' |
|
959
|
|
|
|
|
|
|
sub gpg_sign |
|
960
|
|
|
|
|
|
|
{ |
|
961
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
962
|
0
|
|
|
|
|
0
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
963
|
0
|
|
|
|
|
0
|
require Mail::Make::GPG; |
|
964
|
|
|
|
|
|
|
my $gpg = Mail::Make::GPG->new( |
|
965
|
|
|
|
|
|
|
( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ), |
|
966
|
0
|
|
0
|
|
|
0
|
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ), |
|
967
|
|
|
|
|
|
|
) || return( $self->pass_error( Mail::Make::GPG->error ) ); |
|
968
|
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
return( $gpg->sign( |
|
970
|
|
|
|
|
|
|
entity => $self, |
|
971
|
|
|
|
|
|
|
key_id => ( $opts->{KeyId} // '' ), |
|
972
|
|
|
|
|
|
|
passphrase => ( $opts->{Passphrase} // undef ), |
|
973
|
0
|
|
0
|
|
|
0
|
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ), |
|
974
|
|
|
|
|
|
|
) || $self->pass_error( $gpg->error ) ); |
|
975
|
|
|
|
|
|
|
} |
|
976
|
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
# gpg_sign_encrypt( %opts ) |
|
978
|
|
|
|
|
|
|
# Signs then encrypts this message. Returns a new Mail::Make object whose body is a |
|
979
|
|
|
|
|
|
|
# RFC 3156 multipart/encrypted structure containing a signed and encrypted payload. |
|
980
|
|
|
|
|
|
|
# |
|
981
|
|
|
|
|
|
|
# Required options: |
|
982
|
|
|
|
|
|
|
# KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752' |
|
983
|
|
|
|
|
|
|
# Recipients => [ 'alice@example.com', ... ] |
|
984
|
|
|
|
|
|
|
# |
|
985
|
|
|
|
|
|
|
# Optional options: |
|
986
|
|
|
|
|
|
|
# Passphrase => 'secret' # or CODE ref |
|
987
|
|
|
|
|
|
|
# Digest => 'SHA256' |
|
988
|
|
|
|
|
|
|
# GpgBin => '/usr/bin/gpg2' |
|
989
|
|
|
|
|
|
|
# KeyServer => 'keys.openpgp.org' |
|
990
|
|
|
|
|
|
|
# AutoFetch => 1 |
|
991
|
|
|
|
|
|
|
sub gpg_sign_encrypt |
|
992
|
|
|
|
|
|
|
{ |
|
993
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
994
|
0
|
|
|
|
|
0
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
995
|
0
|
|
|
|
|
0
|
require Mail::Make::GPG; |
|
996
|
|
|
|
|
|
|
my $gpg = Mail::Make::GPG->new( |
|
997
|
|
|
|
|
|
|
( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ), |
|
998
|
|
|
|
|
|
|
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ), |
|
999
|
|
|
|
|
|
|
( defined( $opts->{KeyServer} ) ? ( keyserver => $opts->{KeyServer} ) : () ), |
|
1000
|
0
|
|
0
|
|
|
0
|
( defined( $opts->{AutoFetch} ) ? ( auto_fetch => $opts->{AutoFetch} ) : () ), |
|
1001
|
|
|
|
|
|
|
) || return( $self->pass_error( Mail::Make::GPG->error ) ); |
|
1002
|
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
my $recipients = $opts->{Recipients} || |
|
1004
|
0
|
|
0
|
|
|
0
|
return( $self->error( 'gpg_sign_encrypt(): Recipients option is required.' ) ); |
|
1005
|
0
|
0
|
|
|
|
0
|
$recipients = [ $recipients ] unless( ref( $recipients ) eq 'ARRAY' ); |
|
1006
|
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
return( $gpg->sign_encrypt( |
|
1008
|
|
|
|
|
|
|
entity => $self, |
|
1009
|
|
|
|
|
|
|
key_id => ( $opts->{KeyId} // '' ), |
|
1010
|
|
|
|
|
|
|
passphrase => ( $opts->{Passphrase} // undef ), |
|
1011
|
|
|
|
|
|
|
recipients => $recipients, |
|
1012
|
0
|
|
0
|
|
|
0
|
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ), |
|
1013
|
|
|
|
|
|
|
) || $self->pass_error( $gpg->error ) ); |
|
1014
|
|
|
|
|
|
|
} |
|
1015
|
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
# smime_encrypt( %opts ) |
|
1018
|
|
|
|
|
|
|
# Encrypts this message for one or more recipients. Returns a new Mail::Make object whose |
|
1019
|
|
|
|
|
|
|
# entity is a RFC 5751 application/pkcs7-mime enveloped message. |
|
1020
|
|
|
|
|
|
|
# |
|
1021
|
|
|
|
|
|
|
# Required options: |
|
1022
|
|
|
|
|
|
|
# RecipientCert => $pem_string_or_path (or arrayref of either) |
|
1023
|
|
|
|
|
|
|
# |
|
1024
|
|
|
|
|
|
|
# Optional options: |
|
1025
|
|
|
|
|
|
|
# CACert => $pem_string_or_path |
|
1026
|
|
|
|
|
|
|
sub smime_encrypt |
|
1027
|
|
|
|
|
|
|
{ |
|
1028
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
1029
|
0
|
|
|
|
|
0
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
1030
|
0
|
|
|
|
|
0
|
require Mail::Make::SMIME; |
|
1031
|
|
|
|
|
|
|
my $smime = Mail::Make::SMIME->new( |
|
1032
|
0
|
|
0
|
|
|
0
|
( defined( $opts->{CACert} ) ? ( ca_cert => $opts->{CACert} ) : () ), |
|
1033
|
|
|
|
|
|
|
) || return( $self->pass_error( Mail::Make::SMIME->error ) ); |
|
1034
|
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
return( $smime->encrypt( |
|
1036
|
|
|
|
|
|
|
entity => $self, |
|
1037
|
0
|
|
0
|
|
|
0
|
RecipientCert => ( $opts->{RecipientCert} || return( $self->error( 'smime_encrypt(): RecipientCert option is required.' ) ) ), |
|
1038
|
|
|
|
|
|
|
) || $self->pass_error( $smime->error ) ); |
|
1039
|
|
|
|
|
|
|
} |
|
1040
|
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
# smime_sign( %opts ) |
|
1042
|
|
|
|
|
|
|
# Signs this message and returns a new Mail::Make object whose entity is a RFC 5751 |
|
1043
|
|
|
|
|
|
|
# multipart/signed structure with a detached S/MIME signature. |
|
1044
|
|
|
|
|
|
|
# |
|
1045
|
|
|
|
|
|
|
# Required options: |
|
1046
|
|
|
|
|
|
|
# Cert => $pem_string_or_path |
|
1047
|
|
|
|
|
|
|
# Key => $pem_string_or_path |
|
1048
|
|
|
|
|
|
|
# |
|
1049
|
|
|
|
|
|
|
# Optional options: |
|
1050
|
|
|
|
|
|
|
# KeyPassword => $string_or_coderef |
|
1051
|
|
|
|
|
|
|
# CACert => $pem_string_or_path |
|
1052
|
|
|
|
|
|
|
sub smime_sign |
|
1053
|
|
|
|
|
|
|
{ |
|
1054
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
1055
|
0
|
|
|
|
|
0
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
1056
|
0
|
|
|
|
|
0
|
require Mail::Make::SMIME; |
|
1057
|
|
|
|
|
|
|
my $smime = Mail::Make::SMIME->new( |
|
1058
|
|
|
|
|
|
|
( defined( $opts->{Cert} ) ? ( cert => $opts->{Cert} ) : () ), |
|
1059
|
|
|
|
|
|
|
( defined( $opts->{Key} ) ? ( key => $opts->{Key} ) : () ), |
|
1060
|
|
|
|
|
|
|
( defined( $opts->{KeyPassword} ) ? ( key_password => $opts->{KeyPassword} ) : () ), |
|
1061
|
0
|
|
0
|
|
|
0
|
( defined( $opts->{CACert} ) ? ( ca_cert => $opts->{CACert} ) : () ), |
|
1062
|
|
|
|
|
|
|
) || return( $self->pass_error( Mail::Make::SMIME->error ) ); |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
0
|
|
0
|
|
|
0
|
return( $smime->sign( |
|
1065
|
|
|
|
|
|
|
entity => $self, |
|
1066
|
|
|
|
|
|
|
) || $self->pass_error( $smime->error ) ); |
|
1067
|
|
|
|
|
|
|
} |
|
1068
|
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
# smime_sign_encrypt( %opts ) |
|
1070
|
|
|
|
|
|
|
# Signs then encrypts this message. Returns a new Mail::Make object whose entity is a |
|
1071
|
|
|
|
|
|
|
# RFC 5751 enveloped message containing a signed payload. |
|
1072
|
|
|
|
|
|
|
# |
|
1073
|
|
|
|
|
|
|
# Required options: |
|
1074
|
|
|
|
|
|
|
# Cert => $pem_string_or_path |
|
1075
|
|
|
|
|
|
|
# Key => $pem_string_or_path |
|
1076
|
|
|
|
|
|
|
# RecipientCert => $pem_string_or_path (or arrayref of either) |
|
1077
|
|
|
|
|
|
|
# |
|
1078
|
|
|
|
|
|
|
# Optional options: |
|
1079
|
|
|
|
|
|
|
# KeyPassword => $string_or_coderef |
|
1080
|
|
|
|
|
|
|
# CACert => $pem_string_or_path |
|
1081
|
|
|
|
|
|
|
sub smime_sign_encrypt |
|
1082
|
|
|
|
|
|
|
{ |
|
1083
|
0
|
|
|
0
|
1
|
0
|
my $self = shift( @_ ); |
|
1084
|
0
|
|
|
|
|
0
|
my $opts = $self->_get_args_as_hash( @_ ); |
|
1085
|
0
|
|
|
|
|
0
|
require Mail::Make::SMIME; |
|
1086
|
|
|
|
|
|
|
my $smime = Mail::Make::SMIME->new( |
|
1087
|
|
|
|
|
|
|
( defined( $opts->{Cert} ) ? ( cert => $opts->{Cert} ) : () ), |
|
1088
|
|
|
|
|
|
|
( defined( $opts->{Key} ) ? ( key => $opts->{Key} ) : () ), |
|
1089
|
|
|
|
|
|
|
( defined( $opts->{KeyPassword} ) ? ( key_password => $opts->{KeyPassword} ) : () ), |
|
1090
|
0
|
|
0
|
|
|
0
|
( defined( $opts->{CACert} ) ? ( ca_cert => $opts->{CACert} ) : () ), |
|
1091
|
|
|
|
|
|
|
) || return( $self->pass_error( Mail::Make::SMIME->error ) ); |
|
1092
|
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
return( $smime->sign_encrypt( |
|
1094
|
|
|
|
|
|
|
entity => $self, |
|
1095
|
|
|
|
|
|
|
RecipientCert => ( $opts->{RecipientCert} || |
|
1096
|
0
|
|
0
|
|
|
0
|
return( $self->error( 'smime_sign_encrypt(): RecipientCert option is required.' ) ) ), |
|
1097
|
|
|
|
|
|
|
) || $self->pass_error( $smime->error ) ); |
|
1098
|
|
|
|
|
|
|
} |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
# _default_domain() |
|
1101
|
|
|
|
|
|
|
# Returns a reasonable FQDN for auto-generating Message-IDs. |
|
1102
|
|
|
|
|
|
|
# Uses Sys::Hostname (core) and falls back to 'mail.make.local'. |
|
1103
|
|
|
|
|
|
|
sub _default_domain |
|
1104
|
|
|
|
|
|
|
{ |
|
1105
|
45
|
|
|
45
|
|
108
|
my $self = shift( @_ ); |
|
1106
|
45
|
|
|
|
|
70
|
local $@; |
|
1107
|
|
|
|
|
|
|
my $host = eval |
|
1108
|
45
|
|
|
|
|
146
|
{ |
|
1109
|
45
|
|
|
|
|
3239
|
require Sys::Hostname; |
|
1110
|
45
|
|
|
|
|
6421
|
Sys::Hostname::hostname(); |
|
1111
|
|
|
|
|
|
|
}; |
|
1112
|
45
|
50
|
33
|
|
|
870
|
return( 'mail.make.local' ) if( $@ || !defined( $host ) || !length( $host ) ); |
|
|
|
|
33
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
# If it is not a FQDN (no dot), append .local to avoid rejection by |
|
1114
|
|
|
|
|
|
|
# Mail::Make::Headers::_generate_message_id |
|
1115
|
45
|
50
|
|
|
|
287
|
$host .= '.local' if( index( $host, '.' ) == -1 ); |
|
1116
|
45
|
|
|
|
|
730
|
return( $host ); |
|
1117
|
|
|
|
|
|
|
} |
|
1118
|
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
# _encode_address( $addr_string ) |
|
1120
|
|
|
|
|
|
|
# Encodes the display name portion of an RFC 2822 address using RFC 2047 when it contains |
|
1121
|
|
|
|
|
|
|
# non-ASCII characters. The addr-spec (the part inside angle brackets) is never altered. |
|
1122
|
|
|
|
|
|
|
# |
|
1123
|
|
|
|
|
|
|
# Recognised forms: |
|
1124
|
|
|
|
|
|
|
# "Display Name" <local@domain> |
|
1125
|
|
|
|
|
|
|
# Display Name <local@domain> |
|
1126
|
|
|
|
|
|
|
# local@domain (bare addr-spec, passed through unchanged) |
|
1127
|
|
|
|
|
|
|
# |
|
1128
|
|
|
|
|
|
|
# Returns the wire-safe string. |
|
1129
|
|
|
|
|
|
|
sub _encode_address |
|
1130
|
|
|
|
|
|
|
{ |
|
1131
|
103
|
|
|
103
|
|
568
|
my( $self, $addr ) = @_; |
|
1132
|
103
|
50
|
33
|
|
|
644
|
return( $addr ) unless( defined( $addr ) && length( $addr ) ); |
|
1133
|
103
|
100
|
|
|
|
644
|
if( $addr =~ /^("?)([^<"]+)\1\s*<([^>]+)>\s*$/ ) |
|
1134
|
|
|
|
|
|
|
{ |
|
1135
|
7
|
|
|
|
|
188
|
my( $name, $spec ) = ( $2, $3 ); |
|
1136
|
7
|
|
|
|
|
161
|
$name =~ s/^\s+|\s+$//g; |
|
1137
|
7
|
|
|
|
|
121
|
my $enc = $self->_encode_header( $name ); |
|
1138
|
|
|
|
|
|
|
# If the name was encoded (contains non-ASCII), the encoded-word is |
|
1139
|
|
|
|
|
|
|
# self-quoting and must NOT be surrounded by double-quotes. |
|
1140
|
|
|
|
|
|
|
# If it is plain ASCII, keep surrounding quotes for correct parsing. |
|
1141
|
7
|
100
|
|
|
|
8060
|
return( $enc ne $name |
|
1142
|
|
|
|
|
|
|
? "${enc} <${spec}>" |
|
1143
|
|
|
|
|
|
|
: qq{"${name}" <${spec}>} ); |
|
1144
|
|
|
|
|
|
|
} |
|
1145
|
|
|
|
|
|
|
# Bare addr-spec - nothing to encode |
|
1146
|
96
|
|
|
|
|
367
|
return( $addr ); |
|
1147
|
|
|
|
|
|
|
} |
|
1148
|
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
# _encode_header( $string ) |
|
1150
|
|
|
|
|
|
|
# Encodes a header value for the wire using RFC 2047 if necessary. |
|
1151
|
|
|
|
|
|
|
# Delegates to Mail::Make::Headers::Subject which handles fragmentation, fold points, |
|
1152
|
|
|
|
|
|
|
# and UTF-8 boundary safety. |
|
1153
|
|
|
|
|
|
|
sub _encode_header |
|
1154
|
|
|
|
|
|
|
{ |
|
1155
|
46
|
|
|
46
|
|
262
|
my( $self, $str ) = @_; |
|
1156
|
46
|
50
|
|
|
|
187
|
return( $str ) unless( defined( $str ) ); |
|
1157
|
46
|
|
|
|
|
688
|
my $s = Mail::Make::Headers::Subject->new; |
|
1158
|
46
|
|
|
|
|
520
|
$s->value( $str ); |
|
1159
|
46
|
|
|
|
|
313
|
return( $s->as_string ); |
|
1160
|
|
|
|
|
|
|
} |
|
1161
|
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
# _format_date() |
|
1163
|
|
|
|
|
|
|
# Returns the current date/time in RFC 2822 format. |
|
1164
|
|
|
|
|
|
|
sub _format_date |
|
1165
|
|
|
|
|
|
|
{ |
|
1166
|
53
|
|
|
53
|
|
2637
|
my @t = localtime( time ); |
|
1167
|
53
|
|
|
|
|
1016
|
my @day = qw( Sun Mon Tue Wed Thu Fri Sat ); |
|
1168
|
53
|
|
|
|
|
712
|
my @mon = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ); |
|
1169
|
|
|
|
|
|
|
my $tz = do |
|
1170
|
53
|
|
|
|
|
116
|
{ |
|
1171
|
53
|
|
|
|
|
798
|
my @lt = localtime( time ); |
|
1172
|
53
|
|
|
|
|
321
|
my @gt = gmtime( time ); |
|
1173
|
53
|
|
|
|
|
192
|
my $diff = ( $lt[2] - $gt[2] ) * 60 + ( $lt[1] - $gt[1] ); |
|
1174
|
53
|
50
|
33
|
|
|
697
|
$diff += 1440 if( $lt[5] > $gt[5] || ( $lt[5] == $gt[5] && $lt[7] > $gt[7] ) ); |
|
|
|
|
33
|
|
|
|
|
|
1175
|
53
|
50
|
33
|
|
|
816
|
$diff -= 1440 if( $lt[5] < $gt[5] || ( $lt[5] == $gt[5] && $lt[7] < $gt[7] ) ); |
|
|
|
|
33
|
|
|
|
|
|
1176
|
53
|
50
|
|
|
|
231
|
my $sign = $diff >= 0 ? '+' : '-'; |
|
1177
|
53
|
|
|
|
|
114
|
$diff = abs( $diff ); |
|
1178
|
53
|
|
|
|
|
566
|
sprintf( '%s%02d%02d', $sign, int( $diff / 60 ), $diff % 60 ); |
|
1179
|
|
|
|
|
|
|
}; |
|
1180
|
53
|
|
|
|
|
1249
|
return( sprintf( '%s, %02d %s %04d %02d:%02d:%02d %s', |
|
1181
|
|
|
|
|
|
|
$day[ $t[6] ], $t[3], $mon[ $t[4] ], $t[5] + 1900, |
|
1182
|
|
|
|
|
|
|
$t[2], $t[1], $t[0], $tz ) ); |
|
1183
|
|
|
|
|
|
|
} |
|
1184
|
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
# NOTE: STORABLE support |
|
1186
|
0
|
|
|
0
|
0
|
|
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); } |
|
1187
|
|
|
|
|
|
|
|
|
1188
|
0
|
|
|
0
|
0
|
|
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); } |
|
1189
|
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
1; |
|
1191
|
|
|
|
|
|
|
# NOTE: POD |
|
1192
|
|
|
|
|
|
|
__END__ |
|
1193
|
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
=encoding utf-8 |
|
1195
|
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
=head1 NAME |
|
1197
|
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
Mail::Make - Strict, Fluent MIME Email Builder |
|
1199
|
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
1201
|
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
use Mail::Make; |
|
1203
|
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
# Fluent API |
|
1205
|
|
|
|
|
|
|
my $mail = Mail::Make->new |
|
1206
|
|
|
|
|
|
|
->from( 'hello@example.com' ) |
|
1207
|
|
|
|
|
|
|
->to( 'jack@example.jp' ) |
|
1208
|
|
|
|
|
|
|
->subject( "Q4 Report - Yamato, Inc." ) |
|
1209
|
|
|
|
|
|
|
->plain( "Please find the report attached." ) |
|
1210
|
|
|
|
|
|
|
->html( '<p>Please find the report <b>attached</b>.</p>' ) |
|
1211
|
|
|
|
|
|
|
->attach_inline( |
|
1212
|
|
|
|
|
|
|
path => '/var/www/images/Yamato,Inc-Logo.png', |
|
1213
|
|
|
|
|
|
|
type => 'image/png', |
|
1214
|
|
|
|
|
|
|
cid => 'logo@yamato-inc', |
|
1215
|
|
|
|
|
|
|
) |
|
1216
|
|
|
|
|
|
|
# Positional shorthand - path, type, and filename are auto-detected |
|
1217
|
|
|
|
|
|
|
->attach( '/path/to/report.pdf' ) |
|
1218
|
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
# Explicit form - override type and filename |
|
1220
|
|
|
|
|
|
|
->attach( |
|
1221
|
|
|
|
|
|
|
path => '/tmp/Q4-Report.pdf', |
|
1222
|
|
|
|
|
|
|
type => 'application/pdf', |
|
1223
|
|
|
|
|
|
|
filename => 'Q4 Report 2025.pdf', |
|
1224
|
|
|
|
|
|
|
); |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
my $raw = $mail->as_string || die( $mail->error ); |
|
1227
|
|
|
|
|
|
|
print $raw; |
|
1228
|
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
# Scalar-ref form - no string copy, useful for large messages |
|
1230
|
|
|
|
|
|
|
my $raw_ref = $mail->as_string_ref || die( $mail->error ); |
|
1231
|
|
|
|
|
|
|
print $$raw_ref; |
|
1232
|
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
# Write directly to a filehandle - no in-memory buffering |
|
1234
|
|
|
|
|
|
|
open( my $fh, '>', '/tmp/message.eml' ) or die $!; |
|
1235
|
|
|
|
|
|
|
$mail->print( $fh ) || die( $mail->error ); |
|
1236
|
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
# Send directly |
|
1238
|
|
|
|
|
|
|
$mail->smtpsend( Host => 'smtp.example.com' ) |
|
1239
|
|
|
|
|
|
|
|| die( $mail->error ); |
|
1240
|
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
# Direct access to the envelope headers object |
|
1242
|
|
|
|
|
|
|
my $h = $mail->headers; |
|
1243
|
|
|
|
|
|
|
$h->set( 'X-Priority' => '1' ); |
|
1244
|
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
# Hash-based alternative constructor |
|
1246
|
|
|
|
|
|
|
my $mail2 = Mail::Make->build( |
|
1247
|
|
|
|
|
|
|
from => 'hello@example.com', |
|
1248
|
|
|
|
|
|
|
to => [ 'jack@example.jp' ], |
|
1249
|
|
|
|
|
|
|
subject => 'Hello', |
|
1250
|
|
|
|
|
|
|
plain => "Hi there.\n", |
|
1251
|
|
|
|
|
|
|
html => '<p>Hi there.</p>', |
|
1252
|
|
|
|
|
|
|
) || die( Mail::Make->error ); |
|
1253
|
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
=head1 VERSION |
|
1255
|
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
v0.22.0 |
|
1257
|
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
1259
|
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
C<Mail::Make> is a strict, validating MIME email builder with a fluent interface. |
|
1261
|
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
All RFC 2822 envelope fields (C<From>, C<To>, C<Cc>, C<Bcc>, C<Subject>, C<Date>, C<Message-ID>, C<In-Reply-To>, C<References>, C<Reply-To>, C<Sender>) are stored in a L<Mail::Make::Headers> instance accessible via L</headers>, eliminating any duplication between C<Mail::Make>'s own fields and the final entity's headers. |
|
1263
|
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
The MIME structure is assembled lazily when L</as_entity>, L</as_string>, or L</print> is called. Structure selection is automatic: |
|
1265
|
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
=over 4 |
|
1267
|
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
=item * plain only → C<text/plain> |
|
1269
|
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
=item * html only → C<text/html> |
|
1271
|
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
=item * plain + html → C<multipart/alternative> |
|
1273
|
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
=item * above + inline parts → wrapped in C<multipart/related> |
|
1275
|
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
=item * above + attachments → wrapped in C<multipart/mixed> |
|
1277
|
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
=back |
|
1279
|
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
Non-ASCII display names in address fields and non-ASCII subjects are RFC 2047 encoded automatically. |
|
1281
|
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
L</as_string> returns a plain string, consistent with C<MIME::Entity::stringify>. |
|
1283
|
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
L</as_string_ref> returns a B<scalar reference> to avoid a string copy, useful for large messages. L</print> writes directly to a filehandle without buffering the message in memory at all, and is the recommended approach for very large messages. |
|
1285
|
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
When L</use_temp_file> is set, or the assembled message size would exceed L</max_body_in_memory_size>, L</as_string_ref> spools to a temporary file during serialisation and reads it back, keeping peak memory use to a single copy rather than two overlapping buffers. |
|
1287
|
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
|
1289
|
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
=head2 new( [%opts] ) |
|
1291
|
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
Creates a new C<Mail::Make> object. Takes an hash or hash reference of options. Supported options are: |
|
1293
|
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=over 4 |
|
1295
|
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
=item * C<max_body_in_memory_size> |
|
1297
|
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
Sets the byte threshold above which L</as_string_ref> spools to a temporary file rather than building the message in RAM. Set to C<0> or C<undef> to disable the threshold entirely. Default: C<$Mail::Make::MAX_BODY_IN_MEMORY_SIZE> (1 MiB). |
|
1299
|
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
=item * C<use_temp_file> |
|
1301
|
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
When true, L</as_string_ref> always spools to a temporary file regardless of message size. Useful when you know the message will be large, or when you want to bound peak memory use unconditionally. Default: false. |
|
1303
|
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
=back |
|
1305
|
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
=head2 build( %params ) |
|
1307
|
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
An alternate hash-based constructor. |
|
1309
|
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
Takes an hash or hash reference of options. |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
Recognised parameters are: L<from|/from>, L<to|/to>, L<cc|/cc>, L<bcc|/bcc>, L<date|/date>, L<reply_to|/reply_to>, L<sender|/sender>, L<subject|/subject>, L<in_reply_to|/in_reply_to>, L<message_id|/message_id>, L<references|/references>, L<plain|/plain>, L<html|/html>, C<plain_opts>, C<html_opts>, C<attach>, C<headers>. |
|
1313
|
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
When using the standard mail envelop headers, C<build> will call each respective method, such as L<from|/from>, L<to|/to>, etc. |
|
1315
|
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
When passing the C<plain> parameter, it will call L<plain|/plain>, and passing it the optional hash reference of parameters provided with C<plain_opts> |
|
1317
|
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
Likewise when passing the C<html> parameter, it will call L<html|/html>, and passing it the optional hash reference of parameters provided with C<html_opts> |
|
1319
|
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
The C<attach> parameter accepts one of the following forms: |
|
1321
|
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
=over 4 |
|
1323
|
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
=item * A plain scalar or stringifiable object resolving to an existing file; C<path>, C<type>, and C<filename> are auto-detected: |
|
1325
|
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
attach => 'report.pdf' |
|
1327
|
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
=item * An array reference of plain scalars for multiple attachments; likewise C<path>, C<type>, and C<filename> are auto-detected: |
|
1329
|
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
attach => [ 'report.pdf', 'log.pdf' ] |
|
1331
|
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
=item * An array reference of hash references for full control over each attachment: |
|
1333
|
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
attach => [ |
|
1335
|
|
|
|
|
|
|
{ path => 'report.pdf', filename => 'Q4 Report.pdf' }, |
|
1336
|
|
|
|
|
|
|
{ path => 'log.pdf', filename => 'Access Log.pdf' }, |
|
1337
|
|
|
|
|
|
|
] |
|
1338
|
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
=item * A mix of both forms is also accepted: |
|
1340
|
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
attach => [ 'report.pdf', { path => 'log.pdf', filename => 'Access Log.pdf' } ] |
|
1342
|
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
=back |
|
1344
|
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
If C<type> is not provided in any of the above forms, it is auto-detected from the file content using L<Module::Generic::File::Magic>. |
|
1346
|
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
Each element is forwarded to L</attach>, so all options supported by L</attach> are available in the hash reference form. |
|
1348
|
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
You can also provide additional mail envelop headers by providing the parameter C<headers> as an hash reference. |
|
1350
|
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
For each element of that hash reference, it will call L<header/header> |
|
1352
|
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
Returns the populated C<Mail::Make> object, or upon error, set an L<error object|Mail::Make::Exception>, and returns C<undef> in scalar context or an empty list in list context. |
|
1354
|
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
=head1 FLUENT METHODS |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
All setter methods return C<$self> to allow chaining. Called without arguments, they act as getters and return the stored value (delegating to the internal L<Mail::Make::Headers> object). |
|
1358
|
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
=head2 attach( %opts ) |
|
1360
|
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
# Positional shorthand: path, type, and filename are auto-detected |
|
1362
|
|
|
|
|
|
|
$mail->attach( '/path/to/report.pdf' ); |
|
1363
|
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
# Explicit form |
|
1365
|
|
|
|
|
|
|
$mail->attach( |
|
1366
|
|
|
|
|
|
|
path => $pdf_path, |
|
1367
|
|
|
|
|
|
|
type => 'application/pdf', |
|
1368
|
|
|
|
|
|
|
filename => 'report.pdf', |
|
1369
|
|
|
|
|
|
|
); # returns $mail |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
Adds a downloadable attachment, and returns the current instance for chaining. |
|
1372
|
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
Takes either a single positional file path as a shorthand, or an hash or hash reference of parameters. |
|
1374
|
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
When a single plain scalar or stringifiable object is provided and it resolves to an existing file on disk, C<path>, C<type>, and C<filename> are set automatically. Additional named options may still be passed after the path: |
|
1376
|
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
$mail->attach( '/path/to/report.pdf', encoding => 'base64' ); |
|
1378
|
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
Requires either C<path> or C<data> when using the named-parameter form. |
|
1380
|
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
Options are: |
|
1382
|
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
=over 4 |
|
1384
|
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
=item * C<charset> |
|
1386
|
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
The optional charset of the attachment. |
|
1388
|
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
=item * C<description> |
|
1390
|
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
A short description. |
|
1392
|
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
=item * C<encoding> |
|
1394
|
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
The encoding of the attachment, such as C<zip>, C<gzip>, C<bzip2>, etc.. |
|
1396
|
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
=item * C<filename> |
|
1398
|
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
The attachment filename as displayed to the reader. |
|
1400
|
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
=item * C<type> |
|
1402
|
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
The attachment mime-type. |
|
1404
|
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
=back |
|
1406
|
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
All parameters are forwarded to L<Mail::Make::Entity/build>. |
|
1408
|
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
=head2 attach_inline( %opts ) |
|
1410
|
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
$mail->attach_inline( |
|
1412
|
|
|
|
|
|
|
path => $img_path, |
|
1413
|
|
|
|
|
|
|
type => 'image/png', |
|
1414
|
|
|
|
|
|
|
filename => 'Yamato,Inc-Logo.png', |
|
1415
|
|
|
|
|
|
|
cid => 'logo@yamato-inc', |
|
1416
|
|
|
|
|
|
|
); # returns $mail |
|
1417
|
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
Adds an inline part (e.g. an embedded image referenced via C<cid:> in HTML), and returns the current instance for chaining. |
|
1419
|
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
Takes an hash or hash reference of parameters. |
|
1421
|
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
Requires either <path> or C<data> and either C<id> or C<cid>. |
|
1423
|
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
Supported parameters are: |
|
1425
|
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
=over 4 |
|
1427
|
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=item * C<boundary> |
|
1429
|
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
The boundary used. |
|
1431
|
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
=item * C<charset> |
|
1433
|
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
The optional charset of the attachment. |
|
1435
|
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
=item * C<cid> or C<id> |
|
1437
|
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
The attachment ID (C<Content-ID>) |
|
1439
|
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
=item * C<data> |
|
1441
|
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
The attachement raw data. |
|
1443
|
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
=item * C<debug> |
|
1445
|
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
An unsigned integer to enable debugging. |
|
1447
|
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
=item * C<description> |
|
1449
|
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
A short description. |
|
1451
|
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
See also C<path> for an alternative. |
|
1453
|
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
=item * C<disposition> |
|
1455
|
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
Can be either C<attachment> or C<inline> |
|
1457
|
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
=item * C<encoding> |
|
1459
|
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
The encoding of the attachment, such as C<zip>, C<gzip>, C<bzip2>, etc.. |
|
1461
|
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
=item * C<filename> |
|
1463
|
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
The attachment filename as displayed to the reader. |
|
1465
|
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
=item * C<path> |
|
1467
|
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
The attachment file path. |
|
1469
|
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
See also C<data> for an alternative. |
|
1471
|
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
=item * C<type> |
|
1473
|
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
The attachment mime-type. |
|
1475
|
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
=back |
|
1477
|
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
=head2 bcc( @addresses ) |
|
1479
|
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
$mail->bcc( qw( hello@example.com john@example.jp ) ); |
|
1481
|
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
$mail->bcc( [qw( hello@example.com john@example.jp )] ); |
|
1483
|
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
Accumulates one or more BCC addresses. May be called multiple times. |
|
1485
|
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
This takes either an array reference or a list of e-mail addresses, encode them if necessary, and add them to the C<Bcc> mail envelop header as a comma-separated value using L<Mail::Make::Headers/push_header> |
|
1487
|
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make::Headers>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1489
|
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
=head2 cc( @addresses ) |
|
1491
|
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
$mail->cc( qw( hello@example.com john@example.jp ) ); |
|
1493
|
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
$mail->cc( [qw( hello@example.com john@example.jp )] ); |
|
1495
|
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
Accumulates one or more CC addresses. |
|
1497
|
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
This takes either an array reference or a list of e-mail addresses, encode them if necessary, and add them to the C<Cc> mail envelop header as a comma-separated value using L<Mail::Make::Headers/push_header> |
|
1499
|
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make::Headers>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1501
|
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
=head2 date( [$date_string_or_epoch] ) |
|
1503
|
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
Gets or sets the C<Date> header. |
|
1505
|
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
Accepts a Unix epoch integer (converted to RFC 5322 format automatically) or a pre-formatted RFC 5322 string. |
|
1507
|
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
Delegates to L<Mail::Make::Headers/date>. If not set explicitly, the current date and time are used when L</as_entity> is first called. |
|
1509
|
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make::Headers>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1511
|
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
=head2 from( [$address] ) |
|
1513
|
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
$mail->from( 'hello@example.com' ); |
|
1515
|
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
Gets or sets the C<From> header by calling L<Mail::Make::Headers/set>. |
|
1517
|
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
Non-ASCII display names are RFC 2047 encoded automatically. |
|
1519
|
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1521
|
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=head2 header( $name [, $value] ) |
|
1523
|
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
$mail->header( 'X-Mailer' => 'MySoft/v1.0.0' ); # returns $mail |
|
1525
|
|
|
|
|
|
|
# or |
|
1526
|
|
|
|
|
|
|
$mail->header( X_Mailer => 'MySoft/v1.0.0' ); # returns $mail |
|
1527
|
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
my $software = $mail->header( 'X-Mailer' ); |
|
1529
|
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
With two arguments: appends an arbitrary header to the envelope using L<push_header|Mail::Make::Headers/push_header> semantics (does not replace an existing field of the same name). |
|
1531
|
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
Returns the current instance of C<Mail::Make> |
|
1533
|
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
With one argument: returns the current value of the named header. |
|
1535
|
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
=head2 headers() |
|
1537
|
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
my $headers = $mail->headers; # Mail::Make::Headers |
|
1539
|
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
Returns the internal L<Mail::Make::Headers> object. Use this for operations not covered by the fluent methods, such as setting C<X-*> headers or reading back any field. |
|
1541
|
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
=head2 html( $content [, %opts] ) |
|
1543
|
|
|
|
|
|
|
|
|
1544
|
|
|
|
|
|
|
$mail->html( '<p>Hello world</p>', { |
|
1545
|
|
|
|
|
|
|
charset => 'utf-8', |
|
1546
|
|
|
|
|
|
|
encoding => 'quoted-printable', |
|
1547
|
|
|
|
|
|
|
}); # returns $mail |
|
1548
|
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
Adds a C<text/html> body part, and returns the current instance for chaining. |
|
1550
|
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1552
|
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
This takes an optional hash or hash reference of the following parameters: |
|
1554
|
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
=over 4 |
|
1556
|
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
=item * C<charset> |
|
1558
|
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
The character set used for thise HTML data. |
|
1560
|
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
Defaults to C<utf-8> |
|
1562
|
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
=item * C<data> |
|
1564
|
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
The HTML data. |
|
1566
|
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
=item * C<encoding> |
|
1568
|
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
Can be C<quoted-printable> or C<base64> |
|
1570
|
|
|
|
|
|
|
|
|
1571
|
|
|
|
|
|
|
Defaults to C<quoted-printable> |
|
1572
|
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
=back |
|
1574
|
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
=head2 in_reply_to( [$mid] ) |
|
1576
|
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
$mail->in_reply_to( 'dave.null@example.com' ); # Returns $mail |
|
1578
|
|
|
|
|
|
|
my $email = $mail->in_reply_to; |
|
1579
|
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
Gets or sets the C<In-Reply-To> header. |
|
1581
|
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
In mutator mode, this sets the C<In-Reply-To> mail envelop header using L<Mail::Make::Headers/set>, and returns the current instance of C<Mail::Make>, and in accessor mode, this returns the current value for the mail envelop header C<In-Reply-To> |
|
1583
|
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1585
|
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
=head2 message_id( [$mid | \%opts] ) |
|
1587
|
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
$mail->message_id( '2adefb89-a26a-4cf1-91c7-1413b13cfd0f@local' ); # Returns $mail |
|
1589
|
|
|
|
|
|
|
$mail->message_id( '2adefb89-a26a-4cf1-91c7-1413b13cfd0f@local', { strict => 1 } ); # Returns $mail |
|
1590
|
|
|
|
|
|
|
$mail->message_id({ generate => 1, domain => 'example.com' }); |
|
1591
|
|
|
|
|
|
|
$mail->message_id( undef ); # remove the message ID |
|
1592
|
|
|
|
|
|
|
my $msgid = $mail->message_id; |
|
1593
|
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
Gets or sets the C<Message-ID>. Auto-generated when L</as_entity> is called if not explicitly set. |
|
1595
|
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
Delegates to L<Mail::Make::Headers/message_id>. |
|
1597
|
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1599
|
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
This takes an optional hash reference of the following parameters: |
|
1601
|
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
=over 4 |
|
1603
|
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
=item * C<domain> |
|
1605
|
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
The domain name to use when generating the message ID. |
|
1607
|
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
=item * C<generate> |
|
1609
|
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
If set to true, then L<Mail::Make::Headers/message_id> will generate the message ID. |
|
1611
|
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
If the option C<domain> is not provided, it will use L<Sys::Hostname/hostname> to guess the domain name. |
|
1613
|
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
=item * C<strict> |
|
1615
|
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
A boolean value (C<1> or C<0>). |
|
1617
|
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
When this is set to true, L<message_id>|Mail::Make::Headers/message_id> will call C<_validate_message_id_value> in L<Mail::Make::Headers> to thoroughly validate the value provided. This means, it will reject the value if: |
|
1619
|
|
|
|
|
|
|
|
|
1620
|
|
|
|
|
|
|
=over 8 |
|
1621
|
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
=item 1. It contains any non-ASCII or spaces/control characters. |
|
1623
|
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
=item 2. It is not wrapped in angle brackets: C<< < >> and C<< > >> |
|
1625
|
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
=item 3. Does not have exactly one at-mark C<@> |
|
1627
|
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
=item 4. The local part (the part on the left of the at-mark) contains characters other than: |
|
1629
|
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
[A-Za-z0-9.!#\$%&'\*\+\/=\?\^_`\{\|\}~\-]+ |
|
1631
|
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
=item 5. The domain part (the part of the right of the at-mark) contains characters other than: |
|
1633
|
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
[A-Za-z0-9](?:[A-Za-z0-9\-\.]*[A-Za-z0-9])? |
|
1635
|
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
=back |
|
1637
|
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
=back |
|
1639
|
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1641
|
|
|
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
=head2 plain( $content [, %opts] ) |
|
1643
|
|
|
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
$mail->plain( 'Hello world', { |
|
1645
|
|
|
|
|
|
|
charset => 'utf-8', |
|
1646
|
|
|
|
|
|
|
encoding => 'quoted-printable', |
|
1647
|
|
|
|
|
|
|
}); # returns $mail |
|
1648
|
|
|
|
|
|
|
|
|
1649
|
|
|
|
|
|
|
Adds a C<text/plain> body part, and returns the current instance for chaining. |
|
1650
|
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1652
|
|
|
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
This takes an optional hash or hash reference of the following parameters: |
|
1654
|
|
|
|
|
|
|
|
|
1655
|
|
|
|
|
|
|
=over 4 |
|
1656
|
|
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
=item * C<charset> |
|
1658
|
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
The character set used for thise HTML data. |
|
1660
|
|
|
|
|
|
|
|
|
1661
|
|
|
|
|
|
|
Defaults to C<utf-8> |
|
1662
|
|
|
|
|
|
|
|
|
1663
|
|
|
|
|
|
|
=item * C<data> |
|
1664
|
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
The HTML data. |
|
1666
|
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
=item * C<encoding> |
|
1668
|
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
Can be C<quoted-printable> or C<base64> |
|
1670
|
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
Defaults to C<quoted-printable> |
|
1672
|
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
=back |
|
1674
|
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
=head2 references( @mids ) |
|
1676
|
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
$mail->references( [ $msg_id1, $msg_id2 ] ); # Returns $mail |
|
1678
|
|
|
|
|
|
|
$mail->references( $msg_id1, $msg_id2 ); # Returns $mail |
|
1679
|
|
|
|
|
|
|
# Removes the header |
|
1680
|
|
|
|
|
|
|
$mail->references( undef ); # Returns $mail |
|
1681
|
|
|
|
|
|
|
my @message_ids = $mail->references; |
|
1682
|
|
|
|
|
|
|
my $comma_list = $mail->references; |
|
1683
|
|
|
|
|
|
|
|
|
1684
|
|
|
|
|
|
|
Accumulates one or more Message-IDs in the C<References> header. |
|
1685
|
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
In mutator mode, this returns the current instance of L<Mail::Make> |
|
1687
|
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
In accessor mode, this returns a list of message IDs, and in scalar mode, this returns a comma-separate list of message IDs.s |
|
1689
|
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1691
|
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
=head2 reply_to( [$address] ) |
|
1693
|
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
$mail->reply_to( 'hello@example.com' ); |
|
1695
|
|
|
|
|
|
|
|
|
1696
|
|
|
|
|
|
|
Gets or sets the C<Reply-To> header by calling L<Mail::Make::Headers/set>. |
|
1697
|
|
|
|
|
|
|
|
|
1698
|
|
|
|
|
|
|
Non-ASCII display names are RFC 2047 encoded automatically. |
|
1699
|
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1701
|
|
|
|
|
|
|
|
|
1702
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1703
|
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
=head2 return_path( [$address] ) |
|
1705
|
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
$mail->return_path( 'dave.null@example.com' ); |
|
1707
|
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
Gets or sets the C<Return-Path> header by calling L<Mail::Make::Headers/set>. |
|
1709
|
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
Non-ASCII display names are RFC 2047 encoded automatically. |
|
1711
|
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1713
|
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1715
|
|
|
|
|
|
|
|
|
1716
|
|
|
|
|
|
|
=head2 sender( [$address] ) |
|
1717
|
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
$mail->sender( 'hello@example.com' ); |
|
1719
|
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
Gets or sets the C<Sender> header by calling L<Mail::Make::Headers/set>. |
|
1721
|
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1723
|
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1725
|
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
=head2 subject( [$string] ) |
|
1727
|
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
$mail->subject( '会議議事録' ); # Returns $mail |
|
1729
|
|
|
|
|
|
|
$mail->subject; |
|
1730
|
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
Gets or sets the C<Subject> by calling L<Mail::Make::Headers/set>. |
|
1732
|
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1734
|
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
Non-ASCII subjects are RFC 2047 encoded before being stored. |
|
1736
|
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1738
|
|
|
|
|
|
|
|
|
1739
|
|
|
|
|
|
|
=head2 to( @addresses ) |
|
1740
|
|
|
|
|
|
|
|
|
1741
|
|
|
|
|
|
|
$mail->to( 'hello@example.com' ); |
|
1742
|
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
Accumulates one or more To addresses. Multiple calls are merged into a single C<To:> field per RFC 5322 §3.6.3 by calling L<Mail::Make::Headers/set>. |
|
1744
|
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
Non-ASCII display names are RFC 2047 encoded automatically. |
|
1746
|
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
Note that it is up to you to ensure there are no duplicates. |
|
1748
|
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header. |
|
1750
|
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1752
|
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
=head1 OUTPUT METHODS |
|
1754
|
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
=head2 as_entity |
|
1756
|
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
my $entity = $mail->as_entity; # Returns a Mail::Make::Entity object |
|
1758
|
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
Assembles and returns the top-level L<Mail::Make::Entity> based on the various content that has been specified, such as plain text, html mail, attachments, or inline attachments. |
|
1760
|
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
The MIME structure is selected automatically (see L</DESCRIPTION>). Envelope headers are merged into the entity using C<init_header> semantics: fields already set on the entity (C<Content-Type>, C<MIME-Version>, etc.) are never overwritten. |
|
1762
|
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
If no C<Message-ID> is set yet, it will compute one. |
|
1764
|
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
C<MIME-Version> will be set to C<1.0> no matter what value may have been set previously. |
|
1766
|
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
The computed value is cached, so repetitive calls will return the cached value. |
|
1768
|
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1770
|
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
=head2 as_string |
|
1772
|
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
my $string = $mail->as_string; |
|
1774
|
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
Assembles the message and returns it as a plain string, consistent with C<MIME::Entity::stringify>. This is the form suitable for direct printing, string interpolation, and most downstream consumers. |
|
1776
|
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
For large messages, prefer L</print> (no buffering) or L</as_string_ref> (no copy on return). |
|
1778
|
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
This method calls L</as_entity>, and returns the value returned by L<Mail::Make::Entity/as_string>, passing it whatever value was provided. |
|
1780
|
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1782
|
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
=head2 as_string_ref |
|
1784
|
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
my $scalar_ref = $mail->as_string_ref; |
|
1786
|
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
Assembles the message and returns it as a B<scalar reference> (or a L<Module::Generic::Scalar> object, which stringifies as needed). No extra string copy is made during the fast path. |
|
1788
|
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
When L</use_temp_file> is true, B<or> the serialised entity size returned by L<Mail::Make::Entity/length> exceeds L</max_body_in_memory_size>, the message is written to a C<Module::Generic::Scalar> buffer via its in-memory filehandle. |
|
1790
|
|
|
|
|
|
|
This keeps peak RAM use to a single copy of the assembled message. |
|
1791
|
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1793
|
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
=head2 max_body_in_memory_size( [$bytes] ) |
|
1795
|
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
Gets or sets the byte threshold above which L</as_string_ref> spools to a temporary file rather than building the message in RAM. Set to C<0> or C<undef> to disable the threshold entirely. Default: C<$Mail::Make::MAX_BODY_IN_MEMORY_SIZE> (1 MiB). |
|
1797
|
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
=head2 print( $fh ) |
|
1799
|
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
$mail->print( $fh ) || die( $mail->error ); |
|
1801
|
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
Writes the fully assembled message to a filehandle without buffering it in memory. This is the recommended approach for very large messages: the MIME tree is serialised part by part directly to C<$fh>, keeping memory use proportional to the largest single part rather than the total message size. |
|
1803
|
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
This returns the current instance of L<Mail::Make> for chaining. |
|
1805
|
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1807
|
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
=head2 smtpsend( %opts ) |
|
1809
|
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
my @recipients = $mail->smtpsend( Host => $smtp ); |
|
1811
|
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
my $rv = $mail->smtpsend( |
|
1813
|
|
|
|
|
|
|
Host => '127.0.0.1', |
|
1814
|
|
|
|
|
|
|
Port => $port, |
|
1815
|
|
|
|
|
|
|
Hello => 'test.local', |
|
1816
|
|
|
|
|
|
|
); |
|
1817
|
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
my $recipients_array_ref = $mail->smtpsend( |
|
1819
|
|
|
|
|
|
|
Host => '127.0.0.1', |
|
1820
|
|
|
|
|
|
|
Port => $port, |
|
1821
|
|
|
|
|
|
|
Hello => 'test.local', |
|
1822
|
|
|
|
|
|
|
MailFrom => 'bounce@example.com', |
|
1823
|
|
|
|
|
|
|
); |
|
1824
|
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
Assembles the message and submits it to an SMTP server via L<Net::SMTP>, which is a core perl module, and loaded only when this method is called. |
|
1826
|
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
This takes a hash or hash reference of options. |
|
1828
|
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
Credential and recipient validation is performed B<before> any network connection is attempted, so configuration errors are reported immediately without consuming network resources. |
|
1830
|
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
Recognised options: |
|
1832
|
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
=over 4 |
|
1834
|
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
=item C<AuthMechanisms> |
|
1836
|
|
|
|
|
|
|
|
|
1837
|
|
|
|
|
|
|
Space-separated list of SASL mechanism names in preference order. |
|
1838
|
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
Defaults to C<"PLAIN LOGIN">, which are safe and universally supported over an encrypted channel (STARTTLS or SSL). |
|
1840
|
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
The actual mechanism used is the intersection of this list and what the server advertises. If no intersection exists, deprecated challenge-response mechanisms (C<DIGEST-MD5>, C<CRAM-MD5>, C<GSSAPI>) are excluded and the remainder of the server's list is tried. |
|
1842
|
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
=item C<Debug> |
|
1844
|
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
Boolean. Enables L<Net::SMTP> debug output. |
|
1846
|
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
=item C<Hello> |
|
1848
|
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
The FQDN sent in the EHLO/HELO greeting. |
|
1850
|
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
=item C<Host> |
|
1852
|
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
Hostname, IP address, or an already-connected L<Net::SMTP> object. If an existing object is passed, it is used as-is and B<not> quit on completion (the caller retains ownership of the connection). |
|
1854
|
|
|
|
|
|
|
|
|
1855
|
|
|
|
|
|
|
If omitted, the colon-separated list in C<$ENV{SMTPHOSTS}> is tried first, then C<mailhost> and C<localhost> in that order. |
|
1856
|
|
|
|
|
|
|
|
|
1857
|
|
|
|
|
|
|
=item C<MailFrom> |
|
1858
|
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
The envelope sender address (C<MAIL FROM>). Defaults to the bare addr-spec extracted from the C<From:> header. |
|
1860
|
|
|
|
|
|
|
|
|
1861
|
|
|
|
|
|
|
=item C<Password> |
|
1862
|
|
|
|
|
|
|
|
|
1863
|
|
|
|
|
|
|
Password for SMTP authentication. May be: |
|
1864
|
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
=over 4 |
|
1866
|
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
=item * A plain string. |
|
1868
|
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
=item * A C<CODE> reference called with no arguments at authentication time. |
|
1870
|
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
Useful for reading credentials from a keyring or secrets manager without storing them in memory until needed: |
|
1872
|
|
|
|
|
|
|
|
|
1873
|
|
|
|
|
|
|
Password => sub { MyKeyring::get('smtp') } |
|
1874
|
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
=back |
|
1876
|
|
|
|
|
|
|
|
|
1877
|
|
|
|
|
|
|
=item C<Port> |
|
1878
|
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
SMTP port number. Common values: |
|
1880
|
|
|
|
|
|
|
|
|
1881
|
|
|
|
|
|
|
=over 4 |
|
1882
|
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
=item * C<25> - plain SMTP (default when C<SSL> is false) |
|
1884
|
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
=item * C<465> - SMTPS, direct SSL/TLS (use with C<< SSL => 1 >>) |
|
1886
|
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
=item * C<587> - submission, usually STARTTLS (use with C<< StartTLS => 1 >>) |
|
1888
|
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
=back |
|
1890
|
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
=item C<SSL> |
|
1892
|
|
|
|
|
|
|
|
|
1893
|
|
|
|
|
|
|
Boolean. When true, the connection is wrapped in SSL/TLS from the start (SMTPS, typically port 465). |
|
1894
|
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
Requires L<IO::Socket::SSL>. |
|
1896
|
|
|
|
|
|
|
|
|
1897
|
|
|
|
|
|
|
=item C<StartTLS> |
|
1898
|
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
Boolean. When true, a plain connection is established first and then upgraded to TLS via the SMTP C<STARTTLS> extension (typically port 587). |
|
1900
|
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
Requires L<IO::Socket::SSL>. Ignored when C<Host> is a pre-built L<Net::SMTP> object. |
|
1902
|
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
=item C<SSL_opts> |
|
1904
|
|
|
|
|
|
|
|
|
1905
|
|
|
|
|
|
|
Hash reference of additional options passed to L<IO::Socket::SSL> during the SSL/TLS handshake. For example: |
|
1906
|
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
SSL_opts => { SSL_verify_mode => 0 } # disable peer cert check |
|
1908
|
|
|
|
|
|
|
SSL_opts => { SSL_ca_file => '/etc/ssl/ca.pem' } |
|
1909
|
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
=item C<Timeout> |
|
1911
|
|
|
|
|
|
|
|
|
1912
|
|
|
|
|
|
|
Connection and command timeout in seconds, passed directly to L<Net::SMTP>. |
|
1913
|
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
=item C<To>, C<Cc>, C<Bcc> |
|
1915
|
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
Override the RCPT TO list. Each may be a string or an array reference of addresses. When omitted, the corresponding message headers are used. |
|
1917
|
|
|
|
|
|
|
|
|
1918
|
|
|
|
|
|
|
C<Bcc:> is always stripped from the outgoing message headers before transmission, per RFC 2822 §3.6.3. |
|
1919
|
|
|
|
|
|
|
|
|
1920
|
|
|
|
|
|
|
=item C<Username> |
|
1921
|
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
Login name for SMTP authentication (SASL). Requires L<Authen::SASL>. |
|
1923
|
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
Must be combined with C<Password>. Validated before any connection is made. |
|
1925
|
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
=back |
|
1927
|
|
|
|
|
|
|
|
|
1928
|
|
|
|
|
|
|
B<Typical usage examples:> |
|
1929
|
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
# Plain SMTP, no auth (LAN relay) |
|
1931
|
|
|
|
|
|
|
$mail->smtpsend( Host => 'mail.example.com' ); |
|
1932
|
|
|
|
|
|
|
|
|
1933
|
|
|
|
|
|
|
# SMTPS (direct TLS, port 465) |
|
1934
|
|
|
|
|
|
|
$mail->smtpsend( |
|
1935
|
|
|
|
|
|
|
Host => 'smtp.example.com', |
|
1936
|
|
|
|
|
|
|
Port => 465, |
|
1937
|
|
|
|
|
|
|
SSL => 1, |
|
1938
|
|
|
|
|
|
|
Username => 'jack@example.com', |
|
1939
|
|
|
|
|
|
|
Password => 'secret', |
|
1940
|
|
|
|
|
|
|
); |
|
1941
|
|
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
# Submission with STARTTLS (port 587) and password callback |
|
1943
|
|
|
|
|
|
|
$mail->smtpsend( |
|
1944
|
|
|
|
|
|
|
Host => 'smtp.example.com', |
|
1945
|
|
|
|
|
|
|
Port => 587, |
|
1946
|
|
|
|
|
|
|
StartTLS => 1, |
|
1947
|
|
|
|
|
|
|
Username => 'jack@example.com', |
|
1948
|
|
|
|
|
|
|
Password => sub { MyKeyring::get('smtp_pass') }, |
|
1949
|
|
|
|
|
|
|
); |
|
1950
|
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
Returns the list of accepted recipient addresses in list context, or a reference to that list in scalar context. |
|
1952
|
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context. |
|
1954
|
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
=head2 use_temp_file( [$bool] ) |
|
1956
|
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
When true, L</as_string_ref> always spools to a temporary file regardless of message size. Useful when you know the message will be large, or when you want to bound peak memory use unconditionally. Default: false. |
|
1958
|
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
=head1 GPG METHODS |
|
1960
|
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
These methods delegate to L<Mail::Make::GPG>, which requires L<IPC::Run> and a working C<gpg> (or C<gpg2>) installation. All three methods produce RFC 3156-compliant messages and return a new L<Mail::Make> object suitable for passing directly to C<smtpsend()>. |
|
1962
|
|
|
|
|
|
|
|
|
1963
|
|
|
|
|
|
|
=head2 gpg_encrypt( %opts ) |
|
1964
|
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
Encrypts this message for one or more recipients and returns a new L<Mail::Make> object whose entity is an RFC 3156 C<multipart/encrypted; protocol="application/pgp-encrypted"> message. |
|
1966
|
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
Required options: |
|
1968
|
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
=over 4 |
|
1970
|
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
=item Recipients => \@addrs_or_key_ids |
|
1972
|
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
Array reference of recipient e-mail addresses or key fingerprints. Each recipient's public key must already be present in the local GnuPG keyring, unless C<AutoFetch> is enabled. |
|
1974
|
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
=back |
|
1976
|
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
Optional options: |
|
1978
|
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
=over 4 |
|
1980
|
|
|
|
|
|
|
|
|
1981
|
|
|
|
|
|
|
=item C<< AutoFetch => $bool >> |
|
1982
|
|
|
|
|
|
|
|
|
1983
|
|
|
|
|
|
|
When true and C<KeyServer> is set, calls C<gpg --locate-keys> for each recipient before encryption. Default: C<0>. |
|
1984
|
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
=item C<< Digest => $algorithm >> |
|
1986
|
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
Hash algorithm for the signature embedded in the encrypted payload. |
|
1988
|
|
|
|
|
|
|
Default: C<SHA256>. |
|
1989
|
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
=item C<< GpgBin => $path >> |
|
1991
|
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
Full path to the C<gpg> executable. Defaults to searching C<gpg2> then C<gpg> in C<PATH>. |
|
1993
|
|
|
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
=item C<< KeyServer => $url >> |
|
1995
|
|
|
|
|
|
|
|
|
1996
|
|
|
|
|
|
|
Keyserver URL for auto-fetching recipient public keys (e.g. C<'keys.openpgp.org'>). Only consulted when C<AutoFetch> is true. |
|
1997
|
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
=back |
|
1999
|
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
=head2 gpg_sign( %opts ) |
|
2001
|
|
|
|
|
|
|
|
|
2002
|
|
|
|
|
|
|
Signs this message and returns a new L<Mail::Make> object whose entity is an RFC 3156 C<multipart/signed; protocol="application/pgp-signature"> message with a detached, ASCII-armoured signature. |
|
2003
|
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
Required options: |
|
2005
|
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
=over 4 |
|
2007
|
|
|
|
|
|
|
|
|
2008
|
|
|
|
|
|
|
=item C<< KeyId => $fingerprint_or_id >> |
|
2009
|
|
|
|
|
|
|
|
|
2010
|
|
|
|
|
|
|
Signing key fingerprint or short ID (e.g. C<'35ADBC3AF8355E845139D8965F3C0261CDB2E752'>). |
|
2011
|
|
|
|
|
|
|
|
|
2012
|
|
|
|
|
|
|
=back |
|
2013
|
|
|
|
|
|
|
|
|
2014
|
|
|
|
|
|
|
Optional options: |
|
2015
|
|
|
|
|
|
|
|
|
2016
|
|
|
|
|
|
|
=over 4 |
|
2017
|
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
=item C<< Digest => $algorithm >> |
|
2019
|
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
Hash algorithm. Default: C<SHA256>. |
|
2021
|
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
Valid values: C<SHA256>, C<SHA384>, C<SHA512>, C<SHA1>. |
|
2023
|
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
=item C<< GpgBin => $path >> |
|
2025
|
|
|
|
|
|
|
|
|
2026
|
|
|
|
|
|
|
Full path to the C<gpg> executable. |
|
2027
|
|
|
|
|
|
|
|
|
2028
|
|
|
|
|
|
|
=item C<< Passphrase => $string_or_coderef >> |
|
2029
|
|
|
|
|
|
|
|
|
2030
|
|
|
|
|
|
|
Passphrase to unlock the secret key. May be a plain string or a C<CODE> reference called with no arguments at signing time. When omitted, GnuPG's agent handles passphrase prompting. |
|
2031
|
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
=back |
|
2033
|
|
|
|
|
|
|
|
|
2034
|
|
|
|
|
|
|
=head2 gpg_sign_encrypt( %opts ) |
|
2035
|
|
|
|
|
|
|
|
|
2036
|
|
|
|
|
|
|
Signs then encrypts this message. Returns a new L<Mail::Make> object whose entity is an RFC 3156 C<multipart/encrypted> message containing a signed and encrypted OpenPGP payload. |
|
2037
|
|
|
|
|
|
|
|
|
2038
|
|
|
|
|
|
|
Accepts all options from both L</gpg_sign> and L</gpg_encrypt>. |
|
2039
|
|
|
|
|
|
|
|
|
2040
|
|
|
|
|
|
|
B<Note:> C<KeyId> and C<Recipients> are both required. |
|
2041
|
|
|
|
|
|
|
|
|
2042
|
|
|
|
|
|
|
B<Typical usage:> |
|
2043
|
|
|
|
|
|
|
|
|
2044
|
|
|
|
|
|
|
# Sign only |
|
2045
|
|
|
|
|
|
|
my $signed = $mail->gpg_sign( |
|
2046
|
|
|
|
|
|
|
KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752', |
|
2047
|
|
|
|
|
|
|
Passphrase => 'my-passphrase', # or: sub { MyKeyring::get('gpg') } |
|
2048
|
|
|
|
|
|
|
) || die $mail->error; |
|
2049
|
|
|
|
|
|
|
$signed->smtpsend( Host => 'smtp.example.com' ); |
|
2050
|
|
|
|
|
|
|
|
|
2051
|
|
|
|
|
|
|
# Encrypt only |
|
2052
|
|
|
|
|
|
|
my $encrypted = $mail->gpg_encrypt( |
|
2053
|
|
|
|
|
|
|
Recipients => [ 'alice@example.com' ], |
|
2054
|
|
|
|
|
|
|
) || die $mail->error; |
|
2055
|
|
|
|
|
|
|
|
|
2056
|
|
|
|
|
|
|
# Sign then encrypt |
|
2057
|
|
|
|
|
|
|
my $protected = $mail->gpg_sign_encrypt( |
|
2058
|
|
|
|
|
|
|
KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752', |
|
2059
|
|
|
|
|
|
|
Passphrase => sub { MyKeyring::get_passphrase() }, |
|
2060
|
|
|
|
|
|
|
Recipients => [ 'alice@example.com', 'bob@example.com' ], |
|
2061
|
|
|
|
|
|
|
) || die $mail->error; |
|
2062
|
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
=head1 S/MIME METHODS |
|
2064
|
|
|
|
|
|
|
|
|
2065
|
|
|
|
|
|
|
These methods delegate to L<Mail::Make::SMIME>, which requires L<Crypt::SMIME> (an XS module wrapping OpenSSL C<libcrypto>). All certificates and keys must be supplied in PEM format, either as file paths or as PEM strings. |
|
2066
|
|
|
|
|
|
|
|
|
2067
|
|
|
|
|
|
|
=head2 Memory usage |
|
2068
|
|
|
|
|
|
|
|
|
2069
|
|
|
|
|
|
|
All three methods load the complete serialised message into memory before performing any cryptographic operation. This is a fundamental constraint imposed by two factors: the L<Crypt::SMIME> API accepts only Perl strings (no filehandle or streaming interface), and the underlying protocols themselves require the entire content to be available before the result can be emitted, thus signing requires a complete hash before the signature can be appended, and PKCS#7 encryption requires the total payload length to be declared in the ASN.1 DER header before any ciphertext is written. |
|
2070
|
|
|
|
|
|
|
|
|
2071
|
|
|
|
|
|
|
For typical email messages this is not a concern. If you anticipate very large attachments, consider L<Mail::Make::GPG> instead, which delegates to the C<gpg> command-line tool via L<IPC::Run> and can handle arbitrary message sizes through temporary files. A future C<v0.2.0> of L<Mail::Make::SMIME> may add a similar C<openssl smime> backend. |
|
2072
|
|
|
|
|
|
|
|
|
2073
|
|
|
|
|
|
|
See L<Mail::Make::SMIME/"MEMORY USAGE AND LIMITATIONS"> for a full discussion. |
|
2074
|
|
|
|
|
|
|
|
|
2075
|
|
|
|
|
|
|
=head2 smime_encrypt( %opts ) |
|
2076
|
|
|
|
|
|
|
|
|
2077
|
|
|
|
|
|
|
$encrypted = $mail->smime_encrypt( |
|
2078
|
|
|
|
|
|
|
RecipientCert => $smime_rec_cert, |
|
2079
|
|
|
|
|
|
|
); |
|
2080
|
|
|
|
|
|
|
|
|
2081
|
|
|
|
|
|
|
Encrypts this message for one or more recipients and returns a new C<Mail::Make> object whose entity is an RFC 5751 C<application/pkcs7-mime; smime-type=enveloped-data> message. |
|
2082
|
|
|
|
|
|
|
|
|
2083
|
|
|
|
|
|
|
Takes an hash or hash reference of options. |
|
2084
|
|
|
|
|
|
|
|
|
2085
|
|
|
|
|
|
|
Required options: |
|
2086
|
|
|
|
|
|
|
|
|
2087
|
|
|
|
|
|
|
=over 4 |
|
2088
|
|
|
|
|
|
|
|
|
2089
|
|
|
|
|
|
|
=item C<< RecipientCert => $pem_string_or_path >> |
|
2090
|
|
|
|
|
|
|
|
|
2091
|
|
|
|
|
|
|
Recipient certificate in PEM format (for encryption). May also be an array reference of PEM strings or file paths for multi-recipient encryption. |
|
2092
|
|
|
|
|
|
|
|
|
2093
|
|
|
|
|
|
|
=back |
|
2094
|
|
|
|
|
|
|
|
|
2095
|
|
|
|
|
|
|
Optional options: |
|
2096
|
|
|
|
|
|
|
|
|
2097
|
|
|
|
|
|
|
=over 4 |
|
2098
|
|
|
|
|
|
|
|
|
2099
|
|
|
|
|
|
|
=item C<< CACert => $pem_string_or_path >> |
|
2100
|
|
|
|
|
|
|
|
|
2101
|
|
|
|
|
|
|
CA certificate to include for chain verification. |
|
2102
|
|
|
|
|
|
|
|
|
2103
|
|
|
|
|
|
|
=back |
|
2104
|
|
|
|
|
|
|
|
|
2105
|
|
|
|
|
|
|
=head2 smime_sign( %opts ) |
|
2106
|
|
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
my $signed = $mail->smime_sign( |
|
2108
|
|
|
|
|
|
|
Cert => $smime_cert, |
|
2109
|
|
|
|
|
|
|
Key => $smime_key, |
|
2110
|
|
|
|
|
|
|
CACert => $smime_ca, # optional |
|
2111
|
|
|
|
|
|
|
); |
|
2112
|
|
|
|
|
|
|
|
|
2113
|
|
|
|
|
|
|
Signs this message with a detached S/MIME signature and returns a new C<Mail::Make> object whose entity is an RFC 5751 C<multipart/signed> message. |
|
2114
|
|
|
|
|
|
|
|
|
2115
|
|
|
|
|
|
|
The signature is always detached, which allows non-S/MIME-aware clients to read the message body. |
|
2116
|
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
Required options: |
|
2118
|
|
|
|
|
|
|
|
|
2119
|
|
|
|
|
|
|
=over 4 |
|
2120
|
|
|
|
|
|
|
|
|
2121
|
|
|
|
|
|
|
=item C<< Cert => $pem_string_or_path >> |
|
2122
|
|
|
|
|
|
|
|
|
2123
|
|
|
|
|
|
|
Signer certificate in PEM format. |
|
2124
|
|
|
|
|
|
|
|
|
2125
|
|
|
|
|
|
|
=item C<< Key => $pem_string_or_path >> |
|
2126
|
|
|
|
|
|
|
|
|
2127
|
|
|
|
|
|
|
Private key in PEM format. |
|
2128
|
|
|
|
|
|
|
|
|
2129
|
|
|
|
|
|
|
=back |
|
2130
|
|
|
|
|
|
|
|
|
2131
|
|
|
|
|
|
|
Optional options: |
|
2132
|
|
|
|
|
|
|
|
|
2133
|
|
|
|
|
|
|
=over 4 |
|
2134
|
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
=item C<< KeyPassword => $string_or_coderef >> |
|
2136
|
|
|
|
|
|
|
|
|
2137
|
|
|
|
|
|
|
Passphrase for an encrypted private key, or a CODE ref that returns one. |
|
2138
|
|
|
|
|
|
|
|
|
2139
|
|
|
|
|
|
|
=item C<< CACert => $pem_string_or_path >> |
|
2140
|
|
|
|
|
|
|
|
|
2141
|
|
|
|
|
|
|
CA certificate to include in the signature for chain verification. |
|
2142
|
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
=back |
|
2144
|
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
=head2 smime_sign_encrypt( %opts ) |
|
2146
|
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
my $result = $mail->smime_sign_encrypt( |
|
2148
|
|
|
|
|
|
|
Cert => $smime_cert, |
|
2149
|
|
|
|
|
|
|
Key => $smime_key, |
|
2150
|
|
|
|
|
|
|
RecipientCert => $smime_rec_cert, |
|
2151
|
|
|
|
|
|
|
CACert => $smime_ca, # optional |
|
2152
|
|
|
|
|
|
|
); |
|
2153
|
|
|
|
|
|
|
|
|
2154
|
|
|
|
|
|
|
Signs this message then encrypts the signed result. Returns a new C<Mail::Make> object whose entity is an RFC 5751 enveloped message containing a signed payload. |
|
2155
|
|
|
|
|
|
|
|
|
2156
|
|
|
|
|
|
|
Accepts all options from both L</smime_sign> and L</smime_encrypt>. |
|
2157
|
|
|
|
|
|
|
|
|
2158
|
|
|
|
|
|
|
B<Note:> C<Cert>, C<Key>, and C<RecipientCert> are all required. |
|
2159
|
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
B<Typical usage:> |
|
2161
|
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
# Sign only |
|
2163
|
|
|
|
|
|
|
my $signed = $mail->smime_sign( |
|
2164
|
|
|
|
|
|
|
Cert => '/path/to/my.cert.pem', |
|
2165
|
|
|
|
|
|
|
Key => '/path/to/my.key.pem', |
|
2166
|
|
|
|
|
|
|
CACert => '/path/to/ca.crt', |
|
2167
|
|
|
|
|
|
|
) || die $mail->error; |
|
2168
|
|
|
|
|
|
|
$signed->smtpsend( Host => 'smtp.example.com' ); |
|
2169
|
|
|
|
|
|
|
|
|
2170
|
|
|
|
|
|
|
# Encrypt only |
|
2171
|
|
|
|
|
|
|
my $encrypted = $mail->smime_encrypt( |
|
2172
|
|
|
|
|
|
|
RecipientCert => '/path/to/recipient.cert.pem', |
|
2173
|
|
|
|
|
|
|
) || die $mail->error; |
|
2174
|
|
|
|
|
|
|
|
|
2175
|
|
|
|
|
|
|
# Sign then encrypt |
|
2176
|
|
|
|
|
|
|
my $protected = $mail->smime_sign_encrypt( |
|
2177
|
|
|
|
|
|
|
Cert => '/path/to/my.cert.pem', |
|
2178
|
|
|
|
|
|
|
Key => '/path/to/my.key.pem', |
|
2179
|
|
|
|
|
|
|
RecipientCert => '/path/to/recipient.cert.pem', |
|
2180
|
|
|
|
|
|
|
) || die $mail->error; |
|
2181
|
|
|
|
|
|
|
|
|
2182
|
|
|
|
|
|
|
=head1 PRIVATE METHODS |
|
2183
|
|
|
|
|
|
|
|
|
2184
|
|
|
|
|
|
|
=head2 _default_domain |
|
2185
|
|
|
|
|
|
|
|
|
2186
|
|
|
|
|
|
|
Returns a FQDN for auto-generated C<Message-ID> values. Uses L<Sys::Hostname> and appends C<.local> when the hostname contains no dot. |
|
2187
|
|
|
|
|
|
|
|
|
2188
|
|
|
|
|
|
|
Falls back to C<mail.make.local>. |
|
2189
|
|
|
|
|
|
|
|
|
2190
|
|
|
|
|
|
|
=head2 _encode_address( $addr_string ) |
|
2191
|
|
|
|
|
|
|
|
|
2192
|
|
|
|
|
|
|
Encodes the display-name portion of an RFC 2822 address using RFC 2047 when the display name contains non-ASCII characters. The addr-spec is never modified. |
|
2193
|
|
|
|
|
|
|
|
|
2194
|
|
|
|
|
|
|
=head2 _encode_header( $string ) |
|
2195
|
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
Encodes an arbitrary header string for the wire using RFC 2047 encoded-words. |
|
2197
|
|
|
|
|
|
|
|
|
2198
|
|
|
|
|
|
|
Delegates to L<Mail::Make::Headers::Subject>. |
|
2199
|
|
|
|
|
|
|
|
|
2200
|
|
|
|
|
|
|
=head2 _format_date |
|
2201
|
|
|
|
|
|
|
|
|
2202
|
|
|
|
|
|
|
Returns the current local date and time as an RFC 2822 string. |
|
2203
|
|
|
|
|
|
|
|
|
2204
|
|
|
|
|
|
|
=head1 AUTHOR |
|
2205
|
|
|
|
|
|
|
|
|
2206
|
|
|
|
|
|
|
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt> |
|
2207
|
|
|
|
|
|
|
|
|
2208
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
2209
|
|
|
|
|
|
|
|
|
2210
|
|
|
|
|
|
|
RFC 2045, RFC 2046, RFC 2047, RFC 2183, RFC 2231, RFC 2822 |
|
2211
|
|
|
|
|
|
|
|
|
2212
|
|
|
|
|
|
|
L<Mail::Make::Entity>, L<Mail::Make::Headers>, L<Mail::Make::Headers::ContentType>, L<Mail::Make::Headers::ContentDisposition>, L<Mail::Make::Headers::ContentTransferEncoding>, L<Mail::Make::Body::InCore>, L<Mail::Make::Body::File>, L<Mail::Make::Stream::Base64>, L<Mail::Make::Stream::QuotedPrint>, L<Mail::Make::Exception>, L<Net::SMTP> |
|
2213
|
|
|
|
|
|
|
|
|
2214
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
|
2215
|
|
|
|
|
|
|
|
|
2216
|
|
|
|
|
|
|
Copyright(c) 2026 DEGUEST Pte. Ltd. |
|
2217
|
|
|
|
|
|
|
|
|
2218
|
|
|
|
|
|
|
All rights reserved. |
|
2219
|
|
|
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
|
2221
|
|
|
|
|
|
|
|
|
2222
|
|
|
|
|
|
|
=cut |