Mail-Make
view release on metacpan or search on metacpan
lib/Mail/Make.pm view on Meta::CPAN
##
## This program is free software; you can redistribute it and/or modify it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Mail::Make;
BEGIN
{
use strict;
use warnings;
warnings::register_categories( 'Mail::Make' );
use parent qw( Module::Generic );
use vars qw( $VERSION $EXCEPTION_CLASS $CRLF $MAX_BODY_IN_MEMORY_SIZE );
use Mail::Make::Entity;
use Mail::Make::Exception;
use Mail::Make::Headers;
use Mail::Make::Headers::Subject;
use Scalar::Util ();
our $CRLF = "\015\012";
our $MAX_BODY_IN_MEMORY_SIZE = 1_048_576; # 1 MiB default
our $EXCEPTION_CLASS = 'Mail::Make::Exception';
our $VERSION = 'v0.23.0';
}
use strict;
use warnings;
sub init
{
my $self = shift( @_ );
# Top-level envelope headers live in a Mail::Make::Headers instance.
# All RFC 2822 envelope fields (From, To, Cc, Bcc, Subject, Date, Message-ID,
# In-Reply-To, References, Reply-To, Sender) are stored there directly, avoiding any
# duplication between Mail::Make and the final Mail::Make::Entity's headers object.
$self->{_headers} = Mail::Make::Headers->new;
# Accumulated body parts (Mail::Make::Entity objects, in order of addition)
$self->{_parts} = [];
# When the serialised message exceeds this byte threshold (or when use_temp_file is true),
# as_string_ref() spools to a temporary file rather than keeping the entire message in RAM.
# Set to 0 or undef to disable file spooling entirely.
$self->{max_body_in_memory_size} = $MAX_BODY_IN_MEMORY_SIZE;
$self->{use_temp_file} = 0;
$self->{_exception_class} = $EXCEPTION_CLASS;
$self->{_init_strict_use_sub} = 1;
$self->SUPER::init( @_ ) || return( $self->pass_error );
return( $self );
}
# as_entity()
# Returns the fully assembled top-level Mail::Make::Entity object.
# The MIME structure is chosen based on the accumulated parts:
#
# Only plain text -> text/plain
# Only HTML -> text/html
# Plain + HTML -> multipart/alternative
# Any of the above + inlines -> multipart/related
# Any of the above + attachments -> multipart/mixed
sub as_entity
{
my $self = shift( @_ );
# When gpg_sign() / gpg_encrypt() / gpg_sign_encrypt() have already assembled the
# top-level entity (stored in _gpg_entity), return it directly. Envelope headers have
# already been merged by _wrap_in_mail().
return( $self->{_gpg_entity} ) if( defined( $self->{_gpg_entity} ) );
# S/MIME: entity pre-assembled by Mail::Make::SMIME::_build_from_smime_output().
# Headers are already embedded in the parsed entity; return it directly.
return( $self->{_smime_entity} ) if( defined( $self->{_smime_entity} ) );
# Partition accumulated parts by role
my( @plain, @html, @inline, @attachment );
foreach my $part ( @{$self->{_parts}} )
{
my $type = lc( $part->effective_type // '' );
# Use get() for the raw string value; content_disposition() returns a typed
# object which stringifies to '' when uninitialised, making // unreliable.
my $cd = lc( $part->headers->get( 'Content-Disposition' ) // '' );
if( $type eq 'text/plain' && $cd !~ /attachment/ )
{
push( @plain, $part );
}
elsif( $type eq 'text/html' && $cd !~ /attachment/ )
{
push( @html, $part );
}
elsif( $cd =~ /inline/ || $part->headers->get( 'Content-ID' ) )
{
# A part is classified as inline when it carries Content-Disposition:
# inline OR a Content-ID (or both). Either signal is sufficient: a
# Content-ID alone means the HTML references it via cid:, and
# Content-Disposition: inline without a Content-ID is caught by the
# guard below, which returns an error.
push( @inline, $part );
}
else
{
push( @attachment, $part );
}
}
# NOTE: Step 1 & 2: assemble body, wrapping html+inline in multipart/related
# when applicable. The resulting structure depends on what parts are present:
#
# plain only -> text/plain
# html only -> text/html
# html + inline -> multipart/related( text/html, image... )
# plain + html -> multipart/alternative( text/plain, text/html )
# plain + html + inline -> multipart/alternative(
# text/plain,
# multipart/related( text/html, image... )
# )
#
# Inline parts without a Content-ID are rejected: the HTML cannot reference
# them via cid: and the message would be broken.
if( @inline )
{
my @missing_cid = grep { !$_->headers->get( 'Content-ID' ) } @inline;
if( @missing_cid )
{
return( $self->error( scalar( @missing_cid ), " inline part(s) are missing a Content-ID. Each inline part must have a 'cid' or 'id' so the HTML can reference it via cid:UUID. Use attach_inline( ..., id => 'your-uuid.ext' )." ) );
}
}
# Build the html entity, then optionally wrap it with its inline parts
lib/Mail/Make.pm view on Meta::CPAN
# Optional options: same as html_to_inline() except 'html' (embed_css, cache_dir,
# charset, encoding, base_url).
sub url_to_inline
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
my $url = $opts->{url};
unless( defined( $url ) && length( $url ) )
{
return( $self->error( "The option 'url' is required." ) );
}
# Initialise the per-instance URL cache
$self->{_hti_cache} //= {};
# Fetch the HTML page itself
my $result = $self->_hti_fetch( $url, cache_dir => $opts->{cache_dir} );
unless( defined( $result ) )
{
return( $self->error( "Could not fetch '$url': " . ( $self->error // 'unknown error' ) ) );
}
my $raw_html = ref( $result->{data} ) ? "${\$result->{data}}" : $result->{data};
unless( defined( $raw_html ) && length( $raw_html ) )
{
return( $self->error( "Fetched page at '$url' is empty." ) );
}
# Derive base_url from the page URL if not provided explicitly.
# Strip the filename part so relative asset URLs resolve correctly:
# https://www.example.com/newsletter/confirm.html
# -> https://www.example.com/newsletter/
unless( defined( $opts->{base_url} ) &&
length( $opts->{base_url} ) )
{
$self->_load_class( 'URI' ) || return( $self->pass_error );
local $@;
my $base = eval
{
my $u = URI->new( $url );
my $path = $u->path;
$path =~ s{[^/]+$}{};
$u->path( $path );
$u->as_string;
};
return( $self->error( "An error occurred while trying to instanciate a URI object with the base URL provided '$url': $@" ) ) if( $@ );
$opts->{base_url} = defined( $base ) ? $base : $url;
}
return( $self->_hti_process_assets( $raw_html, $opts ) );
}
# use_temp_file( [$bool] )
# When true, as_string_ref() always spools to a temporary file regardless of message size.
# This is used when we know the message will be large, or when we want to bound peak
# memory use unconditionally.
# Default: false.
sub use_temp_file { return( shift->_set_get_boolean( 'use_temp_file', @_ ) ); }
# gpg_encrypt( %opts )
# Encrypts this message for one or more recipients and returns a new Mail::Make object
# whose body is a RFC 3156 multipart/encrypted structure.
#
# Required options:
# Recipients => [ 'alice@example.com', ... ]
#
# Optional options:
# GpgBin => '/usr/bin/gpg2'
# KeyServer => 'keys.openpgp.org'
# AutoFetch => 1
# Digest => 'SHA256'
sub gpg_encrypt
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
require Mail::Make::GPG;
my $gpg = Mail::Make::GPG->new(
( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ),
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
( defined( $opts->{KeyServer} ) ? ( keyserver => $opts->{KeyServer} ) : () ),
( defined( $opts->{AutoFetch} ) ? ( auto_fetch => $opts->{AutoFetch} ) : () ),
) || return( $self->pass_error( Mail::Make::GPG->error ) );
my $recipients = $opts->{Recipients} ||
return( $self->error( 'Recipients option is required.' ) );
$recipients = [ $recipients ] unless( ref( $recipients ) eq 'ARRAY' );
return( $gpg->encrypt(
entity => $self,
recipients => $recipients,
) || $self->pass_error( $gpg->error ) );
}
# gpg_sign( %opts )
# Signs this message and returns a new Mail::Make object whose body is a
# RFC 3156 multipart/signed structure with a detached ASCII-armoured signature.
#
# Required options:
# KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752'
#
# Optional options:
# Passphrase => 'secret' # or CODE ref; omit to use gpg-agent
# Digest => 'SHA256'
# GpgBin => '/usr/bin/gpg2'
sub gpg_sign
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
require Mail::Make::GPG;
my $gpg = Mail::Make::GPG->new(
( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ),
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
) || return( $self->pass_error( Mail::Make::GPG->error ) );
return( $gpg->sign(
entity => $self,
key_id => ( $opts->{KeyId} // '' ),
passphrase => ( $opts->{Passphrase} // undef ),
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
) || $self->pass_error( $gpg->error ) );
}
# gpg_sign_encrypt( %opts )
# Signs then encrypts this message. Returns a new Mail::Make object whose body is a
# RFC 3156 multipart/encrypted structure containing a signed and encrypted payload.
#
# Required options:
# KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752'
# Recipients => [ 'alice@example.com', ... ]
#
# Optional options:
# Passphrase => 'secret' # or CODE ref
# Digest => 'SHA256'
# GpgBin => '/usr/bin/gpg2'
# KeyServer => 'keys.openpgp.org'
# AutoFetch => 1
sub gpg_sign_encrypt
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
require Mail::Make::GPG;
my $gpg = Mail::Make::GPG->new(
( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ),
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
( defined( $opts->{KeyServer} ) ? ( keyserver => $opts->{KeyServer} ) : () ),
( defined( $opts->{AutoFetch} ) ? ( auto_fetch => $opts->{AutoFetch} ) : () ),
) || return( $self->pass_error( Mail::Make::GPG->error ) );
my $recipients = $opts->{Recipients} ||
return( $self->error( 'Recipients option is required.' ) );
$recipients = [ $recipients ] unless( ref( $recipients ) eq 'ARRAY' );
return( $gpg->sign_encrypt(
entity => $self,
key_id => ( $opts->{KeyId} // '' ),
passphrase => ( $opts->{Passphrase} // undef ),
recipients => $recipients,
( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
) || $self->pass_error( $gpg->error ) );
}
# smime_encrypt( %opts )
# Encrypts this message for one or more recipients. Returns a new Mail::Make object whose
# entity is a RFC 5751 application/pkcs7-mime enveloped message.
#
# Required options:
# RecipientCert => $pem_string_or_path (or arrayref of either)
#
# Optional options:
# CACert => $pem_string_or_path
sub smime_encrypt
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
require Mail::Make::SMIME;
my $smime = Mail::Make::SMIME->new(
( defined( $opts->{CACert} ) ? ( ca_cert => $opts->{CACert} ) : () ),
) || return( $self->pass_error( Mail::Make::SMIME->error ) );
return( $smime->encrypt(
entity => $self,
RecipientCert => ( $opts->{RecipientCert} ||
return( $self->error( 'RecipientCert option is required.' ) ) ),
) || $self->pass_error( $smime->error ) );
}
# smime_sign( %opts )
# Signs this message and returns a new Mail::Make object whose entity is a RFC 5751
# multipart/signed structure with a detached S/MIME signature.
#
# Required options:
# Cert => $pem_string_or_path
# Key => $pem_string_or_path
#
# Optional options:
# KeyPassword => $string_or_coderef
# CACert => $pem_string_or_path
sub smime_sign
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
require Mail::Make::SMIME;
my $smime = Mail::Make::SMIME->new(
( defined( $opts->{Cert} ) ? ( cert => $opts->{Cert} ) : () ),
( defined( $opts->{Key} ) ? ( key => $opts->{Key} ) : () ),
( defined( $opts->{KeyPassword} ) ? ( key_password => $opts->{KeyPassword} ) : () ),
( defined( $opts->{CACert} ) ? ( ca_cert => $opts->{CACert} ) : () ),
) || return( $self->pass_error( Mail::Make::SMIME->error ) );
return( $smime->sign(
entity => $self,
) || $self->pass_error( $smime->error ) );
}
# smime_sign_encrypt( %opts )
# Signs then encrypts this message. Returns a new Mail::Make object whose entity is a
# RFC 5751 enveloped message containing a signed payload.
#
lib/Mail/Make.pm view on Meta::CPAN
Requires L<IO::Socket::SSL>. Ignored when C<Host> is a pre-built L<Net::SMTP> object.
=item C<SSL_opts>
Hash reference of additional options passed to L<IO::Socket::SSL> during the SSL/TLS handshake. For example:
SSL_opts => { SSL_verify_mode => 0 } # disable peer cert check
SSL_opts => { SSL_ca_file => '/etc/ssl/ca.pem' }
=item C<Timeout>
Connection and command timeout in seconds, passed directly to L<Net::SMTP>.
=item C<To>, C<Cc>, C<Bcc>
Override the RCPT TO list. Each may be a string or an array reference of addresses. When omitted, the corresponding message headers are used.
C<Bcc:> is always stripped from the outgoing message headers before transmission, per RFC 2822 §3.6.3.
=item C<Username>
Login name for SMTP authentication (SASL). Requires L<Authen::SASL>.
Must be combined with C<Password>. Validated before any connection is made.
=back
B<Typical usage examples:>
# Plain SMTP, no auth (LAN relay)
$mail->smtpsend( Host => 'mail.example.com' );
# SMTPS (direct TLS, port 465)
$mail->smtpsend(
Host => 'smtp.example.com',
Port => 465,
SSL => 1,
Username => 'jack@example.com',
Password => 'secret',
);
# Submission with STARTTLS (port 587) and password callback
$mail->smtpsend(
Host => 'smtp.example.com',
Port => 587,
StartTLS => 1,
Username => 'jack@example.com',
Password => sub { MyKeyring::get('smtp_pass') },
);
Returns the list of accepted recipient addresses in list context, or a reference to that list in scalar context.
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.
=head2 use_temp_file( [$bool] )
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.
=head1 GPG METHODS
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<sm...
=head2 gpg_encrypt( %opts )
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.
Required options:
=over 4
=item Recipients => \@addrs_or_key_ids
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.
=back
Optional options:
=over 4
=item C<< AutoFetch => $bool >>
When true and C<KeyServer> is set, calls C<gpg --locate-keys> for each recipient before encryption. Default: C<0>.
=item C<< Digest => $algorithm >>
Hash algorithm for the signature embedded in the encrypted payload.
Default: C<SHA256>.
=item C<< GpgBin => $path >>
Full path to the C<gpg> executable. Defaults to searching C<gpg2> then C<gpg> in C<PATH>.
=item C<< KeyServer => $url >>
Keyserver URL for auto-fetching recipient public keys (e.g. C<'keys.openpgp.org'>). Only consulted when C<AutoFetch> is true.
=back
=head2 gpg_sign( %opts )
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.
Required options:
=over 4
=item C<< KeyId => $fingerprint_or_id >>
Signing key fingerprint or short ID (e.g. C<'35ADBC3AF8355E845139D8965F3C0261CDB2E752'>).
=back
Optional options:
=over 4
=item C<< Digest => $algorithm >>
Hash algorithm. Default: C<SHA256>.
Valid values: C<SHA256>, C<SHA384>, C<SHA512>, C<SHA1>.
=item C<< GpgBin => $path >>
Full path to the C<gpg> executable.
=item C<< Passphrase => $string_or_coderef >>
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.
=back
=head2 gpg_sign_encrypt( %opts )
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.
Accepts all options from both L</gpg_sign> and L</gpg_encrypt>.
B<Note:> C<KeyId> and C<Recipients> are both required.
B<Typical usage:>
# Sign only
my $signed = $mail->gpg_sign(
KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752',
Passphrase => 'my-passphrase', # or: sub { MyKeyring::get('gpg') }
) || die( $mail->error );
$signed->smtpsend( Host => 'smtp.example.com' );
# Encrypt only
my $encrypted = $mail->gpg_encrypt(
Recipients => [ 'alice@example.com' ],
) || die( $mail->error );
# Sign then encrypt
my $protected = $mail->gpg_sign_encrypt(
KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752',
Passphrase => sub { MyKeyring::get_passphrase() },
Recipients => [ 'alice@example.com', 'bob@example.com' ],
) || die( $mail->error );
=head1 S/MIME METHODS
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.
=head2 Memory usage
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 i...
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 ...
See L<Mail::Make::SMIME/"MEMORY USAGE AND LIMITATIONS"> for a full discussion.
=head2 smime_encrypt( %opts )
$encrypted = $mail->smime_encrypt(
RecipientCert => $smime_rec_cert,
);
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.
Takes an hash or hash reference of options.
Required options:
=over 4
=item C<< RecipientCert => $pem_string_or_path >>
Recipient certificate in PEM format (for encryption). May also be an array reference of PEM strings or file paths for multi-recipient encryption.
=back
Optional options:
=over 4
=item C<< CACert => $pem_string_or_path >>
CA certificate to include for chain verification.
=back
=head2 smime_sign( %opts )
my $signed = $mail->smime_sign(
Cert => $smime_cert,
Key => $smime_key,
CACert => $smime_ca, # optional
);
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.
The signature is always detached, which allows non-S/MIME-aware clients to read the message body.
Required options:
=over 4
=item C<< Cert => $pem_string_or_path >>
Signer certificate in PEM format.
=item C<< Key => $pem_string_or_path >>
Private key in PEM format.
=back
Optional options:
( run in 0.590 second using v1.01-cache-2.11-cpan-df04353d9ac )