view release on metacpan or  search on metacpan

scripts/mailmake  view on Meta::CPAN

        {
            _die( "--smime-key is required for S/MIME signing." );
        }
        $smime_opts{Cert}        = "$opts->{smime_cert}";
        $smime_opts{Key}         = "$opts->{smime_key}";
        if( defined( $opts->{smime_key_password} ) )
        {
            $smime_opts{KeyPassword} = $opts->{smime_key_password};
        }
        if( defined( $opts->{smime_ca_cert} ) )
        {
            $smime_opts{CACert} = "$opts->{smime_ca_cert}";
        }
    }
    if( $opts->{smime_encrypt} )
    {
        unless( defined( $opts->{smime_recipient_cert} ) && @{$opts->{smime_recipient_cert}} )
        {
            _die( "--smime-recipient-cert is required for S/MIME encryption." );
        }
        $smime_opts{RecipientCert} = [ map{ "$_" } @{$opts->{smime_recipient_cert}} ];
    }

    my $result;
    if( $opts->{smime_sign} && $opts->{smime_encrypt} )
    {
        _message( 2, "Applying S/MIME sign+encrypt." );
        $result = $mail->smime_sign_encrypt( %smime_opts );
    }
    elsif( $opts->{smime_encrypt} )
    {
        _message( 2, "Applying S/MIME encryption." );
        $result = $mail->smime_encrypt( %smime_opts );
    }
    else
    {
        _message( 2, "Applying S/MIME signature." );
        $result = $mail->smime_sign( %smime_opts );
    }

    unless( defined( $result ) )
    {
        _message( 1, "<red>S/MIME operation failed:</> ", $mail->error );
        return;
    }
    return( $result );
}

# _deliver( $mail ) → 1 on success, 0 on failure
sub _deliver
{
    my $mail = shift( @_ );

    unless( defined( $opts->{smtp_host} ) && length( $opts->{smtp_host} ) )
    {
        _die( "No SMTP host specified. Use --smtp-host (or --print to output the message instead)." );
    }

    my %smtp_opts = (
        Host    => $opts->{smtp_host},
        Timeout => $opts->{smtp_timeout} // 30,
    );
    $smtp_opts{Port}     = $opts->{smtp_port}     if( defined( $opts->{smtp_port} ) );
    $smtp_opts{SSL}      = 1                      if( $opts->{smtp_tls} );
    $smtp_opts{StartTLS} = 1                      if( $opts->{smtp_starttls} );
    $smtp_opts{Username} = $opts->{smtp_user}     if( defined( $opts->{smtp_user} ) );
    $smtp_opts{Password} = $opts->{smtp_password} if( defined( $opts->{smtp_password} ) );
    $smtp_opts{Debug}    = 1                      if( $DEBUG >= 3 );

    _message( 2, "Sending via <green>$opts->{smtp_host}</>." );
    my $rcpts = $mail->smtpsend( %smtp_opts );
    unless( defined( $rcpts ) )
    {
        _message( 1, "<red>Delivery failed:</> ", $mail->error );
        return(0);
    }
    my @addrs = ref( $rcpts ) eq 'ARRAY' ? @{$rcpts} : ( $rcpts );
    unless( $opts->{quiet} )
    {
        _message( 1, "Message accepted for: <green>", join( ', ', @addrs ), "</>" );
    }
    return(1);
}

sub _cleanup_and_exit
{
    my $exit = shift( @_ );
    $exit = 0 if( !length( $exit // '' ) || $exit !~ /^\d+$/ );
    exit( $exit );
}

sub _die
{
    my $msg = join( '', @_ );
    _message( "<red>$msg</>" );
    die( $msg . "\n" );
}

sub _message
{
    my $required_level;
    if( $_[0] =~ /^\d{1,2}$/ )
    {
        $required_level = shift( @_ );
    }
    else
    {
        $required_level = 0;
    }
    return if( !$LOG_LEVEL || $LOG_LEVEL < $required_level );
    my $msg = join( '', map( ref( $_ ) eq 'CODE' ? $_->() : $_, @_ ) );
    if( index( $msg, '</>' ) != -1 )
    {
        $msg =~ s
        {
            <([^\>]+)>(.*?)<\/>
        }
        {
            my $colour = $1;
            my $txt = $2;
            my $obj = color( $txt );