Mail-Make
view release on metacpan or search on metacpan
- Net::SMTP integration with plain TCP, SSL/TLS, and STARTTLS support
- SASL authentication (PLAIN/LOGIN preferred, DIGEST-MD5/CRAM-MD5
intentionally excluded as deprecated); Authen::SASL used directly to
avoid mechanism negotiation pitfalls
- Passphrase supplied as string or CODE reference
- Bcc stripping from the transmitted copy
- Recipient validation and credential checks before opening the
network connection
[OpenPGP (Mail::Make::GPG, RFC 3156)]
- gpg_sign(): multipart/signed with detached armoured signature;
configurable digest algorithm (default SHA-256, SHA-512 tested)
- gpg_encrypt(): multipart/encrypted (RFC 3156 §4)
- gpg_sign_encrypt(): inline sign-then-encrypt
- Passphrase supplied as string, CODE reference, or undef (gpg-agent)
- Optional public-key auto-fetch from keyserver
- Requires IPC::Run and File::Which; gpg binary located automatically
(gpg2 preferred, gpg fallback) or specified explicitly via GpgBin
- RFC 3156 §5.1 compliance: Part 1 of multipart/signed carries only
Content-* headers; RFC 2822 envelope fields (From, To, Subject, Date,
Message-ID) appear solely on the outer wrapper
- Signature verified correct by Thunderbird (SHA-256 and SHA-512),
Enigmail, and gpg --verify against all four structural variants:
sign-only, sign SHA-512, encrypt-only, sign+encrypt
t/08_headers_subject.t
t/09_multipart_structure.t
t/10_mail_make_headers.t
t/11_smtpsend_mock.t
t/12_html_to_inline.t
t/89_mm_table.t
t/90_pod.t
t/91_coverage.t
t/92_manifest.t
t/93_signature.t
t/94_gpg_live.t
t/95_smime_live.t
t/99_kwalitee.t
t/smtpsend_live.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
SIGNATURE Public-key signature (added by MakeMaker)
If an error occurs, it sets an exception object, and returns "undef" in
scalar context, or an empty list in list context.
use_temp_file( [$bool] )
When true, "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.
GPG METHODS
These methods delegate to Mail::Make::GPG, which requires IPC::Run and a
working "gpg" (or "gpg2") installation. All three methods produce RFC
3156-compliant messages and return a new Mail::Make object suitable for
passing directly to "smtpsend()".
gpg_encrypt( %opts )
Encrypts this message for one or more recipients and returns a new
Mail::Make object whose entity is an RFC 3156 "multipart/encrypted;
protocol="application/pgp-encrypted"" message.
Required options:
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 "AutoFetch" is enabled.
Optional options:
"AutoFetch => $bool"
When true and "KeyServer" is set, calls "gpg --locate-keys" for each
recipient before encryption. Default: 0.
"Digest => $algorithm"
Hash algorithm for the signature embedded in the encrypted payload.
Default: "SHA256".
"GpgBin => $path"
Full path to the "gpg" executable. Defaults to searching "gpg2" then
"gpg" in "PATH".
"KeyServer => $url"
Keyserver URL for auto-fetching recipient public keys (e.g.
'keys.openpgp.org'). Only consulted when "AutoFetch" is true.
gpg_sign( %opts )
Signs this message and returns a new Mail::Make object whose entity is
an RFC 3156 "multipart/signed; protocol="application/pgp-signature""
message with a detached, ASCII-armoured signature.
Required options:
"KeyId => $fingerprint_or_id"
Signing key fingerprint or short ID (e.g.
'35ADBC3AF8355E845139D8965F3C0261CDB2E752').
Optional options:
"Digest => $algorithm"
Hash algorithm. Default: "SHA256".
Valid values: "SHA256", "SHA384", "SHA512", "SHA1".
"GpgBin => $path"
Full path to the "gpg" executable.
"Passphrase => $string_or_coderef"
Passphrase to unlock the secret key. May be a plain string or a
"CODE" reference called with no arguments at signing time. When
omitted, GnuPG's agent handles passphrase prompting.
gpg_sign_encrypt( %opts )
Signs then encrypts this message. Returns a new Mail::Make object whose
entity is an RFC 3156 "multipart/encrypted" message containing a signed
and encrypted OpenPGP payload.
Accepts all options from both "gpg_sign" and "gpg_encrypt".
Note: "KeyId" and "Recipients" are both required.
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 );
S/MIME METHODS
These methods delegate to Mail::Make::SMIME, which requires Crypt::SMIME
(an XS module wrapping OpenSSL "libcrypto"). All certificates and keys
must be supplied in PEM format, either as file paths or as PEM strings.
constraint imposed by two factors: the 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.
For typical email messages this is not a concern. If you anticipate very
large attachments, consider Mail::Make::GPG instead, which delegates to
the "gpg" command-line tool via IPC::Run and can handle arbitrary
message sizes through temporary files. A future "v0.2.0" of
Mail::Make::SMIME may add a similar "openssl smime" backend.
See "MEMORY USAGE AND LIMITATIONS" in Mail::Make::SMIME for a full
discussion.
smime_encrypt( %opts )
$encrypted = $mail->smime_encrypt(
RecipientCert => $smime_rec_cert,
);
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 [exception object](https://metacpan.org/pod/Mail%3A%3AMake%3A%3AException), and returns `undef` in scalar context, or an empty list in list context.
## use\_temp\_file( \[$bool\] )
When true, ["as\_string\_ref"](#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.
# GPG METHODS
These methods delegate to [Mail::Make::GPG](https://metacpan.org/pod/Mail%3A%3AMake%3A%3AGPG), which requires [IPC::Run](https://metacpan.org/pod/IPC%3A%3ARun) and a working `gpg` (or `gpg2`) installation. All three methods produce RFC 3156-compliant...
## gpg\_encrypt( %opts )
Encrypts this message for one or more recipients and returns a new [Mail::Make](https://metacpan.org/pod/Mail%3A%3AMake) object whose entity is an RFC 3156 `multipart/encrypted; protocol="application/pgp-encrypted"` message.
Required options:
- 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 `AutoFetch` is enabled.
Optional options:
- `AutoFetch => $bool`
When true and `KeyServer` is set, calls `gpg --locate-keys` for each recipient before encryption. Default: `0`.
- `Digest => $algorithm`
Hash algorithm for the signature embedded in the encrypted payload.
Default: `SHA256`.
- `GpgBin => $path`
Full path to the `gpg` executable. Defaults to searching `gpg2` then `gpg` in `PATH`.
- `KeyServer => $url`
Keyserver URL for auto-fetching recipient public keys (e.g. `'keys.openpgp.org'`). Only consulted when `AutoFetch` is true.
## gpg\_sign( %opts )
Signs this message and returns a new [Mail::Make](https://metacpan.org/pod/Mail%3A%3AMake) object whose entity is an RFC 3156 `multipart/signed; protocol="application/pgp-signature"` message with a detached, ASCII-armoured signature.
Required options:
- `KeyId => $fingerprint_or_id`
Signing key fingerprint or short ID (e.g. `'35ADBC3AF8355E845139D8965F3C0261CDB2E752'`).
Optional options:
- `Digest => $algorithm`
Hash algorithm. Default: `SHA256`.
Valid values: `SHA256`, `SHA384`, `SHA512`, `SHA1`.
- `GpgBin => $path`
Full path to the `gpg` executable.
- `Passphrase => $string_or_coderef`
Passphrase to unlock the secret key. May be a plain string or a `CODE` reference called with no arguments at signing time. When omitted, GnuPG's agent handles passphrase prompting.
## gpg\_sign\_encrypt( %opts )
Signs then encrypts this message. Returns a new [Mail::Make](https://metacpan.org/pod/Mail%3A%3AMake) object whose entity is an RFC 3156 `multipart/encrypted` message containing a signed and encrypted OpenPGP payload.
Accepts all options from both ["gpg\_sign"](#gpg_sign) and ["gpg\_encrypt"](#gpg_encrypt).
**Note:** `KeyId` and `Recipients` are both required.
**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 );
# S/MIME METHODS
These methods delegate to [Mail::Make::SMIME](https://metacpan.org/pod/Mail%3A%3AMake%3A%3ASMIME), which requires [Crypt::SMIME](https://metacpan.org/pod/Crypt%3A%3ASMIME) (an XS module wrapping OpenSSL `libcrypto`). All certificates and keys must be...
## 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 [Crypt::SMIME](https://metacpan.org/pod/Crypt%3A%3ASMIME) API accepts only ...
For typical email messages this is not a concern. If you anticipate very large attachments, consider [Mail::Make::GPG](https://metacpan.org/pod/Mail%3A%3AMake%3A%3AGPG) instead, which delegates to the `gpg` command-line tool via [IPC::Run](https://me...
See ["MEMORY USAGE AND LIMITATIONS" in Mail::Make::SMIME](https://metacpan.org/pod/Mail%3A%3AMake%3A%3ASMIME#MEMORY-USAGE-AND-LIMITATIONS) for a full discussion.
## smime\_encrypt( %opts )
$encrypted = $mail->smime_encrypt(
RecipientCert => $smime_rec_cert,
);
Encrypts this message for one or more recipients and returns a new `Mail::Make` object whose entity is an RFC 5751 `application/pkcs7-mime; smime-type=enveloped-data` message.
SHA256 34a5656f4af55932116a6316f52eafbcb321c97b5c40253c8f544505c4270ec7 t/08_headers_subject.t
SHA256 08bf10e39410e8b0f1c7ecd7ab11227def4c9688eed1bb77e2d0c819552d07b6 t/09_multipart_structure.t
SHA256 3d03781793c1ebea09538f22c9a5adc358ee234bd4edd07582cb2f47a666d468 t/10_mail_make_headers.t
SHA256 f215267b75fa5982afdc0261e291ee465948c00d9d56f84d4b35179f5fde7776 t/11_smtpsend_mock.t
SHA256 a9464046f374e33cb8b9741caa7ff6a050e3275287292cd7f29160fd8dc16273 t/12_html_to_inline.t
SHA256 03630d97915735de2aacf50ad9e128a0d310256ab963465caa5204c718b4088c t/89_mm_table.t
SHA256 62aa6aa85707f9693e678da55a78a461e292bab447734b35129e8e9c68eb7619 t/90_pod.t
SHA256 1855f1851cc59711d63c6ce10bb000e24b838e77cc02acd2a314b03bda80cb49 t/91_coverage.t
SHA256 310a1b527105a8453812d86a4829006f901591218f00e708bdc45ef2f5e8f5f6 t/92_manifest.t
SHA256 f229776ce2dd7cd0fa3b6b87fc42ddfe50bdb505b736154ebfd4c5bcf5b5129e t/93_signature.t
SHA256 dd343f56c3a8b8a43d14824afefc0a7ee0b3ded5419bea90bc8777e743863a39 t/94_gpg_live.t
SHA256 c03f6306fd1cb30e6d868f2b63215bf58e8a96a8bc69c297caf1cb34f1421e63 t/95_smime_live.t
SHA256 51e3199e1210ec73cf9bf5acee8de3216cb6002150cad36c10de47fa36c87f55 t/99_kwalitee.t
SHA256 dd1ba84c5aebeee70a73de0d7ea676712c58a57999be70c32b8545f34e98bfd2 t/smtpsend_live.t
-----BEGIN PGP SIGNATURE-----
iQIzBAEBAwAdFiEENa28Ovg1XoRROdiWXzwCYc2y51IFAmoB4/IACgkQXzwCYc2y
51KPIg//W7lpCD5sQhimDkITcVnAYaedXLd5pME+F2AusGXsbno0MTbxSH49J7xK
hP6VT9mcacuxgSuciA993dwmo8Uuew/YzrMsjiI0wtGBCoaC+OmHklG+eG76YkZj
9gpBa+iv8E7wRzk/U+GH0xaB7jKmM2R/5DkAcDNhF27HdsabjVrrJVC+Fl4bjl/A
CZBgIsNuAg0vDKcSIqgYYuX9b6uOLw5OZ592tKXxKSARhOP8tUb0MUiTmNMa0GDZ
lib/Mail/Make.pm view on Meta::CPAN
#
# 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 // '' );
lib/Mail/Make.pm view on Meta::CPAN
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)
#
lib/Mail/Make.pm view on Meta::CPAN
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'>).
lib/Mail/Make.pm view on Meta::CPAN
=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.
lib/Mail/Make/GPG.pm view on Meta::CPAN
};
use strict;
use warnings;
sub init
{
my $self = shift( @_ );
$self->{auto_fetch} = 0; # bool: fetch missing recipient keys from keyserver
$self->{digest} = 'SHA256';
$self->{gpg_bin} = undef; # explicit path to gpg binary; undef = search PATH
$self->{key_id} = undef; # default signing key fingerprint or ID
$self->{keyserver} = undef; # keyserver URL for auto-fetch
$self->{passphrase} = undef; # string or CODE ref; undef = use gpg-agent
$self->{_exception_class} = $EXCEPTION_CLASS;
$self->SUPER::init( @_ ) || return( $self->pass_error );
return( $self );
}
sub auto_fetch { return( shift->_set_get_boolean( 'auto_fetch', @_ ) ); }
sub digest { return( shift->_set_get_scalar( 'digest', @_ ) ); }
# encrypt( entity => $entity, recipients => \@addrs [, %opts] )
lib/Mail/Make/GPG.pm view on Meta::CPAN
my $recipients = $opts->{recipients} ||
return( $self->error( "The option 'recipients' is required." ) );
$recipients = [ $recipients ] unless( ref( $recipients ) eq 'ARRAY' );
unless( scalar( @$recipients ) )
{
return( $self->error( "The value for the 'recipients' must not be empty." ) );
}
$self->_maybe_fetch_keys( $recipients ) || return( $self->pass_error );
# Serialise the original message body for gpg input
my $plaintext = $self->_serialise_for_gpg( $entity ) || return( $self->pass_error );
my @args = ( $self->_base_gpg_args, '--encrypt', '--armor' );
push( @args, '--recipient', $_ ) for( @$recipients );
my $ciphertext = $self->_run_gpg( \@args, \$plaintext ) || return( $self->pass_error );
return( $self->_build_encrypted_mail( $entity, \$ciphertext ) );
}
sub gpg_bin { return( shift->_set_get_scalar( 'gpg_bin', @_ ) ); }
sub key_id { return( shift->_set_get_scalar( 'key_id', @_ ) ); }
sub keyserver { return( shift->_set_get_scalar( 'keyserver', @_ ) ); }
sub passphrase { return( shift->_set_get_scalar( 'passphrase', @_ ) ); }
# sign( entity => $entity [, %opts] )
# Signs $entity and returns a new Mail::Make object whose top-level MIME type is
# multipart/signed per RFC 3156 §5.
sub sign
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
my $entity = $opts->{entity} ||
return( $self->error( "The option ¶entity' is required." ) );
my $key_id = $self->_resolve_key_id( $opts ) ||
return( $self->error( 'KeyId is required (set via option or gpg_sign() default).' ) );
my $digest = uc( $opts->{digest} // $self->{digest} );
# Ensure Date and Message-ID are committed to the Mail::Make object's own _headers
# BEFORE serialising. This must happen without calling as_entity(), which would merge
# RFC 2822 headers onto $self->{_parts}[0].
$self->_ensure_envelope_headers( $entity ) || return( $self->pass_error );
# Serialise the MIME body that will be signed: Part 1 of multipart/signed.
# Per RFC 3156 §5.1 this is the entity with CRLF line endings, exactly as it will
# appear on the wire.
my $canonical = $self->_serialise_for_gpg( $entity ) || return( $self->pass_error );
my $passphrase = $self->_resolve_passphrase( $opts );
return( $self->pass_error ) if( $self->error ); # CODE ref may have thrown
my @args = (
$self->_base_gpg_args,
'--detach-sign',
'--armor',
'--digest-algo', $digest,
'--local-user', $key_id,
);
if( defined( $passphrase ) )
{
push( @args, '--passphrase-fd', '0', '--pinentry-mode', 'loopback' );
}
my $signature = $self->_run_gpg( \@args, \$canonical, passphrase => $passphrase ) || return( $self->pass_error );
return( $self->_build_signed_mail( $entity, \$signature, $canonical, digest => $digest ) );
}
# sign_encrypt( entity => $entity, recipients => \@addrs [, %opts] )
# Signs then encrypts $entity. The result is a multipart/encrypted message whose payload
# is a signed+encrypted OpenPGP message.
sub sign_encrypt
{
my $self = shift( @_ );
lib/Mail/Make/GPG.pm view on Meta::CPAN
unless( scalar( @$recipients ) )
{
return( $self->error( "The value for the option 'recipients' must not be empty." ) );
}
my $key_id = $self->_resolve_key_id( $opts ) || return( $self->error( 'KeyId is required.' ) );
my $digest = uc( $opts->{digest} // $self->{digest} );
$self->_maybe_fetch_keys( $recipients ) || return( $self->pass_error );
my $plaintext = $self->_serialise_for_gpg( $entity ) || return( $self->pass_error );
my $passphrase = $self->_resolve_passphrase( $opts );
return( $self->pass_error ) if( $self->error );
my @args = (
$self->_base_gpg_args,
'--sign',
'--encrypt',
'--armor',
'--digest-algo', $digest,
'--local-user', $key_id,
);
push( @args, '--recipient', $_ ) for( @$recipients );
if( defined( $passphrase ) )
{
push( @args, '--passphrase-fd', '0', '--pinentry-mode', 'loopback' );
}
my $ciphertext = $self->_run_gpg( \@args, \$plaintext, passphrase => $passphrase ) || return( $self->pass_error );
return( $self->_build_encrypted_mail( $entity, \$ciphertext ) );
}
# _base_gpg_args() → list
# Returns args common to every gpg invocation.
sub _base_gpg_args
{
my $self = shift( @_ );
my $bin = $self->_find_gpg_bin || return( $self->pass_error );
return(
$bin,
'--batch',
'--no-tty',
'--status-fd', '2',
);
}
# _build_encrypted_mail( $original_mail, \$ciphertext ) → Mail::Make object
# Constructs a new Mail::Make object whose body is a RFC 3156 §4
lib/Mail/Make/GPG.pm view on Meta::CPAN
my $signature_ref = shift( @_ );
my $canonical = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
my $digest = lc( $opts->{digest} // $self->{digest} );
require Mail::Make;
require Mail::Make::Entity;
my $boundary = _random_boundary();
# Part 1: a fresh entity whose content is exactly $canonical (the MIME-only bytes
# that gpg signed). Built via _entity_from_canonical() which parses the Content-* headers
# from $canonical and wraps the body in a Body::InCore.
# We never call as_entity() on $original here: for simple text/plain messages
# as_entity() would re-add RFC 2822 headers onto $self->{_parts}[0], corrupting the
# MIME-only Part 1.
my $body_entity = $self->_entity_from_canonical( $canonical ) || return( $self->pass_error );
# Part 2: the detached signature
my $sig_part = Mail::Make::Entity->build(
type => 'application/pgp-signature',
encoding => '7bit',
lib/Mail/Make/GPG.pm view on Meta::CPAN
),
) || return( $self->pass_error( Mail::Make::Entity->error ) );
$top->add_part( $body_entity );
$top->add_part( $sig_part );
return( $self->_wrap_in_mail( $original, $top ) );
}
# _ensure_envelope_headers( $mail_make_obj )
# Generates Date and Message-ID on $mail directly into its _headers object WITHOUT calling
# as_entity(). Called by sign() and sign_encrypt() before _serialise_for_gpg() so that
# those values exist when _wrap_in_mail() later copies _headers onto the outer multipart wrapper.
sub _ensure_envelope_headers
{
my $self = shift( @_ );
my $mail = shift( @_ ) ||
return( $self->error( "No Make::Mail instance was provided." ) );
if( !$self->_is_a( $mail => 'Mail::Make' ) )
{
return( $self->error( "Value provided is not a Mail::Make instance." ) );
}
lib/Mail/Make/GPG.pm view on Meta::CPAN
$mail->{_headers}->message_id(
{ generate => 1, domain => $mail->_default_domain }
) || return( $self->pass_error( $mail->{_headers}->error ) );
}
return(1);
}
# _entity_from_canonical( $canonical ) → Mail::Make::Entity
# Builds a fresh Mail::Make::Entity whose headers and body match $canonical exactly (the
# MIME-only string returned by _serialise_for_gpg). Used as Part 1 of the multipart/signed
# wrapper so that what Thunderbird verifies is byte-for-byte identical to what gpg signed.
sub _entity_from_canonical
{
my( $self, $canonical ) = @_;
require Mail::Make::Entity;
require Mail::Make::Headers;
require Mail::Make::Body::InCore;
# Split on the first CRLF+CRLF blank-line separator.
my $pos = index( $canonical, "\015\012\015\012" );
if( $pos < 0 )
lib/Mail/Make/GPG.pm view on Meta::CPAN
# Cache effective_type so is_multipart() and similar checks work.
my $ct = $headers->get( 'Content-Type' ) // '';
( my $type = $ct ) =~ s/;.*//s;
$type =~ s/\s+$//;
$entity->effective_type( $type );
return( $entity );
}
# _find_gpg_bin() → $path
# Locates the gpg binary: explicit gpg_bin attribute wins; otherwise we search for gpg2
# then gpg in PATH via File::Which.
sub _find_gpg_bin
{
my $self = shift( @_ );
if( defined( $self->{gpg_bin} ) && length( $self->{gpg_bin} ) )
{
return( $self->{gpg_bin} );
}
$self->_load_class( 'File::Which' ) ||
return( $self->error( 'File::Which is required to locate gpg. Install it with: cpan File::Which' ) );
for my $candidate ( qw( gpg2 gpg ) )
{
my $path = File::Which::which( $candidate );
if( defined( $path ) && length( $path ) )
{
$self->{gpg_bin} = $path;
return( $path );
}
}
return( $self->error( 'The gpg binary is not found in PATH. Install GnuPG or set the GpgBin option.' ) );
}
# _maybe_fetch_keys( \@recipients )
# When auto_fetch is enabled and a keyserver is configured, attempts to retrieve missing
# public keys for each recipient. Failures are silently ignored and the key may already be
# in the local keyring.
sub _maybe_fetch_keys
{
my( $self, $recipients ) = @_;
return(1) unless( $self->{auto_fetch} && defined( $self->{keyserver} ) && length( $self->{keyserver} ) );
$self->_load_class( 'IPC::Run' ) ||
return( $self->error( 'IPC::Run is required for GPG operations. Install it with: cpan IPC::Run' ) );
my $bin = $self->_find_gpg_bin || return( $self->pass_error );
local $@;
foreach my $r ( @$recipients )
{
my( $out, $err ) = ( '', '' );
eval
{
IPC::Run::run(
[ $bin, '--batch', '--no-tty',
'--keyserver', $self->{keyserver},
'--locate-keys', $r,
lib/Mail/Make/GPG.pm view on Meta::CPAN
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
my $kid = $opts->{key_id} // $self->{key_id} // '';
return( $kid );
}
# _resolve_passphrase( \%opts ) → $string | undef
# Resolves the passphrase from per-call option or instance default.
# CODE refs are called once here with no arguments.
# Returns undef when no passphrase is configured (gpg-agent will be used).
sub _resolve_passphrase
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
my $pp = $opts->{passphrase} // $self->{passphrase};
return unless( defined( $pp ) );
if( ref( $pp ) eq 'CODE' )
{
local $@;
$pp = eval{ $pp->() };
if( $@ )
{
return( $self->error( "Passphrase callback failed: $@" ) );
}
}
return( $pp );
}
# _run_gpg( \@args, \$input, passphrase => $pp ) → $stdout_string | undef
#
# Executes gpg via IPC::Run. IPC::Run handles multiplexed I/O internally, avoiding the
# select()-loop complexity of a raw fork/pipe approach.
#
# Passphrase handling (--passphrase-fd 0 + --pinentry-mode loopback):
# We prepend the passphrase (followed by a newline) to the stdin payload.
# gpg reads exactly one line from fd 0 as the passphrase, then continues reading the same
# fd for the message data. This avoids opening a second file descriptor and is the standard
# approach for batch use of GnuPG 2.1+.
sub _run_gpg
{
my $self = shift( @_ );
my $args = shift( @_ );
my $input_ref = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
my $passphrase = $opts->{passphrase};
$self->_load_class( 'IPC::Run' ) ||
return( $self->error( 'IPC::Run is required for GPG operations. Install it with: cpan IPC::Run' ) );
lib/Mail/Make/GPG.pm view on Meta::CPAN
my( $stdout, $stderr ) = ( '', '' );
local $@;
local $SIG{PIPE} = 'IGNORE';
my $ok = eval
{
IPC::Run::run( $args, \$stdin, \$stdout, \$stderr );
};
if( $@ )
{
return( $self->error( "gpg execution error: $@" ) );
}
unless( $ok )
{
# Extract the most informative line from gpg's stderr output
my @lines = split( /\n/, $stderr );
my ($msg) = grep { /\bERROR\b|\berror\b|failed|No secret key|No public key|bad passphrase/i } @lines;
$msg //= $lines[-1] // $stderr;
$msg =~ s/^\s+|\s+$//g;
return( $self->error( "gpg failed: $msg" ) );
}
return( $stdout );
}
# _serialise_for_gpg( $mail_make_obj ) → $string
# Returns the MIME body of the Mail::Make object with CRLF line endings, suitable for
# feeding to gpg (signing) or for encrypting.
#
# For multipart/signed (RFC 3156 §5.1) the data fed to gpg must be identical to Part 1 as
# it will appear on the wire, i.e. with CRLF.
sub _serialise_for_gpg
{
my( $self, $mail ) = @_;
unless( defined( $mail ) )
{
return( $self->error( 'No Mail::Make object supplied.' ) );
}
unless( $mail->can( 'as_entity' ) )
{
return( $self->error( 'Argument must be a Mail::Make object.' ) );
lib/Mail/Make/GPG.pm view on Meta::CPAN
# copying envelope headers (From, To, Cc, Subject, etc.) from $original_mail.
sub _wrap_in_mail
{
my( $self, $original, $top_entity ) = @_;
require Mail::Make;
# Ok, the check for error here is really semantic, because there is virtually zero chance of that happening.
my $new = Mail::Make->new || return( $self->pass_error( Mail::Make->error ) );
# Date and Message-ID were generated by _ensure_envelope_headers() in
# sign() / sign_encrypt() before _serialise_for_gpg() was called, so
# $original->headers already has them. Do NOT call as_entity() here:
# for simple text/plain messages as_entity() reuses $self->{_parts}[0] as $top_entity
# and would merge RFC 2822 headers back onto it, which would corrupt Part 1 of the
# multipart/signed structure.
# Merge envelope headers into BOTH the new Mail::Make object AND directly into
# $top_entity's headers. The hook in as_entity() returns _gpg_entity verbatim, so the
# standard header-merge logic never runs.
# We must therefore inject the RFC 2822 headers here.
my $ent_headers = $top_entity->headers;
$ent_headers->init_header( 'MIME-Version' => '1.0' );
$original->headers->scan(sub
{
my( $name, $value ) = @_;
# Inject into top entity so the wire message carries all headers
$ent_headers->init_header( $name => $value );
# Also keep in the new Mail::Make object for introspection
$new->headers->set( $name => $value );
return(1);
});
# Store the pre-assembled top entity so as_entity() returns it directly.
$new->{_gpg_entity} = $top_entity;
return( $new );
}
# NOTE: STORABLE support
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
1;
lib/Mail/Make/GPG.pm view on Meta::CPAN
use Mail::Make;
my $mail = Mail::Make->new
->from( 'jack@deguest.jp' )
->to( 'alice@example.com' )
->subject( 'Signed message' )
->plain( "Hello Alice.\n" );
# Sign only - multipart/signed (RFC 3156 §5)
$mail->gpg_sign(
KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752',
Passphrase => 'my-passphrase', # or: sub { MyKeyring::get('gpg') }
)->smtpsend( %smtp_opts );
# Encrypt only - multipart/encrypted (RFC 3156 §4)
$mail->gpg_encrypt(
Recipients => [ 'alice@example.com' ],
)->smtpsend( %smtp_opts );
# Sign then encrypt
$mail->gpg_sign_encrypt(
KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752',
Passphrase => sub { MyKeyring::get_passphrase() },
Recipients => [ 'alice@example.com', 'bob@example.com' ],
)->smtpsend( %smtp_opts );
# Auto-fetch recipient keys from a keyserver
$mail->gpg_encrypt(
Recipients => [ 'alice@example.com' ],
KeyServer => 'keys.openpgp.org',
AutoFetch => 1,
)->smtpsend( %smtp_opts );
=head1 VERSION
v0.1.5
=head1 DESCRIPTION
C<Mail::Make::GPG> adds OpenPGP support to L<Mail::Make> via direct calls to the C<gpg> binary using L<IPC::Run>. It produces RFC 3156-compliant C<multipart/signed> and C<multipart/encrypted> MIME structures.
This approach supports all key types that your installed GnuPG supports (RSA, DSA, Ed25519, ECDSA, etc.) and integrates naturally with C<gpg-agent> for transparent passphrase caching.
This module is not normally used directly. The C<gpg_sign()>, C<gpg_encrypt()>, and C<gpg_sign_encrypt()> methods are added to L<Mail::Make> itself as fluent methods that load and delegate to this module.
=head1 OPTIONS
All options may be passed to the C<gpg_sign()>, C<gpg_encrypt()>, and C<gpg_sign_encrypt()> methods on L<Mail::Make> directly; they are forwarded to this module.
=over 4
=item C<KeyId>
Signing key fingerprint or ID (required for signing operations).
Example: C<35ADBC3AF8355E845139D8965F3C0261CDB2E752>.
=item C<Passphrase>
lib/Mail/Make/GPG.pm view on Meta::CPAN
Array reference of recipient addresses or key IDs (required for encryption).
=item C<Digest>
Hash algorithm for signing. Defaults to C<SHA256>.
Valid values: C<SHA256>, C<SHA384>, C<SHA512>, C<SHA1>.
=item C<GpgBin>
Full path to the C<gpg> executable. If omitted, C<gpg2> and then C<gpg> are searched in C<PATH>.
=item C<KeyServer>
Keyserver URL for auto-fetching recipient public keys.
Only consulted when C<AutoFetch> is true.
Example: C<'keys.openpgp.org'>.
=item C<AutoFetch>
Boolean. When true and C<KeyServer> is set, C<gpg --locate-keys> is called for each recipient address before encryption. Defaults to C<0> (disabled).
=back
=head1 METHODS
=head2 auto_fetch( [$bool] )
Gets or sets the auto-fetch flag. When true and C<keyserver()> is set, C<gpg --locate-keys> is called for each recipient before encryption.
Default: C<0>.
=head2 digest( [$algorithm] )
Gets or sets the hash algorithm used for signing. The value is uppercased automatically.
Default: C<SHA256>.
Valid values: C<SHA256>, C<SHA384>, C<SHA512>, C<SHA1>.
=head2 encrypt( entity => $mail [, %opts] )
Encrypts C<$mail> for one or more recipients and returns a new L<Mail::Make> object whose top-level MIME type is C<multipart/encrypted> (RFC 3156 §4).
The caller is responsible for supplying recipient public keys in the GnuPG keyring. When C<auto_fetch()> and C<keyserver()> are set, key retrieval via C<gpg --locate-keys> is attempted before encryption.
Required options:
=over 4
=item entity => $mail_make_obj
The L<Mail::Make> object to encrypt.
=item recipients => \@addrs_or_key_ids
Array reference of recipient e-mail addresses or key fingerprints.
=back
Optional options mirror the accessor names: C<digest>, C<gpg_bin>, C<key_id>, C<keyserver>, C<passphrase>.
=head2 gpg_bin( [$path] )
Gets or sets the full path to the C<gpg> executable. When not set, C<gpg2> and then C<gpg> are searched in C<PATH>.
=head2 key_id( [$fingerprint] )
Gets or sets the default signing key fingerprint or ID.
=head2 keyserver( [$url] )
Gets or sets the keyserver URL used for auto-fetching recipient public keys.
Example: C<'keys.openpgp.org'>.
lib/Mail/Make/GPG.pm view on Meta::CPAN
=item entity => $mail_make_obj
The L<Mail::Make> object to sign.
=item key_id => $fingerprint_or_id
Signing key fingerprint or short ID.
=back
Optional options: C<digest>, C<gpg_bin>, C<passphrase>.
=head2 sign_encrypt( entity => $mail, recipients => \@addrs [, %opts] )
Signs then encrypts C<$mail>. Returns a new L<Mail::Make> object whose top-level MIME type is C<multipart/encrypted> containing a signed and encrypted OpenPGP payload.
Accepts all options from both L</sign> and L</encrypt>.
=head1 DEPENDENCIES
=over 4
=item L<IPC::Run>
Loaded on demand. Required for all GPG operations.
=item L<File::Which>
Loaded on demand. Used to locate the C<gpg> binary in C<PATH>.
=item GnuPG 2.x
Must be installed and accessible as C<gpg2> or C<gpg> in C<PATH>, or explicitly set via the C<GpgBin> option.
=back
=head1 STANDARDS
=over 4
=item RFC 3156 - MIME Security with OpenPGP
=item RFC 4880 - OpenPGP Message Format
lib/Mail/Make/SMIME.pm view on Meta::CPAN
return( $self->_build_from_smime_output( $entity, $result ) );
}
# _build_from_smime_output( $original_mail, $smime_string ) → Mail::Make
# Parses the S/MIME output string from Crypt::SMIME (which already contains all the correct
# headers) into a new Mail::Make object that smtpsend() can use directly.
#
# Crypt::SMIME::sign() and encrypt() return a fully formed RFC 2822 message string. We
# wrap it in a Mail::Make object by parsing it into an Entity and storing it as
# _smime_entity, mirroring what _gpg_entity does for GPG.
sub _build_from_smime_output
{
my( $self, $original, $smime_str ) = @_;
require Mail::Make;
# Canonicalise line endings to CRLF
( my $canon = $smime_str ) =~ s/\015?\012/\015\012/g;
# Locate the header / body separator
my $pos = index( $canon, "\015\012\015\012" );
lib/Mail/Make/SMIME.pm view on Meta::CPAN
{
return( $self->error( "File '$source' does not contain PEM data." ) );
}
return( $pem );
}
# _serialise_for_smime( $mail_make_obj ) → $string
# Serialises the Mail::Make object to a full RFC 2822 message string
# (headers + body, CRLF line endings).
# Unlike _serialise_for_gpg, we pass the COMPLETE message to Crypt::SMIME; it handles
# RFC 5751 header separation internally.
sub _serialise_for_smime
{
my( $self, $mail ) = @_;
unless( defined( $mail ) )
{
return( $self->error( 'No Mail::Make object supplied.' ) );
}
t/94_gpg_live.t view on Meta::CPAN
#!/usr/local/bin/perl
##----------------------------------------------------------------------------
## Mail Builder - t/94_gpg_live.t
## Live GPG signing and encryption tests - AUTHOR USE ONLY.
##
## Sends real signed and/or encrypted emails via a real SMTP server and
## verifies the message is accepted. Visual inspection in a GPG-capable
## mail client (Thunderbird, Mutt, etc.) is required to confirm that:
## - multipart/signed messages verify cleanly
## - multipart/encrypted messages decrypt correctly
## - sign+encrypt messages do both
##
## Required: SMTP configuration (same as smtpsend_live.t):
## MM_SMTP_FROM, MM_SMTP_TO (or [smtp] section in ~/.mailmakerc)
##
## Required: GPG configuration:
## MM_GPG_KEY_ID Signing key fingerprint or ID (e.g. 35ADBC3A...)
## MM_GPG_PASSPHRASE Passphrase for the key (omit to use gpg-agent)
## MM_GPG_RECIPIENT Recipient address for encryption tests
## Defaults to MM_SMTP_TO when omitted
## MM_GPG_BIN Full path to gpg binary (optional; default: gpg2/gpg)
##
## ~/.mailmakerc: optional [gpg] section:
## [gpg]
## key_id = 35ADBC3AF8355E845139D8965F3C0261CDB2E752
## passphrase = secret
## recipient = jack@deguest.jp
## bin = /usr/bin/gpg2
##
## Run:
## MM_RC=dev/mailmake_rc.pl AUTHOR_TESTING=1 prove -lv t/94_gpg_live.t
##----------------------------------------------------------------------------
BEGIN
{
use strict;
use warnings;
use lib './lib';
use Test::More;
};
use strict;
t/94_gpg_live.t view on Meta::CPAN
my $smtp_from = $ENV{MM_SMTP_FROM} // $rc{'smtp.from'};
my $smtp_to = $ENV{MM_SMTP_TO} // $rc{'smtp.to'};
my $smtp_hello = $ENV{MM_SMTP_HELLO} // $rc{'smtp.hello'} // do { require Sys::Hostname; Sys::Hostname::hostname() };
my $smtp_username = $ENV{MM_SMTP_USERNAME} // $rc{'smtp.username'};
my $smtp_password = $ENV{MM_SMTP_PASSWORD} // $rc{'smtp.password'};
my $smtp_starttls = $ENV{MM_SMTP_STARTTLS} // $rc{'smtp.starttls'} // 0;
my $smtp_ssl = $ENV{MM_SMTP_SSL} // $rc{'smtp.ssl'} // 0;
my $smtp_debug = $ENV{MM_SMTP_DEBUG} // $rc{'smtp.debug'} // 0;
# GPG config
my $gpg_key_id = $ENV{MM_GPG_KEY_ID} // $rc{'gpg.key_id'};
my $gpg_passphrase = $ENV{MM_GPG_PASSPHRASE} // $rc{'gpg.passphrase'};
my $gpg_recipient = $ENV{MM_GPG_RECIPIENT} // $rc{'gpg.recipient'} // $smtp_to;
my $gpg_bin = $ENV{MM_GPG_BIN} // $rc{'gpg.bin'};
# NOTE: Dependency and configuration checks
# diag( "\$smtp_from is '", ( $smtp_from // 'undef' ), "' and \$smtp_to is '", ( $smtp_to // 'undef' ), "'" );
unless( defined( $smtp_from ) && length( $smtp_from ) &&
defined( $smtp_to ) && length( $smtp_to ) )
{
plan( skip_all =>
'Live GPG test skipped: set MM_SMTP_FROM + MM_SMTP_TO ' .
'or configure [smtp] from/to in ~/.mailmakerc' );
}
eval{ require IPC::Run } or plan( skip_all => 'IPC::Run not installed - required for GPG operations' );
eval{ require File::Which } or plan( skip_all => 'File::Which not installed - required to locate gpg binary' );
# Locate gpg binary early so we can skip cleanly if absent
my $gpg_bin_found;
if( defined( $gpg_bin ) && length( $gpg_bin ) )
{
$gpg_bin_found = -x $gpg_bin ? $gpg_bin : undef;
}
unless( defined( $gpg_bin_found ) && length( $gpg_bin_found ) )
{
for my $candidate ( qw( gpg2 gpg ) )
{
my $p = File::Which::which( $candidate );
if( defined( $p ) && length( $p ) )
{
$gpg_bin_found = $p;
last;
}
}
}
unless( defined( $gpg_bin_found ) )
{
plan( skip_all => 'gpg binary not found in PATH - install GnuPG or set MM_GPG_BIN' );
}
# Signing tests require a key ID
my $can_sign = ( defined( $gpg_key_id ) && length( $gpg_key_id ) );
# NOTE: Common helpers
my %smtp_common = (
Host => $smtp_host,
Port => $smtp_port,
Hello => $smtp_hello,
Debug => $smtp_debug,
);
$smtp_common{StartTLS} = 1 if( $smtp_starttls );
$smtp_common{SSL} = 1 if( $smtp_ssl );
$smtp_common{Username} = $smtp_username if( defined( $smtp_username ) && length( $smtp_username ) );
$smtp_common{Password} = $smtp_password if( defined( $smtp_password ) && length( $smtp_password ) );
my %gpg_common = ( GpgBin => $gpg_bin_found );
sub _make_base_mail
{
my( $subject, $body ) = @_;
require Mail::Make;
return( Mail::Make->new
->from( $smtp_from )
->to( $smtp_to )
->subject( $subject )
->plain( $body ) );
t/94_gpg_live.t view on Meta::CPAN
# NOTE: Tests
use_ok( 'Mail::Make' );
use_ok( 'Mail::Make::GPG' );
# NOTE: Plain-signed message (multipart/signed, RFC 3156 §5)
SKIP:
{
skip( 'MM_GPG_KEY_ID not set - signing tests skipped', 2 ) unless( $can_sign );
# NOTE: live: gpg_sign - multipart/signed delivered
subtest 'live: gpg_sign - multipart/signed delivered' => sub
{
plan( tests => 2 );
my $mail = _make_base_mail(
'[Mail::Make] Live GPG test - sign only',
"This message is signed with a detached OpenPGP signature.\n\n" .
"Your mail client should show a valid signature indicator.\n",
);
my %sign_opts = ( %gpg_common, KeyId => $gpg_key_id );
$sign_opts{Passphrase} = $gpg_passphrase if( defined( $gpg_passphrase ) );
local $@;
my $signed = eval { $mail->gpg_sign( %sign_opts ) };
if( $@ || !defined( $signed ) )
{
diag( 'gpg_sign error: ' . ( $@ || $mail->error // 'unknown' ) );
ok( 0, 'gpg_sign() succeeded' );
ok( 0, 'signed message accepted by server' );
return;
}
ok( 1, 'gpg_sign() succeeded' );
_send_and_check( $signed, 'signed message' );
};
# NOTE: SHA-512 digest variant
subtest 'live: gpg_sign - SHA-512 digest' => sub
{
plan( tests => 2 );
my $mail = _make_base_mail(
'[Mail::Make] Live GPG test - sign SHA-512',
"Signed with SHA-512 digest algorithm.\n",
);
my %sign_opts = ( %gpg_common, KeyId => $gpg_key_id, Digest => 'SHA512' );
$sign_opts{Passphrase} = $gpg_passphrase if( defined( $gpg_passphrase ) );
local $@;
my $signed = eval { $mail->gpg_sign( %sign_opts ) };
if( $@ || !defined( $signed ) )
{
diag( 'gpg_sign SHA-512 error: ' . ( $@ || $mail->error // 'unknown' ) );
ok( 0, 'gpg_sign() SHA-512 succeeded' );
ok( 0, 'SHA-512 signed message accepted by server' );
return;
}
ok( 1, 'gpg_sign() SHA-512 succeeded' );
_send_and_check( $signed, 'SHA-512 signed message' );
};
}
# NOTE: Encrypted message (multipart/encrypted, RFC 3156 §4)
subtest 'live: gpg_encrypt - multipart/encrypted delivered' => sub
{
plan( tests => 2 );
my $mail = _make_base_mail(
'[Mail::Make] Live GPG test - encrypt only',
"This message is encrypted with OpenPGP.\n\n" .
"Only the holder of the private key for $gpg_recipient can read this.\n",
);
local $@;
my $encrypted = eval
{
$mail->gpg_encrypt(
%gpg_common,
Recipients => [ $gpg_recipient ],
);
};
if( $@ || !defined( $encrypted ) )
{
diag( 'gpg_encrypt error: ' . ( $@ || $mail->error // 'unknown' ) );
ok( 0, 'gpg_encrypt() succeeded' );
ok( 0, 'encrypted message accepted by server' );
return;
}
ok( 1, 'gpg_encrypt() succeeded' );
_send_and_check( $encrypted, 'encrypted message' );
};
# NOTE: Sign then encrypt
SKIP:
{
skip( 'MM_GPG_KEY_ID not set - sign+encrypt test skipped', 1 ) unless( $can_sign );
# NOTE: live: gpg_sign_encrypt - signed and encrypted delivered
subtest 'live: gpg_sign_encrypt - signed and encrypted delivered' => sub
{
plan( tests => 2 );
my $mail = _make_base_mail(
'[Mail::Make] Live GPG test - sign + encrypt',
"This message is signed and encrypted with OpenPGP.\n\n" .
"Only $gpg_recipient can decrypt it, and the signature proves\n" .
"it came from the holder of key $gpg_key_id.\n",
);
my %opts = (
%gpg_common,
KeyId => $gpg_key_id,
Recipients => [ $gpg_recipient ],
);
$opts{Passphrase} = $gpg_passphrase if( defined( $gpg_passphrase ) );
local $@;
my $result = eval { $mail->gpg_sign_encrypt( %opts ) };
if( $@ || !defined( $result ) )
{
diag( 'gpg_sign_encrypt error: ' . ( $@ || $mail->error // 'unknown' ) );
ok( 0, 'gpg_sign_encrypt() succeeded' );
ok( 0, 'sign+encrypt message accepted by server' );
return;
}
ok( 1, 'gpg_sign_encrypt() succeeded' );
_send_and_check( $result, 'sign+encrypt message' );
};
}
# NOTE: Structure check - no SMTP send, just verify MIME output
subtest 'structure: gpg_sign produces multipart/signed entity' => sub
{
plan( tests => 3 );
skip( 'MM_GPG_KEY_ID not set', 3 ) unless( $can_sign );
my $mail = _make_base_mail(
'Structure check - multipart/signed',
"Testing MIME structure without sending.\n",
);
my %sign_opts = ( %gpg_common, KeyId => $gpg_key_id );
$sign_opts{Passphrase} = $gpg_passphrase if( defined( $gpg_passphrase ) );
local $@;
my $signed = eval { $mail->gpg_sign( %sign_opts ) };
if( $@ || !defined( $signed ) )
{
diag( 'gpg_sign error: ' . ( $@ || $mail->error // 'unknown' ) );
ok( 0, 'gpg_sign() succeeded' ) for( 1..3 );
return;
}
ok( 1, 'gpg_sign() succeeded' );
my $entity = $signed->as_entity;
ok( defined( $entity ), 'as_entity() returns defined value' );
my $ct = $entity->headers->get( 'Content-Type' ) // '';
like( $ct, qr{multipart/signed}i, 'Content-Type is multipart/signed' );
};
# NOTE: structure: gpg_encrypt produces multipart/encrypted entity
subtest 'structure: gpg_encrypt produces multipart/encrypted entity' => sub
{
plan( tests => 3 );
my $mail = _make_base_mail(
'Structure check - multipart/encrypted',
"Testing MIME structure without sending.\n",
);
local $@;
my $encrypted = eval
{
$mail->gpg_encrypt(
%gpg_common,
Recipients => [ $gpg_recipient ],
);
};
if( $@ || !defined( $encrypted ) )
{
diag( 'gpg_encrypt error: ' . ( $@ || $mail->error // 'unknown' ) );
ok( 0, 'gpg_encrypt() succeeded' ) for( 1..3 );
return;
}
ok( 1, 'gpg_encrypt() succeeded' );
my $entity = $encrypted->as_entity;
ok( defined( $entity ), 'as_entity() returns defined value' );
my $ct = $entity->headers->get( 'Content-Type' ) // '';
like( $ct, qr{multipart/encrypted}i, 'Content-Type is multipart/encrypted' );
};
done_testing();
__END__
=head1 NAME
t/94_gpg_live.t - Live OpenPGP signing and encryption tests for Mail::Make
=head1 SYNOPSIS
# Minimal: encrypt only (no key ID needed, uses MM_SMTP_TO as recipient)
MM_RC=dev/mailmake_rc.pl \
AUTHOR_TESTING=1 \
prove -lv t/94_gpg_live.t
# Full: sign + encrypt
MM_RC=dev/mailmake_rc.pl \
MM_GPG_KEY_ID=35ADBC3AF8355E845139D8965F3C0261CDB2E752 \
MM_GPG_PASSPHRASE=secret \
MM_GPG_RECIPIENT=jack@deguest.jp \
AUTHOR_TESTING=1 \
prove -lv t/94_gpg_live.t
=head1 CONFIGURATION
SMTP options are identical to F<t/smtpsend_live.t>.
Add a C<[gpg]> section to F<~/.mailmakerc>:
[gpg]
key_id = 35ADBC3AF8355E845139D8965F3C0261CDB2E752
passphrase = secret
recipient = jack@deguest.jp
bin = /usr/bin/gpg2
=head1 TESTS
=over 4
=item 1. C<gpg_sign()> - multipart/signed, SHA-256
=item 2. C<gpg_sign()> - multipart/signed, SHA-512
=item 3. C<gpg_encrypt()> - multipart/encrypted
=item 4. C<gpg_sign_encrypt()> - signed + encrypted
=item 5. Structure check - multipart/signed Content-Type (no SMTP)
=item 6. Structure check - multipart/encrypted Content-Type (no SMTP)
=back
Tests 1, 2, 4, and 5 are skipped automatically when C<MM_GPG_KEY_ID> is not set.
=cut
( run in 1.303 second using v1.01-cache-2.11-cpan-df04353d9ac )