App-mailmake
view release on metacpan or search on metacpan
scripts/mailmake view on Meta::CPAN
## Version v0.1.1
## Copyright(c) 2026 DEGUEST Pte. Ltd.
## Author: Jacques Deguest <jack@deguest.jp>
## Created 2026/03/06
## Modified 2026/03/07
## All rights reserved
##
## This program is free software; you can redistribute it and/or modify it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
use v5.16.0;
use strict;
use warnings;
use utf8;
use open ':std' => ':utf8';
use vars qw(
$VERSION $DEBUG $VERBOSE $LOG_LEVEL $PROG_NAME
$opt $opts $out $err
);
use Encode ();
use Getopt::Class;
use Mail::Make;
use Module::Generic::File qw( file stdout stderr );
use Pod::Usage;
use Term::ANSIColor::Simple;
our $VERSION = 'v0.1.1';
our $LOG_LEVEL = 0;
our $DEBUG = 0;
our $VERBOSE = 0;
our $PROG_NAME = file( __FILE__ )->basename( '.pl' );
$SIG{INT} = $SIG{TERM} = \&_signal_handler;
our $out = stdout( binmode => 'utf-8', autoflush => 1 );
our $err = stderr( binmode => 'utf-8', autoflush => 1 );
@ARGV = map( Encode::decode_utf8( $_ ), @ARGV );
# NOTE: options dictionary
# Tokens use underscores; Getopt::Class automatically exposes them as dashes on the
# command line. Example: gpg_key_id -> --gpg-key-id
my $dict =
{
# Envelope / headers
from => { type => 'string', alias => [qw( f )], required => 1 },
to => { type => 'array', alias => [qw( t )], required => 1 },
cc => { type => 'array' },
bcc => { type => 'array' },
reply_to => { type => 'string' },
sender => { type => 'string' },
subject => { type => 'string', alias => [qw( s )] },
header => { type => 'array' }, # repeatable: Name:Value
# Body
plain => { type => 'string' }, # plain-text body (literal)
plain_file => { type => 'file' }, # plain-text body from file
html => { type => 'string' }, # HTML body (literal)
html_file => { type => 'file' }, # HTML body from file
attach => { type => 'file-array' }, # file attachments
attach_inline => { type => 'file-array' }, # inline (related) parts
charset => { type => 'string', default => 'UTF-8' },
# Output - print to stdout instead of sending
print => { type => 'boolean', default => 0 },
# SMTP delivery
smtp_host => { type => 'string', alias => [qw( host H )] },
smtp_port => { type => 'integer', alias => [qw( port P )] },
smtp_user => { type => 'string', alias => [qw( user U )] },
smtp_password => { type => 'string', alias => [qw( password )] },
smtp_tls => { type => 'boolean', default => 0 }, # SMTPS port 465
smtp_starttls => { type => 'boolean', default => 0 }, # STARTTLS
smtp_timeout => { type => 'integer', default => 30 },
# OpenPGP (Mail::Make::GPG - requires gpg and IPC::Run)
gpg_sign => { type => 'boolean', default => 0 },
gpg_encrypt => { type => 'boolean', default => 0 },
gpg_key_id => { type => 'string' },
gpg_passphrase => { type => 'string' },
gpg_recipients => { type => 'array' }, # defaults to --to if omitted
gpg_digest => { type => 'string', default => 'SHA256' },
gpg_bin => { type => 'string' },
gpg_keyserver => { type => 'string' },
gpg_autofetch => { type => 'boolean', default => 0 },
# S/MIME (Mail::Make::SMIME - requires Crypt::SMIME)
smime_sign => { type => 'boolean', default => 0 },
smime_encrypt => { type => 'boolean', default => 0 },
smime_cert => { type => 'file' }, # signer cert (PEM)
smime_key => { type => 'file' }, # signer private key (PEM)
smime_key_password => { type => 'string' },
smime_ca_cert => { type => 'file' }, # CA cert (PEM)
smime_recipient_cert => { type => 'file-array' }, # recipient cert(s) (PEM)
# Generic options
debug => { type => 'integer', alias => [qw( d )], default => \$DEBUG },
help => { type => 'code', alias => [qw( h ? )],
code => sub{ pod2usage( -exitstatus => 1, -verbose => 99,
-sections => [qw( NAME SYNOPSIS DESCRIPTION OPTIONS AUTHOR COPYRIGHT )] ) },
action => 1 },
log_level => { type => 'integer', default => \$LOG_LEVEL },
man => { type => 'code',
code => sub{ pod2usage( -exitstatus => 0, -verbose => 2 ) },
action => 1 },
quiet => { type => 'boolean', default => 0 },
verbose => { type => 'integer', default => \$VERBOSE },
v => { type => 'code',
code => sub{ $out->print( $VERSION, "\n" ); exit(0) },
action => 1 },
};
our $opt = Getopt::Class->new({ dictionary => $dict }) ||
die( "Error instantiating Getopt::Class object: ", Getopt::Class->error, "\n" );
$opt->usage( sub{ pod2usage(2) } );
our $opts = $opt->exec || die( "An error occurred executing Getopt::Class: ", $opt->error, "\n" );
my @errors = ();
my $opt_errors = $opt->configure_errors;
push( @errors, @$opt_errors ) if( $opt_errors->length );
if( $opts->{quiet} )
scripts/mailmake view on Meta::CPAN
? $dict->{ $action_found }->{code}
: main->can( $action_found );
if( !defined( $coderef ) )
{
die( "There is no sub for action \"$action_found\"\n" );
}
&_cleanup_and_exit( $coderef->() ? 0 : 1 );
# NOTE: send
sub compose
{
# Build the Mail::Make object
my $mail = Mail::Make->new ||
_die( "Failed to instantiate Mail::Make: ", Mail::Make->error );
$mail->from( $opts->{from} ) || _die( $mail->error );
$mail->to( ref( $opts->{to} ) ? join( ', ', @{$opts->{to}} ) : $opts->{to} ) || _die( $mail->error );
if( defined( $opts->{cc} ) && @{$opts->{cc}} )
{
$mail->cc( join( ', ', @{$opts->{cc}} ) ) || _die( $mail->error );
}
if( defined( $opts->{bcc} ) && @{$opts->{bcc}} )
{
$mail->bcc( join( ', ', @{$opts->{bcc}} ) ) || _die( $mail->error );
}
# We need to capture and handle any error returned
if( defined( $opts->{reply_to} ) && length( $opts->{reply_to} // '' ) )
{
$mail->reply_to( $opts->{reply_to} ) || _die( $mail->error );
}
if( defined( $opts->{sender} ) && length( $opts->{sender} // '' ) )
{
$mail->sender( $opts->{sender} ) || _die( $mail->error );
}
if( defined( $opts->{subject} ) && length( $opts->{subject} // '' ) )
{
$mail->subject( $opts->{subject} ) || _die( $mail->error );
}
# Arbitrary extra headers: Name:Value
if( defined( $opts->{header} ) && @{$opts->{header}} )
{
foreach my $hdr ( @{$opts->{header}} )
{
if( $hdr =~ /^([\w-]+)\s*:\s*(.*)$/ )
{
$mail->header( $1 => $2 ) ||
_die( "Error setting header $1 with value $2: ", $mail->error );
}
else
{
_message( 1, "Warning: ignoring malformed --header value: <orange>$hdr</>" );
}
}
}
# Body
my $charset = $opts->{charset} // 'UTF-8';
if( $opts->{plain_file} )
{
my $f = $opts->{plain_file};
_die( "plain-file \"$f\" does not exist." ) unless( $f->exists );
my $text = $f->load_utf8 ||
_die( "Cannot read plain-file \"$f\": ", $f->error );
$mail->plain( $text, charset => $charset ) || _die( $mail->error );
}
elsif( defined( $opts->{plain} ) && length( $opts->{plain} // '' ) )
{
_message( 3, "Setting body to '", $opts->{plain}, "'" );
$mail->plain( $opts->{plain}, charset => $charset ) ||
_die( "Error setting plain body: ", $mail->error );
}
if( $opts->{html_file} )
{
my $f = $opts->{html_file};
_die( "html-file \"$f\" does not exist." ) unless( $f->exists );
my $html = $f->load_utf8 ||
_die( "Cannot read html-file \"$f\": ", $f->error );
$mail->html( $html, charset => $charset ) || _die( $mail->error );
}
elsif( defined( $opts->{html} ) && length( $opts->{html} // '' ) )
{
$mail->html( $opts->{html}, charset => $charset ) || _die( $mail->error );
}
if( $opts->{attach} && @{$opts->{attach}} )
{
_message( 3, "Processing ", scalar( @{$opts->{attach}} ), " attachments." );
foreach my $f ( @{$opts->{attach}} )
{
_message( 3, "Attaching file $f" );
_die( "Attachment file \"$f\" does not exist." ) unless( $f->exists );
$mail->attach( path => "$f" ) || _die( $mail->error );
}
}
if( defined( $opts->{attach_inline} ) && @{$opts->{attach_inline}} )
{
for my $f ( @{$opts->{attach_inline}} )
{
_die( "Inline attachment file \"$f\" does not exist." ) unless( $f->exists );
$mail->attach_inline( path => "$f" ) || _die( $mail->error );
}
}
# Cryptographic operations
if( $opts->{gpg_sign} || $opts->{gpg_encrypt} )
{
$mail = _apply_gpg( $mail ) || return(0);
}
elsif( $opts->{smime_sign} || $opts->{smime_encrypt} )
{
$mail = _apply_smime( $mail ) || return(0);
}
# Output or deliver
if( $opts->{print} )
{
my $str = $mail->as_string ||
_die( "Failed to serialise message: ", $mail->error );
$out->print( $str );
return(1);
}
return( _deliver( $mail ) );
}
# _apply_gpg( $mail ) → $mail (possibly a new object) or undef on error
sub _apply_gpg
{
my $mail = shift( @_ );
my %gpg_opts = (
Digest => $opts->{gpg_digest},
);
$gpg_opts{GpgBin} = $opts->{gpg_bin} if( defined( $opts->{gpg_bin} ) );
$gpg_opts{KeyServer} = $opts->{gpg_keyserver} if( defined( $opts->{gpg_keyserver} ) );
$gpg_opts{AutoFetch} = 1 if( $opts->{gpg_autofetch} );
if( $opts->{gpg_sign} || ( $opts->{gpg_sign} && $opts->{gpg_encrypt} ) )
{
$gpg_opts{KeyId} = $opts->{gpg_key_id} if( defined( $opts->{gpg_key_id} ) );
$gpg_opts{Passphrase} = $opts->{gpg_passphrase} if( defined( $opts->{gpg_passphrase} ) );
scripts/mailmake view on Meta::CPAN
=item B<--to>, B<-t> ADDRESS [ADDRESS ...]
One or more recipient addresses (required, repeatable).
=item B<--cc> ADDRESS [ADDRESS ...]
Carbon-copy addresses (repeatable).
=item B<--bcc> ADDRESS [ADDRESS ...]
Blind carbon-copy addresses (repeatable).
=item B<--reply-to> ADDRESS
C<Reply-To> header value.
=item B<--sender> ADDRESS
C<Sender> header value (when the submitter differs from the author).
=item B<--subject>, B<-s> TEXT
Message subject. Non-ASCII characters are encoded automatically (RFC 2047).
=item B<--header> Name:Value
Add an arbitrary header. Repeatable. Example: C<--header "X-Mailer:mailmake">
=back
=head2 Body
At least one of C<--plain>, C<--plain-file>, C<--html>, or C<--html-file> should be supplied. When both plain and HTML bodies are given, a C<multipart/alternative> structure is built automatically. Adding attachments wraps everything in C<multipart/m...
=over 4
=item B<--plain> TEXT
Plain-text body (literal string).
=item B<--plain-file> FILE
Plain-text body loaded from a file.
=item B<--html> TEXT
HTML body (literal string).
=item B<--html-file> FILE
HTML body loaded from a file.
=item B<--attach> FILE [FILE ...]
File attachment(s), added as C<multipart/mixed> parts (repeatable).
=item B<--attach-inline> FILE [FILE ...]
Inline attachment(s), added as C<multipart/related> parts, intended for embedding images in HTML (repeatable).
=item B<--charset> NAME
Character set for text bodies. Default: C<UTF-8>.
=back
=head2 Output
=over 4
=item B<--print>
Write the assembled RFC 2822 message to STDOUT instead of delivering it.
Useful for piping to C<sendmail>, inspecting the message, or testing.
=back
=head2 SMTP Delivery
=over 4
=item B<--smtp-host>, B<-H> HOST
SMTP server hostname or IP address.
=item B<--smtp-port>, B<-P> PORT
SMTP port. Defaults to 25 (plain), 587 (STARTTLS), or 465 (SMTPS/TLS).
=item B<--smtp-user>, B<-U> USERNAME
Login name for SMTP authentication (SASL PLAIN/LOGIN).
Requires L<Authen::SASL>.
=item B<--smtp-password> PASSWORD
Password for SMTP authentication.
=item B<--smtp-starttls>
Upgrade the connection to TLS using STARTTLS (typically port 587).
=item B<--smtp-tls>
Use direct TLS from the start (SMTPS, typically port 465).
=item B<--smtp-timeout> SECONDS
Connection and command timeout. Default: 30.
=back
=head2 OpenPGP (requires C<gpg> / C<gpg2> and L<IPC::Run>)
OpenPGP options cannot be combined with S/MIME options.
=over 4
=item B<--gpg-sign>
( run in 0.614 second using v1.01-cache-2.11-cpan-39bf76dae61 )